![]() ![]() | ![]() |
Editing now works for bulletin board posts.
# The LearningOnline Network # Feedback # # $Id: lonfeedback.pm,v 1.110 2004/07/29 22:42:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # ### package Apache::lonfeedback; use strict; use Apache::Constants qw(:common); use Apache::lonmsg(); use Apache::loncommon(); use Apache::lontexconvert(); use Apache::lonlocal; # must not have () use Apache::lonhtmlcommon(); use Apache::lonspeller(); sub discussion_open { my ($status)=@_; if (defined($status) && !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' || $status eq 'OPEN')) { return 0; } my $close=&Apache::lonnet::EXT('resource.0.discussend'); 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)) { return 0; } } return 1; } sub list_discussion { my ($mode,$status,$symb)=@_; my $outputtarget=$ENV{'form.grade_target'}; if (not &discussion_visible($status)) { return ''; } my @bgcols = ("#cccccc","#eeeeee"); my $discussiononly=0; if ($mode eq 'board') { $discussiononly=1; } unless ($ENV{'request.course.id'}) { return ''; } my $crs='/'.$ENV{'request.course.id'}; my $cid=$ENV{'request.course.id'}; if ($ENV{'request.course.sec'}) { $crs.='_'.$ENV{'request.course.sec'}; } $crs=~s/\_/\//g; unless ($symb) { $symb=&Apache::lonnet::symbread(); } unless ($symb) { return ''; } my %usernamesort = (); my %namesort =(); my %subjectsort = (); # backward compatibility (bulletin boards used to be 'wrapped') my $ressymb=$symb; if ($mode eq 'board') { unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } } # Get discussion display settings for this discussion my $lastkey = $ressymb.'_lastread'; my $showkey = $ressymb.'_showonlyunread'; my $visitkey = $ressymb.'_visit'; my $ondispkey = $ressymb.'_markondisp'; my $userpickkey = $ressymb.'_userpick'; my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'}); my %discinfo = (); my $showonlyunread = 0; my $markondisp = 0; my $prevread = 0; my $previous = 0; my $visit = 0; my $newpostsflag = 0; my @posters = split/\&/,$dischash{$userpickkey}; # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']); my $sortposts = $ENV{'form.sortposts'}; my $rolefilter = $ENV{'form.rolefilter'}; my $statusfilter = $ENV{'form.statusfilter'}; my $sectionpick = $ENV{'form.sectionpick'}; my $totposters = $ENV{'form.totposters'}; $previous = $ENV{'form.previous'}; if ($previous > 0) { $prevread = $previous; } elsif (defined($dischash{$lastkey})) { unless ($dischash{$lastkey} eq '') { $prevread = $dischash{$lastkey}; } } # Get information about students and non-students in course for filtering display of posts my %roleshash = (); my %roleinfo = (); if ($rolefilter) { %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'}); foreach (keys %roleshash) { my ($role,$uname,$udom,$sec) = split/:/,$_; my ($end,$start) = split/:/,$roleshash{$_}; my $now = time; my $status = 'Active'; if (($now < $start) || ($end > 0 && $now > $end)) { $status = 'Expired'; } push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status; } my ($classlist) = &Apache::loncoursedata::get_classlist( $ENV{'request.course.id'}, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); while (my ($student,$data) = each %$classlist) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); push @{$roleinfo{$student}}, 'st:'.$section.':'.$status; } } # Get discussion display default settings for user my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'}); my $discdisplay=$userenv{'discdisplay'}; if ($discdisplay eq 'unread') { $showonlyunread = 1; } my $discmarkread=$userenv{'discmarkread'}; if ($discmarkread eq 'ondisp') { $markondisp = 1; } # Override user's default if user specified display setting for this discussion if (defined($dischash{$ondispkey})) { $markondisp = $dischash{$ondispkey}; } if ($markondisp) { $discinfo{$lastkey} = time; } if (defined($dischash{$showkey})) { $showonlyunread = $dischash{$showkey}; } if (defined($dischash{$visitkey})) { $visit = $dischash{$visitkey}; } $visit ++; my $seeid=&Apache::lonnet::allowed('rin',$crs); my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/)); my @discussionitems=(); my %shown = (); my @posteridentity=(); my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my $visible=0; my @depth=(); my @original=(); my @index=(); my @replies=(); my %alldiscussion=(); 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'}); if ($contrib{'version'}) { my $oldest = $contrib{'1:timestamp'}; if ($prevread eq '0') { $prevread = $oldest-1; } for (my $id=1;$id<=$contrib{'version'};$id++) { my $idx=$id; my $posttime = $contrib{$idx.':timestamp'}; if ($prevread <= $posttime) { $newpostsflag = 1; } my $hidden=($contrib{'hidden'}=~/\.$idx\./); my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); my $deleted=($contrib{'deleted'}=~/\.$idx\./); my $origindex='0.'; my $numoldver=0; if ($contrib{$idx.':replyto'}) { if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) { # 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; } } my ($message,$subject); if ($idx > 0) { if ($contrib{$idx.':message'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) { $message = $1; } else { $message = $contrib{$idx.':message'}; } } else { $message=$contrib{$idx.':message'}; } my $attachmenturls = $contrib{$idx.':attachmenturl'}; $message=~s/\n/\<br \/\>/g; $message=&Apache::lontexconvert::msgtexconverted($message); if ($idx > 0) { if ($contrib{$idx.':subject'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) { $subject = $1; } else { $subject = $contrib{$idx.':subject'}; } } else { $subject=$contrib{$idx.':subject'}; } if (defined($subject)) { $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); } if ($attachmenturls) { my @attachments = (); my %currattach = (); &extract_attachments($attachmenturls,$idx,$numoldver,\$message,\@attachments,\%currattach); } if ($message) { if ($hidden) { $message='<font color="#888888">'.$message.'</font>'; if ($studenthidden) { $message .='<br /><br />Deleted by poster (student).'; } } my $screenname=&Apache::loncommon::screenname( $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); my $plainname=&Apache::loncommon::nickname( $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); my $sender=&mt('Anonymous'); # Set up for sorting by subject if ($contrib{$idx.':subject'} eq '') { if (defined($subjectsort{'__No subject'})) { push @{$subjectsort{'__No subject'}}, $idx; } else { @{$subjectsort{'__No subject'}} = ("$idx"); } } else { if (defined($subjectsort{$contrib{$idx.':subject'}})) { push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx; } else { @{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx"); } } if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { $sender=&Apache::loncommon::aboutmewrapper( $plainname, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}).' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; if ($contrib{$idx.':anonymous'}) { $sender.=' ['.&mt('anonymous').'] '. $screenname; } # Set up for sorting by domain, then username unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) { %{$usernamesort{$contrib{$idx.':senderdomain'}}} = (); } if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) { push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx; } else { @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); } # Set up for sorting by last name, then first name my %names = &Apache::lonnet::get('environment',['firstname','lastname'], $contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); my $lastname = $names{'lastname'}; my $firstname = $names{'firstname'}; if ($lastname eq '') { $lastname = '_'; } if ($firstname eq '') { $firstname = '_'; } unless (defined($namesort{$lastname})) { %{$namesort{$lastname}} = (); } if (defined($namesort{$lastname}{$firstname})) { push @{$namesort{$lastname}{$firstname}}, $idx; } else { @{$namesort{$lastname}{$firstname}} = ("$idx"); } if ($ENV{"course.$cid.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>'; } my $vgrlink; if ($viewgrades) { $vgrlink=&Apache::loncommon::submlink('Submissions', $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb); } #figure out at what position this needs to print my $thisindex=$idx; if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) { $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2); } $alldiscussion{$thisindex}=$idx; $shown{$idx} = 0; $index[$idx]=$thisindex; my $spansize = 2; if ($showonlyunread && $prevread > $posttime) { $notshown{$idx} = 1; } else { # apply filters my $uname = $contrib{$idx.':sendername'}; my $udom = $contrib{$idx.':senderdomain'}; my $poster = $uname.':'.$udom; my $rolematch = ''; my $skiptest = 1; if ($totposters > 0) { if (grep/^$poster$/,@posters) { $shown{$idx} = 1; } } else { if ($rolefilter) { if ($rolefilter eq 'all') { $rolematch = '([^:]+)'; } else { $rolematch = $rolefilter; $skiptest = 0; } } if ($sectionpick) { if ($sectionpick eq 'all') { $rolematch .= ':([^:]*)'; } else { $rolematch .= ':'.$sectionpick; $skiptest = 0; } } if ($statusfilter) { if ($statusfilter eq 'all') { $rolematch .= ':([^:]+)'; } else { $rolematch .= ':'.$statusfilter; $skiptest = 0; } } if ($skiptest) { $shown{$idx} = 1; } else { foreach my $role (@{$roleinfo{$poster}}) { if ($role =~ m/^$rolematch$/) { $shown{$idx} = 1; last; } } } } } unless ($notshown{$idx} == 1) { if ($prevread > 0 && $prevread <= $posttime) { $newitem{$idx} = 1; $discussionitems[$idx] .= ' <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></tr>'. '</table><blockquote>'.$message.'</blockquote></p>'; if ($contrib{$idx.':history'}) { my @postversions = (); $discussionitems[$idx] .= '<br />'.&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]).' '; } } } } } } } my $discussion=''; 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', 'ondisp' => 'Once displayed', 'onmark' => 'Once marked read', 'disa' => 'Posts to be displayed', 'npce' => 'Posts cease to be marked "NEW"', 'chgt' => 'Change', 'disp' => 'Display', 'nolo' => 'Not new', ); my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; my $dispchange = $lt{'unread'}; my $markchange = $lt{'ondisp'}; my $chglink = '/adm/feedback?modifydisp='.$ressymb; my $displink = 'onlyunread'; my $marklink = 'markondisp'; if ($markondisp) { $currmark = $lt{'ondisp'}; $markchange = $lt{'onmark'}; $marklink = 'markonread'; } if ($showonlyunread) { $currdisp = $lt{'unread'}; $dispchange = $lt{'allposts'}; $displink = 'allposts'; } $chglink .= '&changes='.$displink.'_'.$marklink; if ($newpostsflag) { $chglink .= '&previous='.$prevread; } if ($visible) { # Print the discusssion if ($outputtarget ne 'tex') { 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.='<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?threadedon='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Threaded View').'</a> '. '<a href="/adm/feedback?threadedoff='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Chronological View').'</a> <a href= "/adm/feedback?sortfilter='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .='">'.&mt('Sorting/Filtering options').'</a>  '; } 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='.$ressymb.'">'.&mt('Mark new posts as read').'</a> '; } else { $discussion .= '<td> </td>'; } } else { $discussion .= '<td> </td>'; } $discussion .= '</tr></table></td></tr>'; } else { $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}'; } my $numhidden = keys %notshown; if ($numhidden > 0) { my $colspan = $maxdepth+1; $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'. '<a href="/adm/feedback?allposts='.$ressymb; if ($newpostsflag) { $discussion .= '&previous='.$prevread; } $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '. $numhidden.' '.&mt('previously viewed posts'). '<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 { $sortposts = 'ascdate'; @showposts = (sort { $a <=> $b } keys %alldiscussion); } foreach (@showposts) { unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'})) { $alldiscussion{$_} = $_; } unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) { if ($outputtarget ne 'tex') { $discussion.="\n<tr>"; } else { $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'; } my $thisdepth=$depth[$alldiscussion{$_}]; if ($outputtarget ne 'tex') { for (1..$thisdepth) { $discussion.='<td> </td>'; } } my $colspan=$maxdepth-$thisdepth+1; if ($outputtarget ne 'tex') { $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].'" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$_}]. '</td></tr>'; } else { #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; #FIXME xmlparse can't be safely called from inside xmlparse # due to the global variables that are use, the safe # space etc. I expect this has unforseen issues that # need resolving. $discussion.=&Apache::lonxml::xmlparse('','tex',$discussionitems[$alldiscussion{$_}]); } } } if ($outputtarget ne 'tex') { 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> END if ($newpostsflag) { $discussion .= '<td><font size="-1">1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i></font></td>'; } else { $discussion .= '<td><font size="-1">'.$lt{'disp'}.' - <i>'.$currdisp.'</i></font></td>'; } $discussion .= <<END; <td> </td> <td> <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b></td> </tr> </table> </td> </tr> </table> </td> </tr> </table> <br /><br /> END } } 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 = &HTML::Entities::encode($ENV{'form.subject'},'<>&"'); $comment = &HTML::Entities::encode($ENV{'form.comment'},'<>&"'); my @keepold = (); &process_attachments(\@currnewattach,\@currdelold,\@keepold); if (@currnewattach > 0) { $attachnum += @currnewattach; } } $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='. $symb.':::" '.$target.'>'. '<img src="/adm/lonMisc/chat.gif" border="0" />'. &mt('Post Discussion').'</a></td></tr></table>'; } } } return $discussion; } 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 ($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) { if ($contrib{$idx.':message'} =~ /::::\Q$numoldver\E::::(.+?)$/si) { $message = $1; } else { $message = $contrib{$idx.':message'}; } } else { $message=$contrib{$idx.':message'}; } $message=~s/\n/\<br \/\>/g; $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>'; if ($idx > 0) { if ($contrib{$idx.':subject'} =~ /::::\Q$numoldver\E::::(.+?)$/si) { $subject = $1; } else { $subject = $contrib{$idx.':subject'}; } $subject = 'Re: '.$subject; } $subject = &HTML::Entities::encode($subject,'<>&"'); } else { $attachmenturls = $contrib{$idx.':attachmenturl'}; if ($contrib{$idx.':message'} =~ /.*::::(\d+)::::(.*?)$/si) { $numoldver = $1; $comment = $2; } else { $comment = $contrib{$idx.':message'}; } $comment = &HTML::Entities::encode($comment,'<>&"'); if ($contrib{$idx.':subject'} =~ /.*::::\d+::::(.+?)$/si) { $subject = $1; } else { $subject = $contrib{$idx.':subject'}; } $subject = &HTML::Entities::encode($subject,'<>&"'); 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 = $ENV{'form.subject'}; $comment = $ENV{'form.comment'}; &process_attachments(\@currnewattach,\@currdelold,\@keepold); } my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders(); my $send=&mt('Send'); $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"> //<!-- function gosubmit() { var rec=0; if (typeof(document.mailform.elements.author)!="undefined") { if (document.mailform.elements.author.checked) { rec=1; } } if (typeof(document.mailform.elements.question)!="undefined") { if (document.mailform.elements.question.checked) { rec=1; } } if (typeof(document.mailform.elements.course)!="undefined") { if (document.mailform.elements.course.checked) { rec=1; } } if (typeof(document.mailform.elements.policy)!="undefined") { if (document.mailform.elements.policy.checked) { rec=1; } } if (typeof(document.mailform.elements.discuss)!="undefined") { if (document.mailform.elements.discuss.checked) { rec=1; } } if (typeof(document.mailform.elements.anondiscuss)!="undefined") { if (document.mailform.elements.anondiscuss.checked) { rec=1; } } if (rec) { if (typeof(document.mailform.onsubmit)!='undefined') { document.mailform.onsubmit(); } document.mailform.submit(); } else { alert('Please check a feedback type.'); } } $anonchk $anonscript //--> </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,$dispchg,$markchg,$feedurl) = @_; # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } my $function = &Apache::loncommon::get_users_function(); my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', $ENV{'user.domain'}); my $bodytag=&Apache::loncommon::bodytag('Discussion options', '',''); my %lt = &Apache::lonlocal::texthash( 'dido' => 'Discussion display options', 'pref' => 'Display Preference', 'curr' => 'Current setting ', 'actn' => 'Action', 'deff' => 'Default for all discussions', 'prca' => 'Preferences can be set for this discussion that determine ....', 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and', 'unwh' => 'Under what circumstances posts are identfied as "New."', 'allposts' => 'All posts', 'unread' => 'New posts only', 'ondisp' => 'Once displayed', 'onmark' => 'Once marked as read', 'disa' => 'Posts displayed?', 'npmr' => 'New posts cease to be identified as "New"?', 'chgt' => 'Change to ', 'mkdf' => 'Set to ', 'yhni' => 'You have not indicated that you wish to change either of the discussion settings', 'ywbr' => 'You will be returned to the previous page if you click OK.' ); my $dispchange = $lt{'unread'}; my $markchange = $lt{'ondisp'}; my $currdisp = $lt{'allposts'}; my $currmark = $lt{'onmark'}; my $discdisp = 'allposts'; my $discmark = 'onmark'; if ($dispchg eq 'allposts') { $dispchange = $lt{'allposts'}; $currdisp = $lt{'unread'}; $discdisp = 'unread'; } if ($markchg eq 'markonread') { $markchange = $lt{'onmark'}; $currmark = $lt{'ondisp'}; $discmark = 'ondisp'; } $r->print(<<END); <html> <head> <title>$lt{'dido'}</title> <meta http-equiv="pragma" content="no-cache" /> <script> function setDisp() { var prev = "$previous" var chktotal = 0 if (document.modifydisp.discdisp.checked == true) { document.modifydisp.$dispchg.value = "$symb" chktotal ++ } if (document.modifydisp.discmark.checked == true) { document.modifydisp.$markchg.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></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><input type="checkbox" name="discdisp" /> $lt{'chgt'} "$dispchange"</td> </tr><tr bgcolor="#eeeeee"> <td>$lt{'npmr'}</td> <td>$lt{$discmark}</td> <td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td> </tr> </table> </td> </tr> </table> </td> </tr> </table> <br /> <br /> <input type="hidden" name="previous" value="$previous" /> <input type="hidden" name="$dispchg" value=""/> <input type="hidden" name="$markchg" 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) = @_; # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } my @sections = (); my $section_sel = ''; my $numsections = 0; my $numvisible = 5; my ($classlist) = &Apache::loncoursedata::get_classlist( $ENV{'request.course.id'}, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); my $sec_index = &Apache::loncoursedata::CL_SECTION(); my $status_index = &Apache::loncoursedata::CL_STATUS(); my %sectioncount = (); while (my ($student,$data) = each %$classlist) { my ($section,$status) = ($data->[$sec_index], $data->[$status_index]); unless ($section eq '' || $section =~ /^\s*$/) { if (!defined($sectioncount{$section})) { $sectioncount{$section} = 1; $numsections ++; } else { $sectioncount{$section} ++; } } } if ($ENV{'request.course.sec'} !~ /^\s*$/) { @sections = ($ENV{'request.course.sec'}); $numvisible = 1; } else { @sections = sort {$a cmp $b} keys(%sectioncount); unshift(@sections,'all'); # Put 'all' at the front of the list if ($numsections < 4) { $numvisible = $numsections + 1; } } foreach (@sections) { $section_sel .= " <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' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.', 'soor' => 'Sort order', 'disp' => 'Specific user roles', 'actv' => 'Specific role status', 'spse' => 'Specific sections', 'psub' => 'Pick specific users (by name)', 'shal' => 'Show a list of current posters' ); $r->print(<<END); <html> <head> <title>$lt{'diso'}</title> <meta http-equiv="pragma" content="no-cache" /> </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{'disp'}</b></td> <td> </td> <td><b>$lt{'actv'}</b></td> <td> </td> <td><b>$lt{'spse'}</b></td> <td> </td> <td><b>$lt{'psub'}</b></td> </tr> <tr> <td> <select name="sortposts"> <option value="ascdate" />Date order - oldest first <option value="descdate" />Date order - newest first <option value="thread" />Threaded <option value="subject" />By subject <option value="username" />By domain and username <option value="lastfirst" />By last name, first name </select> </td> <td> </td> <td> <select name="rolefilter" multiple="true" size="5"> <option value="all" />All users <option value="st" />Students <option value="cc" />Course Coordinators <option value="in" />Instructors <option value="ta" />TAs <option value="pr" />Exam proctors <option value="cr" />Custom roles </select> </td> <td> </td> <td> <select name="statusfilter"> <option value="all" />Roles of any status <option value="Active" />Only active roles <option value="Expired" />Only inactive roles </select> </td> <td> </td> <td> <select name="sectionpick" multiple="true" size="$numvisible"> $section_sel </select> </td> <td> </td> <td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</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="javascript:document.modifyshown.submit()" /> <br /> <br /> </form> </body> </html> END } sub print_showposters { my ($r,$symb,$previous,$feedurl,$sortposts) = @_; # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } # backward compatibility (bulletin boards used to be 'wrapped') my $ressymb=$symb; if ($ressymb =~ /bulletin___\d+___/) { unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } } 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($ressymb,$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"); } } } } } $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"><input name="stuinfo" type="checkbox" value="'.$_.'" /></td><td>'.$last.', '.$first.' ('.$uname.','.$udom.')</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 fail_redirect { my ($r,$feedurl) = @_; if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; $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="/adm/lonIcons/lonlogos.gif" /> <b>Sorry, no recipients ...</b> </body> </html> ENDFAILREDIR } sub redirect_back { my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_; my $sorttag = ''; my $roletag = ''; my $statustag = ''; my $sectag = ''; my $userpicktag = ''; my $qrystr = ''; my $prevtag = ''; # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } 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)) && ($numpicks > 0) ) { my $userpickqry = 'totposters='.$numpicks; $feedurl .= '&'.$userpickqry; $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />'; } else { my $roleqry = 'rolefilter='.$rolefilter; $feedurl .= '&'.$roleqry; $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />'; $feedurl .= '&statusfilter='.$statusfilter; $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />'; $feedurl .= '§ionpick='.$secpick; $sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />'; } } $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="/adm/lonIcons/lonlogos.gif" /> $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> </body> </html> ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); $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='.$feedurl.'">'); } $r->print (<<ENDNOREDIRTWO); </head> <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'> <img align="right" src="/adm/lonIcons/lonlogos.gif" /> <b>$nofeed</b> </body> </html> ENDNOREDIRTWO } sub screen_header { my ($feedurl) = @_; my $msgoptions=''; my $discussoptions=''; unless (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) { if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { $msgoptions= '<p><input type="checkbox" name="author" /> '. &mt('Feedback to resource author').'</p>'; } if (&feedback_available(1)) { $msgoptions.= '<br /><input type="checkbox" name="question" /> '. &mt('Question about resource content'); } if (&feedback_available(0,1)) { $msgoptions.= '<br /><input type="checkbox" name="course" /> '. &mt('Question/Comment/Feedback about course content'); } if (&feedback_available(0,0,1)) { $msgoptions.= '<br /><input type="checkbox" name="policy" /> '. &mt('Question/Comment/Feedback about course policy'); } } if ($ENV{'request.course.id'}) { if (&discussion_open() && &Apache::lonnet::allowed('pch', $ENV{'request.course.id'}. ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '. ($ENV{'form.replydisc'}?' checked="1"':'').' /> '. &mt('Contribution to course discussion of resource'); $discussoptions.='<br /><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>'; } } if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; } if ($discussoptions) { $discussoptions='<h2><img src="/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, 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"; Refers to <a href="$feedurl">$feedurl</a> $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 ''; } 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=''; if (&discussion_open() && &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'}); $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'} =~ /::::\d+::::/) { $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.'::::'.$numnewver.'::::'.$contrib{'subject'}; } else { $contrib{'subject'} = '::::0::::'.$oldcontrib{$oldidx.':subject'}.'::::1::::'.$contrib{'subject'}; } } if (defined($oldcontrib{$oldidx.':message'})) { if ($oldcontrib{$oldidx.':message'} =~ /::::\d+::::/) { $contrib{'message'} = $oldcontrib{$oldidx.':message'}.'::::'.$numnewver.'::::'.$contrib{'message'}; } else { $contrib{'message'} = '::::0::::'.$oldcontrib{$oldidx.':message'}.'::::1::::'.$contrib{'message'}; } } $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; my $message=&clear_out_html($ENV{'form.comment'}); $message=~s/\n/\<br \/\>/g; $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); $r->print('<table border="2"><tr><td>'. '<b>Subject:</b> '.$subject.'<br /><br />'. $message.'</td></tr></table>'); } 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)!='undefined') {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 $subject=&clear_out_html($ENV{'form.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); } $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 (@currold) { my $id = $_; $attachments[$id] =~ m#/([^/]+)$#; $r->print('<input type="checkbox" name="deloldattach" value="'.$_.'" /> '.$1.'<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('<input type="checkbox" name="delnewattach" value="'.$_.'" /> '.$1.'<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) = @_; if (exists($ENV{'form.currnewattach'})) { if (ref($ENV{'form.currnewattach'}) eq 'ARRAY') { @{$currnewattach} = @{$ENV{'form.currnewattach'}}; } else { $$currnewattach[0] = $ENV{'form.currnewattach'}; } } if (exists($ENV{'form.deloldattach'})) { if (ref($ENV{'form.deloldattach'}) eq 'ARRAY') { @{$currdelold} = @{$ENV{'form.deloldattach'}}; } else { $$currdelold[0] = $ENV{'form.deloldattach'}; } } if (exists($ENV{'form.delnewattach'})) { my @currdelnew = (); my @currnew = (); if (ref($ENV{'form.delnewattach'}) eq 'ARRAY') { @currdelnew = @{$ENV{'form.delnewattach'}}; } else { $currdelnew[0] = $ENV{'form.delnewattach'}; } foreach my $newone (@{$currnewattach}) { my $delflag = 0; foreach (@currdelnew) { if ($newone eq $_) { $delflag = 1; last; } } unless ($delflag) { push @currnew, $newone; } } @{$currnewattach} = @currnew; } if (exists($ENV{'form.keepold'})) { if (ref($ENV{'form.keepold'}) eq 'ARRAY') { @{$keepold} = @{$ENV{'form.keepold'}}; } else { $$keepold[0] = $ENV{'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="this.form.subject.value=document.mailform.subject.value;this.form.comment.value=document.mailform.comment.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) = @_; if ($attachmenturls =~ m/::::\d+:[\.yn\d]+::::/) { @{$attachments} = split/::::\d+:[\.yn\d]+::::/,$attachmenturls; shift @{$attachments}; my $searchstr = '::::'; for (my $i=0; $i<@{$attachments}; $i++) { if ($attachmenturls =~ m#^\Q$searchstr\E(\d+)(:[\.yn\d]+)::::#) { my $info = $1.$2; my $attachid = $1-1; $searchstr .= $info.'::::'.$$attachments[$i].'::::'; if ($info =~ /\.$numoldver([yn])\./) { if (defined($currdelold)) { if (@{$currdelold} > 0) { unless (grep/^$attachid$/,@{$currdelold}) { my $id = $i; $$currattach{$id} = $1; } } else { my $id = $i; $$currattach{$id} = $1; } } else { my $id = $i; $$currattach{$id} = $1; } } } } my @attached = (sort { $a <=> $b } keys %{$currattach}); if (@attached == 1) { my $id = $attached[0]; $$attachments[$attached[0]]=~m|/([^/]+)$|; $$message.='<br /><a href="'.$$attachments[$id].'"><tt>'. $1.'</tt></a><br />'; &Apache::lonnet::allowuploaded('/adm/feedback', $$attachments[$id]); } elsif (@attached > 1) { $$message.='<ol>'; foreach (@attached) { my $id = $_; my ($fname) =($$attachments[$id]=~m|/([^/]+)$|); $$message .= '<li><a href="'.$$attachments[$id]. '"><tt>'. $fname.'</tt></a></li>'; &Apache::lonnet::allowuploaded('/adm/feedback', $$attachments[$id]); } $$message .= '</ol><br />'; } } else { my ($fname) =($attachmenturls=~m|/([^/]+)$|); $$message .='<p>'.&mt('Attachment'). ': <a href="'.$attachmenturls. '"><tt>'. $fname.'</tt></a></p>'; $$attachments[0] = $attachmenturls; $$currattach{'0'} = 'n'; &Apache::lonnet::allowuploaded('/adm/feedback', $attachmenturls); } } sub construct_attachmenturl { my ($currnewattach,$keepold,$symb,$idx)=@_; my $oldattachmenturl; my $newattachmenturl; my $startnum = 1; 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/::::\d+:[\.yn\d]+::::/) { my @attachments = split/::::\d+:[\.yn\d]+::::/,$oldattachmenturl; shift @attachments; $startnum += @attachments; my $searchstr = '::::'; $newattachmenturl = '::::'; for (my $i=0; $i<@attachments; $i++) { if ($oldattachmenturl =~ m#^\Q$searchstr\E(\d+)(:[\.yn\d]+)::::#) { my $attachid = $1 - 1; $searchstr .= $1.$2.'::::'.$attachments[$i].'::::'; $newattachmenturl .= $1.$2; if (grep/^$attachid$/,@{$keepold}) { $newattachmenturl .= '.'.$currver.'n.'; } $newattachmenturl .= '::::'.$attachments[$i].'::::'; } } $newattachmenturl =~ s/::::$//; } else { $newattachmenturl = '::::1:.0n.'; unless (grep/^0$/,@{$keepold}) { $newattachmenturl .= '.1n.'; } $newattachmenturl .= '::::'.$oldattachmenturl; $startnum ++; } } } for (my $i=0; $i<@{$currnewattach}; $i++) { my $attachnum = $startnum + $i; $newattachmenturl .= '::::'.$attachnum.':.'.$currver.'n.::::'.$$currnewattach[$i]; } return $newattachmenturl; } 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','threadedon','threadedoff','onlyunread','allposts','previous','markread','markonread','markondisp','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions']); if ($ENV{'form.allversions'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; 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'}); my $ressymb=$symb; unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } if ($idx > 0) { my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); if ($contrib{$idx.':history'}) { my $attachmenturls = $contrib{$idx.':attachmenturl'}; my @postversions = (); if ($contrib{$idx.':history'} =~ m/:/) { @postversions = split/:/,$contrib{$idx.':history'}; } else { @postversions = ("$contrib{$idx.':history'}"); } if (@postversions > 0) { push @postversions,$contrib{$idx.':timestamp'}; my $screenname=&Apache::loncommon::screenname( $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); my $plainname=&Apache::loncommon::nickname( $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}); my $sender=&Apache::loncommon::aboutmewrapper( $plainname, $contrib{$idx.':sendername'}, $contrib{$idx.':senderdomain'}).' ('. $contrib{$idx.':sendername'}.' at '. $contrib{$idx.':senderdomain'}.')'; if ($contrib{$idx.':anonymous'}) { $sender.=' ['.&mt('anonymous').'] '.$screenname; } $r->print('<b>'.$sender.'</b><br /><ul>'); for (my $i=0; $i<@postversions; $i++) { my ($timesent,$message,$subject,$attachmsg); $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]); if ($i == @postversions-1) { ($message)=($contrib{$idx.':message'} =~ /.*::::\Q$i\E::::(.+?)$/si); ($subject)=($contrib{$idx.':subject'} =~ /.*::::\Q$i\E::::(.+?)$/si); } else { ($message)=($contrib{$idx.':message'} =~ /::::\Q$i\E::::(.+?)::::/si); ($subject)=($contrib{$idx.':subject'} =~ /::::\Q$i\E::::(.+?)::::/si); } $message=~s/\n/\<br \/\>/g; $message=&Apache::lontexconvert::msgtexconverted($message); $subject=~s/\n/\<br \/\>/g; $subject=&Apache::lontexconvert::msgtexconverted($subject); if ($attachmenturls) { my @attachments = (); my %currattach = (); &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,\@attachments,\%currattach); } if ($attachmsg) { $attachmsg = '<br />Attachments:'.$attachmsg.'<br />'; } else { $attachmsg = '<br />'; } $r->print (<<END); <li><b>$subject</b>, $timesent<br /> $message<br /> $attachmsg</li> END } $r->print('</ul></body></html>'); } } } return OK; } if ($ENV{'form.posterlist'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.posterlist'}; my $sortposts = $ENV{'form.sortposts'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $previous=$ENV{'form.previous'}; my $feedurl = &Apache::lonnet::clutter($url); # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } &print_showposters($r,$symb,$previous,$feedurl,$sortposts); return OK; } if ($ENV{'form.userpick'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.userpick'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $previous=$ENV{'form.previous'}; # backward compatibility (bulletin boards used to be 'wrapped') my $ressymb=$symb; unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } my $sort=$ENV{'form.sortposts'}; my @posters = (); if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') { @posters = $ENV{'form.stuinfo'}; } else { $posters[0] = $ENV{'form.stuinfo'}; } my $numpicks = @posters; if (defined($ENV{'form.userpick'})) { my %discinfo = (); $discinfo{$ressymb.'_userpick'} = join('&',@posters); &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); } my $feedurl = &Apache::lonnet::clutter($url); # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks); return OK; } if ($ENV{'form.applysort'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.applysort'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $previous=$ENV{'form.previous'}; my $sort = $ENV{'form.sortposts'}; my $rolefilter = $ENV{'form.rolefilter'}; my $statusfilter = $ENV{'form.statusfilter'}; my $secpick = $ENV{'form.sectionpick'}; my $feedurl = &Apache::lonnet::clutter($url); # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick); return OK; } elsif ($ENV{'form.sortfilter'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.sortfilter'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $previous=$ENV{'form.previous'}; my $feedurl = &Apache::lonnet::clutter($url); # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } &print_sortfilter_options($r,$symb,$previous,$feedurl); return OK; } elsif ($ENV{'form.navmaps'}) { my %discinfo = (); my @resources = (); if ($ENV{'form.navmaps'} =~ /:/) { @resources = split/:/,$ENV{'form.navmaps'}; } else { @resources = ("$ENV{'form.navmaps'}"); } 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.' ); foreach (@resources) { # backward compatibility (bulletin boards used to be 'wrapped') my $ressymb=$_; if ($ressymb =~ m/bulletin___\d+___/) { unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|; } } my $lastkey = $ressymb.'_lastread'; $discinfo{$lastkey} = time; } &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; $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="/adm/lonIcons/lonlogos.gif" /> <b>$lt{'mnpa'} $numitems $lt{'robb'}</b> <form name="reldt" action="$feedurl" target="loncapaclient"> </form> </body> </html> ENDREDIR return OK; } elsif ($ENV{'form.modifydisp'}) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.modifydisp'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); my $previous=$ENV{'form.previous'}; my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'}; my $feedurl = &Apache::lonnet::clutter($url); # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } &print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl); return OK; } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $previous=$ENV{'form.previous'}; my ($map,$ind,$url); if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) { # ---------------------- Modify setting for identification of 'NEW' posts in this discussion my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'}; my $ressymb = $symb; ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } my %discinfo = (); my $lastkey = $ressymb.'_lastread'; my $ondispkey = $ressymb.'_markondisp'; if ($ENV{'form.markondisp'}) { $discinfo{$lastkey} = time; $discinfo{$ondispkey} = 1; } elsif ($ENV{'form.markonread'}) { if ( $previous > 0 ) { $discinfo{$lastkey} = $previous; } $discinfo{$ondispkey} = 0; } &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); } if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) { # ----------------------------------------------------------------- Modify display setting for this discussion my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'}; my $ressymb = $symb; ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } my %discinfo = (); if ($ENV{'form.allposts'}) { $discinfo{$ressymb.'_showonlyunread'} = 0; } elsif ($ENV{'form.onlyunread'}) { $discinfo{$ressymb.'_showonlyunread'} = 1; } &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); } if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) { &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous); } else { &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0'); } return OK; } elsif ($ENV{'form.markread'}) { # ----------------------------------------------------------------- Mark new posts as read &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $symb=$ENV{'form.markread'}; my $ressymb = $symb; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; } my %discinfo = (); my $lastkey = $ressymb.'_lastread'; $discinfo{$lastkey} = time; &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'}); &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0'); return OK; } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { # ----------------------------------------------------------------- Hide/unhide &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; my ($symb,$idx)=split(/\:\:\:/,$entry); my ($map,$ind,$url)=&Apache::lonnet::decode_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,&Apache::lonnet::clutter($url), &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'}); } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; if ($ENV{'form.threadedon'}) { &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on'); } else { &Apache::lonnet::del('environment',['threadeddiscussion']); &Apache::lonnet::delenv('environment\.threadeddiscussion'); } my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'}; my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); &redirect_back($r,&Apache::lonnet::clutter($url), &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'}); } elsif ($ENV{'form.deldisc'}) { # --------------------------------------------------------------- Hide for good &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; my $entry=$ENV{'form.deldisc'}; my ($symb,$idx)=split(/\:\:\:/,$entry); my ($map,$ind,$url)=&Apache::lonnet::decode_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 $currentdeleted=$contrib{'deleted'}; $currentdeleted.='.'.$idx.'.'; my %newhash=('deleted' => $currentdeleted); &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,&Apache::lonnet::clutter($url), &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'}); } elsif ($ENV{'form.preview'}) { # -------------------------------------------------------- User wants a preview $r->content_type('text/html'); $r->send_http_header; &show_preview($r); } 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 = (); my @currdelold = (); my @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 $idx = $ENV{'form.idx'}; my $symb = $ENV{'form.attach'}; 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); } 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); } } my $goahead=1; if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { unless ($symb) { $goahead=0; } } # backward compatibility (bulletin boards used to be 'wrapped') if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { $feedurl=~s|^/adm/wrapper||; } if ($goahead) { # Go ahead with feedback, no ambiguous reference &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; if ( ( ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) ) || ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) || ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) ) { # --------------------------------------------------- Print login screen header unless ($ENV{'form.sendit'}) { my $options=&screen_header($feedurl); if ($options) { &mail_screen($r,$feedurl,$options); } else { &fail_redirect($r,$feedurl); } } else { # 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'}; } 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'}) { my $subject = &clear_out_html($ENV{'form.subject'}); $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject); $numpost++; } if ($ENV{'form.anondiscuss'}) { my $subject = &clear_out_html($ENV{'form.subject'}); $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject); $numpost++; } # Receipt screen and redirect back to where came from &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'}); } } else { # Unable to give feedback &no_redirect_back($r,$feedurl); } } else { # Ambiguous Problem Resource if ( &Apache::lonnet::mod_perl_version() == 2 ) { &Apache::lonnet::cleanenv(); } $r->internal_redirect('/adm/ambiguous'); } } return OK; } 1; __END__