--- loncom/interface/lonfeedback.pm 2002/10/25 13:57:28 1.35 +++ loncom/interface/lonfeedback.pm 2010/03/08 17:47:45 1.290 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.35 2002/10/25 13:57:28 www Exp $ +# $Id: lonfeedback.pm,v 1.290 2010/03/08 17:47:45 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,24 +25,7 @@ # # http://www.lon-capa.org/ # -# (Internal Server Error Handler -# -# (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) -# -# 3/1/1 Gerd Kortemeyer) -# -# 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer -# 2/9 Guy Albertelli -# 2/10 Gerd Kortemeyer -# 2/13 Guy Albertelli -# 7/25 Gerd Kortemeyer -# 7/26 Guy Albertelli -# 7/26,8/10,10/1,11/5,11/6,12/27,12/29 Gerd Kortemeyer -# YEAR=2002 -# 1/1,1/16 Gerd Kortemeyer -# +### package Apache::lonfeedback; @@ -51,170 +34,2635 @@ 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 HTML::Tidy::libXML; +use Apache::lonspeller(); +use Apache::longroup; +use Cwd; +use LONCAPA; + +sub discussion_open { + my ($status,$symb)=@_; + if ($env{'request.role.adv'}) { return 1; } + if (defined($status) && + !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' + || $status eq 'OPEN')) { + return 0; + } + my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); + if (defined($close) && $close ne '' && $close < time) { + return 0; + } + return 1; +} -sub mail_screen { - my ($r,$feedurl,$options) = @_; - my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', - '','onLoad="window.focus();"'); - $r->print(< - -The LearningOnline Network with CAPA - - - -$bodytag -

$feedurl

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

-

- - +END + + # Breadcrumbs + my $brcrum = [{'href' => '', + 'text' => 'Resource Feedback and Discussion'}]; + + my %onload = ('onload' => 'window.focus();setposttype();'); + my $start_page= + &Apache::loncommon::start_page('Resource Feedback and Discussion',$js, + {'add_entries' => \%onload, + 'bread_crumbs' => $brcrum,}); + + if ($quote ne '') { + $quote = &HTML::Entities::decode($quote); + unless (&contains_block_html($quote)) { + &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(< +$lt{'atta'} $attachmaxtext: +

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

