--- loncom/interface/lonfeedback.pm 2001/02/09 21:17:48 1.6 +++ loncom/interface/lonfeedback.pm 2007/01/23 01:27:17 1.241 @@ -1,192 +1,2609 @@ # The LearningOnline Network # Feedback # -# (Internal Server Error Handler +# $Id: lonfeedback.pm,v 1.241 2007/01/23 01:27:17 raeburn Exp $ # -# (Login Screen -# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, -# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) +# Copyright Michigan State University Board of Trustees # -# 3/1/1 Gerd Kortemeyer) +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). # -# 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. # +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +### + package Apache::lonfeedback; use strict; use Apache::Constants qw(:common); use Apache::lonmsg(); +use Apache::loncommon(); +use Apache::lontexconvert(); +use Apache::lonlocal; # must not have () +use Apache::lonnet; +use Apache::lonhtmlcommon(); +use Apache::lonnavmaps; +use Apache::lonenc(); +use Apache::lonrss(); +use HTML::LCParser(); +use Apache::lonspeller(); +use Apache::longroup; +use Cwd; +use LONCAPA; + +sub discussion_open { + my ($status,$symb)=@_; + if ($env{'request.role.adv'}) { return 1; } + if (defined($status) && + !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' + || $status eq 'OPEN')) { + return 0; + } + my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); + if (defined($close) && $close ne '' && $close < time) { + return 0; + } + return 1; +} -sub mail_screen { - my ($r,$feedurl,$options) = @_; - $r->print(< - -The LearningOnline Network with CAPA +sub discussion_visible { + my ($status)=@_; + if (not &discussion_open($status)) { + my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); + if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { + if (!$env{'request.role.adv'}) { return 0; } + } + } + return 1; +} + +sub list_discussion { + my ($mode,$status,$ressymb,$imsextras,$group)=@_; + unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } + unless ($ressymb) { return ''; } + $ressymb=&wrap_symb($ressymb); + my $outputtarget=$env{'form.grade_target'}; + if (defined($env{'form.export'})) { + if($env{'form.export'}) { + $outputtarget = 'export'; + } + } + if (defined($imsextras)) { + if ($$imsextras{'caller'} eq 'imsexport') { + $outputtarget = 'export'; + } + } + if (not &discussion_visible($status)) { + if ($mode ne 'board') { + &Apache::lonenc::check_encrypt(\$ressymb); + return &send_message_link($ressymb); + } + } + if ($group ne '' && $mode eq 'board') { + if (&check_group_priv($group,'vgb') ne 'ok') { + return ''; + } + } + + my ($blocked,$blocktext) = + &Apache::loncommon::blocking_status('boards'); + if ($blocked) { + &Apache::lonenc::check_encrypt(\$ressymb); + if ($mode ne 'board') { + $blocktext.='
'.&send_message_link($ressymb); + } + return $blocktext; + } + + my @bgcols = ("#cccccc","#eeeeee"); + my $discussiononly=0; + if ($mode eq 'board') { $discussiononly=1; } + unless ($env{'request.course.id'}) { return ''; } + my $crs='/'.$env{'request.course.id'}; + my $cid=$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; + } + $crs=~s/\_/\//g; + my $encsymb=&Apache::lonenc::check_encrypt($ressymb); + my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) + && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form|task)$/)); + + my %usernamesort = (); + my %namesort =(); + my %subjectsort = (); + +# Get discussion display settings for this discussion + my $lastkey = $ressymb.'_lastread'; + my $showkey = $ressymb.'_showonlyunread'; + my $markkey = $ressymb.'_showonlyunmark', + my $visitkey = $ressymb.'_visit'; + my $ondispkey = $ressymb.'_markondisp'; + my $userpickkey = $ressymb.'_userpick'; + my $toggkey = $ressymb.'_readtoggle'; + my $readkey = $ressymb.'_read'; + $ressymb=$encsymb; + my %dischash = &Apache::lonnet::get('nohist_'.$cid.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$env{'user.domain'},$env{'user.name'}); + my %discinfo = (); + my $showonlyunread = 0; + my $showunmark = 0; + my $markondisp = 0; + my $prevread = 0; + my $previous = 0; + my $visit = 0; + my $newpostsflag = 0; + my @posters = split(/\&/,$dischash{$userpickkey}); + +# Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','grouppick','totposters']); + my $sortposts = $env{'form.sortposts'}; + my $statusfilter = $env{'form.statusfilter'}; + my @sectionpick = split(/,/,$env{'form.sectionpick'}); + my @grouppick = split(/,/,$env{'form.grouppick'}); + my @rolefilter = split(/,/,$env{'form.rolefilter'}); + + my $totposters = $env{'form.totposters'}; + $previous = $env{'form.previous'}; + if ($previous > 0) { + $prevread = $previous; + } elsif (defined($dischash{$lastkey})) { + unless ($dischash{$lastkey} eq '') { + $prevread = $dischash{$lastkey}; + } + } + + my $cdom = $env{'course.'.$cid.'.domain'}; + my $cnum = $env{'course.'.$cid.'.num'}; + +# Get information about students and non-students in course for filtering display of posts + my %roleshash = (); + my %roleinfo = (); + my ($classgroups,$studentgroups); + if ($env{'form.rolefilter'}) { + %roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); + foreach my $rolekey (keys(%roleshash)) { + my ($role,$uname,$udom,$sec) = split(/:/,$rolekey); + if ($role =~ /^cr/) { + $role = 'cr'; + } + my ($end,$start) = split(/:/,$roleshash{$rolekey}); + my $now = time; + my $status = 'Active'; + if (($now < $start) || ($end > 0 && $now > $end)) { + $status = 'Expired'; + } + if ($uname && $udom) { + push(@{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status); + } + } + my ($classlist,$keylist) = + &Apache::loncoursedata::get_classlist($cdom,$cnum); + my $sec_index = &Apache::loncoursedata::CL_SECTION(); + my $status_index = &Apache::loncoursedata::CL_STATUS(); + while (my ($student,$data) = each %$classlist) { + my ($section,$status) = ($data->[$sec_index], + $data->[$status_index]); + push(@{$roleinfo{$student}}, 'st:'.$section.':'.$status); + } + ($classgroups,$studentgroups) = + &Apache::loncoursedata::get_group_memberships($classlist,$keylist, + $cdom,$cnum); + } + +# Get discussion display default settings for user + if ($env{'environment.discdisplay'} eq 'unread') { + $showonlyunread = 1; + } + if ($env{'environment.discmarkread'} eq 'ondisp') { + $markondisp = 1; + } + +# Override user's default if user specified display setting for this discussion + if (defined($dischash{$ondispkey})) { + unless ($dischash{$ondispkey} eq '') { + $markondisp = $dischash{$ondispkey}; + } + } + if ($markondisp) { + $discinfo{$lastkey} = time; + } + + if (defined($dischash{$showkey})) { + unless ($dischash{$showkey} eq '') { + $showonlyunread = $dischash{$showkey}; + } + } + + if (defined($dischash{$markkey})) { + unless ($dischash{$markkey} eq '') { + $showunmark = $dischash{$markkey}; + } + } + + if (defined($dischash{$visitkey})) { + unless ($dischash{$visitkey} eq '') { + $visit = $dischash{$visitkey}; + } + } + $visit ++; + + my $seeid; + if (($group ne '') && ($mode eq 'board') && + ($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { + if (&check_group_priv($group,'dgp') eq 'ok') { + $seeid = 1; + } + } else { + $seeid=&Apache::lonnet::allowed('rin',$crs); + } + my @discussionitems=(); + my %shown = (); + my @posteridentity=(); + + my $current=0; + my $visible=0; + my @depth=(); + my @replies = (); + my %alldiscussion=(); + my %imsitems=(); + my %imsfiles=(); + my %notshown = (); + my %newitem = (); + my $maxdepth=0; + my %anonhash=(); + my $anoncnt=0; + my $target=''; + unless ($env{'browser.interface'} eq 'textual' || + $env{'environment.remote'} eq 'off' ) { + $target='target="LONcom"'; + } + + my $now = time; + $discinfo{$visitkey} = $visit; + + &Apache::lonnet::put('nohist_'.$cid.'_discuss',\%discinfo,$env{'user.domain'},$env{'user.name'}); + &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$encsymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); + + my $discussion=''; + my $manifestfile; + my $manifestok=0; + my $tempexport; + my $imsresources; + my $copyresult; + + my $function = &Apache::loncommon::get_users_function(); + my $color = &Apache::loncommon::designparm($function.'.tabbg', + $env{'user.domain'}); + my %lt = &Apache::lonlocal::texthash( + 'cuse' => 'Current discussion settings', + 'allposts' => 'All posts', + 'unread' => 'New posts only', + 'unmark' => 'Unread only', + 'ondisp' => 'Once displayed', + 'onmark' => 'Once marked not NEW', + 'toggoff' => 'Off', + 'toggon' => 'On', + 'disa' => 'Posts to be displayed', + 'npce' => 'Posts cease to be marked "NEW"', + 'epcb' => 'Each post can be toggled read/unread', + 'chgt' => 'Change', + 'disp' => 'Display', + 'nolo' => 'Not new', + 'togg' => 'Toggle read/unread', + 'aner' => 'An error occurred opening the manifest file.', + 'difo' => 'Discussion for', + 'aerr' => 'An error occurred opening the export file for posting', + 'aysu' => 'Are you sure you want to delete this post?', + 'dpwn' => 'Deleted posts will no longer be visible to you and other students', + 'bwco' => 'but will continue to be visible to your instructor', + 'depo' => 'Deleted posts will no longer be visible to you or anyone else.', + ); + + my $currdisp = $lt{'allposts'}; + my $currmark = $lt{'onmark'}; + my $currtogg = $lt{'toggoff'}; + my $dispchange = $lt{'unread'}; + my $markchange = $lt{'ondisp'}; + my $toggchange = $lt{'toggon'}; + my $chglink = '/adm/feedback?modifydisp='.$ressymb; + my $displinkA = 'onlyunread'; + my $displinkB = 'onlyunmark'; + my $marklink = 'markondisp'; + my $togglink = 'toggon'; + + if ($markondisp) { + $currmark = $lt{'ondisp'}; + $markchange = $lt{'onmark'}; + $marklink = 'markonread'; + } + + if ($showonlyunread) { + $currdisp = $lt{'unread'}; + $dispchange = $lt{'allposts'}; + $displinkA = 'allposts'; + } + + if ($showunmark) { + $currdisp = $lt{'unmark'}; + $dispchange = $lt{'unmark'}; + $displinkA='allposts'; + $displinkB='onlyunread'; + $showonlyunread = 0; + } + + if ($dischash{$toggkey}) { + $currtogg = $lt{'toggon'}; + $toggchange = $lt{'toggoff'}; + $togglink = 'toggoff'; + } + + $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; + + if ($newpostsflag) { + $chglink .= '&previous='.$prevread; + } + $chglink.=&group_args($group); + + if ($visible) { +# Print the discusssion + if ($outputtarget eq 'tex') { + $discussion.='{\tiny \vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. + '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'. + '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'. + '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. + '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}}'; + } elsif ($outputtarget eq 'export') { +# Create temporary directory if this is an export + my $now = time; + if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { + $tempexport = $$imsextras{'tempexport'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$$imsextras{'count'}; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + } else { + $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$now; + if (!-e $tempexport) { + mkdir($tempexport,0700); + } + $tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'}; + } + if (!-e $tempexport) { + mkdir($tempexport,0700); + } +# open manifest file + my $manifest = '/imsmanifest.xml'; + my $manifestfilename = $tempexport.$manifest; + if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { + $manifestok=1; + print $manifestfile qq| + + + + + $lt{'difo'} $ressymb\n|; + } else { + $discussion .= $lt{'aner'}.'
'; + } + } else { + my $colspan=$maxdepth+1; + $discussion.= qq| + |; + $discussion.='
'; + $discussion .= &action_links_bar($colspan,$ressymb,$visible, + $newpostsflag,$group, + $prevread,$markondisp); + my $escsymb=&escape($ressymb); + my $numhidden = keys(%notshown); + if ($numhidden > 0) { + my $colspan = $maxdepth+1; + $discussion.="\n".''; + } } - if (document.mailform.elements.question!=undefined) { - if (document.mailform.elements.question.checked) { - rec=1; - } + +# Choose sort mechanism + my @showposts = (); + if ($sortposts eq 'descdate') { + @showposts = (sort { $b <=> $a } keys(%alldiscussion)); + } elsif ($sortposts eq 'thread') { + @showposts = (sort { $a <=> $b } keys(%alldiscussion)); + } elsif ($sortposts eq 'subject') { + foreach my $key (sort(keys(%subjectsort))) { + push(@showposts, @{$subjectsort{$key}}); + } + } elsif ($sortposts eq 'username') { + foreach my $domain (sort(keys(%usernamesort))) { + foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { + push(@showposts, @{$usernamesort{$domain}{$key}}); + } + } + } elsif ($sortposts eq 'lastfirst') { + foreach my $last (sort(keys(%namesort))) { + foreach my $key (sort(keys(%{$namesort{$last}}))) { + push(@showposts, @{$namesort{$last}{$key}}); + } + } + } else { + @showposts = (sort { $a <=> $b } keys(%alldiscussion)); } - if (document.mailform.elements.course!=undefined) { - if (document.mailform.elements.course.checked) { - rec=1; - } + my $currdepth = 0; + my $firstidx = $alldiscussion{$showposts[0]}; + foreach my $post (@showposts) { + unless (($sortposts eq 'thread') || (($sortposts eq '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { + $alldiscussion{$post} = $post; + } + unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + $discussion.="\n"; + } + my $thisdepth=$depth[$alldiscussion{$post}]; + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + for (1..$thisdepth) { + $discussion.=''; + } + } + my $colspan=$maxdepth-$thisdepth+1; + if ($outputtarget eq 'tex') { + #cleanup block + $discussionitems[$alldiscussion{$post}]=~s/]*)>/
'. + ''.&mt('Show all posts').' '.&mt('to display').' '. + $numhidden.' '; + if ($showunmark) { + $discussion .= &mt('posts previously marked read'); + } else { + $discussion .= &mt('previously viewed posts'); + } + $discussion .= '
   
/; + $discussionitems[$alldiscussion{$post}]=~s/]*)>]*)>/'; + } + } + } + unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { + my $colspan=$maxdepth+1; + $discussion .= < + + +END + $discussion .= &action_links_bar($colspan,$ressymb,$visible, + $newpostsflag,$group, + $prevread,$markondisp); + $discussion .= " +
/; + my $threadinsert=''; + if ($thisdepth > 0) { + $threadinsert='
Reply: '.$thisdepth.''; + } + $discussionitems[$alldiscussion{$post}]=~s/<\/td>]*)>/$threadinsert<\/td>		/; + $discussionitems[$alldiscussion{$post}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; + $discussionitems[$alldiscussion{$post}]=~s/(|<\/b>|<\/a>|]+)>)//g; + + $discussionitems[$alldiscussion{$post}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$discussionitems[$alldiscussion{$post}]; + $discussion.=$discussionitems[$alldiscussion{$post}]; + } elsif ($outputtarget eq 'export') { + my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html'; + if ($manifestok) { + if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) { + print $manifestfile ' '."\n"; + } + $currdepth = $depth[$alldiscussion{$post}]; + print $manifestfile "\n". + ''. + ''.$imsitems{$alldiscussion{$post}}{'title'}.''; + $imsresources .= "\n". + ''."\n". + ''."\n". + $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}."\n". + ''; + } + my $postingfile; + my $postingfilename = $tempexport.'/'.$postfilename; + if ($postingfile = Apache::File->new('>'.$postingfilename)) { + print $postingfile 'Discussion Post'. + $imsitems{$alldiscussion{$post}}{'title'}.' '. + $imsitems{$alldiscussion{$post}}{'sender'}. + $imsitems{$alldiscussion{$post}}{'timestamp'}.'

'. + $imsitems{$alldiscussion{$post}}{'message'}.'
'. + $imsitems{$alldiscussion{$post}}{'attach'}.''."\n"; + close($postingfile); + } else { + $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'
'; + } + $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); + } else { + $discussion.='		'. $discussionitems[$alldiscussion{$post}]. + '
+ + + +END + if ($sortposts) { + my %sort_types = (); + my %role_types = (); + my %status_types = (); + &sort_filter_names(\%sort_types,\%role_types,\%status_types); + + $discussion .= ''; + } + } + if ($dischash{$toggkey}) { + my $storebutton = &mt('Store read/unread changes'); + $discussion.=''; + } + $discussion .= (< +
+ + + + + + + + +
+ $lt{'cuse'}:  +END + if ($newpostsflag) { + $discussion .= + '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''; + if ($dischash{$toggkey}) { + $discussion .= '  3. '.$lt{'togg'}.' - '.$currtogg.''; + } + } else { + if ($dischash{$toggkey}) { + $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.' 2. '.$lt{'togg'}.' - '.$currtogg.''; + } else { + $discussion .= + $lt{'disp'}.' - '.$currdisp.''; + } + } + $discussion .= <  + $lt{'chgt'}? +
+ 		'.&mt('Sorted by').': '.$sort_types{$sortposts}.'
'; + if (defined($env{'form.totposters'})) { + $discussion .= &mt('Posts by').':'; + if ($totposters > 0) { + foreach my $poster (@posters) { + $discussion .= ' '.$poster.','; + } + $discussion =~ s/,$//; + } else { + $discussion .= &mt('None selected'); + } + } else { + my $filterchoice =''; + if (@sectionpick > 0) { + $filterchoice = ''.&mt('sections').'- '.$env{'form.sectionpick'}; + $filterchoice .= '    '; + } + if (@grouppick > 0) { + $filterchoice = ''.&mt('groups').'- '.$env{'form.grouppick'}; + $filterchoice .= '    '; + } + if (@rolefilter > 0) { + $filterchoice .= ''.&mt('roles').'-'; + foreach my $role (@rolefilter) { + $filterchoice .= ' '.$role_types{$role}.','; + } + $filterchoice =~ s/,$//; + $filterchoice .= '
        '; + } + if ($statusfilter) { + $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter}; + } + if ($filterchoice) { + $discussion .= ''.&mt('Filters').': '.$filterchoice; + } + $discussion .= '		'. + ''."\n". + ''."\n". + '
+
+

\n"; + } + if ($outputtarget eq 'export') { + if ($manifestok) { + while ($currdepth > 0) { + print $manifestfile " \n"; + $currdepth --; + } + print $manifestfile qq| + + + + $imsresources + + + |; + close($manifestfile); + if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { + $discussion = $copyresult; + } else { + +#Create zip file in prtspool + + my $imszipfile = '/prtspool/'. + $env{'user.name'}.'_'.$env{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.zip'; + my $cwd = &getcwd(); + my $imszip = '/home/httpd/'.$imszipfile; + chdir $tempexport; + open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); + close(OUTPUT); + chdir $cwd; + $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive','').'
'; + if ($copyresult) { + $discussion .= &mt('The following errors occurred during export').' -
'.$copyresult; + } + } + } else { + $discussion .= '
'.&mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.').'
'; + } + return $discussion; + } + } + if ($discussiononly) { + my $now = time; + my $attachnum = 0; + my $currnewattach = []; + my $currdelold = []; + my $comment = ''; + my $subject = ''; + if ($env{'form.origpage'}) { + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']); + $subject = &unescape($env{'form.subject'}); + $comment = &unescape($env{'form.comment'}); + my @keepold = (); + &process_attachments($currnewattach,$currdelold,\@keepold); + if (@{$currnewattach} > 0) { + $attachnum += @{$currnewattach}; + } + } + if (&discussion_open($status)) { + if (($group ne '') && ($mode eq 'board')) { + if (&check_group_priv($group,'pgd') eq 'ok') { + $discussion .= + &postingform_display($mode,$ressymb,$now,$subject, + $comment,$outputtarget,$attachnum, + $currnewattach,$currdelold, + $group); + } + } else { + $discussion.= + &postingform_display($mode,$ressymb,$now,$subject, + $comment,$outputtarget,$attachnum, + $currnewattach,$currdelold); + } + } + } else { + $discussion.='
'; + 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.= &send_feedback_link($ressymb,$target). + '
'; + } + } + if ($outputtarget ne 'tex') { + $discussion.= &send_message_link($ressymb); + } + $discussion.='
'; + } + return $discussion; +} + +sub send_feedback_link { + my ($ressymb,$target) = @_; + my $output = ''. + ' '. + ''.&mt('Post Discussion').''; + return $output; +} + +sub send_message_link { + my ($ressymb) = @_; + my $output = ''. + ' '.&mt('Send Message').''; + return $output; +} + +sub action_links_bar { + my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp) = @_; + my $discussion = ''. + ''; + my $escsymb=&escape($ressymb); + if ($visible>2) { + $discussion .= ''; + if ($newpostsflag) { + if (!$markondisp) { + $discussion .=''; + } + } else { + $discussion .= ''; + } + $discussion .= '
'. + ''.&mt('Threaded View').'  '. + ''.&mt('Chronological View').'   + '.&mt('Sorting/Filtering options').'  '; + } else { + $discussion .= ''; + } + $discussion .=''.&mt('Export').'?  '. + &mt('Preferences on what is marked as NEW'). + '
'.&mt('Mark NEW posts no longer new').''; + } else { + $discussion .= '		  
'; + return $discussion; +} + +sub postingform_display { + my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum, + $currnewattach,$currdelold,$group) = @_; + my $newattachmsg; + my %lt = &Apache::lonlocal::texthash( + 'note' => 'Note: in anonymous discussion, your name is visible only to course faculty', + 'title' => 'Title', + 'podi' => 'Post Discussion', + 'poan' => 'Post Anonymous Discussion', + 'newa' => 'New attachments', + ); + my $postingform = (< + + + +
+$lt{'note'}
+$lt{'title'}: 

+ +ENDDISCUSS + if ($env{'form.origpage'}) { + $postingform .= ''."\n"; + foreach my $att (@{$currnewattach}) { + $postingform .= ''."\n"; + } + } + if (exists($env{'form.ref'})) { + $postingform .= ''; + } + if ($group ne '') { + $postingform .=''; + } + my $blockblog = &Apache::loncommon::blocking_status('blogs'); + if (!$blockblog) { + $postingform .= &add_blog_checkbox(); + } + $postingform .= "\n"; + if ($outputtarget ne 'tex') { + $postingform .= &generate_attachments_button('',$attachnum,$ressymb, + $now,$currnewattach, + $currdelold,'',$mode, + $blockblog); + if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { + $newattachmsg = '
'.$lt{'newa'}.'
'; + if (@{$currnewattach} > 1) { + $newattachmsg .= '
    '; + foreach my $item (@{$currnewattach}) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $$currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + $postingform .= $newattachmsg; + $postingform .= &generate_preview_button(); + } + return $postingform; +} + +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,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_; + my @original=(); + my @index=(); + my $skip_group_check = 0; + my $symb=&Apache::lonenc::check_decrypt($ressymb); + my $escsymb=&escape($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 ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) { + $skip_group_check = 1; + } + 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'); +# Anonymous users getting number within a discussion +# Since idx is in static order, this should give the same sequence every time. + my $key=$contrib{$idx.':sendername'}.'@'.$contrib{$idx.':senderdomain'}; + unless ($$anonhash{$key}) { + $anoncnt++; + $$anonhash{$key}=&mt('Anonymous').' '.$anoncnt; + } + my ($message,$subject,$vgrlink,$ctlink); + &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver); + + +# Set up for sorting by subject + unless ($outputtarget eq 'export') { + $message=$messages{$numoldver}; + $message.=$attachtxt{$numoldver}; + $subject=$subjects{$numoldver}; + if ($message) { + if ($hidden) { + $message=''.$message.''; + if ($studenthidden) { + $message .='

Deleted by poster (student).'; + } + } + + if ($subject eq '') { + if (defined($$subjectsort{'__No subject'})) { + push(@{$$subjectsort{'__No subject'}}, $idx); + } else { + @{$$subjectsort{'__No subject'}} = ("$idx"); + } + } else { + if (defined($$subjectsort{$subject})) { + push(@{$$subjectsort{$subject}}, $idx); + } else { + @{$$subjectsort{$subject}} = ("$idx"); + } + } + if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { + $sender=&Apache::loncommon::aboutmewrapper( + $plainname, + $contrib{$idx.':sendername'}, + $contrib{$idx.':senderdomain'}).' ('. + $contrib{$idx.':sendername'}.' at '. + $contrib{$idx.':senderdomain'}.')'; + if ($contrib{$idx.':anonymous'}) { + $sender.=' ['.$$anonhash{$key}.'] '. + $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 (&editing_allowed($escsymb.':::'.$idx,$group)) { + if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { + $sender.=' '.&mt('Edit').''; + + unless ($seeid) { + my $grpargs = &group_args($group); + $sender.=" '; + } + } + } + if ($seeid) { + if ($hidden) { + unless ($studenthidden) { + $sender.=' '.&mt('Make Visible').''; + } + } else { + $sender.=' '.&mt('Hide').''; + } + my $grpargs = &group_args($group); + $sender.= + " "; + $sender .= &mt('Delete').''; + } + } else { + if ($screenname) { + $sender=''.$screenname.''; + } else { + $sender=''.$$anonhash{$key}.''; + } +# 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)) { + if (($group ne '') && + (&check_group_priv($group,'pgd') eq 'ok')) { + $sender.=' '.&mt('Reply').''; + } elsif (&Apache::lonnet::allowed('pch', + $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'. + $env{'request.course.sec'}:''))) { + $sender.=' '.&mt('Reply').''; + } + } + if ($viewgrades) { + $vgrlink=&Apache::loncommon::submlink('Submissions', + $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); + } + if ($$dischash{$readkey}=~/\.$idx\./) { + $ctlink = ''; + } else { + $ctlink = ''; + } + } +#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 ($env{'form.totposters'} ne '') { + 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; + } + } + } + if ($$shown{$idx} && !$skip_group_check) { + my $showflag = 0; + if (ref($$classgroups{$poster}{active}) eq 'HASH') { + foreach my $grp (@{$grouppick}) { + if (grep/^\Q$grp\E$/, + keys(%{$$classgroups{$poster}{active}})) { + $showflag = 1; + last; + } + } + } + if ($showflag) { + $$shown{$idx} = 1; + } else { + $$shown{$idx} = 0; + } + } + } else { + $$shown{$idx} = 1; + } + } + unless ($$notshown{$idx} == 1) { + if ($prevread > 0 && $prevread <= $posttime) { + $$newitem{$idx} = 1; + $$discussionitems[$idx] .= ' +

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

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

'. + $message.'

'; + if ($contrib{$idx.':history'}) { + my @postversions = (); + $$discussionitems[$idx] .= &mt('This post has been edited by the author.'); + if ($seeid) { + $$discussionitems[$idx] .= '  '.&mt('Display all versions').''; + } + $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); + if ($contrib{$idx.':history'} =~ m/:/) { + @postversions = split(/:/,$contrib{$idx.':history'}); + } else { + @postversions = ("$contrib{$idx.':history'}"); + } + for (my $i=0; $i<@postversions; $i++) { + my $version = $i+1; + $$discussionitems[$idx] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; + } + } + } + } + } + } + } + } +} + +sub filter_regexp { + my ($rolefilter,$sectionpick,$statusfilter) = @_; + my ($roleregexp,$secregexp,$statusregexp); + my $skiptest = 1; + if (@{$rolefilter} > 0) { + my @okrolefilter = (); + foreach my $role (@{$rolefilter}) { + unless ($role eq '') { + push(@okrolefilter, $role); + } + } + 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 my $sec (@{$sectionpick}) { + unless ($sec eq '') { + push(@oksectionpick, $sec); + } + } + 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=$$contrib{$idx.':screenname'}; + + 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'}) { + @postversions = split(/:/,$$contrib{$idx.':history'}); + } + &get_post_versions($messages,$$contrib{$idx.':message'},1); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1); + push(@postversions,$$contrib{$idx.':timestamp'}); + $end = @postversions; + } else { + &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); + &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); + } + + if ($$contrib{$idx.':anonymous'}) { + $sender.=' ['.&mt('anonymous').'] '.$$screenname; + } + if ($type eq 'allversions') { + $discussion=(''.$sender.'
'; + return $discussion; + } else { + return; + } +} + +sub replicate_attachments { + my ($attachrefs,$tempexport) = @_; + my $response; + foreach my $id (keys(%{$attachrefs})) { + if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { + my $path = $tempexport; + my $tail = $1.'/'.$2.$4; + my @extras = split(/\//,$tail); + my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5; + if (!-e $destination) { + my $i= 0; + while ($i<@extras) { + $path .= '/'.$extras[$i]; + if (!-e $path) { + mkdir($path,0700); + } + $i ++; + } + my ($content,$rtncode); + my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode); + if ($uploadreply eq 'ok') { + my $attachcopy; + if ($attachcopy = Apache::File->new('>'.$destination)) { + print $attachcopy $content; + close($attachcopy); + } else { + $response .= &mt('Error copying file attachment - [_1] to IMS package',$5).': '.$!.'
'."\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 .= &mt('Error copying file attachment - [_1] to IMS package: ',$5).$rtncode.'
'."\n"; + } + } + } + } + return $response; +} + +sub mail_screen { + my ($r,$feedurl,$options,$caller_symb) = @_; + if (exists($env{'form.origpage'})) { + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss','blog','group','ref']); + } + + my %lt = &Apache::lonlocal::texthash( + 'plch' => 'Please check at least one of the following feedback types:', + 'myqu' => 'My question/comment/feedback:', + 'title' => 'Title', + 'reta' => 'Retained attachments', + 'atta' => 'Attachment (128 KB max size)', + ); + my $restitle = &get_resource_title($caller_symb,$feedurl); + my $quote=''; + my $subject = ''; + my $comment = ''; + my $prevtag = ''; + my $parentmsg = ''; + my ($symb,$idx,$attachmenturls); + my $numoldver = 0; + my $attachmsg = ''; + my $newattachmsg = ''; + my @currnewattach = (); + my @currdelold = (); + my @keepold = (); + my %attachments = (); + my %currattach = (); + my $attachnum = 0; + my $anonchk = (< 0) { + my %msgversions = (); + &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); + $quote = $msgversions{$numoldver}; + } + if ($idx > 0) { + my %subversions = (); + &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver); + $subject = &mt('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 = 'nonanon'; + if ($contrib{$idx.':anonymous'}) { + $anonflag = 'anon'; + } + $anonscript = (<'; + } + } + + if ($env{'form.origpage'}) { + $subject = &unescape($env{'form.subject'}); + $comment = &unescape($env{'form.comment'}); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + } + my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(); + my $send=&mt('Send'); + my $alert = &mt('Please select a feedback type.'); + my $js= < +// + +END + + my %onload = ('onload' => 'window.focus();setposttype();'); + my $start_page= + &Apache::loncommon::start_page('Resource Feedback and Discussion',$js, + {'add_entries' => \%onload}); + + if ($quote ne '') { + &newline_to_br(\$quote); + $quote='
'.&Apache::lontexconvert::msgtexconverted($quote).'
'; + } + + $r->print(<$restitle +
+$prevtag + +END + if ($env{'form.replydisc'}) { + $r->print(< +END + } elsif ($env{'form.editdisc'}) { + $r->print(< + +END + } + $r->print(< +$quote +

$lt{'myqu'}

+

+$latexHelp +$lt{'title'}:

+

+

+

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

+END + } + if (exists($env{'form.group'})) { + $r->print(''); + } + if (exists($env{'form.ref'})) { + $r->print(''); + } + $r->print(< + + +

+ +END + if ($env{'form.editdisc'} || $env{'form.replydisc'}) { + my $now = time; + my $ressymb = $symb; + &Apache::lonenc::check_encrypt(\$ressymb); + my $postidx = ''; + if ($env{'form.editdisc'}) { + $postidx = $idx; + } + if (@currnewattach > 0) { + $attachnum += @currnewattach; + } + my $blockblog = &Apache::loncommon::blocking_status('blogs'); + $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog)); + if ($attachnum > 0) { + if (@currnewattach > 0) { + $newattachmsg .= '
'.&mt('New attachments').'
'; + if (@currnewattach > 1) { + $newattachmsg .= '
    '; + foreach my $item (@currnewattach) { + $item =~ m#.*/([^/]+)$#; + $newattachmsg .= '
  1. '.$1.'
    2. '."\n"; + } + $newattachmsg .= '
'."\n"; + } else { + $currnewattach[0] =~ m#.*/([^/]+)$#; + $newattachmsg .= ''.$1.'
'."\n"; + } + } + if ($attachmsg) { + $r->print("
$lt{'reta'}:$attachmsg
\n"); + } + if ($newattachmsg) { + $r->print("$newattachmsg
"); + } + } + } + $r->print(&generate_preview_button(). + &Apache::lonhtmlcommon::htmlareaselectactive('comment'). + &Apache::loncommon::end_page()); + +} + +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 %lt = &Apache::lonlocal::texthash( + '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 $js = < +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" + } + } + } +} + +END + + + my $start_page = + &Apache::loncommon::start_page('Discussion display options',$js); + my $end_page = + &Apache::loncommon::end_page(); + $r->print(< +$lt{'sdpf'}
$lt{'prca'}
  1. $lt{'whpo'}
  2. $lt{'unwh'}
  3. $lt{'wipa'}
+
+END + $r->print(&Apache::loncommon::start_data_table()); + $r->print(< + $lt{'pref'} + $lt{'curr'} + $lt{'actn'}? + +END + $r->print(&Apache::loncommon::start_data_table_row()); + $r->print(<$lt{'disa'} + $lt{$discdisp} + +
+ + +END + $r->print(&Apache::loncommon::end_data_table_row()); + $r->print(&Apache::loncommon::start_data_table_row()); + $r->print(<$lt{'npmr'} + $lt{$discmark} + +END + $r->print(&Apache::loncommon::end_data_table_row()); + $r->print(&Apache::loncommon::start_data_table_row()); + $r->print(<$lt{'dotm'} + $lt{$disctogg} + +END + $r->print(&Apache::loncommon::end_data_table_row()); + $r->print(&Apache::loncommon::end_data_table()); + $r->print(< +
+ + + + + + + +END + if (exists($env{'form.group'})) { + $r->print(''); + } + if (exists($env{'form.ref'})) { + $r->print(''); + } + $r->print(" +
+
+ +$end_page + "); + 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 $numvisible = 5; + my @groups; + my $group_sel = ''; + my $numgroupvis = 5; + my %sectioncount = &Apache::loncommon::get_sections(); + + 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); + if (scalar(@sections) < 4) { + $numvisible = scalar(@sections) + 1; + } + unshift(@sections,'all'); # Put 'all' at the front of the list + + } + foreach my $sec (@sections) { + $section_sel .= " \n"; + } + + if (&check_group_priv() eq 'ok') { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum); + @groups = sort {$a cmp $b} keys(%curr_groups); + if (scalar(@groups) < 4) { + $numgroupvis = scalar(@groups) + 1; + } + unshift(@groups,'all'); # Put 'all' at the front of the list + } else { + my @coursegroups = split(/:/,$env{'request.course.groups'}); + if (@coursegroups > 0) { + @coursegroups = sort {$a cmp $b} @coursegroups; + @groups = ('all',@coursegroups); + if (scalar(@groups) < 4) { + $numgroupvis = scalar(@groups) + 1; + } + } else { + @groups = ('all'); + $numgroupvis = 1; + } + } + foreach my $group (@groups) { + $group_sel .= " \n"; + } + + my $function = &Apache::loncommon::get_users_function(); + my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', + $env{'user.domain'}); + my %lt = &Apache::lonlocal::texthash( + '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', + 'spgr' => 'Specific groups', + 'psub' => 'Pick specific users (by name)', + 'shal' => 'Show a list of current posters', + 'stor' => 'Store changes', + ); + + my %sort_types = (); + my %role_types = (); + my %status_types = (); + &sort_filter_names(\%sort_types,\%role_types,\%status_types); + + my $js = < +function verifyFilter() { + var rolenum = 0 + for (var i=0; i - - - -

Feedback

-

$feedurl

-
- -Please check at least one of the following feedback types: -$options
-My question/comment/feedback:

-

- - +END + + my $start_page= + &Apache::loncommon::start_page('Discussion options',$js); + my $end_page= + &Apache::loncommon::end_page(); + + $r->print(< +$lt{'diso'}
$lt{'prca'} +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + +
$lt{'soor'} $lt{'sprs'} $lt{'spur'} $lt{'spse'} $lt{'spgr'} $lt{'psub'}
+ +   + +   + +   + +   + +  
+
+
+ + + +END + if (exists($env{'form.group'})) { + $r->print(''); + } + if (exists($env{'form.ref'})) { + $r->print(''); + } + $r->print(" +
+
- - -ENDDOCUMENT +$end_page +"); +} + +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; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $group = $env{'form.group'}; + my $ressymb = &wrap_symb($symb); + if (($group ne '') && + ($ressymb =~ m|^bulletin___ \d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) { + if (&check_group_priv($group,'dgp') eq 'ok') { + $seeid = 1; + } + } else { + $seeid=&Apache::lonnet::allowed('rin',$crs); + } + my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, + $cdom,$cnum); + my %namesort = (); + my %postcounts = (); + + my %lt = &Apache::lonlocal::texthash( + sele => 'Select', + full => 'Fullname', + usdo => 'Username:domain', + post => 'Posts', + ); + 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'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { + 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 $start_page = &Apache::loncommon::start_page('Discussion options'); + my $table_start =&Apache::loncommon::start_data_table(); + $r->print(< +
+ $table_start + + # + $lt{'sele'} + $lt{'full'} ($lt{'usdo'}) + $lt{'post'} + +END + my $count = 0; + foreach my $last (sort(keys(%namesort))) { + foreach my $first (sort(keys(%{$namesort{$last}}))) { + foreach my $user (sort(@{$namesort{$last}{$first}})) { + my ($uname,$udom) = split(/:/,$user); + if (!$uname || !$udom) { + next; + } else { + $count ++; + $r->print(&Apache::loncommon::start_data_table_row(). + ''.$count.' + + '.$postcounts{$user}.''. + &Apache::loncommon::end_data_table_row()); + } + } + } + } + $r->print(&Apache::loncommon::end_data_table()); + my $end_page = &Apache::loncommon::end_page(); + $r->print(< + + + + +$end_page +END +} + +sub get_post_versions { + my ($versions,$incoming,$htmldecode,$numver) = @_; + if ($incoming =~ /^/) { + 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/^/) { + 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) = @_; - $r->print (<Feedback not sent - - - - -Sorry, no recipients ... - - + if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; + my %lt = &Apache::lonlocal::texthash( + 'sorr' => 'Sorry, no recipients ...', + ); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + $r->print(&Apache::loncommon::start_page('Feedback not sent',undef, + {'redirect' => [2,$feedurl], + 'only_body' => 1,})); + $r->print(< +$lt{'sorr'} ENDFAILREDIR + $r->print(&Apache::loncommon::end_page()); } sub redirect_back { - my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_; - $r->print (< -Feedback sent - - - - + my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group) = @_; + my $sorttag = ''; + my $roletag = ''; + my $statustag = ''; + my $sectag = ''; + my $grptag = ''; + 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 = ''; + } + if (defined($sort)) { + my $sortqry = 'sortposts='.$sort; + if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) { + $feedurl .= '&'.$sortqry; + } else { + $feedurl .= '?'.$sortqry; + } + $sorttag = ''; + if (defined($numpicks)) { + my $userpickqry = 'totposters='.$numpicks; + $feedurl .= '&'.$userpickqry; + $userpicktag = ''; + } else { + if (ref($sectionpick) eq 'ARRAY') { + $feedurl .= '§ionpick='; + $sectag .= ''; + } else { + $feedurl .= '§ionpick='.$sectionpick; + $sectag = ''; + } + if (ref($grouppick) eq 'ARRAY') { + $feedurl .= '&grouppick='; + $sectag .= ''; + } else { + $feedurl .= '&grouppick='.$grouppick; + $grptag = ''; + } + if (ref($rolefilter) eq 'ARRAY') { + $feedurl .= '&rolefilter='; + $roletag .= ''; + } else { + $feedurl .= '&rolefilter='.$rolefilter; + $roletag = ''; + } + $feedurl .= '&statusfilter='.$statusfilter; + $statustag =''; + } + } + my $grouptag; + if ($group ne '') { + $grouptag = ''; my $refarg; + if (exists($env{'form.ref'})) { + $refarg = '&ref='.$env{'form.ref'}; + $grouptag .= ''; + } + if ($feedurl =~ /\?/) { + $feedurl .= '&group='.$group.$refarg; + } else { + $feedurl .= '?group='.$group.$refarg; + } + } + &Apache::lonenc::check_encrypt(\$feedurl); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + my %onload; + if ($env{'environment.remote'} ne 'off') { + $onload{'onload'} = + "if (window.name!='loncapaclient') { this.document.reldt.submit(); self.window.close(); }"; + } + my $start_page= + &Apache::loncommon::start_page('Feedback sent',undef, + {'redirect' => [0,$feedurl], + 'only_body' => 1, + 'add_entries' => \%onload}); + my $end_page = &Apache::loncommon::end_page(); + $r->print(< $typestyle -Sent $sendsomething message(s). -$status - - +Sent $sendsomething message(s), and $sendposts post(s). +$blog +$status +

+$prevtag +$sorttag +$statustag +$roletag +$sectag +$grptag +$userpicktag +$grouptag +
+$end_page ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; - $r->print (<Feedback not sent - - - - -Sorry, no feedback possible on this resource ... - - -ENDNOREDIR + my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); + + my %onload; + if ($env{'environment.remote'} ne 'off') { + $onload{'onload'} = + "if (window.name!='loncapaclient') { self.window.close(); }"; + } + + my %body_options = ('only_body' => 1, + 'bgcolor' => '#FFFFFF', + 'add_entries' => \%onload,); + + if ($feedurl !~ m{^/adm/feedback}) { + $body_options{'rediect'} = [2,$feedurl]; + } + my $start_page= + &Apache::loncommon::start_page('Feedback not sent',undef, + \%body_options); + + my $end_page = &Apache::loncommon::end_page(); + + &Apache::lonenc::check_encrypt(\$feedurl); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + $r->print (< +$nofeed +
+$end_page +ENDNOREDIRTWO } sub screen_header { - my ($feedurl) = @_; - my $options=''; - if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) { - $options= - '

Feedback to resource author'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) { - $options.= - '
Question about resource content'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) { - $options.= - '
'. - 'Question/Comment/Feedback about course content'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) { - $options.= - '
'. - 'Question/Comment/Feedback about course policy'; - } - return $options; -} - -sub get_previous_attempt { - my ($feedurl)=@_; - my $symb=&Apache::lonnet::symbread($feedurl); - my $prevattempts=''; - if ($symb) { - my $answer=&Apache::lonnet::reply( - "restore:".$ENV{'user.domain'}.':'.$ENV{'user.name'}.':'. - $ENV{'request.course.id'}.':'. - &Apache::lonnet::escape($symb), - $ENV{'user.home'}); - my %returnhash=(); - map { - my ($name,$value)=split(/\=/,$_); - $returnhash{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - } split(/\&/,$answer); - my %lasthash=(); - my $version; - for ($version=1;$version<=$returnhash{'version'};$version++) { - map { - $lasthash{$_}=$returnhash{$version.':'.$_}; - } split(/\:/,$returnhash{$version.':keys'}); - } - $prevattempts=''; - map { - $prevattempts.=''; - } keys %lasthash; - for ($version=1;$version<=$returnhash{'version'};$version++) { - $prevattempts.=''; - map { - $prevattempts.=''; - } keys %lasthash; - } - $prevattempts.=''; - map { - $prevattempts.=''; - } keys %lasthash; - $prevattempts.='
History'.$_.'
Attempt '.$version.''.$returnhash{$version.':'.$_}.'
Current'.$lasthash{$_}.'
'; - } + my ($feedurl,$symb) = @_; + my $msgoptions=''; + my $discussoptions=''; + unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { + if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { + $msgoptions= + '

'; + } + if (&feedback_available(1)) { + $msgoptions.= + '

'; + } + if (&feedback_available(0,1)) { + $msgoptions.= + '

'; + } + if (&feedback_available(0,0,1)) { + $msgoptions.= + '

'; + } + } + if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) { + my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); + if (!$blocked && &discussion_open(undef,$symb) && + &Apache::lonnet::allowed('pch', + $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { + $discussoptions='
'. + ''.&mt('Change Screenname').''; + my $blockblog = &Apache::loncommon::blocking_status('blogs'); + if (!$blockblog) { + $discussoptions.= &add_blog_checkbox(); + } + } + } + if ($msgoptions) { $msgoptions='

'.&mt('Sending Messages').'

'.$msgoptions; } + if ($discussoptions) { + $discussoptions='

'.&mt('Discussion Contributions').'

'.$discussoptions; } + return $msgoptions.$discussoptions; } sub resource_output { my ($feedurl) = @_; - my $usersaw=&Apache::lonnet::ssi($feedurl); + my $usersaw=&Apache::lonnet::ssi_body($feedurl); $usersaw=~s/\]*\>//gi; $usersaw=~s/\<\/body\>//gi; $usersaw=~s/\//gi; @@ -198,133 +2615,1406 @@ sub resource_output { } sub clear_out_html { - my $message=$ENV{'form.comment'}; - $message=~s/\/\>\;/g; + my ($message,$override,$ignore_htmlarea)=@_; + if (!$ignore_htmlarea + && !&Apache::lonhtmlcommon::htmlareablocked()) { return $message; } +# Always allow the -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


      • + #

        + # + %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/(\]*)\>/ + {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; return $message; } sub assemble_email { - my ($feedurl,$message,$prevattempts,$usersaw)=@_; + my ($message,$prevattempts,$usersaw,$useranswer)=@_; + my %lt = &Apache::lonlocal::texthash( + 'prev' => 'Previous attempts of student (if applicable)', + 'orig' => 'Original screen output (if applicable)', + 'corr' => 'Correct Answer(s) (if applicable)', + ); my $email=<<"ENDEMAIL"; -Refers to $feedurl - $message ENDEMAIL my $citations=<<"ENDCITE"; -

        Previous attempts of student (if applicable)

        +

        $lt{'prev'}

        $prevattempts -

        -

        Original screen output (if applicable)

        +
        +

        $lt{'orig'}

        $usersaw +

        $lt{'corr'}

        +$useranswer ENDCITE return ($email,$citations); } +sub secapply { + my $rec=shift; + my $defaultflag=shift; + $rec=~s/\s+//g; + $rec=~s/\@/\:/g; + my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/); + if ($sections_or_groups) { + foreach my $item (split(/\;/,$sections_or_groups)) { + if (($item eq $env{'request.course.sec'}) || + ($defaultflag && ($item eq '*'))) { + return $adr; + } elsif ($env{'request.course.groups'}) { + my @usersgroups = split(/:/,$env{'request.course.groups'}); + if (grep(/^\Q$item\E$/,@usersgroups)) { + 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. + 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) = @_; + my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; + &Apache::lonenc::check_decrypt(\$feedurl); my $typestyle=''; my %to=(); - if ($ENV{'form.author'}) { - $typestyle.='Author Feedback
        '; - $feedurl=~/^\/res\/(\w+)\/(\w+)\//; + if ($env{'form.discuss'} eq 'author' ||$author) { + $typestyle.='Submitting as Author Feedback
        '; + $feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/}; $to{$2.':'.$1}=1; } - if ($ENV{'form.question'}) { - $typestyle.='Question
        '; - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}); - } - if ($ENV{'form.course'}) { - $typestyle.='Comment
        '; - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}); - } - if ($ENV{'form.policy'}) { - $typestyle.='Policy
        '; - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}); + if ($env{'form.discuss'} eq 'question' ||$question) { + $typestyle.=&mt('Submitting as Question').'
        '; + foreach my $item (split(/\,/, + $env{'course.'.$env{'request.course.id'}.'.question.email'}) + ) { + my $rec=&secapply($item,$defaultflag); + if ($rec) { $to{$rec}=1; } + } + } + if ($env{'form.discuss'} eq 'course' ||$course) { + $typestyle.=&mt('Submitting as Comment').'
        '; + foreach my $item (split(/\,/, + $env{'course.'.$env{'request.course.id'}.'.comment.email'}) + ) { + my $rec=&secapply($item,$defaultflag); + if ($rec) { $to{$rec}=1; } + } + } + if ($env{'form.discuss'} eq 'policy' ||$policy) { + $typestyle.=&mt('Submitting as Policy Feedback').'
        '; + foreach my $item (split(/\,/, + $env{'course.'.$env{'request.course.id'}.'.policy.email'}) + ) { + my $rec=&secapply($item,$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,%to)=@_; + my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,%to)=@_; my $status=''; my $sendsomething=0; - map { - if ($_) { - unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),'Feedback '.$feedurl, - $email,$citations) eq 'ok') { - $status.='
        Error sending message to '.$_.'
        '; + my $restitle = &get_resource_title($symb,$feedurl); + if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; } + unless ($title=~/\w/) { $title=&mt('Feedback'); } + foreach my $key (keys(%to)) { + if ($key) { + unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$key), + $title.' ['.$restitle.']',$email,$citations,$feedurl, + $attachmenturl,undef,undef,$symb,$restitle)=~/ok/) { + $status.='
        '.&mt('Error sending message to').' '.$key.'
        '; } else { - #$status.='
        Message sent to '.$_.'
        '; $sendsomething++; } } - } keys %to; + } + + 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.='
        '.&mt('Not registered').'
        '; + } + } + 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)) { + my $now = time; + if ($env{'form.editdisc'}) { + $contrib{'ip'}=$ENV{'REMOTE_ADDR'}; + $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; + $contrib{'timestamp'} = $now; + $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'} =~ /^/) { + $contrib{'subject'} = ''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; + $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; + } else { + $contrib{'subject'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').''.&HTML::Entities::encode($contrib{'subject'},'<>&"').''; + } + } + if (defined($oldcontrib{$oldidx.':message'})) { + if ($oldcontrib{$oldidx.':message'} =~ /^/) { + $contrib{'message'} = ''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; + $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; + } else { + $contrib{'message'} = ''.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').''.&HTML::Entities::encode($contrib{'message'},'<>&"').''; + } + } + $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; + my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'}, + $oldsymb,$oldidx,\%contrib, + $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 => $now); + $status.='
        '.&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.='
        '.&mt('Registering').': '. + &Apache::lonnet::cstore(\%newrecord,'_discussion'); + } + } else { + $status.='Failed.'; + } + return $status.'
        '; +} + +sub get_discussion_info { + my ($idx,%contrib) = @_; + my $changelast = 0; + my $count = 0; + my $hiddenflag = 0; + my $deletedflag = 0; + my ($hidden,$deleted,%info,$newlastdisc); + my $version = $contrib{'version'}; + if ($version) { + for (my $id=$version; $id>0; $id--) { + my $vkeys=$contrib{$id.':keys'}; + my @keys=split(/:/,$vkeys); + if (grep(/^hidden$/,@keys)) { + if (!$hiddenflag) { + $hidden = $contrib{$id.':hidden'}; + $hiddenflag = 1; + } + } elsif (grep(/^deleted$/,@keys)) { + if (!$deletedflag) { + $deleted = $contrib{$id.':deleted'}; + $deletedflag = 1; + } + } else { + if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)) { + $count++; + $info{$count}{'id'} = $id; + $info{$count}{'timestamp'}=$contrib{$id.':timestamp'}; + } + } + } + if ($info{'1'}{'id'} == $idx) { + $changelast = 1; + if ($count > 1) { + $newlastdisc = $info{'2'}{'timestamp'}; + } else { + $newlastdisc = 0; + } + } + } + return ($changelast,$newlastdisc); +} + +# ----------------------------------------------------------- Preview function + +sub show_preview { + my ($r) = @_; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + my $start_page= + &Apache::loncommon::start_page('Preview',undef, + {'only_body' => 1,}); + + 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'},undef,1); + $subject=~s/\n/\
        /g; + $subject=&Apache::lontexconvert::msgtexconverted($subject); + + my $end_page = &Apache::loncommon::end_page(); + + $r->print($start_page.'
        '. + ''.&mt('Subject').': '.$subject.'

        '. + $message.'
        '.$end_page); +} + + +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/\
        /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 ($formname,$fieldname)=@_; + unless ($formname) { $formname='mailform'; } + unless ($fieldname) { $fieldname='comment'; } + my $pre=&mt("Show Preview and Check Spelling"); + return(< +
        + + + +
        +ENDPREVIEW +} + +sub modify_attachments { + my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_; + + my %lt = &Apache::lonlocal::texthash( + 'subj' => 'Subject', + 'thfo' => 'The following attachments were part of the most recent saved version of this posting.', + 'chth' => 'Check the checkboxes for any you wish to remove.', + 'thef' => 'The following attachments have been uploaded for inclusion with this posting.', + 'adda' => 'Add a new attachment to this post.', + 'stch' => 'Store Changes', + ); + my $js = < + function setAction () { + document.modattachments.action = document.modattachments.origpage.value; + document.modattachments.submit(); + } + +END + + my $start_page = + &Apache::loncommon::start_page('Discussion Post Attachments',$js); + + my $orig_subject = &unescape($env{'form.subject'}); + my $subject=&clear_out_html($orig_subject,undef,1); + $subject=~s/\n/\
        /g; + $subject=&Apache::lontexconvert::msgtexconverted($subject); + my $timestamp=$env{'form.timestamp'}; + my $numoldver=$env{'form.numoldver'}; + + my $msg = ''; + my %attachments = (); + my %currattach = (); + if ($idx) { + &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold); + } + &Apache::lonenc::check_encrypt(\$symb); + + my $end_page = + &Apache::loncommon::end_page(); + + $r->print(< + + + + +
        + Subject: $subject

        +END + if ($idx) { + if ($attachmenturls) { + my @currold = keys(%currattach); + if (@currold > 0) { + $r->print($lt{'thfo'}.'
        '.$lt{'chth'}.'
        '."\n"); + foreach my $id (@currold) { + my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); + $attachurl =~ m#/([^/]+)$#; + $r->print('
        '."\n"); + } + $r->print("
        "); + } + } + } + if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { + $r->print($lt{'thef'}.'
        '.$lt{'chth'}.'
        '."\n"); + foreach my $attach (@{$currnewattach}) { + $attach =~ m#/([^/]+)$#; + $r->print('
        '."\n"); + } + $r->print("
        "); + } + $r->print(< +
        + + + + + + + + +END + foreach my $item (@{$currnewattach}) { + $r->print(''."\n"); + } + foreach my $item (@{$currdelold}) { + $r->print(''."\n"); + } + $r->print(< + +$end_page +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 my $item (@currdelnew) { + if ($newone eq $item) { + $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,$blockblog) = @_; + my $origpage = $ENV{'REQUEST_URI'}; + my $att=$attachnum.' '.&mt("attachments"); + my %lt = &Apache::lonlocal::texthash( + 'clic' => 'Click to add/remove attachments', + ); + my $response = (< +
        +$lt{'clic'}:  + + + + + + + + +ENDATTACH + if (defined($deloldattach)) { + if (@{$deloldattach} > 0) { + foreach my $delatt (@{$deloldattach}) { + $response .= ''."\n"; + } + } + } + if (defined($currnewattach)) { + if (@{$currnewattach} > 0) { + foreach my $attach (@{$currnewattach}) { + $response .= ''."\n"; + } + } + } + $response .= '
        '; + 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/^/) { + $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); + } else { + $attachurl = $$attachments{$id}{'filename'}; + } + $attachurl=~m|/([^/]+)$|; + $$message.='
        '. + $1.'
        '; + &Apache::lonnet::allowuploaded('/adm/feedback', + $attachurl); + } elsif (@attached > 1) { + $$message.='
          '; + foreach my $attach (@attached) { + my $id = $attach; + my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); + my ($fname) + =($attachurl=~m|/([^/]+)$|); + $$message .= '
        1. '. + $fname.'
          2. '; + &Apache::lonnet::allowuploaded('/adm/feedback', + $attachurl); + } + $$message .= '
        '; + } +} + +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/^/) { + 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 .= ''.$attachments{$num}{'filename'}.''; + foreach my $item (sort {$a <=> $b} keys(%{$attachments{$num}})) { + unless ($item eq 'filename') { + $newattachmenturl .= ''.$attachments{$num}{$item}.''; + } + } + if (grep/^$num$/,@{$keepold}) { + $newattachmenturl .= ''.$attachments{$num}{$prevver}.''; + } + $newattachmenturl .= ''; + } + } else { + $newattachmenturl = ''.&HTML::Entities::encode($oldattachmenturl).'n'; + unless (grep/^0$/,@{$keepold}) { + $newattachmenturl .= 'n'; + } + $newattachmenturl .= ''; + $startnum ++; + } + } + } + for (my $i=0; $i<@{$currnewattach}; $i++) { + my $attachnum = $startnum + $i; + $newattachmenturl .= ''.&HTML::Entities::encode($$currnewattach[$i]).'n'; + } + return $newattachmenturl; +} + +sub add_blog_checkbox { + my ($checkstatus); + if ($env{'form.blog'}) { + $checkstatus = 'checked="checked"'; + } + my $output = ' +
        +
        '."\n"; + return $output; +} + +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 past roles', + Future => 'Only future roles', + ); +} + sub handler { my $r = shift; - $r->content_type('text/html'); - $r->send_http_header; - return OK if $r->header_only; - - my $feedurl=$ENV{'form.postdata'}; - $feedurl=~s/^http\:\/\///; - $feedurl=~s/^$ENV{'SERVER_NAME'}//; - $feedurl=~s/^$ENV{'HTTP_HOST'}//; - - if ((($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) - || ($ENV{'request.course.id'})) { -# --------------------------------------------------- Print login screen header - unless ($ENV{'form.sendit'}) { - my $options=&screen_header($feedurl); - if ($options) { - &mail_screen($r,$feedurl,$options); + 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','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']); + my $group = $env{'form.group'}; + if ($env{'form.editdisc'}) { + if (!(&editing_allowed($env{'form.editdisc'},$env{'form.group'}))) { + my $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; + my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); + my $feedurl=&Apache::lonnet::clutter($url); + &redirect_back($r,$feedurl,&mt('Editing not permitted').'
        ', '0','0','','',$env{'form.previous'},undef,undef,undef, + undef,undef,undef,$group); + return OK; + } + } + 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').'
        ', + '0','0','','',$env{'form.previous'},'','','', + undef,undef,undef,$group); + return OK; + } + if ($env{'form.allversions'}) { + &Apache::loncommon::content_type($r,'text/html'); + &Apache::loncommon::no_cache($r); + $r->send_http_header; + + $r->print(&Apache::loncommon::start_page('Discussion Post Versions')); + + my $crs='/'.$env{'request.course.id'}; + if ($env{'request.course.sec'}) { + $crs.='_'.$env{'request.course.sec'}; + } + $crs=~s|_|/|g; + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); + ($symb)=&get_feedurl_and_clean_symb($symb); + my $ressymb = &wrap_symb($symb); + my $group = $env{'form.group'}; + my $seeid; + if (($group ne '') && (($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|))) { + if (&check_group_priv($group,'dgp') eq 'ok') { + $seeid = 1; + } } else { - &fail_redirect($r,$feedurl); + $seeid = &Apache::lonnet::allowed('rin',$crs); + } + 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)); + } + $r->print(&Apache::loncommon::end_page()); + 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').'
        ','0','0','', + '',$env{'form.previous'},$env{'form.sortposts'},'','','', + '',$numpicks,$group); + 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').'
        ','0','0','', + '',$env{'form.previous'},$env{'form.sortposts'}, + $env{'form.rolefilter'},$env{'form.statusfilter'}, + $env{'form.sectionpick'},$env{'form.grouppick'}, + undef,$group); + 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 my $res (@resources) { + my $ressymb=$res; + &Apache::lonenc::check_decrypt(\$ressymb); + my $lastkey = $ressymb.'_lastread'; + $discinfo{$lastkey} = $env{'form.navtime'}; + } + my $textline = "$lt{'mnpa'} $numitems $lt{'robb'}"; + if ($numitems > 0) { + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%discinfo,$env{'user.domain'},$env{'user.name'}); + } else { + $textline = "$lt{'twnp'}"; + } + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + my %onload; + if ($env{'environment.remote'} ne 'off') { + $onload{'onload'} = + "if (window.name!='loncapaclient') { this.document.reldt.submit(); self.window.close(); }"; + } + + my $start_page= + &Apache::loncommon::start_page('New posts marked as read',undef, + {'redirect' => [2,$feedurl], + 'only_body' => 1, + 'add_entries' => \%onload}); + my $end_page = &Apache::loncommon::end_page(); + $r->print (< +$textline +
        +
        +
        +$end_page +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').'
        ', + '0','0','','',$previous,'','','','','','',$group); + 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 $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'} && !$seeid && !(&editing_allowed($env{'form.hide'},$env{'form.group'}))) { + &redirect_back($r,$feedurl,&mt('Deletion not permitted').'
        ', '0','0','','',$env{'form.previous'},'','','','', + undef,undef,$group,); + return OK; + } + + 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'}; + + 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; + } + if ($env{'form.hide'}) { + my $changelast = 0; + my $newlast; + ($changelast,$newlast) = &get_discussion_info($idx,%contrib); + if ($changelast) { + &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + } + } + &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').'
        ', + '0','0','','',$env{'form.previous'},undef,undef,undef, + undef,undef,undef,$group); + 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').'
        ', + '0','0','','',$env{'form.previous'},undef,undef,undef, + undef,undef,undef,$group); + 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 ($changelast,$newlast) = &get_discussion_info($idx,%contrib); + if ($changelast) { + &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, + $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').'
        ', + '0','0','','',$env{'form.previous'},undef,undef,undef, + undef,undef,undef,$group); + 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','discuss','blog']); + 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 $start_page = + &Apache::loncommon::start_page('Resource Feedback and Discussion'); + my $end_page = + &Apache::loncommon::end_page(); + $r->print($start_page.$discussion.$end_page); + 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]; + } elsif ($env{'form.editdisc'}) { + $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; + } elsif ($env{'form.origpage'}) { + $symb=""; + } else { + $symb=&Apache::lonnet::symbread($feedurl); + } + unless ($symb) { + $symb=$env{'form.symb'}; + } + if (defined($symb)) { + ($symb,$feedurl)=&get_feedurl_and_clean_symb($symb); + } else { + # backward compatibility (bulletin boards used to be 'wrapped') + &Apache::lonenc::check_decrypt(\$feedurl); + &dewrapper(\$feedurl); + } + my $goahead=1; + if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form|task)$/) { + unless ($symb) { $goahead=0; } + } + 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 + &Apache::lonenc::check_encrypt(\$feedurl); + &no_redirect_back($r,$feedurl); + return OK; + } +# --------------------------------------------------- Print login screen header + unless ($env{'form.sendit'}) { + &Apache::lonenc::check_encrypt(\$feedurl); + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { + my ($blocked,$blocktext) = + &Apache::loncommon::blocking_status('boards'); + if ($blocked) { + $r->print(&blocked_reply_or_edit($blocktext)); + return OK; + } + } + my $options=&screen_header($feedurl,$symb); + if ($options) { + &mail_screen($r,$feedurl,$options,$symb); + } else { + &fail_redirect($r,$feedurl); + } + return OK; } - } else { # Get previous user input - my $prevattempts=&get_previous_attempt($feedurl); + my $prevattempts=&Apache::loncommon::get_previous_attempt( + $symb,$env{'user.name'},$env{'user.domain'}, + $env{'request.course.id'}); # Get output from resource + &Apache::lonenc::check_encrypt(\$feedurl); 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 $usersymb = &Apache::lonenc::check_encrypt($symb); + my $useranswer= + &Apache::loncommon::get_student_answers( + $usersymb,$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; + my $message=&clear_out_html($env{'form.comment'}); # Assemble email - my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,$usersaw); - + my ($email,$citations)=&assemble_email($message,$prevattempts, + $usersaw,$useranswer); + # Who gets this? my ($typestyle,%to) = &decide_receiver($feedurl); # Actually send mail - my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to); + my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}, + undef,1), + $feedurl,$email,$citations, + $attachmenturl,$usersymb,%to); + +# Discussion? Store that. + my $numpost=0; + if ( ($env{'form.discuss'} ne '' + && $env{'form.discuss'} !~ /^(?:author|question|course|policy)/) + || $env{'form.anondiscuss'} ne '') { + my $subject = &clear_out_html($env{'form.subject'},undef,1); + my $anonmode=($env{'form.discuss'} eq 'anon' || $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,$status,$numsent); +# Add to blog? - } - } else { - &no_redirect_back($r,$feedurl); + my $blog=''; + if ($env{'form.blog'}) { + my $subject = &clear_out_html($env{'form.subject'},undef,1); + $status.=&Apache::lonrss::addentry($env{'user.name'}, + $env{'user.domain'}, + 'CourseBlog_'.$env{'request.course.id'}, + $subject,$message,$feedurl,'public'); + $blog='
        '.&mt('Added to my course blog').'
        '; + } + +# Receipt screen and redirect back to where came from + &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group); } return OK; +} + +sub blocked_reply_or_edit { + my ($blocktext) = @_; + return + &Apache::loncommon::start_page('Resource Feedback and Discussion'). + $blocktext.'

        '. + &mt('Back to previous page'). + &Apache::loncommon::end_page(); } -1; -__END__ +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); +} +sub editing_allowed { + my ($postid,$group) = @_; + $postid = &unescape($postid); + my $can_edit = 0; + if ($group ne '') { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if ($postid =~ m|^bulletin___\d+___adm/wrapper(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) { + if (&check_group_priv($group,'egp') eq 'ok') { + $can_edit = 1; + } + return $can_edit; + } + } + my $cid = $env{'request.course.id'}; + my $role = (split(/\./,$env{'request.role'}))[0]; + my $section = $env{'request.course.sec'}; + my $allow_editing_config = + $env{'course.'.$cid.'.allow_discussion_post_editing'}; + if ($allow_editing_config =~ m/^\s*yes\s*$/i) { + $can_edit = 1; + } else { + foreach my $editor (split(/,/,$allow_editing_config)) { + my ($editor_role,$editor_sec) = split(/:/,$editor); + if ($editor_role eq $role + && defined($editor_sec) + && defined($section) + && $editor_sec eq $section) { + $can_edit = 1; + last; + } + if ($editor_role eq $role + && !defined($editor_sec)) { + $can_edit = 1; + } + } + } + return $can_edit; +} +sub check_group_priv { + my ($group,$grp_priv) = @_; + foreach my $priv ('mdg','vcg') { + my $checkcourse = $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''); + if (&Apache::lonnet::allowed($priv,$checkcourse)) { + return 'ok'; + } + } + if ($grp_priv && $group ne '') { + if (&Apache::lonnet::allowed($grp_priv,$env{'request.course.id'}.'/'.$group)) { + return 'ok'; + } + } + return ''; +} + +sub group_args { + my ($group) = @_; + if ($group eq '') { return ''; } + my $extra_args = '&group='.$group; + if (exists($env{'form.ref'})) { + $extra_args .= '&ref='.$env{'form.ref'}; + } + return $extra_args; +} + +sub get_resource_title { + my ($symb,$feedurl) = @_; + my ($restitle,$plainurl); + if (defined($symb)) { + my $plain_symb = &Apache::lonenc::check_decrypt($symb); + $restitle = &Apache::lonnet::gettitle($plain_symb); + } + if (defined($feedurl)) { + $plainurl = &Apache::lonenc::check_decrypt($feedurl); + } + if (!defined($restitle)) { + if (defined($feedurl)) { + $restitle = &Apache::lonnet::gettitle($plainurl); + } + } + if ($plainurl ne $feedurl) { + my ($plain_filename) = ($plainurl =~ m-/([^/]+)$-); + if ($plain_filename eq $restitle) { + $restitle = &mt('Untitled resource'); + } + } + if ($restitle eq '') { + $restitle = &mt('Untitled resource'); + } + return $restitle; +} + +1; +__END__ 500 Internal Server Error

        Internal Server Error

        The server encountered an internal error or misconfiguration and was unable to complete your request.

        Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

        More information about this error may be available in the server error log.