--- loncom/interface/lonfeedback.pm 2001/02/06 14:22:30 1.3 +++ loncom/interface/lonfeedback.pm 2010/01/25 03:30:23 1.273.4.5 @@ -1,224 +1,4173 @@ # The LearningOnline Network # Feedback # -# (Internal Server Error Handler +# $Id: lonfeedback.pm,v 1.273.4.5 2010/01/25 03:30:23 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 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 handler { - my $r = shift; - $r->content_type('text/html'); - $r->send_http_header; - return OK if $r->header_only; +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; +} - my $feedurl=$ENV{'form.postdata'}; - $feedurl=~s/^http\:\/\///; - $feedurl=~s/^$ENV{'SERVER_NAME'}//; - $feedurl=~s/^$ENV{'HTTP_HOST'}//; +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; +} - if (($feedurl=~/^\/res/) || ($ENV{'request.course.id'})) { -# --------------------------------------------------- Print login screen header - unless ($ENV{'form.sendit'}) { - my $options=''; - if ($feedurl=~/^\/res/) { - $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'; - } - $r->print(< - -The LearningOnline Network with CAPA - - - -

Feedback

-

$feedurl

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

-

- -

- - -ENDDOCUMENT -} else { -# -# Get previous user input -# - 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'}); +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 = ("LC_disc_old_item","LC_disc_new_item"); + 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'}; + my $crstype = &Apache::loncommon::course_type(); + + +# 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.='
'. + "\n".''; + $discussion .= &action_links_bar($colspan,$ressymb,$visible, + $newpostsflag,$group, + $prevread,$markondisp); + my $escsymb=&escape($ressymb); + my $numhidden = keys(%notshown); + if ($numhidden > 0) { + my $colspan = $maxdepth+1; + $discussion.="\n".''; + } + } + +# Choose sort mechanism + my @showposts = (); + if ($sortposts eq 'descdate') { + @showposts = (sort { $b <=> $a } keys(%alldiscussion)); + } elsif ($sortposts eq 'thread') { + @showposts = (sort { $a <=> $b } keys(%alldiscussion)); + } elsif ($sortposts eq 'subject') { + foreach my $key (sort(keys(%subjectsort))) { + push(@showposts, @{$subjectsort{$key}}); + } + } elsif ($sortposts eq 'username') { + foreach my $domain (sort(keys(%usernamesort))) { + foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { + push(@showposts, @{$usernamesort{$domain}{$key}}); + } + } + } elsif ($sortposts eq 'lastfirst') { + foreach my $last (sort(keys(%namesort))) { + foreach my $key (sort(keys(%{$namesort{$last}}))) { + push(@showposts, @{$namesort{$last}{$key}}); + } + } + } else { + @showposts = (sort { $a <=> $b } keys(%alldiscussion)); + } + my $currdepth = 0; + my $firstidx = $alldiscussion{$showposts[0]}; + foreach my $post (@showposts) { + unless (($sortposts eq 'thread') || (($sortposts eq '') && ($env{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) { + $alldiscussion{$post} = $post; + } + unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + $discussion.="\n"; + } + my $thisdepth=$depth[$alldiscussion{$post}]; + if ($outputtarget ne 'tex' && $outputtarget ne 'export') { + for (1..$thisdepth) { + $discussion.=''; + } + } + my $colspan=$maxdepth-$thisdepth+1; + if ($outputtarget eq 'tex') { + #cleanup block + $discussionitems[$alldiscussion{$post}]=~s/]*)>/
'. + ''.&mt('Show all posts').' '.&mt('to display').' '. + $numhidden.' '; + if ($showunmark) { + $discussion .= &mt('posts previously marked read'); + } else { + $discussion .= &mt('previously viewed posts'); + } + $discussion .= '
   
/; + $discussionitems[$alldiscussion{$post}]=~s/]*)>]*)>/'; + } + } + } + unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { + my $colspan=$maxdepth+1; + $discussion .= < + + +END + $discussion .= &action_links_bar($colspan,$ressymb,$visible, + $newpostsflag,$group, + $prevread,$markondisp); + $discussion .= " +
/; + my $threadinsert=''; + if ($thisdepth > 0) { + $threadinsert='
Reply: '.$thisdepth.''; + } + $discussionitems[$alldiscussion{$post}]=~s/<\/td>]*)>/$threadinsert<\/td>		/; + $discussionitems[$alldiscussion{$post}]=~s/]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g; + $discussionitems[$alldiscussion{$post}]=~s/(|<\/b>|<\/a>|]+)>)//g; + + $discussionitems[$alldiscussion{$post}]='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.$discussionitems[$alldiscussion{$post}]; + $discussion.=$discussionitems[$alldiscussion{$post}]; + } elsif ($outputtarget eq 'export') { + my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html'; + if ($manifestok) { + if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) { + print $manifestfile ' '."\n"; + } + $currdepth = $depth[$alldiscussion{$post}]; + print $manifestfile "\n". + ''. + ''.$imsitems{$alldiscussion{$post}}{'title'}.''; + $imsresources .= "\n". + ''."\n". + ''."\n". + $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}."\n". + ''; + } + my $postingfile; + my $postingfilename = $tempexport.'/'.$postfilename; + if ($postingfile = Apache::File->new('>'.$postingfilename)) { + print $postingfile 'Discussion Post'. + $imsitems{$alldiscussion{$post}}{'title'}.' '. + $imsitems{$alldiscussion{$post}}{'sender'}. + $imsitems{$alldiscussion{$post}}{'timestamp'}.'

'. + $imsitems{$alldiscussion{$post}}{'message'}.'
'. + $imsitems{$alldiscussion{$post}}{'attach'}.''."\n"; + close($postingfile); + } else { + $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'
'; + } + $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); + } else { + $discussion.='		'. $discussionitems[$alldiscussion{$post}]. + '
+ + + +END + if ($sortposts) { + my %sort_types = (); + my %role_types = (); + my %status_types = (); + &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype); + + $discussion .= ''; + } + } + if ($dischash{$toggkey}) { + my $storebutton = &mt('Save read/unread changes'); + $discussion.=''; + } + $discussion .= (< +
+ + + + + + + + +
+ $lt{'cuse'}:  +END + if ($newpostsflag) { + $discussion .= + '1. '.$lt{'disp'}.' - '.$currdisp.'  2. '.$lt{'nolo'}.' - '.$currmark.''; + if ($dischash{$toggkey}) { + $discussion .= '  3. '.$lt{'togg'}.' - '.$currtogg.''; + } + } else { + if ($dischash{$toggkey}) { + $discussion .= '1. '.$lt{'disp'}.' - '.$currdisp.' 2. '.$lt{'togg'}.' - '.$currtogg.''; + } else { + $discussion .= + $lt{'disp'}.' - '.$currdisp.''; + } + } + $discussion .= <  + $lt{'chgt'}? +
+ 		'.&mt('Sorted by').': '.$sort_types{$sortposts}.'
'; + if (defined($env{'form.totposters'})) { + $discussion .= &mt('Posts by').':'; + if ($totposters > 0) { + foreach my $poster (@posters) { + $discussion .= ' '.$poster.','; + } + $discussion =~ s/,$//; + } else { + $discussion .= &mt('None selected'); + } + } else { + my $filterchoice =''; + if (@sectionpick > 0) { + $filterchoice = ''.&mt('sections').'- '.$env{'form.sectionpick'}; + $filterchoice .= '    '; + } + if (@grouppick > 0) { + $filterchoice = ''.&mt('groups').'- '.$env{'form.grouppick'}; + $filterchoice .= '    '; + } + if (@rolefilter > 0) { + $filterchoice .= ''.&mt('roles').'-'; + foreach my $role (@rolefilter) { + $filterchoice .= ' '.$role_types{$role}.','; + } + $filterchoice =~ s/,$//; + $filterchoice .= '
'.(' ' x8); + } + 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; + } } -# -# Get output from resource -# - my $usersaw=&Apache::lonnet::ssi($feedurl); - $usersaw=~s/\]*\>//gi; - $usersaw=~s/\<\/body\>//gi; - $usersaw=~s/\//gi; - $usersaw=~s/\<\/html\>//gi; - $usersaw=~s/\//gi; - $usersaw=~s/\<\/head\>//gi; - $usersaw=~s/action\s*\=/would_be_action\=/gi; -# -# Filter HTML out of message (could be nasty) -# - my $message=$ENV{'form.comment'}; - $message=~s/\/\>\;/g; + 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,$crstype); + } + } else { + $discussion.= + &postingform_display($mode,$ressymb,$now,$subject, + $comment,$outputtarget,$attachnum, + $currnewattach,$currdelold,'',$crstype); + } + } + } 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; +} -# -# Assemble email -# - my $email=<<"ENDEMAIL"; -Refers to $feedurl -
-

Message

-
+sub send_feedback_link {
+    my ($ressymb,$target) = @_;
+    my $output = ''.
+                 ' '.
+                 ''.&mt('Post Discussion').'';
+    return $output;
+}
+
+sub send_message_link {
+    my ($ressymb) = @_;
+    my $output = ''.
+                 '  '.&mt('Send Feedback').'';
+    return $output;
+}
+
+sub action_links_bar {
+    my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp) = @_;
+    my $discussion = ''.
+                     ''.
+                     '';
+    if ($newpostsflag) {
+        if (!$markondisp) {
+            $discussion .='';
+        } else {
+            $discussion .= '';
+        }
+    } else {
+        $discussion .= '';
+    }
+    $discussion .= '
';
+    my $escsymb=&escape($ressymb);
+    if ($visible>2) {
+        $discussion .= ''.&mt('Threaded View').'  '.
+                      ''.&mt('Chronological View').'  
+                       '.&mt('Sorting/Filtering options').''.(' ' x2);
+    }
+    $discussion .=''.&mt('Export').'?  '.
+                           &mt('Preferences on what is marked as NEW').
+                           '
'.&mt('Mark NEW posts no longer new').'		  
';
+    return $discussion;
+}
+
+sub postingform_display {
+    my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum,
+        $currnewattach,$currdelold,$group,$crstype) = @_;
+    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',
+    );
+    if ($crstype eq 'Community') {
+        $lt{'note'} = &mt('Note: in anonymous discussion, your name is visible only to community facilitators');
+    }
+    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($crstype);
+    }
+    $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'});
+
+    my $see_anonymous = 
+	&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''));
+
+    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'} || $see_anonymous) {
+			    $sender=&Apache::loncommon::aboutmewrapper(
+					 $plainname,
+					 $contrib{$idx.':sendername'},
+					 $contrib{$idx.':senderdomain'}).' ('.
+					 $contrib{$idx.':sendername'}.':'.
+					 $contrib{$idx.':senderdomain'}.')';
+                            $sender = ''.$sender.'';
+			    if ($contrib{$idx.':anonymous'}) {
+			        $sender.=' ['.$$anonhash{$key}.'] '.
+				    $screenname;
+			    }
+			    if ($see_anonymous) {
+				$sender.=&Apache::loncommon::student_image_tag($contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
+			    }
+                            $sender = ''.$sender.'';
+# 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] .= '
+                                 
'.&mt('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.'
    ');
+    }
+    for (my $i=$start; $i<$end; $i++) {
+        my ($timesent,$attachmsg);
+        my %currattach = ();
+        $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]);
+	&newline_to_br(\$messages->{$i});
+        $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i});
+        $$subjects{$i}=~s/\n/\
    /g;
