# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.148 2005/02/13 22:52:48 albertel Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### package Apache::lonfeedback; use strict; 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 Apache::lonenc(); 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,$ressymb,$imsextras)=@_; my $outputtarget=$ENV{'form.grade_target'}; if (defined($ENV{'form.export'})) { if($ENV{'form.export'}) { $outputtarget = 'export'; } } if (defined($imsextras)) { if ($$imsextras{'caller'} eq 'imsexport') { $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 ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } unless ($ressymb) { return ''; } $ressymb=&wrap_symb($ressymb); my $encsymb=&Apache::lonenc::check_encrypt($ressymb); my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form)$/)); my %usernamesort = (); my %namesort =(); my %subjectsort = (); # 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'; $ressymb=$encsymb; 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 $statusfilter = $ENV{'form.statusfilter'}; my @sectionpick = (); if ($ENV{'form.sectionpick'} =~ /,/) { @sectionpick = split/,/,$ENV{'form.sectionpick'}; } else { $sectionpick[0] = $ENV{'form.sectionpick'}; } my @rolefilter = (); if ($ENV{'form.rolefilter'} =~ /,/) { @rolefilter = split/,/,$ENV{'form.rolefilter'}; } else { $rolefilter[0] = $ENV{'form.rolefilter'}; } 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 ($ENV{'form.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/:/,$_; if ($role =~ /^cr/) { $role = 'cr'; } my ($end,$start) = split/:/,$roleshash{$_}; my $now = time; my $status = 'Active'; if (($now < $start) || ($end > 0 && $now > $end)) { $status = 'Expired'; } if ($uname && $udom) { 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 @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,$encsymb,$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; if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { $tempexport = $$imsextras{'tempexport'}; if (!-e $tempexport) { mkdir($tempexport,0700); } $tempexport .= '/'.$$imsextras{'count'}; if (!-e $tempexport) { mkdir($tempexport,0700); } } else { $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 { @showposts = (sort { $a <=> $b } keys %alldiscussion); } my $currdepth = 0; my $firstidx = $alldiscussion{$showposts[0]}; foreach (@showposts) { unless (($sortposts eq 'thread') || (($sortposts eq '') && ($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". ''."\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 ($sortposts) { my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types); $discussion .= ''; } } 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'}?
'.&mt('Sorted by').': '.$sort_types{$sortposts}.'
'; if (defined($ENV{'form.totposters'})) { $discussion .= &mt('Posts by').':'; if ($totposters > 0) { foreach my $poster (@posters) { $poster =~ s/:/\@/; $discussion .= ' '.$poster.','; } $discussion =~ s/,$//; } else { $discussion .= &mt('None selected'); } } else { my $filterchoice =''; if (@sectionpick > 0) { $filterchoice = ''.&mt('sections').'- '.$ENV{'form.sectionpick'}; $filterchoice .= '    '; } if (@rolefilter > 0) { $filterchoice .= ''.&mt('roles').'-'; foreach (@rolefilter) { $filterchoice .= ' '.$role_types{$_}.','; } $filterchoice =~ s/,$//; $filterchoice .= '
        '; } if ($statusfilter) { $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter}; } if ($filterchoice) { $discussion .= ''.&mt('Filters').': '.$filterchoice; } $discussion .= '		'. ''."\n". ''."\n". '


END } if ($outputtarget eq 'export') { if ($manifestok) { while ($currdepth > 0) { print $manifestfile " \n"; $currdepth --; } print $manifestfile qq| $imsresources |; close($manifestfile); if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { $discussion = $copyresult; } else { #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 $symb=&Apache::lonenc::check_decrypt($ressymb); my %contrib=&Apache::lonnet::restore($symb,$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; } my ($skiptest,$rolematch,$roleregexp,$secregexp,$statusregexp); if ($sortposts) { ($skiptest,$roleregexp,$secregexp,$statusregexp) = &filter_regexp($rolefilter,$sectionpick,$statusfilter); $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp; } 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 '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 '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; if (defined($ENV{'form.totposters'})) { if ($totposters == 0) { $$shown{$idx} = 0; } elsif ($totposters > 0) { if (grep/^$poster$/,@{$posters}) { $$shown{$idx} = 1; } } } elsif ($sortposts) { if ($skiptest) { $$shown{$idx} = 1; } else { foreach my $role (@{$$roleinfo{$poster}}) { if ($role =~ /^cc:/) { my $cc_regexp = $roleregexp.':[^:]*:'.$statusregexp; if ($role =~ /$cc_regexp/) { $$shown{$idx} = 1; last; } } elsif ($role =~ /^$rolematch$/) { $$shown{$idx} = 1; last; } } } } else { $$shown{$idx} = 1; } } 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 filter_regexp { my ($rolefilter,$sectionpick,$statusfilter) = @_; my ($roleregexp,$secregexp,$statusregexp); my $skiptest = 1; if (@{$rolefilter} > 0) { my @okrolefilter = (); foreach (@{$rolefilter}) { unless ($_ eq '') { push @okrolefilter, $_; } } if (@okrolefilter > 0) { if (grep/^all$/,@okrolefilter) { $roleregexp='[^:]+'; } else { if (@okrolefilter == 1) { $roleregexp=$okrolefilter[0]; } else { $roleregexp='('.join('|',@okrolefilter).')'; } $skiptest = 0; } } } if (@{$sectionpick} > 0) { my @oksectionpick = (); foreach (@{$sectionpick}) { unless ($_ eq '') { push @oksectionpick, $_; } } if ((@oksectionpick > 0) && (!grep/^all$/,@oksectionpick)) { if (@oksectionpick == 1) { $secregexp = $oksectionpick[0]; } else { $secregexp .= '('.join('|',@oksectionpick).')'; } $skiptest = 0; } else { $secregexp .= '[^:]*'; } } if (defined($statusfilter) && $statusfilter ne '') { if ($statusfilter eq 'all') { $statusregexp = '[^:]+'; } else { $statusregexp = $statusfilter; $skiptest = 0; } } return ($skiptest,$roleregexp,$secregexp,$statusregexp); } 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();setposttype();"'); my $title=&Apache::lonnet::gettitle($feedurl); if (!$title) { $title = $feedurl; } my $quote=''; my $subject = ''; my $comment = ''; my $prevtag = ''; my $parentmsg = ''; my ($symb,$idx,$attachmenturls); my $numoldver = 0; my $attachmsg = ''; my $newattachmsg = ''; my @currnewattach = (); my @currdelold = (); my @keepold = (); my %attachments = (); my %currattach = (); my $attachnum = 0; my $anonchk = (< 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 $htmlheader $bodytag

$title

$prevtag END if ($ENV{'form.replydisc'}) { $r->print(< END } elsif ($ENV{'form.editdisc'}) { $r->print(< END } $r->print(< $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(<

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) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; 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) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &Apache::lonenc::check_encrypt(\$symb); my @sections = (); my $section_sel = ''; my $numsections = 0; my $numvisible = 5; my %sectioncount = (); $numsections = &Apache::loncommon::get_sections($ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'},\%sectioncount); if ($ENV{'request.course.sec'} !~ /^\s*$/) { #Restrict section choice to current section @sections = ('all',$ENV{'request.course.sec'}); $numvisible = 2; } 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 .= "