# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.251 2007/10/26 20:51:43 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::lonnet; use Apache::lonhtmlcommon(); use Apache::lonnavmaps; use Apache::lonenc(); use Apache::lonrss(); use HTML::LCParser(); use Apache::lonspeller(); use Apache::longroup; use Cwd; use LONCAPA; sub discussion_open { my ($status,$symb)=@_; if ($env{'request.role.adv'}) { return 1; } 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,$group)=@_; unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } unless ($ressymb) { return ''; } $ressymb=&wrap_symb($ressymb); 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)) { if ($mode ne 'board') { &Apache::lonenc::check_encrypt(\$ressymb); return '
'.&send_message_link($ressymb); } } if ($group ne '' && $mode eq 'board') { if (&check_group_priv($group,'vgb') ne 'ok') { return ''; } } my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); if ($blocked) { &Apache::lonenc::check_encrypt(\$ressymb); if ($mode ne 'board') { $blocktext.='
'.&send_message_link($ressymb); } return $blocktext; } 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; my $encsymb=&Apache::lonenc::check_encrypt($ressymb); my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form|task)$/)); 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_'.$cid.'_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','grouppick','totposters']); my $sortposts = $env{'form.sortposts'}; my $statusfilter = $env{'form.statusfilter'}; my @sectionpick = split(/,/,$env{'form.sectionpick'}); my @grouppick = split(/,/,$env{'form.grouppick'}); my @rolefilter = split(/,/,$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}; } } my $cdom = $env{'course.'.$cid.'.domain'}; my $cnum = $env{'course.'.$cid.'.num'}; # Get information about students and non-students in course for filtering display of posts my %roleshash = (); my %roleinfo = (); my ($classgroups,$studentgroups); if ($env{'form.rolefilter'}) { %roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); foreach my $rolekey (keys(%roleshash)) { my ($role,$uname,$udom,$sec) = split(/:/,$rolekey); if ($role =~ /^cr/) { $role = 'cr'; } my ($end,$start) = split(/:/,$roleshash{$rolekey}); 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,$keylist) = &Apache::loncoursedata::get_classlist($cdom,$cnum); 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); } ($classgroups,$studentgroups) = &Apache::loncoursedata::get_group_memberships($classlist,$keylist, $cdom,$cnum); } # 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; if (($group ne '') && ($mode eq 'board') && ($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { if (&check_group_priv($group,'dgp') eq 'ok') { $seeid = 1; } } else { $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 %anonhash=(); my $anoncnt=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_'.$cid.'_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,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); 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', 'aner' => 'An error occurred opening the manifest file.', 'difo' => 'Discussion for', 'aerr' => 'An error occurred opening the export file for posting', 'aysu' => 'Are you sure you want to delete this post?', 'dpwn' => 'Deleted posts will no longer be visible to you and other students', 'bwco' => 'but will continue to be visible to your instructor', 'depo' => 'Deleted posts will no longer be visible to you or anyone else.', ); 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; } $chglink.=&group_args($group); if ($visible) { # Print the discusssion if ($outputtarget eq 'tex') { $discussion.='{\tiny \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| $lt{'difo'} $ressymb\n|; } else { $discussion .= $lt{'aner'}.'
'; } } else { my $colspan=$maxdepth+1; $discussion.= qq| |; $discussion.='
'; $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp); my $escsymb=&escape($ressymb); 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 my $key (sort(keys(%subjectsort))) { push(@showposts, @{$subjectsort{$key}}); } } elsif ($sortposts eq 'username') { foreach my $domain (sort(keys(%usernamesort))) { foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { push(@showposts, @{$usernamesort{$domain}{$key}}); } } } elsif ($sortposts eq 'lastfirst') { foreach my $last (sort(keys(%namesort))) { foreach my $key (sort(keys(%{$namesort{$last}}))) { push(@showposts, @{$namesort{$last}{$key}}); } } } else { @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } my $currdepth = 0; my $firstidx = $alldiscussion{$showposts[0]}; foreach my $post (@showposts) { unless (($sortposts eq 'thread') || (($sortposts eq '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { $alldiscussion{$post} = $post; } unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { if ($outputtarget ne 'tex' && $outputtarget ne 'export') { $discussion.="\n"; } my $thisdepth=$depth[$alldiscussion{$post}]; if ($outputtarget ne 'tex' && $outputtarget ne 'export') { for (1..$thisdepth) { $discussion.=''; } } my $colspan=$maxdepth-$thisdepth+1; if ($outputtarget eq 'tex') { #cleanup block $discussionitems[$alldiscussion{$post}]=~s/]*)>/
'. ''.&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{$post}]=~s/]*)>]*)>/'; } } } unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { my $colspan=$maxdepth+1; $discussion .= < END $discussion .= &action_links_bar($colspan,$ressymb,$visible, $newpostsflag,$group, $prevread,$markondisp); $discussion .= "
/; my $threadinsert=''; if ($thisdepth > 0) { $threadinsert='
Reply: '.$thisdepth.''; } $discussionitems[$alldiscussion{$post}]=~s/<\/td>]*)>/$threadinsert<\/td>
/; $discussionitems[$alldiscussion{$post}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; $discussionitems[$alldiscussion{$post}]=~s/(|<\/b>|<\/a>|]+)>)//g; $discussionitems[$alldiscussion{$post}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$discussionitems[$alldiscussion{$post}]; $discussion.=$discussionitems[$alldiscussion{$post}]; } elsif ($outputtarget eq 'export') { my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html'; if ($manifestok) { if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) { print $manifestfile ' '."\n"; } $currdepth = $depth[$alldiscussion{$post}]; print $manifestfile "\n". ''. ''.$imsitems{$alldiscussion{$post}}{'title'}.''; $imsresources .= "\n". ''."\n". ''."\n". $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}."\n". ''; } my $postingfile; my $postingfilename = $tempexport.'/'.$postfilename; if ($postingfile = Apache::File->new('>'.$postingfilename)) { print $postingfile 'Discussion Post'. $imsitems{$alldiscussion{$post}}{'title'}.' '. $imsitems{$alldiscussion{$post}}{'sender'}. $imsitems{$alldiscussion{$post}}{'timestamp'}.'

'. $imsitems{$alldiscussion{$post}}{'message'}.'
'. $imsitems{$alldiscussion{$post}}{'attach'}.''."\n"; close($postingfile); } else { $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'
'; } $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); } else { $discussion.='
'. $discussionitems[$alldiscussion{$post}]. '
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('Save 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) { $discussion .= ' '.$poster.','; } $discussion =~ s/,$//; } else { $discussion .= &mt('None selected'); } } else { my $filterchoice =''; if (@sectionpick > 0) { $filterchoice = ''.&mt('sections').'- '.$env{'form.sectionpick'}; $filterchoice .= '    '; } if (@grouppick > 0) { $filterchoice = ''.&mt('groups').'- '.$env{'form.grouppick'}; $filterchoice .= '    '; } if (@rolefilter > 0) { $filterchoice .= ''.&mt('roles').'-'; foreach my $role (@rolefilter) { $filterchoice .= ' '.$role_types{$role}.','; } $filterchoice =~ s/,$//; $filterchoice .= '
        '; } if ($statusfilter) { $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter}; } if ($filterchoice) { $discussion .= ''.&mt('Filters').': '.$filterchoice; } $discussion .= '
'. ''."\n". ''."\n". '


\n"; } 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'; my $cwd = &getcwd(); my $imszip = '/home/httpd/'.$imszipfile; chdir $tempexport; open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); close(OUTPUT); chdir $cwd; $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive','').'
'; if ($copyresult) { $discussion .= &mt('The following errors occurred during export').' -
'.$copyresult; } } } else { $discussion .= '
'.&mt('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 $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 = &unescape($env{'form.subject'}); $comment = &unescape($env{'form.comment'}); my @keepold = (); &process_attachments($currnewattach,$currdelold,\@keepold); if (@{$currnewattach} > 0) { $attachnum += @{$currnewattach}; } } if (&discussion_open($status)) { if (($group ne '') && ($mode eq 'board')) { if (&check_group_priv($group,'pgd') eq 'ok') { $discussion .= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold, $group); } } else { $discussion.= &postingform_display($mode,$ressymb,$now,$subject, $comment,$outputtarget,$attachnum, $currnewattach,$currdelold); } } } else { $discussion.='