+        $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i});
+        if ($attachmenturls) {
+            &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach);
+        }
+        if ($type eq 'export') {
+            $$imsfiles{$idx}{$i} = '';
+            if ($attachmsg) {
+                $$attachtxt{$i} = '
    '.&mt('Attachments').':
    ';
+                foreach my $key (sort(keys(%currattach))) {
+                    if ($$allattachments{$key}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
+                        my $fname = $1.$3.'/'.$4;
+                        $$imsfiles{$idx}{$i} .= ''."\n";
+                        $$attachtxt{$i}.= ''.$4.'
    ';
+                    }
+                }
+            }
+        } else {
+            if ($attachmsg) {
+                $$attachtxt{$i} = '
    '.&mt('Attachments').':'.$attachmsg.'
    ';
+            } else {
+                $$attachtxt{$i} = '';
+            }
+        }
+        if ($type eq 'allversions') {
+            $discussion.= <<"END";
+
  • $$subjects{$i}, $timesent
    
+$$messages{$i}
    
+$$attachtxt{$i}
    • 
+END
+        }
+    }
+    if ($type eq 'allversions') {
+        $discussion.='
';
+        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,$attachmaxtext) = @_;
+  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(
+            'myqu' => 'My question/comment/feedback:',
+            'title' => 'Title',
+            'reta' => 'Retained attachments',
+            'atta' => 'Attachment',
+           );
+  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(undef,undef,1);
+  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 discussion 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
+    my $save = &mt('Save');
+    $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();
+    my @courseroles = qw(st ad ep ta in);
+    my $crstype = &Apache::loncommon::course_type();
+    my $ccrole = 'cc';
+    if ($crstype eq 'Community') {
+        $ccrole = 'co';
+    }
+    push(@courseroles,$ccrole);
+
+    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' => 'Save changes',
+    );
+
+    my %sort_types = ();
+    my %role_types = ();
+    my %status_types = ();
+    &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype);
+
+    my $js = <
+function verifyFilter() {
+    var rolenum = 0
+    for (var i=0; i
+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("
+

+

+
+$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) = @_;
+  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,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group,$toolarge) = @_;
+  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), and $sendposts post(s).
+$blog
+$toolarge
+$status
+