-ENDDOCUMENT -$r->print(&generate_preview_button().''); +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) = @_; - $r->print (<Feedback not sent - - - - - - -Sorry, no recipients ... - - + if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; + my %lt = &Apache::lonlocal::texthash( + 'sorr' => 'Sorry, no recipients ...', + ); + my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); + $r->print(&Apache::loncommon::start_page('Feedback not sent',undef, + {'redirect' => [2,$feedurl], + 'only_body' => 1,})); + $r->print(< +$lt{'sorr'} ENDFAILREDIR + $r->print(&Apache::loncommon::end_page()); } sub redirect_back { - my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_; - $r->print (< -Feedback sent - - - - - - + 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 .= '&sectionpick='; + $sectag .= ''; + } else { + $feedurl .= '&sectionpick='.$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). -$status - - +$blog +$toolarge +$status +
+$prevtag +$sorttag +$statustag +$roletag +$sectag +$grptag +$userpicktag +$grouptag +
+$end_page ENDREDIR } sub no_redirect_back { my ($r,$feedurl) = @_; - $r->print (<Feedback not sent - -ENDNOREDIR + my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); + + my %onload; + if ($env{'environment.remote'} ne 'off') { + $onload{'onload'} = + "if (window.name!='loncapaclient') { self.window.close(); }"; + } + + my %body_options = ('only_body' => 1, + 'bgcolor' => '#FFFFFF', + 'add_entries' => \%onload,); - if ($feedurl!~/^\/adm\/feedback/) { - $r->print(''); + 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 (< - - - -Sorry, no feedback possible on this resource ... - - +$start_page + +$nofeed +
+$end_page ENDNOREDIRTWO } sub screen_header { - my ($feedurl) = @_; - my $options=''; - if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { - $options= - '

Feedback to resource author'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) { - $options.= - '
Question about resource content'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) { - $options.= - '
'. - 'Question/Comment/Feedback about course content'; - } - if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) { - $options.= - '
'. - 'Question/Comment/Feedback about course policy'; - } - - if ($ENV{'request.course.id'}) { - if (&Apache::lonnet::allowed('pch', - $ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { - $options.='
'. - 'Contribution to course discussion of resource'; - $options.='
'. - 'Anonymous contribution to course discussion of resource'. - ' (name only visible to course faculty)'; - } - } - return $options; + 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($feedurl); + my $usersaw=&Apache::lonnet::ssi_body($feedurl); $usersaw=~s/\]*\>//gi; $usersaw=~s/\<\/body\>//gi; $usersaw=~s/\//gi; @@ -226,304 +2674,1538 @@ sub resource_output { } sub clear_out_html { - my $message=$ENV{'form.comment'}; - $message=~s/\<\/*m\s*\>//g; - $message=~s/\/\>\;/g; + my ($message,$override,$ignore_htmlarea)=@_; + if (!$ignore_htmlarea + && !&Apache::lonhtmlcommon::htmlareablocked()) { return $message; } +# Always allow the -tag + my %html=(M=>1); +# Check if more is allowed + my $cid=$env{'request.course.id'}; + if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || + ($override)) { + # allows


      • + #

        + # + %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, + BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1, + M=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1, + H1=>1, H2=>1, H3=>1, H4=>1, H5=>1, H6=>1, + TABLE=>1, TR=>1, TD=>1, TH=>1, TBODY=>1); + } +# Do the substitution of everything that is not explicitly allowed + $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ + {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; + $message =~ s/(\]*)\>/ + {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; return $message; } sub assemble_email { - my ($feedurl,$message,$prevattempts,$usersaw)=@_; + my ($message,$prevattempts,$usersaw,$useranswer)=@_; + my %lt = &Apache::lonlocal::texthash( + 'prev' => 'Previous attempts of student (if applicable)', + 'orig' => 'Original screen output (if applicable)', + 'corr' => 'Correct Answer(s) (if applicable)', + ); + if (&Apache::loncommon::course_type() eq 'Community') { + $lt{'prev'} = &mt('Previous attempts of member (if applicable)'); + } my $email=<<"ENDEMAIL"; -Refers to $feedurl - $message ENDEMAIL my $citations=<<"ENDCITE"; -

        Previous attempts of student (if applicable)

        +

        $lt{'prev'}

        $prevattempts -

        -

        Original screen output (if applicable)

        +
        +

        $lt{'orig'}

        $usersaw +

        $lt{'corr'}

        +$useranswer ENDCITE return ($email,$citations); } -sub secapply { - my $rec=shift; - return $rec; -} -sub decide_receiver { - my ($feedurl) = @_; - my $typestyle=''; - my %to=(); - if ($ENV{'form.author'}) { - $typestyle.='Submitting as Author Feedback
        '; - $feedurl=~/^\/res\/(\w+)\/(\w+)\//; - $to{$2.':'.$1}=1; - } - if ($ENV{'form.question'}) { - $typestyle.='Submitting as Question
        '; - foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) - ) { - if (my $rec=&secapply($_)) { $to{$rec}=1; } - } - } - if ($ENV{'form.course'}) { - $typestyle.='Submitting as Comment
        '; - foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) - ) { - if (my $rec=&secapply($_)) { $to{$rec}=1; } - } - } - if ($ENV{'form.policy'}) { - $typestyle.='Submitting as Policy Feedback
        '; - foreach (split(/\,/, - $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) - ) { - if (my $rec=&secapply($_)) { $to{$rec}=1; } - } - } - return ($typestyle,%to); +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 ($feedurl,$email,$citations,%to)=@_; - my $status=''; - my $sendsomething=0; - foreach (keys %to) { - if ($_) { - my $declutter=&Apache::lonnet::declutter($feedurl); - unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), - 'Feedback ['.$declutter.']',$email,$citations)=~/ok/) { - $status.='
        Error sending message to '.$_.'
        '; - } else { - $sendsomething++; - } + 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++; + } + } + } } - } + my %record=&Apache::lonnet::restore('_feedback'); - my ($temp)=keys %record; + 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.='
        Not registered
        '; - } + 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); + + return ($status,$sendsomething); } sub adddiscuss { - my ($symb,$email,$anon)=@_; + my ($symb,$email,$anon,$attachmenturl,$subject)=@_; my $status=''; - if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. - ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { + 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'}); + '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)) { - $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. - &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - my %storenewentry=($symb => time); - $status.='
        Updating discussion time: '. + 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'}); + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); } my %record=&Apache::lonnet::restore('_discussion'); - my ($temp)=keys %record; + my ($temp)=keys(%record); unless ($temp=~/^error\:/) { my %newrecord=(); $newrecord{'resource'}=$symb; $newrecord{'subnumber'}=$record{'subnumber'}+1; - $status.='
        Registering: '. + $status.='
        '.&mt('Registering').': '. &Apache::lonnet::cstore(\%newrecord,'_discussion'); } } else { $status.='Failed.'; } - return $status.'
        '; + 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=shift; - my $message=&clear_out_html($ENV{'form.comment'}); - $message=~s/\n/\
        /g; + 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); - $r->print('
        '. - $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 tidy_html { + my ($message)=@_; +# my $tidy = HTML::Tidy::libXML->new(); +# my $xhtml = $tidy->clean($message, 'utf-8', 1); +# $xhtml =~ m/(.*)<\/body>/is; +# my $clean = $1; +# # remove any empty block-level tags +# $clean =~ s/<(table|p|div|tbody|blockquote|m|pre|algebra|center|ol|ul|span|h1|h2|h3|h4|h5|h6)\s*\/>//i; +# $message=$clean; + return $message; +} + +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 + + # Breadcrumbs + my $brcrum = [{'href' => '', + 'text' => 'Discussion Post Attachments'}]; + my $start_page = + &Apache::loncommon::start_page('Discussion Post Attachments',$js, + {'bread_crumbs' => $brcrum,}); + + 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) { - $r->content_type('text/html'); + &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','postdata','preview']); + &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; + + # Breadcrumbs + my $brcrum = [{'href' => '', + 'text' => 'Discussion Post Versions'}]; + + $r->print(&Apache::loncommon::start_page('Discussion Post Versions',undef, + {'bread_crumbs' => $brcrum,}) + ); + + 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(); }"; + } - if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { + my $start_page= + &Apache::loncommon::start_page('New posts marked as read',undef, + {'redirect' => [2,$feedurl], + 'only_body' => 1, + 'add_entries' => \%onload}); + my $end_page = &Apache::loncommon::end_page(); + $r->print (< +$textline +
        +
        +
        +$end_page +ENDREDIR + return OK; + } elsif ($env{'form.modifydisp'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'}); + my ($dispchgA,$dispchgB,$markchg,$toggchg) = + split(/_/,$env{'form.changes'}); + &print_display_options($r,$symb,$env{'form.previous'},$dispchgA, + $dispchgB,$markchg,$toggchg,$feedurl); + return OK; + } elsif ($env{'form.markondisp'} || $env{'form.markonread'} || + $env{'form.allposts'} || $env{'form.onlyunread'} || + $env{'form.onlyunmark'} || $env{'form.toggoff'} || + $env{'form.toggon'} || $env{'form.markread'}) { + my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); + my %discinfo; +# ------------------------ Modify setting for read/unread toggle for each post + if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; } + if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; } +# --------- Modify setting for identification of 'NEW' posts in this discussion + if ($env{'form.markondisp'}) { + $discinfo{$symb.'_lastread'} = time; + $discinfo{$symb.'_markondisp'} = 1; + } + if ($env{'form.markonread'}) { + if ( $env{'form.previous'} > 0 ) { + $discinfo{$symb.'_lastread'} = $env{'form.previous'}; + } + $discinfo{$symb.'_markondisp'} = 0; + } +# --------------------------------- Modify display setting for this discussion + if ($env{'form.allposts'}) { + $discinfo{$symb.'_showonlyunread'} = 0; + $discinfo{$symb.'_showonlyunmark'} = 0; + } + if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; } + if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; } +# ----------------------------------------------------- Mark new posts not NEW + if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; } + &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', + \%discinfo,$env{'user.domain'},$env{'user.name'}); + my $previous=$env{'form.previous'}; + if ($env{'form.markondisp'}) { $previous=undef; } + &redirect_back($r,$feedurl,&mt('Changed display status').'
        ', + '0','0','','',$previous,'','','','','','',$group); + return OK; + } elsif (($env{'form.hide'}) || ($env{'form.unhide'})) { # ----------------------------------------------------------------- Hide/unhide - $r->content_type('text/html'); - $r->send_http_header; - - my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; - - my ($symb,$idx)=split(/\:\:\:/,$entry); - my ($map,$ind,$url)=split(/\_\_\_/,$symb); - - my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - - my $currenthidden=$contrib{'hidden'}; - - if ($ENV{'form.hide'}) { - $currenthidden.='.'.$idx.'.'; - } else { - $currenthidden=~s/\.$idx\.//g; - } - my %newhash=('hidden' => $currenthidden); + 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); - &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); + 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; + } - &redirect_back($r,&Apache::lonnet::clutter($url), - 'Changed discussion status

        ','0','0'); - } elsif ($ENV{'form.preview'}) { + 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/^http\:\/\///; - $feedurl=~s/^$ENV{'SERVER_NAME'}//; - $feedurl=~s/^$ENV{'HTTP_HOST'}//; - - my $symb=&Apache::lonnet::symbread($feedurl); - unless ($symb) { - $symb=$ENV{'form.symb'}; - if ($symb) { - my ($map,$id,$url)=split(/\_\_\_/,$symb); - $feedurl=&Apache::lonnet::clutter($url); + 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; } - } - my $goahead=1; - if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { - unless ($symb) { $goahead=0; } - } - - if ($goahead) { # Go ahead with feedback, no ambiguous reference - $r->content_type('text/html'); - $r->send_http_header; - - if ( - ( - ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) - ) - || - ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) - || - ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) - ) { + 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'}) { - my $options=&screen_header($feedurl); - if ($options) { - &mail_screen($r,$feedurl,$options); - } else { - &fail_redirect($r,$feedurl); + 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; } - } else { # Get previous user input my $prevattempts=&Apache::loncommon::get_previous_attempt( - $symb,$ENV{'user.name'},$ENV{'user.domain'}, - $ENV{'request.course.id'}); + $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; + my $message=&clear_out_html($env{'form.comment'}); # Assemble email - my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, - $usersaw); - + my ($email,$citations)=&assemble_email($message,$prevattempts, + $usersaw,$useranswer); + # Who gets this? - my ($typestyle,%to) = &decide_receiver($feedurl); + my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl); # Actually send mail - my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to); + my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}, + undef,1), + $feedurl,$email,$citations, + $attachmenturl,$usersymb,%to); # Discussion? Store that. - my $numpost=0; - if ($ENV{'form.discuss'}) { - $typestyle.=&adddiscuss($symb,$message); + 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++; } - if ($ENV{'form.anondiscuss'}) { - $typestyle.=&adddiscuss($symb,$message,1); - $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 + &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group,$toolarge); + } + 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(); +} -# Receipt screen and redirect back to where came from - &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status); +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|; } - } else { -# Unable to give feedback - &no_redirect_back($r,$feedurl); - } - } else { -# Ambiguous Problem Resource - $r->internal_redirect('/adm/ambiguous'); - } + 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; } - return OK; -} 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 tidy_html() + +=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 500 Internal Server Error

        Internal Server Error

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

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

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