--- loncom/interface/lonfeedback.pm 2003/08/06 17:00:30 1.50 +++ loncom/interface/lonfeedback.pm 2004/11/11 22:19:53 1.129 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.50 2003/08/06 17:00:30 albertel Exp $ +# $Id: lonfeedback.pm,v 1.129 2004/11/11 22:19:53 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,24 +25,7 @@ # # http://www.lon-capa.org/ # -# (Internal Server Error Handler -# -# (Login Screen -# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, -# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) -# -# 3/1/1 Gerd Kortemeyer) -# -# 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer -# 2/9 Guy Albertelli -# 2/10 Gerd Kortemeyer -# 2/13 Guy Albertelli -# 7/25 Gerd Kortemeyer -# 7/26 Guy Albertelli -# 7/26,8/10,10/1,11/5,11/6,12/27,12/29 Gerd Kortemeyer -# YEAR=2002 -# 1/1,1/16 Gerd Kortemeyer -# +### package Apache::lonfeedback; @@ -51,18 +34,1302 @@ use Apache::Constants qw(:common); use Apache::lonmsg(); use Apache::loncommon(); use Apache::lontexconvert(); +use Apache::lonlocal; # must not have () +use Apache::lonhtmlcommon(); +use Apache::lonnavmaps; +use HTML::LCParser(); +use Apache::lonspeller(); +use Cwd; + +sub discussion_open { + my ($status,$symb)=@_; + if (defined($status) && + !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' + || $status eq 'OPEN')) { + return 0; + } + my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); + if (defined($close) && $close ne '' && $close < time) { + return 0; + } + return 1; +} + +sub discussion_visible { + my ($status)=@_; + if (not &discussion_open($status)) { + my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); + if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { + if (!$ENV{'request.role.adv'}) { return 0; } + } + } + return 1; +} + +sub list_discussion { + my ($mode,$status,$symb)=@_; + my $outputtarget=$ENV{'form.grade_target'}; + if (defined($ENV{'form.export'})) { + if($ENV{'form.export'}) { + $outputtarget = 'export'; + } + } + if (not &discussion_visible($status)) { return ''; } + my @bgcols = ("#cccccc","#eeeeee"); + my $discussiononly=0; + if ($mode eq 'board') { $discussiononly=1; } + unless ($ENV{'request.course.id'}) { return ''; } + my $crs='/'.$ENV{'request.course.id'}; + my $cid=$ENV{'request.course.id'}; + if ($ENV{'request.course.sec'}) { + $crs.='_'.$ENV{'request.course.sec'}; + } + $crs=~s/\_/\//g; + unless ($symb) { + $symb=&Apache::lonnet::symbread(); + } + unless ($symb) { return ''; } + my %usernamesort = (); + my %namesort =(); + my %subjectsort = (); +# backward compatibility (bulletin boards used to be 'wrapped') + my $ressymb=$symb; + if ($mode eq 'board') { + unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { + $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; + } + } + $ressymb=&Apache::lonenc::check_encrypt($ressymb); +# Get discussion display settings for this discussion + my $lastkey = $ressymb.'_lastread'; + my $showkey = $ressymb.'_showonlyunread'; + my $markkey = $ressymb.'_showonlyunmark', + my $visitkey = $ressymb.'_visit'; + my $ondispkey = $ressymb.'_markondisp'; + my $userpickkey = $ressymb.'_userpick'; + my $toggkey = $ressymb.'_readtoggle'; + my $readkey = $ressymb.'_read'; + + my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$ENV{'user.domain'},$ENV{'user.name'}); + my %discinfo = (); + my $showonlyunread = 0; + my $showunmark = 0; + my $markondisp = 0; + my $prevread = 0; + my $previous = 0; + my $visit = 0; + my $newpostsflag = 0; + my @posters = split/\&/,$dischash{$userpickkey}; + +# Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']); + my $sortposts = $ENV{'form.sortposts'}; + my $rolefilter = $ENV{'form.rolefilter'}; + my $statusfilter = $ENV{'form.statusfilter'}; + my $sectionpick = $ENV{'form.sectionpick'}; + my $totposters = $ENV{'form.totposters'}; + $previous = $ENV{'form.previous'}; + if ($previous > 0) { + $prevread = $previous; + } elsif (defined($dischash{$lastkey})) { + unless ($dischash{$lastkey} eq '') { + $prevread = $dischash{$lastkey}; + } + } + +# Get information about students and non-students in course for filtering display of posts + my %roleshash = (); + my %roleinfo = (); + if ($rolefilter) { + %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + foreach (keys %roleshash) { + my ($role,$uname,$udom,$sec) = split/:/,$_; + my ($end,$start) = split/:/,$roleshash{$_}; + my $now = time; + my $status = 'Active'; + if (($now < $start) || ($end > 0 && $now > $end)) { + $status = 'Expired'; + } + push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status; + } + my ($classlist) = &Apache::loncoursedata::get_classlist( + $ENV{'request.course.id'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + my $sec_index = &Apache::loncoursedata::CL_SECTION(); + my $status_index = &Apache::loncoursedata::CL_STATUS(); + while (my ($student,$data) = each %$classlist) { + my ($section,$status) = ($data->[$sec_index], + $data->[$status_index]); + push @{$roleinfo{$student}}, 'st:'.$section.':'.$status; + } + } + +# Get discussion display default settings for user + if ($ENV{'environment.discdisplay'} eq 'unread') { + $showonlyunread = 1; + } + if ($ENV{'environment.discmarkread'} eq 'ondisp') { + $markondisp = 1; + } + +# Override user's default if user specified display setting for this discussion + if (defined($dischash{$ondispkey})) { + unless ($dischash{$ondispkey} eq '') { + $markondisp = $dischash{$ondispkey}; + } + } + if ($markondisp) { + $discinfo{$lastkey} = time; + } + + if (defined($dischash{$showkey})) { + unless ($dischash{$showkey} eq '') { + $showonlyunread = $dischash{$showkey}; + } + } + + if (defined($dischash{$markkey})) { + unless ($dischash{$markkey} eq '') { + $showunmark = $dischash{$markkey}; + } + } + + if (defined($dischash{$visitkey})) { + unless ($dischash{$visitkey} eq '') { + $visit = $dischash{$visitkey}; + } + } + $visit ++; + + my $seeid=&Apache::lonnet::allowed('rin',$crs); + my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) + && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/)); + my @discussionitems=(); + my %shown = (); + my @posteridentity=(); + + my $current=0; + my $visible=0; + my @depth=(); + my @replies = (); + my %alldiscussion=(); + my %imsitems=(); + my %imsfiles=(); + my %notshown = (); + my %newitem = (); + my $maxdepth=0; + + my $target=''; + unless ($ENV{'browser.interface'} eq 'textual' || + $ENV{'environment.remote'} eq 'off' ) { + $target='target="LONcom"'; + } + + my $now = time; + $discinfo{$visitkey} = $visit; + + &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); + &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget); + + my $discussion=''; + my $manifestfile; + my $manifestok=0; + my $tempexport; + my $imsresources; + my $copyresult; + + my $function = &Apache::loncommon::get_users_function(); + my $color = &Apache::loncommon::designparm($function.'.tabbg', + $ENV{'user.domain'}); + my %lt = &Apache::lonlocal::texthash( + 'cuse' => 'Current discussion settings', + 'allposts' => 'All posts', + 'unread' => 'New posts only', + 'unmark' => 'Unread only', + 'ondisp' => 'Once displayed', + 'onmark' => 'Once marked not NEW', + 'toggoff' => 'Off', + 'toggon' => 'On', + 'disa' => 'Posts to be displayed', + 'npce' => 'Posts cease to be marked "NEW"', + 'epcb' => 'Each post can be toggled read/unread', + 'chgt' => 'Change', + 'disp' => 'Display', + 'nolo' => 'Not new', + 'togg' => 'Toggle read/unread', + ); + + my $currdisp = $lt{'allposts'}; + my $currmark = $lt{'onmark'}; + my $currtogg = $lt{'toggoff'}; + my $dispchange = $lt{'unread'}; + my $markchange = $lt{'ondisp'}; + my $toggchange = $lt{'toggon'}; + my $chglink = '/adm/feedback?modifydisp='.$ressymb; + my $displinkA = 'onlyunread'; + my $displinkB = 'onlyunmark'; + my $marklink = 'markondisp'; + my $togglink = 'toggon'; + + if ($markondisp) { + $currmark = $lt{'ondisp'}; + $markchange = $lt{'onmark'}; + $marklink = 'markonread'; + } + + if ($showonlyunread) { + $currdisp = $lt{'unread'}; + $dispchange = $lt{'allposts'}; + $displinkA = 'allposts'; + } + + if ($showunmark) { + $currdisp = $lt{'unmark'}; + $dispchange = $lt{'unmark'}; + $displinkA='allposts'; + $displinkB='onlyunread'; + $showonlyunread = 0; + } + + if ($dischash{$toggkey}) { + $currtogg = $lt{'toggon'}; + $toggchange = $lt{'toggoff'}; + $togglink = 'toggoff'; + } + + $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; + + if ($newpostsflag) { + $chglink .= '&previous='.$prevread; + } + + if ($visible) { +# Print the discusssion + if ($outputtarget eq 'tex') { + $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. + '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. + '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. + '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. + '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}'; + } elsif ($outputtarget eq 'export') { +# Create temporary directory if this is an export + my $now = time; + $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$now; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$ENV{'user.domain'}.'_'.$ENV{'user.name'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } +# open manifest file + my $manifest = '/imsmanifest.xml'; + my $manifestfilename = $tempexport.$manifest; + if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { + $manifestok=1; + print $manifestfile qq| + + + + + Discussion for $ressymb\n|; + } else { + $discussion .= 'An error occurred opening the manifest file.
'; + } + } else { + my $colspan=$maxdepth+1; + $discussion.= qq| + + |; + $discussion.='
'; + $discussion .=''; + + my $numhidden = keys %notshown; + if ($numhidden > 0) { + my $colspan = $maxdepth+1; + $discussion.="\n".''; + } + } + +# Choose sort mechanism + my @showposts = (); + if ($sortposts eq 'descdate') { + @showposts = (sort { $b <=> $a } keys %alldiscussion); + } elsif ($sortposts eq 'thread') { + @showposts = (sort { $a <=> $b } keys %alldiscussion); + } elsif ($sortposts eq 'subject') { + foreach (sort keys %subjectsort) { + push @showposts, @{$subjectsort{$_}}; + } + } elsif ($sortposts eq 'username') { + foreach my $domain (sort keys %usernamesort) { + foreach (sort keys %{$usernamesort{$domain}}) { + push @showposts, @{$usernamesort{$domain}{$_}}; + } + } + } elsif ($sortposts eq 'lastfirst') { + foreach my $last (sort keys %namesort) { + foreach (sort keys %{$namesort{$last}}) { + push @showposts, @{$namesort{$last}{$_}}; + } + } + } else { + $sortposts = 'ascdate'; + @showposts = (sort { $a <=> $b } keys %alldiscussion); + } + my $currdepth = 0; + my $firstidx = $alldiscussion{$showposts[0]}; + foreach (@showposts) { + unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'}) || ($outputtarget eq 'export')) { + $alldiscussion{$_} = $_; + } + unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) { + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + $discussion.="\n"; + } + my $thisdepth=$depth[$alldiscussion{$_}]; + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + for (1..$thisdepth) { + $discussion.=''; + } + } + my $colspan=$maxdepth-$thisdepth+1; + if ($outputtarget eq 'tex') { + #cleanup block + $discussionitems[$alldiscussion{$_}]=~s/]*)>/
'. + ''; + if ($visible>2) { + $discussion.=''; + if ($newpostsflag) { + if (!$markondisp) { + $discussion .=''; + } + } else { + $discussion .= ''; + } + $discussion .= '
'. + ''.&mt('Threaded View').'  '. + ''.&mt('Chronological View').'   + '.&mt('Sorting/Filtering options').'  '; + } else { + $discussion .= ''; + } + $discussion .=''.&mt('Export').'?  '.&mt('Mark NEW posts no longer new').'  '; + } else { + $discussion .= '  
'. + ''.&mt('Show all posts').' '.&mt('to display').' '. + $numhidden.' '; + if ($showunmark) { + $discussion .= &mt('posts previously marked read'); + } else { + $discussion .= &mt('previously viewed posts'); + } + $discussion .= '
   
/; + $discussionitems[$alldiscussion{$_}]=~s/]*)>]*)>/'; + } + } + } + unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { + my $colspan=$maxdepth+1; + $discussion .= < + + +
/; + my $threadinsert=''; + if ($thisdepth > 0) { + $threadinsert='
Reply: '.$thisdepth.''; + } + $discussionitems[$alldiscussion{$_}]=~s/<\/td>]*)>/$threadinsert<\/td>		/; + $discussionitems[$alldiscussion{$_}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; + $discussionitems[$alldiscussion{$_}]=~s/(|<\/b>|<\/a>|]+)>)//g; + + $discussionitems[$alldiscussion{$_}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$discussionitems[$alldiscussion{$_}]; + $discussion.=$discussionitems[$alldiscussion{$_}]; + } elsif ($outputtarget eq 'export') { + my $postfilename = $alldiscussion{$_}.'-'.$imsitems{$alldiscussion{$_}}{'timestamp'}.'.html'; + if ($manifestok) { + if (($depth[$alldiscussion{$_}] <= $currdepth) && ($alldiscussion{$_} != $firstidx)) { + print $manifestfile ' '."\n"; + } + $currdepth = $depth[$alldiscussion{$_}]; + print $manifestfile "\n". + ''. + ''.$imsitems{$alldiscussion{$_}}{'title'}.''; + $imsresources .= "\n". + ''. + ''."\n". + $imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n". + ''; + } + my $postingfile; + my $postingfilename = $tempexport.'/'.$postfilename; + if ($postingfile = Apache::File->new('>'.$postingfilename)) { + print $postingfile 'Discussion Post'. + $imsitems{$alldiscussion{$_}}{'title'}.' '. + $imsitems{$alldiscussion{$_}}{'sender'}. + $imsitems{$alldiscussion{$_}}{'timestamp'}.'

'. + $imsitems{$alldiscussion{$_}}{'message'}.'
'. + $imsitems{$alldiscussion{$_}}{'attach'}.''."\n"; + close($postingfile); + } else { + $discussion .= 'An error occurred opening the export file for posting '.$alldiscussion{$_}.'
'; + } + $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$_}}{'allattachments'},$tempexport); + } else { + $discussion.='		'. $discussionitems[$alldiscussion{$_}]. + '
+ + + +END + if ($dischash{$toggkey}) { + my $storebutton = &mt('Store read/unread changes'); + $discussion.=''; + } + $discussion .= (< +
+ + + + + + + + +
+ $lt{'cuse'}:  +END + if ($newpostsflag) { + $discussion .= + '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''; + if ($dischash{$toggkey}) { + $discussion .= '  3. '.$lt{'togg'}.' - '.$currtogg.''; + } + } else { + if ($dischash{$toggkey}) { + $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.' 2. '.$lt{'togg'}.' - '.$currtogg.''; + } else { + $discussion .= + $lt{'disp'}.' - '.$currdisp.''; + } + } + $discussion .= <  + $lt{'chgt'}? +
+ 		'. + ''."\n". + ''."\n". + '
+
+

+END + } + if ($outputtarget eq 'export') { + if ($manifestok) { + while ($currdepth > 0) { + print $manifestfile " \n"; + $currdepth --; + } + print $manifestfile qq| + + + + $imsresources + + + |; + close($manifestfile); + +#Create zip file in prtspool + + my $imszipfile = '/prtspool/'. + $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.zip'; + # zip can cause an sh launch which can pass along all of %ENV + # which can be too large for /bin/sh to handle + my %oldENV=%ENV; + undef(%ENV); + my $cwd = &getcwd(); + my $imszip = '/home/httpd/'.$imszipfile; + chdir $tempexport; + open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); + close(OUTPUT); + chdir $cwd; + %ENV=%oldENV; + undef(%oldENV); + $discussion .= 'Download the zip file from Discussion Posting Archive
'; + if ($copyresult) { + $discussion .= 'The following errors occurred during export -
'.$copyresult; + } + } else { + $discussion .= '
Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.
'; + } + return $discussion; + } + } + if ($discussiononly) { + my $now = time; + my $attachnum = 0; + my $newattachmsg = ''; + my @currnewattach = (); + my @currdelold = (); + my $comment = ''; + my $subject = ''; + if ($ENV{'form.origpage'}) { + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']); + $subject = &Apache::lonnet::unescape($ENV{'form.subject'}); + $comment = &Apache::lonnet::unescape($ENV{'form.comment'}); + my @keepold = (); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + if (@currnewattach > 0) { + $attachnum += @currnewattach; + } + } + if (&discussion_open($status)) { + $discussion.=(< + + + + + +
+Note: in anonymous discussion, your name is visible only +to course faculty
+Title: 

+ +ENDDISCUSS + if ($ENV{'form.origpage'}) { + $discussion.=''."\n"; + foreach (@currnewattach) { + $discussion.=''."\n"; + } + } + $discussion.="\n"; + if ($outputtarget ne 'tex') { + $discussion.=&generate_attachments_button('',$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,'',$mode); + if (@currnewattach > 0) { + $newattachmsg .= 'New attachments
'; + if (@currnewattach > 1) { + $newattachmsg .= '
    '; + foreach my $item (@currnewattach) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + $discussion.=$newattachmsg; + $discussion.=&generate_preview_button(); + } + } + } else { + if (&discussion_open($status) && + &Apache::lonnet::allowed('pch', + $ENV{'request.course.id'}. + ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + if ($outputtarget ne 'tex') { + $discussion.='
'. + ''. + &mt('Post Discussion').'
'; + } + } + } + return $discussion; +} + +sub build_posting_display { + my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget) = @_; + + my @original=(); + my @index=(); + + my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + if ($contrib{'version'}) { + my $oldest = $contrib{'1:timestamp'}; + if ($prevread eq '0') { + $prevread = $oldest-1; + } + for (my $id=1;$id<=$contrib{'version'};$id++) { + my $idx=$id; + my $posttime = $contrib{$idx.':timestamp'}; + if ($prevread <= $posttime) { + $$newpostsflag = 1; + } + my $hidden=($contrib{'hidden'}=~/\.$idx\./); + my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); + my $deleted=($contrib{'deleted'}=~/\.$idx\./); + my $origindex='0.'; + my $numoldver=0; + if ($contrib{$idx.':replyto'}) { + if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { +# this is a follow-up message + $original[$idx]=$original[$contrib{$idx.':replyto'}]; + $$depth[$idx]=$$depth[$contrib{$idx.':replyto'}]+1; + $origindex=$index[$contrib{$idx.':replyto'}]; + if ($$depth[$idx]>$$maxdepth) { $$maxdepth=$$depth[$idx]; } + } else { + $original[$idx]=0; + $$depth[$idx]=0; + } + } else { +# this is an original message + $original[$idx]=0; + $$depth[$idx]=0; + } + if ($$replies[$$depth[$idx]]) { + $$replies[$$depth[$idx]]++; + } else { + $$replies[$$depth[$idx]]=1; + } + unless ((($hidden) && (!$seeid)) || ($deleted)) { + $$visible++; + if ($contrib{$idx.':history'}) { + if ($contrib{$idx.':history'} =~ /:/) { + my @oldversions = split/:/,$contrib{$idx.':history'}; + $numoldver = @oldversions; + } else { + $numoldver = 1; + } + } + $$current = $numoldver; + my %messages = (); + my %subjects = (); + my %attachtxt = (); + my %allattachments = (); + my ($screenname,$plainname); + my $sender = &mt('Anonymous'); + my ($message,$subject,$vgrlink,$ctlink); + &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver); + + +# Set up for sorting by subject + unless ($outputtarget eq 'export') { + $message=$messages{$numoldver}; + $message.=$attachtxt{$numoldver}; + $subject=$subjects{$numoldver}; + if ($message) { + if ($hidden) { + $message=''.$message.''; + if ($studenthidden) { + $message .='

Deleted by poster (student).'; + } + } + + if ($subject eq '') { + if (defined($$subjectsort{'__No subject'})) { + push @{$$subjectsort{'__No subject'}}, $idx; + } else { + @{$$subjectsort{'__No subject'}} = ("$idx"); + } + } else { + if (defined($$subjectsort{$subject})) { + push @{$$subjectsort{$subject}}, $idx; + } else { + @{$$subjectsort{$subject}} = ("$idx"); + } + } + if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { + $sender=&Apache::loncommon::aboutmewrapper( + $plainname, + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}).' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + if ($contrib{$idx.':anonymous'}) { + $sender.=' ['.&mt('anonymous').'] '. + $screenname; + } + +# Set up for sorting by domain, then username + unless (defined($$usernamesort{$contrib{$idx.':senderdomain'}})) { + %{$$usernamesort{$contrib{$idx.':senderdomain'}}} = (); + } + if (defined($$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) { + push @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx; + } else { + @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); + } +# Set up for sorting by last name, then first name + my %names = &Apache::lonnet::get('environment', + ['firstname','lastname'],$contrib{$idx.':senderdomain'}, + ,$contrib{$idx.':sendername'}); + my $lastname = $names{'lastname'}; + my $firstname = $names{'firstname'}; + if ($lastname eq '') { + $lastname = '_'; + } + if ($firstname eq '') { + $firstname = '_'; + } + unless (defined($$namesort{$lastname})) { + %{$$namesort{$lastname}} = (); + } + if (defined($$namesort{$lastname}{$firstname})) { + push @{$$namesort{$lastname}{$firstname}}, $idx; + } else { + @{$$namesort{$lastname}{$firstname}} = ("$idx"); + } + if ($ENV{'course.'.$ENV{'request.course.id'}.'.allow_discussion_post_editing'} =~ m/yes/i) { + if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) { + $sender.=' '.&mt('Edit').''; + unless ($seeid) { + $sender.=" '; + } + } + } + if ($seeid) { + if ($hidden) { + unless ($studenthidden) { + $sender.=' '.&mt('Make Visible').''; + } + } else { + $sender.=' '.&mt('Hide').''; + } + $sender.=' '.&mt('Delete').''; + } + } else { + if ($screenname) { + $sender=''.$screenname.''; + } +# Set up for sorting by domain, then username for anonymous + unless (defined($$usernamesort{'__anon'})) { + %{$$usernamesort{'__anon'}} = (); + } + if (defined($$usernamesort{'__anon'}{'__anon'})) { + push @{$$usernamesort{'__anon'}{'__anon'}}, $idx; + } else { + @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx"); + } +# Set up for sorting by last name, then first name for anonymous + unless (defined($$namesort{'__anon'})) { + %{$$namesort{'__anon'}} = (); + } + if (defined($$namesort{'__anon'}{'__anon'})) { + push @{$$namesort{'__anon'}{'__anon'}}, $idx; + } else { + @{$$namesort{'__anon'}{'__anon'}} = ("$idx"); + } + } + if (&discussion_open($status) && + &Apache::lonnet::allowed('pch', + $ENV{'request.course.id'}. + ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + $sender.=' '.&mt('Reply').''; + } + if ($viewgrades) { + $vgrlink=&Apache::loncommon::submlink('Submissions', + $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); + } + if ($$dischash{$readkey}=~/\.$idx\./) { + $ctlink = ''.&mt('Mark unread').'? '; + } else { + $ctlink = ''.&mt('Mark read').'? '; + } + } +#figure out at what position this needs to print + } + if ($outputtarget eq 'export' || $message) { + my $thisindex=$idx; + if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) { + $thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2); + } + $$alldiscussion{$thisindex}=$idx; + $$shown{$idx} = 0; + $index[$idx]=$thisindex; + } + if ($outputtarget eq 'export') { + %{$$imsitems{$idx}} = (); + $$imsitems{$idx}{'isvisible'}='true'; + if ($hidden) { + $$imsitems{$idx}{'isvisible'}='false'; + } + $$imsitems{$idx}{'title'}=$subjects{$numoldver}; + $$imsitems{$idx}{'message'}=$messages{$numoldver}; + $$imsitems{$idx}{'attach'}=$attachtxt{$numoldver}; + $$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'}; + $$imsitems{$idx}{'sender'}=$plainname.' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + $$imsitems{$idx}{'isanonymous'}='false'; + if ($contrib{$idx.':anonymous'}) { + $$imsitems{$idx}{'isanonymous'}='true'; + } + $$imsitems{$idx}{'currversion'}=$numoldver; + %{$$imsitems{$idx}{'allattachments'}}=%allattachments; + unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') { + $$shown{$idx} = 1; + } + } else { + if ($message) { + my $spansize = 2; + if ($showonlyunread && $prevread > $posttime) { + $$notshown{$idx} = 1; + } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) { + $$notshown{$idx} = 1; + } else { +# apply filters + my $uname = $contrib{$idx.':sendername'}; + my $udom = $contrib{$idx.':senderdomain'}; + my $poster = $uname.':'.$udom; + my $rolematch = ''; + my $skiptest = 1; + if ($totposters > 0) { + if (grep/^$poster$/,@{$posters}) { + $$shown{$idx} = 1; + } + } else { + if ($rolefilter) { + if ($rolefilter eq 'all') { + $rolematch = '([^:]+)'; + } else { + $rolematch = $rolefilter; + $skiptest = 0; + } + } + if ($sectionpick) { + if ($sectionpick eq 'all') { + $rolematch .= ':([^:]*)'; + } else { + $rolematch .= ':'.$sectionpick; + $skiptest = 0; + } + } + if ($statusfilter) { + if ($statusfilter eq 'all') { + $rolematch .= ':([^:]+)'; + } else { + $rolematch .= ':'.$statusfilter; + $skiptest = 0; + } + } + if ($skiptest) { + $$shown{$idx} = 1; + } else { + foreach my $role (@{$$roleinfo{$poster}}) { + if ($role =~ m/^$rolematch$/) { + $$shown{$idx} = 1; + last; + } + } + } + } + } + unless ($$notshown{$idx} == 1) { + if ($prevread > 0 && $prevread <= $posttime) { + $$newitem{$idx} = 1; + $$discussionitems[$idx] .= ' +

+ '; + } else { + $$newitem{$idx} = 0; + $$discussionitems[$idx] .= ' +

NEW
+ '; + } + $$discussionitems[$idx] .= ''; + if ($$dischash{$toggkey}) { + $$discussionitems[$idx].=''; + } + $$discussionitems[$idx].= '
   '. + ''.$subject.'  '. + $sender.' '.$vgrlink.' ('. + &Apache::lonlocal::locallocaltime($posttime).')  '. + $ctlink.'

'. + $message.'

'; + if ($contrib{$idx.':history'}) { + my @postversions = (); + $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); + if ($seeid) { + $$discussionitems[$idx] .= '  '.&mt('Display all versions').''; + } + $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); + if ($contrib{$idx.':history'} =~ m/:/) { + @postversions = split/:/,$contrib{$idx.':history'}; + } else { + @postversions = ("$contrib{$idx.':history'}"); + } + for (my $i=0; $i<@postversions; $i++) { + my $version = $i+1; + $$discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; + } + } + } + } + } + } + } + } +} + +sub get_post_contents { + my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_; + my $discussion = ''; + my $start=$numver; + my $end=$numver + 1; + %{$$imsfiles{$idx}}=(); + if ($type eq 'allversions') { + unless($seeid) { + $discussion=&mt('You do not have privileges to view all versions of posts.').&mt('Please select a different role'); + return $discussion; + } + } +# $$screenname=&Apache::loncommon::screenname( +# $$contrib{$idx.':sendername'}, +# $$contrib{$idx.':senderdomain'}); +# $$plainname=&Apache::loncommon::nickname( +# $$contrib{$idx.':sendername'}, +# $$contrib{$idx.':senderdomain'}); + ($$screenname,$$plainname)=($$contrib{$idx.':screenname'}, + $$contrib{$idx.':plainname'}); + my $sender=&Apache::loncommon::aboutmewrapper( + $$plainname, + $$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}).' ('. + $$contrib{$idx.':sendername'}.' at '. + $$contrib{$idx.':senderdomain'}.')'; + my $attachmenturls = $$contrib{$idx.':attachmenturl'}; + my @postversions = (); + if ($type eq 'allversions' || $type eq 'export') { + $start = 0; + if ($$contrib{$idx.':history'}) { + if ($$contrib{$idx.':history'} =~ m/:/) { + @postversions = split/:/,$$contrib{$idx.':history'}; + } else { + @postversions = ("$$contrib{$idx.':history'}"); + } + } + &get_post_versions($messages,$$contrib{$idx.':message'},1); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1); + push @postversions,$$contrib{$idx.':timestamp'}; + $end = @postversions; + } else { + &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); + } + + if ($$contrib{$idx.':anonymous'}) { + $sender.=' ['.&mt('anonymous').'] '.$$screenname; + } + if ($type eq 'allversions') { + $discussion=(''.$sender.'
'); + return $discussion; + } else { + return; + } +} + +sub replicate_attachments { + my ($attachrefs,$tempexport) = @_; + my $response; + foreach my $id (keys %{$attachrefs}) { + if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { + my $path = $tempexport; + my $tail = $1.'/'.$2.$4; + my @extras = split/\//,$tail; + my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5; + if (!-e $destination) { + my $i= 0; + while ($i<@extras) { + $path .= '/'.$extras[$i]; + if (!-e $path) { + mkdir($path,0700); + } + $i ++; + } + my ($content,$rtncode); + my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode); + if ($uploadreply eq 'ok') { + my $attachcopy; + if ($attachcopy = Apache::File->new('>'.$destination)) { + print $attachcopy $content; + close($attachcopy); + } else { + $response .= 'Error copying file attachment - '.$5.' to IMS package: '.$!.'
'."\n"; + } + } else { + &Apache::lonnet::logthis("Replication of attachment failed when building IMS export of discussion posts - domain: $1, course: $2, file: $$attachrefs{$id}{'filename'} -error: $rtncode"); + $response .= 'Error copying file attachment - '.$5.' to IMS package: '.$rtncode.'
'."\n"; + } + } + } + } + return $response; +} sub mail_screen { my ($r,$feedurl,$options) = @_; + if (exists($ENV{'form.origpage'})) { + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss']); + } my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', - '','onLoad="window.focus();"'); - my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); - $r->print(< 0) { + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $message = $msgversions{$numoldver}; + } + $message=~s/\n/\
/g; + $quote='
'.&Apache::lontexconvert::msgtexconverted($message).'
'; + if ($idx > 0) { + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); + $subject = 'Re: '.$subversions{$numoldver}; + } + $subject = &HTML::Entities::encode($subject,'<>&"'); + } else { + $attachmenturls = $contrib{$idx.':attachmenturl'}; + if ($idx > 0) { + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $comment = $msgversions{$numoldver}; + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},0,$numoldver); + $subject = $subversions{$numoldver}; + } + if (defined($contrib{$idx.':replyto'})) { + $parentmsg = $contrib{$idx.':replyto'}; + } + unless (exists($ENV{'form.origpage'})) { + my $anonflag = 0; + if ($contrib{$idx.':anonymous'}) { + $anonflag = 1; + } + $anonscript = (<'; + } + } + + if ($ENV{'form.origpage'}) { + $subject = &Apache::lonnet::unescape($ENV{'form.subject'}); + $comment = &Apache::lonnet::unescape($ENV{'form.comment'}); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + } + my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); + my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders(); + my $send=&mt('Send'); + $r->print(< The LearningOnline Network with CAPA - $bodytag -

$feedurl

+

$title

- +$prevtag + +END + if ($ENV{'form.replydisc'}) { + $r->print(< +END + } elsif ($ENV{'form.editdisc'}) { + $r->print(< + +END + } + $r->print(< -My question/comment/feedback:

+$options

+$quote +

My question/comment/feedback:

+

$latexHelp -

+Title:

+

+

+

+END + if ( ($ENV{'form.editdisc'}) || ($ENV{'form.replydisc'}) ) { + if ($ENV{'form.origpage'}) { + foreach (@currnewattach) { + $r->print(''."\n"); + } + foreach (@currdelold) { + $r->print(''."\n"); + } + } + if ($ENV{'form.editdisc'}) { + if ($attachmenturls) { + &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold); + $attachnum = scalar(keys %currattach); + foreach (keys %currattach) { + $r->print(''."\n"); + } + } + } + } else { + $r->print(<

+END + } + $r->print(< - +

-ENDDOCUMENT -$r->print(&generate_preview_button().''); +END + if ($ENV{'form.editdisc'} || $ENV{'form.replydisc'}) { + my $now = time; + my $ressymb = $symb; + my $postidx = ''; + if ($ENV{'form.editdisc'}) { + $postidx = $idx; + } + if (@currnewattach > 0) { + $attachnum += @currnewattach; + } + $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver)); + if ($attachnum > 0) { + if (@currnewattach > 0) { + $newattachmsg .= 'New attachments
'; + if (@currnewattach > 1) { + $newattachmsg .= '
    '; + foreach my $item (@currnewattach) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + if ($attachmsg) { + $r->print("Retained attachments:$attachmsg
\n"); + } + if ($newattachmsg) { + $r->print("$newattachmsg
"); + } + } + } + $r->print(&generate_preview_button(). + &Apache::lonhtmlcommon::htmlareaselectactive('comment'). + ''); +} + +sub print_display_options { + my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_; + # backward compatibility (bulletin boards used to be 'wrapped') + if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { + $feedurl=~s|^/adm/wrapper||; + } + + my $function = &Apache::loncommon::get_users_function(); + my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', + $ENV{'user.domain'}); + my $bodytag=&Apache::loncommon::bodytag('Discussion options', + '',''); + + my %lt = &Apache::lonlocal::texthash( + 'dido' => 'Discussion display options', + 'pref' => 'Display Preference', + 'curr' => 'Current setting ', + 'actn' => 'Action', + 'deff' => 'Default for all discussions', + 'prca' => 'Preferences can be set for this discussion that determine ....', + 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and', + 'unwh' => 'Under what circumstances posts are identified as "NEW", and', + 'wipa' => 'Whether individual posts can be marked as read/unread', + 'allposts' => 'All posts', + 'unread' => 'New posts only', + 'unmark' => 'Posts not marked read', + 'ondisp' => 'Once displayed', + 'onmark' => 'Once marked not NEW ', + 'toggon' => 'Shown', + 'toggoff' => 'Not shown', + 'disa' => 'Posts displayed?', + 'npmr' => 'New posts cease to be identified as "NEW"?', + 'dotm' => 'Option to mark each post as read/unread?', + 'chgt' => 'Change to ', + 'mkdf' => 'Set to ', + 'yhni' => 'You have not indicated that you wish to change any of the discussion settings', + 'ywbr' => 'You will be returned to the previous page if you click OK.' + ); + + my $dispchangeA = $lt{'unread'}; + my $dispchangeB = $lt{'unmark'}; + my $markchange = $lt{'ondisp'}; + my $toggchange = $lt{'toggon'}; + my $currdisp = $lt{'allposts'}; + my $currmark = $lt{'onmark'}; + my $discdisp = 'allposts'; + my $discmark = 'onmark'; + my $currtogg = $lt{'toggoff'}; + my $disctogg = 'toggoff'; + + if ($dispchgA eq 'allposts') { + $dispchangeA = $lt{'allposts'}; + $currdisp = $lt{'unread'}; + $discdisp = 'unread'; + } + + if ($markchg eq 'markonread') { + $markchange = $lt{'onmark'}; + $currmark = $lt{'ondisp'}; + $discmark = 'ondisp'; + } + + if ($dispchgB eq 'onlyunread') { + $dispchangeB = $lt{'unread'}; + $currdisp = $lt{'unmark'}; + $discdisp = 'unmark'; + } + if ($toggchg eq 'toggoff') { + $toggchange = $lt{'toggoff'}; + $currtogg = $lt{'toggon'}; + $disctogg = 'toggon'; + } + $r->print(< + +$lt{'dido'} + + + +$bodytag +
+$lt{'sdpf'}
$lt{'prca'}
  1. $lt{'whpo'}
  2. $lt{'unwh'}
  3. $lt{'wipa'}
+
+ + + + +
+ + + + +
+ + + + + + + + + + + + + + + + + + + +
$lt{'pref'}$lt{'curr'}$lt{'actn'}?
$lt{'disa'}$lt{$discdisp} $lt{'chgt'} "$dispchangeA" +
+  $lt{'chgt'} "$dispchangeB" +
$lt{'npmr'}$lt{$discmark}$lt{'chgt'} "$markchange"
$lt{'dotm'}$lt{$disctogg}$lt{'chgt'} "$toggchange"
+
+
+
+
+ + + + + + +
+
+
+ + +END + return; +} + +sub print_sortfilter_options { + my ($r,$symb,$previous,$feedurl) = @_; + # backward compatibility (bulletin boards used to be 'wrapped') + if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { + $feedurl=~s|^/adm/wrapper||; + } + my @sections = (); + my $section_sel = ''; + my $numsections = 0; + my $numvisible = 5; + my ($classlist) = &Apache::loncoursedata::get_classlist( + $ENV{'request.course.id'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, + $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + + my $sec_index = &Apache::loncoursedata::CL_SECTION(); + my $status_index = &Apache::loncoursedata::CL_STATUS(); + my %sectioncount = (); + while (my ($student,$data) = each %$classlist) { + my ($section,$status) = ($data->[$sec_index], + $data->[$status_index]); + unless ($section eq '' || $section =~ /^\s*$/) { + if (!defined($sectioncount{$section})) { + $sectioncount{$section} = 1; + $numsections ++; + } else { + $sectioncount{$section} ++; + } + } + } + + if ($ENV{'request.course.sec'} !~ /^\s*$/) { + @sections = ($ENV{'request.course.sec'}); + $numvisible = 1; + } else { + @sections = sort {$a cmp $b} keys(%sectioncount); + unshift(@sections,'all'); # Put 'all' at the front of the list + if ($numsections < 4) { + $numvisible = $numsections + 1; + } + } + foreach (@sections) { + $section_sel .= "