+$prevtag
+$sorttag
+$statustag
+$roletag
+$sectag
+$grptag
+$userpicktag
+$grouptag
+

+$end_page
+ENDREDIR
+}
+
+sub no_redirect_back {
+  my ($r,$feedurl) = @_;
+  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,$symb) = @_;
+    my $crscontent = &mt('Question/Comment/Feedback about course content');
+    my $crspolicy = &mt('Question/Comment/Feedback about course policy');
+    my $contribdisc = &mt('Contribution to course discussion of resource');
+    my $anoncontrib = &mt('Anonymous contribution to course discussion of resource');
+    my $namevis = &mt('name only visible to course faculty');
+    my $crstype;
+    if ($env{'request.course.id'}) {
+        $crstype = &Apache::loncommon::course_type();
+        if ($crstype eq 'Community') {
+            $crscontent = &mt('Question/Comment/Feedback about community content');
+            $crspolicy = &mt('Question/Comment/Feedback about community policy');
+            $contribdisc = &mt('Contribution to community discussion of resource');
+            $anoncontrib = &mt('Anonymous contribution to community discussion of resource');
+            $namevis = &mt('name only visible to community facilitators');
+        }
+    }
+    my $msgoptions='';
+    my $discussoptions='';
+    unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) {
+	if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) {
+	    $msgoptions= 
+		'
';
+	}
+        my %optionhash=();
+        foreach my $type ('question','comment','policy') {
+	    $optionhash{$type}=$env{'course.'.$env{'request.course.id'}.'.'.$type.'.email.text'};
+	}
+	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($crstype);
+            }
+        }
+    }
+    if ($msgoptions) {
+        $msgoptions='
'
+                   .' '.&mt('Send Feedback').'
'.&Apache::lonhtmlcommon::coursepreflink(&mt('Feedback Settings'),'feedback').'
'
+                   .$msgoptions;
+    }
+    if ($discussoptions) { 
+	$discussoptions='
'
+                        .' '.&mt('Discussion Contributions').'
'.&Apache::lonhtmlcommon::coursepreflink(&mt('Discussion Settings'),'discussion').'
'
+                        .$discussoptions;
+    }
+    return $msgoptions.$discussoptions;
+}
+
+sub resource_output {
+  my ($feedurl) = @_;
+  my $usersaw=&Apache::lonnet::ssi_body($feedurl);
+  $usersaw=~s/\]*\>//gi;
+  $usersaw=~s/\<\/body\>//gi;
+  $usersaw=~s/\//gi;
+  $usersaw=~s/\<\/html\>//gi;
+  $usersaw=~s/\//gi;
+  $usersaw=~s/\<\/head\>//gi;
+  $usersaw=~s/action\s*\=/would_be_action\=/gi;
+  return $usersaw;
+}
+
+sub clear_out_html {
+  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 ($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";
 $message
-
    • -
    -

    Previous attempts of student (if applicable)

    +ENDEMAIL + my $citations=<<"ENDCITE"; +

    $lt{'prev'}

    $prevattempts -

    -

    Original screen output (if applicable)

    +
    +

    $lt{'orig'}

    $usersaw -ENDEMAIL -# -# Who gets this? -# - my %to=(); - if ($ENV{'form.author'}) { - $feedurl=~/^\/res\/(\w+)\/(\w+)\//; - $to{$2.':'.$1}=1; - } - if ($ENV{'form.question'}) { - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}); - } - if ($ENV{'form.comment'}) { - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}); - } - if ($ENV{'form.policy'}) { - map { - $to{$_}=1; - } split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}); +

    $lt{'corr'}

    +$useranswer +ENDCITE + return ($email,$citations); +} + + +sub feedback_available { + my ($question,$course,$policy)=@_; + my ($typestyle,%to)=&Apache::lonmsg::decide_receiver('',0,$question, + $course,$policy); + return scalar(%to); +} + +sub send_msg { + my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,%to)=@_; + my $status=''; + my $sendsomething=0; + 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) { + my ($user,$domain) = split(/\:/,$key,2); + if (!defined($user)) { + $status.='
    '.&mt('Error sending message to [_1], no user specified.',$key); + } elsif (!defined($domain)) { + $status.='
    '.&mt('Error sending message to [_1], no domain specified.',$key); + } else { + unless (&Apache::lonmsg::user_normal_msg($user,$domain, + $title.' ['.$restitle.']',$email,$citations,$feedurl, + $attachmenturl,undef,undef,$symb,$restitle)=~/ok/) { + $status.='
    '.&mt('Error sending message to').' '.$key.'
    '; + } else { + $sendsomething++; + } + } + } } -# -# Actually send mail -# + + + 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=''; - map { - if ($_) { - unless ( - &Apache::lonmsg::user_normal_msg(split(/\:/,$_),'Feedback '.$feedurl, - $email) eq 'ok') { - $status.='
    Error sending message to '.$_.'
    '; + 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('Preview').'

    ' + .&Apache::lonhtmlcommon::start_pick_box() + .&Apache::lonhtmlcommon::row_title(&mt('Subject')) + .$subject + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Message')) + .$message + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + .$end_page + ); +} + +sub contains_block_html { + my ($message)=@_; + return ($message =~ m{ + <(br|h1|h2|h3|h4|h5|h6|p|ol|ul|table|pre|address|blockquote|center|div) + \s* + (\w+\=['"]\w+['"])* + \s* + ( + \s*/>| + >.* + )}xs + ); +} + +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, + $attachmaxtext,$toolarge)=@_; + + 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' => 'Save 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(<
    + $lt{'adda'} +
    $attachmaxtext
    + + + + + + + + +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 ($crstype) = @_; + 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(); + if (defined($navmap)) { + my @allres=$navmap->retrieveResources(); + foreach my $resource (@allres) { + if ($resource->hasDiscussion()) { + my $ressymb = $resource->wrap_symb(); + if (ref($resourcesref) eq 'ARRAY') { + push(@{$resourcesref}, $ressymb); + } + } + } + } else { + &Apache::lonnet::logthis('Has discussion check failed - could not create navmap object.'); + } + return; +} + +sub sort_filter_names { + my ($sort_types,$role_types,$status_types,$crstype) = @_; + if (ref($sort_types) eq 'HASH') { + %{$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' + ); + } + my @courseroles = qw(st in ta ep ad); + if ($crstype eq 'Community') { + push(@courseroles,'co'); + } else { + push(@courseroles,'cc'); + } + if (ref($role_types) eq 'HASH') { + foreach my $role (@courseroles) { + $role_types->{$role} = &Apache::lonnet::plaintext($role,$crstype); + } + $role_types->{'all'} = 'All roles'; + $role_types->{'cr'} = 'Custom role'; + } + if (ref($status_types) eq 'HASH') { + %{$status_types} = ( + all => 'Roles of any status', + Active => 'Only active roles', + Expired => 'Only past roles', + Future => 'Only future roles', + ); + } +} + +sub handler { + my $r = shift; + if ($r->header_only) { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK; + } + +# --------------------------- Get query string for limited number of parameters + + &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, + ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']); + my $group = $env{'form.group'}; + my %attachmax = ( + text => &mt('(128 KB max size)'), + num => 131072, + ); + 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 { + $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 discussion 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'}; } - } - } keys %to; -# + $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,$toolarge); + &process_attachments(\@currnewattach,\@currdelold,\@keepold); + if (exists($env{'form.addnewattach.filename'})) { + if (length($env{'form.addnewattach'})<=$attachmax{'num'}) { + my $subdir = 'feedback/'.$env{'form.timestamp'}; + my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir); + push(@currnewattach, $newattachment); + } else { + $toolarge = '

    '.&mt('Attachment not included - exceeded permitted length').'

    '; + } + } + 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,$attachmax{'text'},$toolarge); + 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/^https?\:\/\///; + $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,$attachmax{'text'}); + } else { + &fail_redirect($r,$feedurl); + } + return OK; + } + +# Get previous user input + my $prevattempts=&Apache::loncommon::get_previous_attempt( + $symb,$env{'user.name'},$env{'user.domain'}, + $env{'request.course.id'}); + +# Get output from resource + &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=''; + my $toolarge=''; + 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'}) { + if (length($env{'form.attachment'})<=$attachmax{'num'}) { + my $now = time; + my $subdir = 'feedback/'.$now; + $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,$subdir); + } else { + $toolarge = '

    '.&mt('Attachment not included - exceeded permitted length').'

    '; + } + } +# Filter HTML out of message (could be nasty) + my $message=&clear_out_html($env{'form.comment'}); + +# Assemble email + my ($email,$citations)=&assemble_email($message,$prevattempts, + $usersaw,$useranswer); + +# Who gets this? + my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl); + +# Actually send mail + 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++; + } + +# Add to blog? + + 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'); + if (&Apache::loncommon::course_type() eq 'Community') { + $blog='
    '.&mt('Added to my community blog').'
    '; + } else { + $blog='
    '.&mt('Added to my course blog').'
    '; + } + } + # Receipt screen and redirect back to where came from -# - print (< -Feedback sent - - - - -Feedback sent ... -$status - - -ENDREDIR -} -} else { - print (<Feedback not sent - - - - -Sorry, no feedback possible on this resource ... - - -ENDNOREDIR + &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group,$toolarge); + } + return OK; } - 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(); } +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__ +=pod + +=head1 NAME + +Apache::lonfeedback.pm + +=head1 SYNOPSIS + +Handles feedback from students to instructors and system administrators. + +Provides a screenshot of the current resource, as well as previous attempts if the resource was a homework. + +Used by lonmsg.pm. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 OVERVIEW + +None + +=head1 SUBROUTINES + +=over + +=item discussion_open() + +=item discussion_visible() + +=item list_discussion() + +=item send_feedback_link() + +=item send_message_link() + +=item action_links_bar() + +=item postingform_display() + +=item build_posting_display + +=item filter_regexp() + +=item get_post_contents() + +=item replicate_attachments() + +=item mail_screen() + +=item print_display_options() + +=item print_sortfilter_options() + +=item print_showposters() + +=item get_post_versions() + +=item get_post_attachments() + +=item fail_redirect() + +=item redirect_back() + +=item no_redirect_back() + +=item screen_header() + +=item resource_output() + +=item clear_out_html() + +=item assemble_email() + +=item feedback_available() + +=item send_msg() + +=item adddiscuss() + +=item get_discussion_info() + +=item show_preview() + +=item newline_to_br() + +=item generate_preview_button() + +=item modify_attachments() + +=item process_attachments() + +=item generate_attachments_button() + +=item extract_attachments() + +=item construct_attachmenturl() + +=item add_blog_checkbox() + +=item has_discussion() + +=item sort_filter_names() + +=item handler() + +=item blocked_reply_or_edit() + +=item wrap_symb() + +=item dewrapper() + +=item get_feedurl() + +=item get_feedurl_and_clean_symb() + +=item editing_allowed() + +=item check_group_priv() + +=item group_args() + +=item get_resource_title() + +=back +=cut