loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.168: download - view: text, annotated - select for diffs
Tue Sep 20 07:52:03 2005 UTC (18 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: version_2_0_X, version_2_0_2, HEAD

- bringing tasks more generally into Lon-CAPA

# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.168 2005/09/20 07:52:03 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 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|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_'.$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.='<tex>{\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.'}}</tex>'; } 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| <?xml version="1.0" encoding="UTF-8"?> <manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1 imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd"> <organizations default="$ressymb"> <organization identifier="$ressymb"> <title>Discussion for $ressymb</title>\n|; } else { $discussion .= 'An error occurred opening the manifest file.<br />'; } } else { my $colspan=$maxdepth+1; $discussion.= qq| <script> function studentdelete (symb,idx,newflag,previous) { var symbparm = symb+':::'+idx var prevparm = "" if (newflag == 1) { prevparm = "&previous="+previous } if (confirm("Are you sure you want to delete this post?\\nDeleted posts will no longer be visible to you and other students,\\nbut will continue to be visible to your instructor")) { document.location.href = "/adm/feedback?hide="+symbparm+prevparm } } </script> |; $discussion.='<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$ressymb.'" ><table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">'; $discussion .='<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'. '<table border="0" width="100%" bgcolor="#DDDDBB"><tr>'; if ($visible>2) { $discussion.='<td align="left">'. '<a href="/adm/feedback?cmd=threadedon&symb='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Threaded View').'</a>  '. '<a href="/adm/feedback?cmd=threadedoff&symb='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Chronological View').'</a>   <a href= "/adm/feedback?cmd=sortfilter&symb='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Sorting/Filtering options').'</a> &nbsp'; } else { $discussion .= '<td align="left">'; } $discussion .='<a href= "/adm/feedback?export='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= '">'.&mt('Export').'?</a>  </td>'; if ($newpostsflag) { if (!$markondisp) { $discussion .='<td align="right"><a href="/adm/feedback?markread=1&symb='.$ressymb.'">'.&mt('Mark NEW posts no longer new').'</a>  '; } else { $discussion .= '<td> </td>'; } } else { $discussion .= '<td> </td>'; } $discussion .= '</tr></table></td></tr>'; my $numhidden = keys %notshown; if ($numhidden > 0) { my $colspan = $maxdepth+1; $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'. '<a href="/adm/feedback?allposts=1&symb='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '. $numhidden.' '; if ($showunmark) { $discussion .= &mt('posts previously marked read'); } else { $discussion .= &mt('previously viewed posts'); } $discussion .= '<br/></td></tr>'; } } # 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<tr>"; } my $thisdepth=$depth[$alldiscussion{$_}]; if ($outputtarget ne 'tex' && $outputtarget ne 'export') { for (1..$thisdepth) { $discussion.='<td>   </td>'; } } my $colspan=$maxdepth-$thisdepth+1; if ($outputtarget eq 'tex') { #cleanup block $discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/; $discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/; my $threadinsert=''; if ($thisdepth > 0) { $threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>'; } $discussionitems[$alldiscussion{$_}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/; $discussionitems[$alldiscussion{$_}]=~s/<a([^>]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; $discussionitems[$alldiscussion{$_}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g; $discussionitems[$alldiscussion{$_}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$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 ' </item>'."\n"; } $currdepth = $depth[$alldiscussion{$_}]; print $manifestfile "\n". '<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$_}.'" isvisible="'. $imsitems{$alldiscussion{$_}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$_}.'">'. '<title>'.$imsitems{$alldiscussion{$_}}{'title'}.'</title>'; $imsresources .= "\n". '<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$_}.'" type="webcontent" href="'.$postfilename.'">'."\n". '<file href="'.$postfilename.'">'."\n". $imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n". '</resource>'; } my $postingfile; my $postingfilename = $tempexport.'/'.$postfilename; if ($postingfile = Apache::File->new('>'.$postingfilename)) { print $postingfile '<html><head><title>Discussion Post</title></head><body>'. $imsitems{$alldiscussion{$_}}{'title'}.' '. $imsitems{$alldiscussion{$_}}{'sender'}. $imsitems{$alldiscussion{$_}}{'timestamp'}.'<br /><br />'. $imsitems{$alldiscussion{$_}}{'message'}.'<br />'. $imsitems{$alldiscussion{$_}}{'attach'}.'</body></html>'."\n"; close($postingfile); } else { $discussion .= 'An error occurred opening the export file for posting '.$alldiscussion{$_}.'<br />'; } $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$_}}{'allattachments'},$tempexport); } else { $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}]. '" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$_}]. '</td></tr>'; } } } unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { my $colspan=$maxdepth+1; $discussion .= <<END; <tr bgcolor="#FFFFFF"> <td colspan="$colspan" valign="top"> <table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2"> <tr> <td align="left"> <table border="0" cellpadding="0" cellspacing="4"> <tr> <td> <font size="-1"><b>$lt{'cuse'}</b>:</td> <td> </td> <td><font size="-1"> END if ($newpostsflag) { $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i>  2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i>'; if ($dischash{$toggkey}) { $discussion .= '  3. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; } } else { if ($dischash{$toggkey}) { $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; } else { $discussion .= $lt{'disp'}.' - <i>'.$currdisp.'</i>'; } } $discussion .= <<END; </font></td> <td> </td> <td align="left"> <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b> </td> </tr> </table> </td> END if ($sortposts) { my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types); $discussion .= '<td><font size="-1"><b>'.&mt('Sorted by').'</b>: '.$sort_types{$sortposts}.'<br />'; 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 = '<i>'.&mt('sections').'</i>- '.$env{'form.sectionpick'}; $filterchoice .= '    '; } if (@rolefilter > 0) { $filterchoice .= '<i>'.&mt('roles').'</i>-'; foreach (@rolefilter) { $filterchoice .= ' '.$role_types{$_}.','; } $filterchoice =~ s/,$//; $filterchoice .= '<br /> &nbsp    &nbsp '; } if ($statusfilter) { $filterchoice .= '<i>'.&mt('status').'</i>- '.$status_types{$statusfilter}; } if ($filterchoice) { $discussion .= '<b>'.&mt('Filters').'</b>: '.$filterchoice; } $discussion .= '</font></td>'; } } if ($dischash{$toggkey}) { my $storebutton = &mt('Store read/unread changes'); $discussion.='<td align="right">'. '<input type="hidden" name="discsymb" value="'.$ressymb.'">'."\n". '<input type="button" name="readoptions" value="'.$storebutton.'"'. ' onClick="this.form.submit();">'."\n". '</td>'; } $discussion .= (<<END); </tr> </table> </td> </tr> </table> <br /><br /></form> END } if ($outputtarget eq 'export') { if ($manifestok) { while ($currdepth > 0) { print $manifestfile " </item>\n"; $currdepth --; } print $manifestfile qq| </organization> </organizations> <resources> $imsresources </resources> </manifest> |; 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 .= 'Download the zip file from <a href="'.$imszipfile.'">Discussion Posting Archive</a><br />'; if ($copyresult) { $discussion .= 'The following errors occurred during export - <br />'.$copyresult; } } } else { $discussion .= '<br />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.<br />'; } 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.=(<<ENDDISCUSS); <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> <input type="submit" name="discuss" value="Post Discussion" /> <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" /> <input type="hidden" name="symb" value="$ressymb" /> <input type="hidden" name="sendit" value="true" /> <input type="hidden" name="timestamp" value="$now" /> <br /><a name="newpost"></a> <font size="1">Note: in anonymous discussion, your name is visible only to course faculty</font><br /> <b>Title:</b> <input type="text" name="subject" value="$subject" size="30" /><br /><br /> <textarea name="comment" cols="80" rows="14" wrap="hard">$comment</textarea> ENDDISCUSS if ($env{'form.origpage'}) { $discussion.='<input type="hidden" name="origpage" value="'.$env{'form.origpage'}.'" />'."\n"; foreach (@currnewattach) { $discussion.='<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n"; } } $discussion.="</form>\n"; if ($outputtarget ne 'tex') { $discussion.=&generate_attachments_button('',$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,'',$mode); if (@currnewattach > 0) { $newattachmsg .= '<b>New attachments</b><br />'; if (@currnewattach > 1) { $newattachmsg .= '<ol>'; foreach my $item (@currnewattach) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; } $newattachmsg .= '</ol>'."\n"; } else { $currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\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.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='. $ressymb.':::" '.$target.'>'. '<img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" border="0" />'. &mt('Post Discussion').'</a></td></tr></table>'; } } } 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='<font color="#888888">'.$message.'</font>'; if ($studenthidden) { $message .='<br /><br />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.=' <font color="red"><b>['.&mt('anonymous').']</b></font> '. $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.=' <a href="/adm/feedback?editdisc='. $ressymb.':::'.$idx; if ($newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '" '.$target.'>'.&mt('Edit').'</a>'; unless ($seeid) { $sender.=" <a href=\"javascript:studentdelete('$ressymb','$idx','$newpostsflag','$prevread')"; $sender .= '">'.&mt('Delete').'</a>'; } } } if ($seeid) { if ($hidden) { unless ($studenthidden) { $sender.=' <a href="/adm/feedback?unhide='. $ressymb.':::'.$idx; if ($newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '">'.&mt('Make Visible').'</a>'; } } else { $sender.=' <a href="/adm/feedback?hide='. $ressymb.':::'.$idx; if ($newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '">'.&mt('Hide').'</a>'; } $sender.=' <a href="/adm/feedback?deldisc='. $ressymb.':::'.$idx; if ($newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '">'.&mt('Delete').'</a>'; } } else { if ($screenname) { $sender='<i>'.$screenname.'</i>'; } # 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.=' <a href="/adm/feedback?replydisc='. $ressymb.':::'.$idx; if ($newpostsflag) { $sender .= '&previous='.$prevread; } $sender .= '" '.$target.'>'.&mt('Reply').'</a>'; } if ($viewgrades) { $vgrlink=&Apache::loncommon::submlink('Submissions', $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); } if ($$dischash{$readkey}=~/\.$idx\./) { $ctlink = '<label><b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" /></label>'; } else { $ctlink = '<label><b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" /></label>'; } } #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] .= ' <p><table border="0" width="100%"> <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>'; } else { $$newitem{$idx} = 0; $$discussionitems[$idx] .= ' <p><table border="0" width="100%"> <tr><td align="left"> </td>'; } $$discussionitems[$idx] .= '<td align ="left">  '. '<b>'.$subject.'</b>  '. $sender.'</b> '.$vgrlink.' ('. &Apache::lonlocal::locallocaltime($posttime).')</td>'; if ($$dischash{$toggkey}) { $$discussionitems[$idx].='<td align="right">  '. $ctlink.'</td>'; } $$discussionitems[$idx].= '</tr></table><blockquote>'. $message.'</blockquote></p>'; if ($contrib{$idx.':history'}) { my @postversions = (); $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); if ($seeid) { $$discussionitems[$idx] .= '  <a href="/adm/feedback?allversions='.$ressymb.':::'.$idx.'">'.&mt('Display all versions').'</a>'; } $$discussionitems[$idx].='<br/>'.&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] .= '<b>'.$version.'.</b> - '.&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=('<b>'.$sender.'</b><br /><ul>'); } for (my $i=$start; $i<$end; $i++) { my ($timesent,$attachmsg); my %currattach = (); $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]); &newline_to_br(\$messages->{$i}); $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i}); $$subjects{$i}=~s/\n/\<br \/\>/g; $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i}); if ($attachmenturls) { &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach); } if ($type eq 'export') { $$imsfiles{$idx}{$i} = ''; if ($attachmsg) { $$attachtxt{$i} = '<br />Attachments:<br />'; foreach (sort keys %currattach) { if ($$allattachments{$_}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { my $fname = $1.$3.'/'.$4; $$imsfiles{$idx}{$i} .= '<file href="'.$fname.'">'."\n"; $$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />'; } } } } else { if ($attachmsg) { $$attachtxt{$i} = '<br />Attachments:'.$attachmsg.'<br />'; } else { $$attachtxt{$i} = ''; } } if ($type eq 'allversions') { $discussion.= <<"END"; <li><b>$$subjects{$i}</b>, $timesent<br /> $$messages{$i}<br /> $$attachtxt{$i}</li> END } } if ($type eq 'allversions') { $discussion.=('</ul></body></html>'); 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: '.$!.'<br />'."\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.'<br />'."\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 = (<<END); function anonchk() { if (document.mailform.anondiscuss.checked == true) { document.attachment.anondiscuss.value = '1' } if (document.mailform.discuss.checked == true) { document.attachment.discuss.value = '1' } return } END my $anonscript; if (exists($env{'form.origpage'})) { $anonscript = (<<END); function setposttype() { var anondisc = $env{'form.anondiscuss'}; var disc = $env{'form.discuss'}; if (anondisc == 1) { document.mailform.anondiscuss.checked = true } if (disc == 1) { document.mailform.discuss.checked = true } return } END } else { $anonscript = (<<END); function setposttype() { return } END } if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if ($env{'form.replydisc'}) { ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); } else { ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); } my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) { if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split/:/,$contrib{$idx.':history'}; $numoldver = @oldversions; } else { $numoldver = 1; } } if ($env{'form.replydisc'}) { if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split/:/,$contrib{$idx.':history'}; $numoldver = @oldversions; } else { $numoldver = 1; } } my $message; if ($idx > 0) { my %msgversions = (); &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); $message = $msgversions{$numoldver}; } &newline_to_br(\$message); $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>'; 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 = (<<END); function setposttype () { var currtype = $anonflag if (currtype == 1) { document.mailform.elements.discuss.checked = false document.mailform.elements.anondiscuss.checked = true } if (currtype == 0) { document.mailform.elements.anondiscuss.checked = false document.mailform.elements.discuss.checked = true } return } END } } } if ($env{'form.previous'}) { $prevtag = '<input type="hidden" name="previous" value="'.$env{'form.previous'}.'" />'; } } 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'); my $html=&Apache::lonxml::xmlbegin(); $r->print(<<END); $html <head> <title>The LearningOnline Network with CAPA</title> <meta http-equiv="pragma" content="no-cache"></meta> $htmlheader <script type="text/javascript"> // </script> </head> $bodytag <h2><tt>$title</tt></h2> <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> $prevtag <input type="hidden" name="postdata" value="$feedurl" /> END if ($env{'form.replydisc'}) { $r->print(<<END); <input type="hidden" name="replydisc" value="$env{'form.replydisc'}" /> END } elsif ($env{'form.editdisc'}) { $r->print(<<END); <input type="hidden" name="editdisc" value ="$env{'form.editdisc'}" /> <input type="hidden" name="parentmsg" value ="$parentmsg" /> END } $r->print(<<END); Please check at least one of the following feedback types: $options<hr /> $quote <p>My question/comment/feedback:</p> <p> $latexHelp Title: <input type="text" name="subject" size="30" value="$subject" /></p> <p> <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">$comment </textarea></p> <p> END if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) { if ($env{'form.origpage'}) { foreach (@currnewattach) { $r->print('<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n"); } foreach (@currdelold) { $r->print('<input type="hidden" name="deloldattach" value="'.$_.'" />'."\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('<input type="hidden" name="keepold" value="'.$_.'" />'."\n"); } } } } else { $r->print(<<END); Attachment (128 KB max size): <input type="file" name="attachment" /> </p> END } $r->print(<<END); <p> <input type="hidden" name="sendit" value="1" /> <input type="button" value="$send" onClick='gosubmit();' /> </p> </form> 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 .= '<b>New attachments</b><br />'; if (@currnewattach > 1) { $newattachmsg .= '<ol>'; foreach my $item (@currnewattach) { $item =~ m#.*/([^/]+)$#; $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; } $newattachmsg .= '</ol>'."\n"; } else { $currnewattach[0] =~ m#.*/([^/]+)$#; $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n"; } } if ($attachmsg) { $r->print("<b>Retained attachments</b>:$attachmsg<br />\n"); } if ($newattachmsg) { $r->print("$newattachmsg<br />"); } } } $r->print(&generate_preview_button(). &Apache::lonhtmlcommon::htmlareaselectactive('comment'). '</body></html>'); } 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'; } my $html=&Apache::lonxml::xmlbegin(); $r->print(<<END); $html <head> <title>$lt{'dido'}</title> <meta http-equiv="pragma" content="no-cache" /> <script> function discdispChk(caller) { var disctogg = '$toggchg' if (caller == 0) { if (document.modifydisp.discdisp[0].checked == true) { if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.discdisp[1].checked = false } } } if (caller == 1) { if (document.modifydisp.discdisp[1].checked == true) { if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.discdisp[0].checked = false } if (disctogg == 'toggon') { document.modifydisp.disctogg.checked = true } if (disctogg == 'toggoff') { document.modifydisp.disctogg.checked = false } } } if (caller == 2) { var dispchgB = '$dispchgB' if (disctogg == 'toggoff') { if (document.modifydisp.disctogg.checked == true) { if (dispchgB == 'onlyunmark') { document.modifydisp.discdisp[1].checked = false } } } } } function setDisp() { var prev = "$previous" var chktotal = 0 if (document.modifydisp.discdisp[0].checked == true) { document.modifydisp.$dispchgA.value = "$symb" chktotal ++ } if (document.modifydisp.discdisp[1].checked == true) { document.modifydisp.$dispchgB.value = "$symb" chktotal ++ } if (document.modifydisp.discmark.checked == true) { document.modifydisp.$markchg.value = "$symb" chktotal ++ } if (document.modifydisp.disctogg.checked == true) { document.modifydisp.$toggchg.value = "$symb" chktotal ++ } if (chktotal > 0) { document.modifydisp.submit() } else { if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) { if (prev > 0) { location.href = "$feedurl?previous=$previous" } else { location.href = "$feedurl" } } } } </script> </head> $bodytag <form name="modifydisp" method="post" action="/adm/feedback"> $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li><li>$lt{'wipa'}</li></ol> <br /> <table border="0" cellpadding="0" cellspacing="0"> <tr> <td width="100%" bgcolor="#000000"> <table width="100%" border="0" cellpadding="1" cellspacing="0"> <tr> <td width="100%" bgcolor="#000000"> <table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF"> <tr bgcolor="$tabcolor"> <td><b>$lt{'pref'}</b></td> <td><b>$lt{'curr'}</b></td> <td><b>$lt{'actn'}?</b></td> </tr> <tr bgcolor="#dddddd"> <td>$lt{'disa'}</td> <td>$lt{$discdisp}</td> <td><label><input type="checkbox" name="discdisp" onClick="discdispChk('0')" /> $lt{'chgt'} "$dispchangeA"</label> <br /> <label><input type="checkbox" name="discdisp" onClick="discdispChk('1')" /> $lt{'chgt'} "$dispchangeB"</label> </td> </tr><tr bgcolor="#eeeeee"> <td>$lt{'npmr'}</td> <td>$lt{$discmark}</td> <td><label><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</label></td> </tr><tr bgcolor="#dddddd"> <td>$lt{'dotm'}</td> <td>$lt{$disctogg}</td> <td><label><input type="checkbox" name="disctogg" onClick="discdispChk('2')" />$lt{'chgt'} "$toggchange"</label></td> </tr> </table> </td> </tr> </table> </td> </tr> </table> <br /> <br /> <input type="hidden" name="symb" value="$symb" /> <input type="hidden" name="previous" value="$previous" /> <input type="hidden" name="$dispchgA" value=""/> <input type="hidden" name="$dispchgB" value=""/> <input type="hidden" name="$markchg" value=""/> <input type="hidden" name="$toggchg" value="" /> <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" /> <br /> <br /> </form> </body> </html> 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 .= " <option value=\"$_\" />$_\n"; } 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( 'diso' => 'Discussion sorting and filtering options', 'diop' => 'Display Options', 'curr' => 'Current setting ', 'actn' => 'Action', 'prca' => 'Set options that control the sort order of posts, and/or which posts are displayed.', 'soor' => 'Sort order', 'spur' => 'Specific user roles', 'sprs' => 'Specific role status', 'spse' => 'Specific sections', 'psub' => 'Pick specific users (by name)', 'shal' => 'Show a list of current posters' ); my %sort_types = (); my %role_types = (); my %status_types = (); &sort_filter_names(\%sort_types,\%role_types,\%status_types); my $html=&Apache::lonxml::xmlbegin(); $r->print(<<END); $html <head> <title>$lt{'diso'}</title> <meta http-equiv="pragma" content="no-cache" /> <script type="text/javascript"> function verifyFilter() { var rolenum = 0 for (var i=0; i<document.modifyshown.rolefilter.length; i++) { if (document.modifyshown.rolefilter.options[i].selected == true) { rolenum ++ } } if (rolenum == 0) { document.modifyshown.rolefilter.options[0].selected = true } var secnum = 0 for (var i=0; i<document.modifyshown.sectionpick.length; i++) { if (document.modifyshown.sectionpick.options[i].selected == true) { secnum ++ } } if (secnum == 0) { document.modifyshown.sectionpick.options[0].selected = true } document.modifyshown.submit(); } </script> </head> $bodytag <form name="modifyshown" method="post" action="/adm/feedback"> <b>$lt{'diso'}</b><br/> $lt{'prca'} <br /><br /> <table border="0"> <tr> <td><b>$lt{'soor'}</b></td> <td> </td> <td><b>$lt{'sprs'}</b></td> <td> </td> <td><b>$lt{'spur'}</b></td> <td> </td> <td><b>$lt{'spse'}</b></td> <td> </td> <td><b>$lt{'psub'}</b></td> </tr> <tr> <td align="center"> <select name="sortposts"> <option value="ascdate" selected="selected" />$sort_types{'ascdate'} <option value="descdate" />$sort_types{'descdate'} <option value="thread" />$sort_types{'thread'} <option value="subject" />$sort_types{'subject'} <option value="username" />$sort_types{'username'} <option value="lastfirst" />$sort_types{'lastfirst'} </select> </td> <td> </td> <td align="center"> <select name="statusfilter"> <option value="all" selected="selected" />$status_types{'all'} <option value="Active" />$status_types{'Active'} <option value="Expired" />$status_types{'Expired'} </select> </td> <td> </td> <td align="center"> <select name="rolefilter" multiple="true" size="5"> <option value="all" />$role_types{'all'} <option value="st" />$role_types{'st'} <option value="cc" />$role_types{'cc'} <option value="in" />$role_types{'in'} <option value="ta" />$role_types{'ta'} <option value="ep" />$role_types{'ep'} <option value="ad" />$role_types{'ad'} <option value="cr" />$role_types{'cr'} </select> </td> <td> </td> <td align="center"> <select name="sectionpick" multiple="true" size="$numvisible"> $section_sel </select> </td> <td> </td> <td><label><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</label></td> </tr> </table> <br /> <br /> <input type="hidden" name="previous" value="$previous" /> <input type="hidden" name="applysort" value="$symb" /> <input type="button" name="sub" value="Store Changes" onClick="verifyFilter()" /> <br /> <br /> </form> </body> </html> END } sub print_showposters { my ($r,$symb,$previous,$feedurl,$sortposts) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &Apache::lonenc::check_encrypt(\$symb); my $crs='/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s/\_/\//g; my $seeid=&Apache::lonnet::allowed('rin',$crs); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); my %namesort = (); my %postcounts = (); my %lt=&Apache::lonlocal::texthash( 'diso' => 'Discussion filtering options', ); my $bodytag=&Apache::loncommon::bodytag('Discussion options', '',''); if ($contrib{'version'}) { for (my $idx=1;$idx<=$contrib{'version'};$idx++) { my $hidden=($contrib{'hidden'}=~/\.$idx\./); my $deleted=($contrib{'deleted'}=~/\.$idx\./); unless ((($hidden) && (!$seeid)) || ($deleted)) { if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { 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}} = (); } my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'}; $postcounts{$poster} ++; if (defined($namesort{$lastname}{$firstname})) { if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) { push @{$namesort{$lastname}{$firstname}}, $poster; } } else { @{$namesort{$lastname}{$firstname}} = ("$poster"); } } } } } my $html=&Apache::lonxml::xmlbegin(); $r->print(<<END); $html <head> <title>$lt{'diso'}</title> <meta http-equiv="pragma" content="no-cache" /> </head> $bodytag <form name="pickpostersform" method="post"> <table border="0"> <tr> <td bgcolor="#777777"> <table border="0" cellpadding="3"> <tr bgcolor="#e6ffff"> <td><b>No.</b></td> <td><b>Select</b></td> <td><b>Fullname</b><font color="#999999">(Username/domain)</font></td> <td><b>Posts</td> </tr> END my $count = 0; foreach my $last (sort keys %namesort) { foreach my $first (sort keys %{$namesort{$last}}) { foreach (sort @{$namesort{$last}{$first}}) { my ($uname,$udom) = split/:/,$_; if (!$uname || !$udom) { next; } else { $count ++; $r->print('<tr bgcolor="#ffffe6"><td align="right">'.$count.'</td><td align="center"><label><input name="stuinfo" type="checkbox" value="'.$_.'" /></td><td>'.$last.', '.$first.' ('.$uname.','.$udom.')</label></td><td>'.$postcounts{$_}.'</td></tr>'); } } } } $r->print(<<END); </table> </td> </tr> </table> <br /> <input type="hidden" name="sortposts" value="$sortposts" /> <input type="hidden" name="userpick" value="$symb" /> <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" /> </form> </body> </html> END } sub get_post_versions { my ($versions,$incoming,$htmldecode,$numver) = @_; if ($incoming =~ /^<version num="0">/) { my $p = HTML::LCParser->new(\$incoming); my $done = 0; while ( (my $token = $p->get_tag("version")) && (!$done)) { my $num = $token->[1]{num}; my $text = $p->get_text("/version"); if (defined($numver)) { if ($num == $numver) { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$numver}=$text; $done = 1; } } else { if ($htmldecode) { $text = &HTML::Entities::decode($text); } $$versions{$num}=$text; } } } else { if (!defined($numver)) { $numver = 0; } if ($htmldecode) { $$versions{$numver} = $incoming; } else { $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"'); } } return; } sub get_post_attachments { my ($attachments,$attachmenturls) = @_; my $num; if ($attachmenturls =~ m/^<attachment id="0">/) { my $p = HTML::LCParser->new(\$attachmenturls); while (my $token = $p->get_tag("attachment","filename","post")) { if ($token->[0] eq "attachment") { $num = $token->[1]{id}; %{$$attachments{$num}} =(); } elsif ($token->[0] eq "filename") { $$attachments{$num}{'filename'} = $p->get_text("/filename"); } elsif ($token->[0] eq "post") { my $id = $token->[1]{id}; $$attachments{$num}{$id} = $p->get_text("/post"); } } } else { %{$$attachments{'0'}} = (); $$attachments{'0'}{'filename'} = $attachmenturls; $$attachments{'0'}{'0'} = 'n'; } return; } sub fail_redirect { my ($r,$feedurl) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my $html=&Apache::lonxml::xmlbegin(); $r->print (<<ENDFAILREDIR); $html <head> <title>Feedback not sent</title> <meta http-equiv="pragma" content="no-cache" /> <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" /> </head> <body bgcolor="#FFFFFF"> <img align="right" src="$logo" /> <b>Sorry, no recipients ...</b> <br /><a href="$feedurl">Continue</a> </body> </html> ENDFAILREDIR } sub redirect_back { my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$numpicks) = @_; my $sorttag = ''; my $roletag = ''; my $statustag = ''; my $sectag = ''; my $userpicktag = ''; my $qrystr = ''; my $prevtag = ''; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &dewrapper(\$feedurl); if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; if ($previous > 0) { $qrystr = 'previous='.$previous; if ($feedurl =~ /\?register=1/) { $feedurl .= '&'.$qrystr; } else { $feedurl .= '?'.$qrystr; } $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />'; } if (defined($sort)) { my $sortqry = 'sortposts='.$sort; if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) { $feedurl .= '&'.$sortqry; } else { $feedurl .= '?'.$sortqry; } $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />'; if (defined($numpicks)) { my $userpickqry = 'totposters='.$numpicks; $feedurl .= '&'.$userpickqry; $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />'; } else { if (ref($sectionpick) eq 'ARRAY') { $feedurl .= '&sectionpick='; $sectag .= '<input type="hidden" name="sectionpick" value="'; foreach (@{$sectionpick}) { $feedurl .= $_.','; $sectag .= $_.','; } $feedurl =~ s/,$//; $sectag =~ s/,$//; $sectag .= '" />'; } else { $feedurl .= '&sectionpick='.$sectionpick; $sectag = '<input type="hidden" name="sectionpick" value="'.$sectionpick.'" />'; } if (ref($rolefilter) eq 'ARRAY') { $feedurl .= '&rolefilter='; $roletag .= '<input type="hidden" name="rolefilter" value="'; foreach (@{$rolefilter}) { $feedurl .= $_.','; $roletag .= $_.','; } $feedurl =~ s/,$//; $roletag =~ s/,$//; $roletag .= '" />'; } else { $feedurl .= '&rolefilter='.$rolefilter; $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />'; } $feedurl .= '&statusfilter='.$statusfilter; $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />'; } } $feedurl=&Apache::lonenc::check_encrypt($feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my $html=&Apache::lonxml::xmlbegin(); $r->print (<<ENDREDIR); $html <head> <title>Feedback sent</title> <meta http-equiv="pragma" content="no-cache" /> <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" /> </head> <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'> <img align="right" src="$logo" /> $typestyle <b>Sent $sendsomething message(s), and $sendposts post(s).</b> <font color="red">$status</font> <form name="reldt" action="$feedurl" target="loncapaclient"> $prevtag $sorttag $statustag $roletag $sectag $userpicktag </form> <br /><a href="$feedurl">Continue</a> </body> </html> ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); my $continue=&mt('Continue'); my $html=&Apache::lonxml::xmlbegin(); $r->print (<<ENDNOREDIR); $html <head> <title>Feedback not sent</title> <meta http-equiv="pragma" content="no-cache" /> ENDNOREDIR if ($feedurl!~/^\/adm\/feedback/) { $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='. &Apache::lonenc::check_encrypt($feedurl).'">'); } $feedurl=&Apache::lonenc::check_encrypt($feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); $r->print (<<ENDNOREDIRTWO); </head> <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'> <img align="right" src="$logo" /> <b>$nofeed</b> <br /><a href="$feedurl">$continue</a> </body> </html> ENDNOREDIRTWO } sub screen_header { my ($feedurl,$symb) = @_; my $msgoptions=''; my $discussoptions=''; unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { $msgoptions= '<p><label><input type="checkbox" name="author" /> '. &mt('Feedback to resource author').'</label></p>'; } if (&feedback_available(1)) { $msgoptions.= '<p><label><input type="checkbox" name="question" /> '. &mt('Question about resource content').'</label></p>'; } if (&feedback_available(0,1)) { $msgoptions.= '<p><label><input type="checkbox" name="course" /> '. &mt('Question/Comment/Feedback about course content'). '</label></p>'; } if (&feedback_available(0,0,1)) { $msgoptions.= '<p><label><input type="checkbox" name="policy" /> '. &mt('Question/Comment/Feedback about course policy'). '</label></p>'; } } if ($env{'request.course.id'}) { if (&discussion_open(undef,$symb) && &Apache::lonnet::allowed('pch', $env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { $discussoptions='<label><input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '. ($env{'form.replydisc'}?' checked="1"':'').' /> '. &mt('Contribution to course discussion of resource'); $discussoptions.='</label><br /><label><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '. &mt('Anonymous contribution to course discussion of resource'). ' <i>('.&mt('name only visible to course faculty').')</i></label>'; } } if ($msgoptions) { $msgoptions='<h2><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/feedback.gif').'" />'.&mt('Sending Messages').'</h2>'.$msgoptions; } if ($discussoptions) { $discussoptions='<h2><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; } return $msgoptions.$discussoptions; } sub resource_output { my ($feedurl) = @_; my $usersaw=&Apache::lonnet::ssi_body($feedurl); $usersaw=~s/\<body[^\>]*\>//gi; $usersaw=~s/\<\/body\>//gi; $usersaw=~s/\<html\>//gi; $usersaw=~s/\<\/html\>//gi; $usersaw=~s/\<head\>//gi; $usersaw=~s/\<\/head\>//gi; $usersaw=~s/action\s*\=/would_be_action\=/gi; return $usersaw; } sub clear_out_html { my ($message,$override)=@_; unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; } # Always allow the <m>-tag my %html=(M=>1); # Check if more is allowed my $cid=$env{'request.course.id'}; if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || ($override)) { # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB> # <SUP> %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1, M=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1, H1=>1, H2=>1, H3=>1, H4=>1, H5=>1); } # Do the substitution of everything that is not explicitly allowed $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; return $message; } sub assemble_email { my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; my $email=<<"ENDEMAIL"; $message ENDEMAIL my $citations=<<"ENDCITE"; <h2>Previous attempts of student (if applicable)</h2> $prevattempts <br /><hr /> <h2>Original screen output (if applicable)</h2> $usersaw <h2>Correct Answer(s) (if applicable)</h2> $useranswer ENDCITE return ($email,$citations); } sub secapply { my $rec=shift; my $defaultflag=shift; $rec=~s/\s+//g; $rec=~s/\@/\:/g; my ($adr,$sections)=($rec=~/^([^$]+)\(([^$]+)\)/); if ($sections) { foreach (split(/\;/,$sections)) { if (($_ eq $env{'request.course.sec'}) || ($defaultflag && ($_ eq '*'))) { return $adr; } } } else { return $rec; } return ''; } =pod =over 4 =item * decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag); Arguments $feedurl - /res/ url of resource (only need if $author is true) $author,$question,$course,$policy - all true/false parameters if true will attempt to find the addresses of user that should receive this type of feedback (author - feedback to author of resource $feedurl, $question 'Resource Content Questions', $course 'Course Content Question', $policy 'Course Policy') (Additionally it also checks $env for whether the corresponding form.<name> element exists, for ease of use in a html response context) $defaultflag - (internal should be left blank) if true gather addresses that aren't for a section even if I have a section (used for reccursion internally, first we look for addresses for our specific section then we recurse and look for non section addresses) Returns $typestyle - string of html text, describing what addresses were found %to - a hash, which keys are addresses of users to send messages to the keys will look like name:domain =cut sub decide_receiver { my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; my $typestyle=''; my %to=(); if ($env{'form.author'}||$author) { $typestyle.='Submitting as Author Feedback<br />'; $feedurl=~/^\/res\/(\w+)\/(\w+)\//; $to{$2.':'.$1}=1; } if ($env{'form.question'}||$question) { $typestyle.='Submitting as Question<br />'; foreach (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.question.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ($env{'form.course'}||$course) { $typestyle.='Submitting as Comment<br />'; foreach (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.comment.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ($env{'form.policy'}||$policy) { $typestyle.='Submitting as Policy Feedback<br />'; foreach (split(/\,/, $env{'course.'.$env{'request.course.id'}.'.policy.email'}) ) { my $rec=&secapply($_,$defaultflag); if ($rec) { $to{$rec}=1; } } } if ((scalar(%to) eq '0') && (!$defaultflag)) { ($typestyle,%to)= &decide_receiver($feedurl,$author,$question,$course,$policy,1); } return ($typestyle,%to); } sub feedback_available { my ($question,$course,$policy)=@_; my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy); return scalar(%to); } sub send_msg { my ($feedurl,$email,$citations,$attachmenturl,%to)=@_; my $status=''; my $sendsomething=0; foreach (keys %to) { if ($_) { my $declutter=&Apache::lonnet::declutter($feedurl); unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), 'Feedback ['.$declutter.']',$email,$citations,$feedurl, $attachmenturl)=~/ok/) { $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />'; } else { $sendsomething++; } } } my %record=&Apache::lonnet::restore('_feedback'); my ($temp)=keys %record; unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$feedurl; $newrecord{'subnumber'}=$record{'subnumber'}+1; unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { $status.='<br />'.&mt('Not registered').'<br />'; } } return ($status,$sendsomething); } sub adddiscuss { my ($symb,$email,$anon,$attachmenturl,$subject)=@_; my $status=''; my $realsymb; if ($symb=~/^bulletin___/) { my $filename=(&Apache::lonnet::decode_symb($symb))[2]; $filename=~s|^adm/wrapper/||; $realsymb=&Apache::lonnet::symbread($filename); } if (&discussion_open(undef,$realsymb) && &Apache::lonnet::allowed('pch',$env{'request.course.id'}. ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { my %contrib=('message' => $email, 'sendername' => $env{'user.name'}, 'senderdomain' => $env{'user.domain'}, 'screenname' => $env{'environment.screenname'}, 'plainname' => $env{'environment.firstname'}.' '. $env{'environment.middlename'}.' '. $env{'environment.lastname'}.' '. $env{'enrironment.generation'}, 'attachmenturl'=> $attachmenturl, 'subject' => $subject); if ($env{'form.replydisc'}) { $contrib{'replyto'}=(split(/\:\:\:/,$env{'form.replydisc'}))[1]; } if ($anon) { $contrib{'anonymous'}='true'; } if (($symb) && ($email)) { if ($env{'form.editdisc'}) { my %newcontrib = (); $contrib{'ip'}=$ENV{'REMOTE_ADDR'}; $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; $contrib{'timestamp'} = time; $contrib{'history'} = ''; my $numoldver = 0; my ($oldsymb,$oldidx)=split(/\:\:\:/,$env{'form.editdisc'}); &Apache::lonenc::check_decrypt(\$oldsymb); $oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|; # get timestamp for last post and history my %oldcontrib=&Apache::lonnet::restore($oldsymb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); if (defined($oldcontrib{$oldidx.':replyto'})) { $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'}; } if (defined($oldcontrib{$oldidx.':history'})) { if ($oldcontrib{$oldidx.':history'} =~ /:/) { my @oldversions = split/:/,$oldcontrib{$oldidx.':history'}; $numoldver = @oldversions; } else { $numoldver = 1; } $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':'; } my $numnewver = $numoldver + 1; if (defined($oldcontrib{$oldidx.':subject'})) { if ($oldcontrib{$oldidx.':subject'} =~ /^<version num="0">/) { $contrib{'subject'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; } else { $contrib{'subject'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; } } if (defined($oldcontrib{$oldidx.':message'})) { if ($oldcontrib{$oldidx.':message'} =~ /^<version num="0">/) { $contrib{'message'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; } else { $contrib{'message'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; } } $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; foreach (keys %contrib) { my $key = $oldidx.':'.&Apache::lonnet::escape($oldsymb).':'.$_; $newcontrib{$key} = $contrib{$_}; } my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'}, \%newcontrib, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); $status='Editing class discussion'.($anon?' (anonymous)':''); } else { $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. &Apache::lonnet::store(\%contrib,$symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); } my %storenewentry=($symb => time); $status.='<br />'.&mt('Updating discussion time').': '. &Apache::lonnet::put('discussiontimes',\%storenewentry, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); } my %record=&Apache::lonnet::restore('_discussion'); my ($temp)=keys %record; unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$symb; $newrecord{'subnumber'}=$record{'subnumber'}+1; $status.='<br />'.&mt('Registering').': '. &Apache::lonnet::cstore(\%newrecord,'_discussion'); } } else { $status.='Failed.'; } return $status.'<br />'; } # ----------------------------------------------------------- Preview function sub show_preview { my $r=shift; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $message=&clear_out_html($env{'form.comment'}); &newline_to_br(\$message); $message=&Apache::lonspeller::markeduptext($message); $message=&Apache::lontexconvert::msgtexconverted($message); my $subject=&clear_out_html($env{'form.subject'}); $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $html=&Apache::lonxml::xmlbegin(); $r->print($html.'<head>'. '</head><body><table border="2"><tr><td>'. '<b>Subject:</b> '.$subject.'<br /><br />'. $message.'</td></tr></table></body></html>'); } sub newline_to_br { my ($message)=@_; my $newmessage; my $parser=HTML::LCParser->new($message); while (my $token=$parser->get_token()) { if ($token->[0] eq 'T') { my $text=$token->[1]; $text=~s/\n/\<br \/\>/g; $newmessage.=$text; } elsif ($token->[0] eq 'D' || $token->[0] eq 'C') { $newmessage.=$token->[1]; } elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') { $newmessage.=$token->[2]; } elsif ($token->[0] eq 'S') { $newmessage.=$token->[4]; } } $$message=$newmessage; } sub generate_preview_button { my $pre=&mt("Show Preview and Check Spelling"); return(<<ENDPREVIEW); <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> <input type="hidden" name="subject"> <input type="hidden" name="comment" /> <input type="button" value="$pre" onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" /> </form> ENDPREVIEW } sub modify_attachments { my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_; my $orig_subject = &Apache::lonnet::unescape($env{'form.subject'}); my $subject=&clear_out_html($orig_subject); $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); my $timestamp=$env{'form.timestamp'}; my $numoldver=$env{'form.numoldver'}; my $bodytag=&Apache::loncommon::bodytag('Discussion Post Attachments', '',''); my $msg = ''; my %attachments = (); my %currattach = (); if ($idx) { &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold); } &Apache::lonenc::check_encrypt(\$symb); my $html=&Apache::lonxml::xmlbegin(); $r->print(<<END); $html <head> <title>Managing Attachments</title> <script> function setAction () { document.modattachments.action = document.modattachments.origpage.value; document.modattachments.submit(); } </script> </head> $bodytag <form name="modattachments" method="post" enctype="multipart/form-data" action="/adm/feedback?attach=$symb"> <table border="2"> <tr> <td> <b>Subject:</b> $subject</b><br /><br /> END if ($idx) { if ($attachmenturls) { my @currold = keys %currattach; if (@currold > 0) { $r->print("The following attachments were part of the most recent saved version of this posting.<br />Check the checkboxes for any you wish to remove<br />\n"); foreach my $id (@currold) { my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); $attachurl =~ m#/([^/]+)$#; $r->print('<label><input type="checkbox" name="deloldattach" value="'.$id.'" /> '.$1.'</label><br />'."\n"); } $r->print("<br />"); } } } if (@{$currnewattach} > 0) { $r->print("The following attachments have been uploaded for inclusion with this posting.<br />Check the checkboxes for any you wish to remove<br />\n"); foreach (@{$currnewattach}) { $_ =~ m#/([^/]+)$#; $r->print('<label><input type="checkbox" name="delnewattach" value="'.$_.'" /> '.$1.'</label><br />'."\n"); } $r->print("<br />"); } $r->print(<<END); Add a new attachment to this post. <input type="file" name="addnewattach" /><input type="button" name="upload" value="Upload" onClick="this.form.submit()" /> </td> </tr> </table> <input type="hidden" name="subject" value="$env{'form.subject'}" /> <input type="hidden" name="comment" value="$env{'form.comment'}" /> <input type="hidden" name="timestamp" value="$env{'form.timestamp'}" /> <input type="hidden" name="idx" value="$env{'form.idx'}" /> <input type="hidden" name="numoldver" value="$env{'form.numoldver'}" /> <input type="hidden" name="origpage" value="$env{'form.origpage'}" /> <input type="hidden" name="anondiscuss" value="$env{'form.anondiscuss'}" /> <input type="hidden" name="discuss" value="$env{'form.discuss'}" /> END foreach (@{$currnewattach}) { $r->print('<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n"); } foreach (@{$currdelold}) { $r->print('<input type="hidden" name="deloldattach" value="'.$_.'" />'."\n"); } $r->print(<<END); <input type="button" name="rtntoedit" value="Store Changes" onClick="setAction()"/> </form> </body> </html> END return; } sub process_attachments { my ($currnewattach,$currdelold,$keepold) = @_; @{$currnewattach}= &Apache::loncommon::get_env_multiple('form.currnewattach'); @{$currdelold}= &Apache::loncommon::get_env_multiple('form.deloldattach'); if (exists($env{'form.delnewattach'})) { my @currdelnew = &Apache::loncommon::get_env_multiple('form.delnewattach'); my @currnew = (); foreach my $newone (@{$currnewattach}) { my $delflag = 0; foreach (@currdelnew) { if ($newone eq $_) { $delflag = 1; last; } } unless ($delflag) { push @currnew, $newone; } } @{$currnewattach} = @currnew; } @{$keepold} = &Apache::loncommon::get_env_multiple('form.keepold'); } sub generate_attachments_button { my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach,$numoldver,$mode) = @_; my $origpage = $ENV{'REQUEST_URI'}; my $att=$attachnum.' '.&mt("attachments"); my $response = (<<END); <form name="attachment" action="/adm/feedback?attach=$ressymb" method="post"> Click to add/remove attachments: <input type="button" value="$att" onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=escape(document.mailform.comment.value);this.form.subject.value=escape(document.mailform.subject.value); END unless ($mode eq 'board') { $response .= 'javascript:anonchk();'; } $response .= (<<ENDATTACH); this.form.submit();" /> <input type="hidden" name="origpage" value="$origpage" /> <input type="hidden" name="idx" value="$idx" /> <input type="hidden" name="timestamp" value="$now" /> <input type="hidden" name="subject" /> <input type="hidden" name="comment" /> <input type="hidden" name="anondiscuss" value = "0" /> <input type="hidden" name="discuss" value = "0" /> <input type="hidden" name="numoldver" value="$numoldver" /> ENDATTACH if (defined($deloldattach)) { if (@{$deloldattach} > 0) { foreach (@{$deloldattach}) { $response .= '<input type="hidden" name="deloldattach" value="'.$_.'" />'."\n"; } } } if (defined($currnewattach)) { if (@{$currnewattach} > 0) { foreach (@{$currnewattach}) { $response .= '<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n"; } } } $response .= '</form>'; return $response; } sub extract_attachments { my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_; %{$attachments}=(); &get_post_attachments($attachments,$attachmenturls); foreach my $id (sort keys %{$attachments}) { if (exists($$attachments{$id}{$numoldver})) { if (defined($currdelold)) { if (@{$currdelold} > 0) { unless (grep/^$id$/,@{$currdelold}) { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } else { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } else { $$currattach{$id} = $$attachments{$id}{$numoldver}; } } } my @attached = (sort { $a <=> $b } keys %{$currattach}); if (@attached == 1) { my $id = $attached[0]; my $attachurl; if ($attachmenturls =~ m/^<attachment id="0">/) { $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); } else { $attachurl = $$attachments{$id}{'filename'}; } $attachurl=~m|/([^/]+)$|; $$message.='<br /><a href="'.$attachurl.'"><tt>'. $1.'</tt></a><br />'; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } elsif (@attached > 1) { $$message.='<ol>'; foreach (@attached) { my $id = $_; my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); my ($fname) =($attachurl=~m|/([^/]+)$|); $$message .= '<li><a href="'.$attachurl. '"><tt>'. $fname.'</tt></a></li>'; &Apache::lonnet::allowuploaded('/adm/feedback', $attachurl); } $$message .= '</ol>'; } } sub construct_attachmenturl { my ($currnewattach,$keepold,$symb,$idx)=@_; my $oldattachmenturl; my $newattachmenturl; my $startnum = 0; my $currver = 0; if (($env{'form.editdisc'}) && ($idx)) { my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); $oldattachmenturl = $contrib{$idx.':attachmenturl'}; if ($contrib{$idx.':history'}) { if ($contrib{$idx.':history'} =~ /:/) { my @oldversions = split/:/,$contrib{$idx.':history'}; $currver = 1 + scalar(@oldversions); } else { $currver = 2; } } else { $currver = 1; } if ($oldattachmenturl) { if ($oldattachmenturl =~ m/^<attachment id="0">/) { my %attachments = (); my $prevver = $currver-1; &get_post_attachments(\%attachments,$oldattachmenturl); my $numattach = scalar(keys %attachments); $startnum += $numattach; foreach my $num (sort {$a <=> $b} keys %attachments) { $newattachmenturl .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>'; foreach $_ (sort {$a <=> $b} keys %{$attachments{$num}}) { unless ($_ eq 'filename') { $newattachmenturl .= '<post id="'.$_.'">'.$attachments{$num}{$_}.'</post>'; } } if (grep/^$num$/,@{$keepold}) { $newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>'; } $newattachmenturl .= '</attachment>'; } } else { $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>'; unless (grep/^0$/,@{$keepold}) { $newattachmenturl .= '<post id="1">n</post>'; } $newattachmenturl .= '</attachment>'; $startnum ++; } } } for (my $i=0; $i<@{$currnewattach}; $i++) { my $attachnum = $startnum + $i; $newattachmenturl .= '<attachment id="'.$attachnum.'"><filename>'.&HTML::Entities::encode($$currnewattach[$i]).'</filename><post id="'.$currver.'">n</post></attachment>'; } return $newattachmenturl; } sub has_discussion { my $resourcesref = shift; my $navmap = Apache::lonnavmaps::navmap->new(); my @allres=$navmap->retrieveResources(); foreach my $resource (@allres) { if ($resource->hasDiscussion()) { my $ressymb = $resource->wrap_symb(); push @{$resourcesref}, $ressymb; } } return; } sub sort_filter_names { my ($sort_types,$role_types,$status_types) = @_; %{$sort_types} = ( ascdate => 'Date order - oldest first', descdate => 'Date order - newest first', thread => 'Threaded', subject => 'By subject', username => 'By domain and username', lastfirst => 'By last name, first name' ); %{$role_types} = ( all => 'All roles', st => 'Students', cc => 'Course Coordinators', in => 'Instructors', ta => 'TAs', ep => 'Exam proctors', ad => 'Administrators', cr => 'Custom roles' ); %{$status_types} = ( all => 'Roles of any status', Active => 'Only active roles', Expired => 'Only inactive roles' ); } sub handler { my $r = shift; if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } # --------------------------- Get query string for limited number of parameters &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export']); if ($env{'form.discsymb'}) { my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.discsymb'}); my $readkey = $symb.'_read'; my $chgcount = 0; my %readinghash = &Apache::lonnet::get('nohist_'.$env{'request.course.id'}.'_discuss',[$readkey],$env{'user.domain'},$env{'user.name'}); foreach my $key (keys %env) { if ($key =~ m/^form\.postunread_(\d+)/) { if ($readinghash{$readkey} =~ /\.$1\./) { $readinghash{$readkey} =~ s/\.$1\.//; $chgcount ++; } } elsif ($key =~ m/^form\.postread_(\d+)/) { unless ($readinghash{$readkey} =~ /\.$1\./) { $readinghash{$readkey} .= '.'.$1.'.'; $chgcount ++; } } } if ($chgcount > 0) { &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%readinghash,$env{'user.domain'},$env{'user.name'}); } &redirect_back($r,$feedurl,&mt('Marked postings read/unread').'<br />', '0','0','',$env{'form.previous'},'','','',); return OK; } if ($env{'form.allversions'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $html=&Apache::lonxml::xmlbegin(); my $bodytag=&Apache::loncommon::bodytag('Discussion Post Versions'); $r->print(<<END); $html <head> <title>Post Versions</title> <meta http-equiv="pragma" content="no-cache" /> </head> $bodytag END my $crs='/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s|_|/|g; my $seeid=&Apache::lonnet::allowed('rin',$crs); my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); ($symb)=&get_feedurl_and_clean_symb($symb); if ($idx > 0) { my %messages = (); my %subjects = (); my %attachmsgs = (); my %allattachments = (); my %imsfiles = (); my ($screenname,$plainname); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); $r->print(&get_post_contents(\%contrib,$idx,$seeid,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname)); } return OK; } if ($env{'form.posterlist'}) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); &print_showposters($r,$symb,$env{'form.previous'},$feedurl, $env{'form.sortposts'}); return OK; } if ($env{'form.userpick'}) { my @posters = &Apache::loncommon::get_env_multiple('form.stuinfo'); my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.userpick'}); my $numpicks = @posters; my %discinfo; $discinfo{$symb.'_userpick'} = join('&',@posters); &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%discinfo,$env{'user.domain'},$env{'user.name'}); &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0', '',$env{'form.previous'},$env{'form.sortposts'},'','','', $numpicks); return OK; } if ($env{'form.applysort'}) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0', '',$env{'form.previous'},$env{'form.sortposts'}, $env{'form.rolefilter'},$env{'form.statusfilter'}, $env{'form.sectionpick'}); return OK; } elsif ($env{'form.cmd'} eq 'sortfilter') { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); &print_sortfilter_options($r,$symb,$env{'form.previous'},$feedurl); return OK; } elsif ($env{'form.navtime'}) { my %discinfo = (); my @resources = (); if (defined($env{'form.navmaps'})) { if ($env{'form.navmaps'} =~ /:/) { @resources = split/:/,$env{'form.navmaps'}; } else { @resources = ("$env{'form.navmaps'}"); } } else { &has_discussion(\@resources); } my $numitems = @resources; my $feedurl = '/adm/navmaps'; if ($env{'form.navurl'}) { $feedurl .= '?'.$env{'form.navurl'}; } my %lt = &Apache::lonlocal::texthash( 'mnpa' => 'Marked "New" posts as read in a total of', 'robb' => 'resources/bulletin boards.', 'twnp' => 'There are currently no resources or bulletin boards with unread discussion postings.' ); foreach (@resources) { my $ressymb=$_; &Apache::lonenc::check_decrypt(\$ressymb); my $lastkey = $ressymb.'_lastread'; $discinfo{$lastkey} = $env{'form.navtime'}; } my $textline = "<b>$lt{'mnpa'} $numitems $lt{'robb'}</b>"; if ($numitems > 0) { &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%discinfo,$env{'user.domain'},$env{'user.name'}); } else { $textline = "<b>$lt{'twnp'}</b>"; } &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my $html=&Apache::lonxml::xmlbegin(); $r->print (<<ENDREDIR); $html <head> <title>New posts marked as read</title> <meta http-equiv="pragma" content="no-cache" /> <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" /> </head> <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'> <img align="right" src="$logo" /> $textline <form name="reldt" action="$feedurl" target="loncapaclient"> </form> <br /><a href="$feedurl">Continue</a> </body> </html> ENDREDIR return OK; } elsif ($env{'form.modifydisp'}) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'}); my ($dispchgA,$dispchgB,$markchg,$toggchg) = split(/_/,$env{'form.changes'}); &print_display_options($r,$symb,$env{'form.previous'},$dispchgA, $dispchgB,$markchg,$toggchg,$feedurl); return OK; } elsif ($env{'form.markondisp'} || $env{'form.markonread'} || $env{'form.allposts'} || $env{'form.onlyunread'} || $env{'form.onlyunmark'} || $env{'form.toggoff'} || $env{'form.toggon'} || $env{'form.markread'}) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); my %discinfo; # ------------------------ Modify setting for read/unread toggle for each post if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; } if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; } # --------- Modify setting for identification of 'NEW' posts in this discussion if ($env{'form.markondisp'}) { $discinfo{$symb.'_lastread'} = time; $discinfo{$symb.'_markondisp'} = 1; } if ($env{'form.markonread'}) { if ( $env{'form.previous'} > 0 ) { $discinfo{$symb.'_lastread'} = $env{'form.previous'}; } $discinfo{$symb.'_markondisp'} = 0; } # --------------------------------- Modify display setting for this discussion if ($env{'form.allposts'}) { $discinfo{$symb.'_showonlyunread'} = 0; $discinfo{$symb.'_showonlyunmark'} = 0; } if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; } if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; } # ----------------------------------------------------- Mark new posts not NEW if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; } &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', \%discinfo,$env{'user.domain'},$env{'user.name'}); my $previous=$env{'form.previous'}; if ($env{'form.markondisp'}) { $previous=undef; } &redirect_back($r,$feedurl,&mt('Changed display status').'<br />', '0','0','',$previous); return OK; } elsif (($env{'form.hide'}) || ($env{'form.unhide'})) { # ----------------------------------------------------------------- Hide/unhide my $entry=$env{'form.hide'}?$env{'form.hide'}:$env{'form.unhide'}; my ($symb,$idx)=split(/\:\:\:/,$entry); ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); my $currenthidden=$contrib{'hidden'}; my $currentstudenthidden=$contrib{'studenthidden'}; my $crs='/'.$env{'request.course.id'}; if ($env{'request.course.sec'}) { $crs.='_'.$env{'request.course.sec'}; } $crs=~s/\_/\//g; my $seeid=&Apache::lonnet::allowed('rin',$crs); if ($env{'form.hide'}) { $currenthidden.='.'.$idx.'.'; unless ($seeid) { $currentstudenthidden.='.'.$idx.'.'; } } else { $currenthidden=~s/\.$idx\.//g; } my %newhash=('hidden' => $currenthidden); if ( ($env{'form.hide'}) && (!$seeid) ) { $newhash{'studenthidden'} = $currentstudenthidden; } &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); &redirect_back($r,$feedurl,&mt('Changed discussion status').'<br />', '0','0','',$env{'form.previous'}); return OK; } elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) { my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); if ($env{'form.cmd'} eq 'threadedon') { &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on'); } else { &Apache::lonnet::del('environment',['threadeddiscussion']); &Apache::lonnet::delenv('environment\.threadeddiscussion'); } &redirect_back($r,$feedurl,&mt('Changed discussion view mode').'<br />', '0','0','',$env{'form.previous'}); return OK; } elsif ($env{'form.deldisc'}) { # --------------------------------------------------------------- Hide for good my ($symb,$idx)=split(/\:\:\:/,$env{'form.deldisc'}); ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); my %newhash=('deleted' => $contrib{'deleted'}.".$idx."); &Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); &redirect_back($r,$feedurl,&mt('Changed discussion status').'<br />', '0','0','',$env{'form.previous'}); return OK; } elsif ($env{'form.preview'}) { # -------------------------------------------------------- User wants a preview &show_preview($r); return OK; } elsif ($env{'form.attach'}) { # -------------------------------------------------------- Work on attachments &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','anondiscuss','discuss']); my (@currnewattach,@currdelold,@keepold); &process_attachments(\@currnewattach,\@currdelold,\@keepold); if (exists($env{'form.addnewattach.filename'})) { unless (length($env{'form.addnewattach'})>131072) { my $subdir = 'feedback/'.$env{'form.timestamp'}; my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir); push @currnewattach, $newattachment; } } my $attachmenturls; my ($symb) = &get_feedurl_and_clean_symb($env{'form.attach'}); my $idx = $env{'form.idx'}; if ($idx) { my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); $attachmenturls = $contrib{$idx.':attachmenturl'}; } &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx, $attachmenturls); return OK; } elsif ($env{'form.export'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.export'}); my $mode='board'; my $status='OPEN'; my $previous=$env{'form.previous'}; if ($feedurl =~ /\.(problem|exam|quiz|assess|survey|form|library|task)$/) { $mode='problem'; $status=$Apache::inputtags::status[-1]; } my $discussion = &list_discussion($mode,$status,$symb); my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion'); $r->print($bodytag.$discussion); return OK; } else { # ------------------------------------------------------------- Normal feedback my $feedurl=$env{'form.postdata'}; $feedurl=~s/^http\:\/\///; $feedurl=~s/^$ENV{'SERVER_NAME'}//; $feedurl=~s/^$ENV{'HTTP_HOST'}//; $feedurl=~s/\?.+$//; my $symb; if ($env{'form.replydisc'}) { $symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0]; my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); $feedurl=&Apache::lonnet::clutter($url); } elsif ($env{'form.editdisc'}) { $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); $feedurl=&Apache::lonnet::clutter($url); } elsif ($env{'form.origpage'}) { $symb=""; } else { $symb=&Apache::lonnet::symbread($feedurl); } unless ($symb) { $symb=$env{'form.symb'}; if ($symb) { my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); $feedurl=&Apache::lonnet::clutter($url); } } &Apache::lonenc::check_decrypt(\$symb); my $goahead=1; if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form|task)$/) { unless ($symb) { $goahead=0; } } # backward compatibility (bulletin boards used to be 'wrapped') &dewrapper(\$feedurl); if (!$goahead) { # Ambiguous Problem Resource $r->internal_redirect('/adm/ambiguous'); return OK; } # Go ahead with feedback, no ambiguous reference unless ( ( ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) ) || ($env{'request.course.id'} && ($feedurl!~m:^/adm:)) || ($env{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) ) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; # Unable to give feedback &no_redirect_back($r,$feedurl); } # --------------------------------------------------- Print login screen header unless ($env{'form.sendit'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $options=&screen_header($feedurl,$symb); if ($options) { &mail_screen($r,$feedurl,$options); } else { &fail_redirect($r,$feedurl); } return OK; } # Get previous user input my $prevattempts=&Apache::loncommon::get_previous_attempt( $symb,$env{'user.name'},$env{'user.domain'}, $env{'request.course.id'}); # Get output from resource my $usersaw=&resource_output($feedurl); # Get resource answer (need to allow student to view grades for this to work) &Apache::lonnet::appenv(('allowed.vgr'=>'F')); my $useranswer=&Apache::loncommon::get_student_answers( $symb,$env{'user.name'},$env{'user.domain'}, $env{'request.course.id'}); &Apache::lonnet::delenv('allowed.vgr'); # Get attachments, if any, and not too large my $attachmenturl=''; if (($env{'form.origpage'}) || ($env{'form.editdisc'}) || ($env{'form.replydisc'})) { my ($symb,$idx); if ($env{'form.replydisc'}) { ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); } elsif ($env{'form.editdisc'}) { ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); } elsif ($env{'form.origpage'}) { $symb = $env{'form.symb'}; } &Apache::lonenc::check_decrypt(\$symb); my @currnewattach = (); my @deloldattach = (); my @keepold = (); &process_attachments(\@currnewattach,\@deloldattach,\@keepold); $symb=~s|(bulletin___\d+___)adm/wrapper/|$1|; $attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx); } elsif ($env{'form.attachment.filename'}) { unless (length($env{'form.attachment'})>131072) { $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback'); } } # Filter HTML out of message (could be nasty) my $message=&clear_out_html($env{'form.comment'}); # Assemble email my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, $usersaw,$useranswer); # Who gets this? my ($typestyle,%to) = &decide_receiver($feedurl); # Actually send mail my ($status,$numsent)=&send_msg($feedurl,$email,$citations, $attachmenturl,%to); # Discussion? Store that. my $numpost=0; if ($env{'form.discuss'} || $env{'form.anondiscuss'}) { my $subject = &clear_out_html($env{'form.subject'}); my $anonmode=(defined($env{'form.anondiscuss'})); $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, $subject); $numpost++; } # Receipt screen and redirect back to where came from &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$env{'form.previous'}); } return OK; } sub wrap_symb { my ($ressymb)=@_; if ($ressymb =~ /bulletin___\d+___/) { unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } } return $ressymb; } sub dewrapper { my ($feedurl)=@_; if ($$feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $$feedurl=~s|^/adm/wrapper||; } } sub get_feedurl { my ($symb)=@_; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $feedurl = &Apache::lonnet::clutter($url); &dewrapper(\$feedurl); return $feedurl; } sub get_feedurl_and_clean_symb { my ($symb)=@_; &Apache::lonenc::check_decrypt(\$symb); # backward compatibility (bulletin boards used to be 'wrapped') unless ($symb =~ m|bulletin___\d+___adm/wrapper|) { $symb=~s|(bulletin___\d+___)|$1adm/wrapper|; } my $feedurl = &get_feedurl($symb); return ($symb,$feedurl); } 1; __END__