--- loncom/interface/lonfeedback.pm 2024/07/03 22:14:18 1.370.2.8 +++ loncom/interface/lonfeedback.pm 2016/03/23 02:19:09 1.372 @@ -1,7 +1,7 @@ # The LearningOnline Network # Feedback # -# $Id: lonfeedback.pm,v 1.370.2.8 2024/07/03 22:14:18 raeburn Exp $ +# $Id: lonfeedback.pm,v 1.372 2016/03/23 02:19:09 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,8 +44,8 @@ use HTML::LCParser(); #use HTML::Tidy::libXML; use Apache::lonspeller(); use Apache::longroup; -use Archive::Zip qw( :ERROR_CODES ); -use LONCAPA qw(:DEFAULT :match); +use Cwd; +use LONCAPA; sub discussion_open { my ($status,$symb)=@_; @@ -696,29 +696,21 @@ END #Create zip file in prtspool - if (($env{'user.name'} =~ /^$match_username$/) - && ($env{'user.domain'} =~ /^$match_domain$/)) { - my $now = time(); - my $imszipfile = '/prtspool/'. - join('_',$env{'user.name'},$env{'user.domain'},$now). - '_'.rand(1000000000).'.zip'; - my $zip = Archive::Zip->new(); - $zip->addTree($tempexport); - my $imszip = '/home/httpd/'.$imszipfile; - if ($zip->writeToFileNamed($imszip) == AZ_OK) { - $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive[_2]', + 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[_2]', '','').'
'; - } else { - $discussion .= &mt('Failed to create zip file').'
'; - } - 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 the zip file.').'

'; + if ($copyresult) { + $discussion .= ''. + &mt('The following errors occurred during export:'). + '
'.$copyresult; } } } else { @@ -855,7 +847,7 @@ sub send_feedback_link { &discussion_link($ressymb, ''.&mt('Post Discussion').'', + '" border="0" />'.&mt('Post Discussion').'', 'replydisc'). ''; } @@ -866,7 +858,7 @@ sub send_message_link { &discussion_link($ressymb, ''.&mt('Send Feedback').'', + '" border="0" />'.&mt('Send Feedback').'', 'sendmessageonly'). ''; return $output; @@ -960,9 +952,14 @@ sub postingform_display { } } } + my $postanon; + if (&Apache::lonnet::allowed('pac',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { + $postanon = ''; + } $postingform .= (< - +$postanon @@ -1264,8 +1261,9 @@ sub build_posting_display { @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); } # Set up for sorting by last name, then first name - my %names = &Apache::loncommon::getnames($contrib{$idx.':sendername'}, - $contrib{$idx.':senderdomain'}); + 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 '') { @@ -1292,7 +1290,7 @@ sub build_posting_display { if (&editing_allowed($escsymb.':::'.$idx,$group)) { if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { $sender.=' '. - &discussion_link($ressymb,&mt('Edit'),'editdisc',$idx,$$newpostsflag,$prevread,&group_args($group)); + &discussion_link($symb,&mt('Edit'),'editdisc',$idx,$$newpostsflag,$prevread,&group_args($group)); unless ($seehidden) { my $grpargs = &group_args($group); $sender.=" '; } else { - $$discussionitems[$idx].=' '.&discussion_link($ressymb,''.&mt('Like').'','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting")); + $$discussionitems[$idx].=' '.&discussion_link($symb,''.&mt('Like').'','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting")); } if ($userunlikes{$idx}) { $$discussionitems[$idx].=''.&mt('You unlike this posting').''; } else { - $$discussionitems[$idx].=' '.&discussion_link($ressymb,''.&mt('Unlike').'','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting")); + $$discussionitems[$idx].=' '.&discussion_link($symb,''.&mt('Unlike').'','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting")); } } } @@ -1543,7 +1541,7 @@ sub build_posting_display { $$discussionitems[$idx] .= '  '.&mt('This post has been edited by the author.'); if ($seehidden) { $$discussionitems[$idx] .= '  '. - &discussion_link($ressymb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group)); + &discussion_link($symb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group)); } $$discussionitems[$idx].='
'.&mt('Earlier version(s) were posted on: '); if ($contrib{$idx.':history'} =~ m/:/) { @@ -1645,8 +1643,9 @@ sub get_post_contents { $$contrib{$idx.':sendername'}, $$contrib{$idx.':senderdomain'}); $$screenname=$$contrib{$idx.':screenname'}; - $$showaboutme = &Apache::loncommon::aboutme_on($$contrib{$idx.':sendername'}, - $$contrib{$idx.':senderdomain'}); + $$showaboutme = &Apache::lonnet::usertools_access($$contrib{$idx.':sendername'}, + $$contrib{$idx.':senderdomain'}, + 'aboutme'); my $sender = $$plainname; if ($$showaboutme) { $sender = &Apache::loncommon::aboutmewrapper( @@ -1774,11 +1773,14 @@ sub mail_screen { my %lt = &Apache::lonlocal::texthash( 'myqu' => 'Question/comment/feedback:', + 'title' => 'Title', 'reta' => 'Retained attachments', 'atta' => 'Attachment', ); - if ($env{'form.editdisc'} || $env{'form.replydisc'}){ - $lt{'myqu'} = &mt('Post Discussion'); + if($env{'form.editdisc'} || $env{'form.replydisc'}){ + %lt = &Apache::lonlocal::texthash( + 'myqu' => 'Post Discussion', + ); } my $restitle = &get_resource_title($caller_symb,$feedurl); my $quote=''; @@ -2053,8 +2055,8 @@ END } else { $r->print(< -$lt{'atta'} $attachmaxtext: - +$lt{'atta'} $attachmaxtext: +

END } @@ -2065,7 +2067,7 @@ END $r->print(''); } $r->print(< +

END @@ -2701,46 +2703,29 @@ sub get_post_attachments { $$attachments{'0'}{'filename'} = $attachmenturls; $$attachments{'0'}{'0'} = 'n'; } + return; } sub fail_redirect { - my ($r,$feedurl,$delay) = @_; + 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'); - my %parms=('only_body' => 1); - if ($delay !~ /^\d+(|\.\d+)$/) { - $delay = 2; - } - if ($env{'form.modal'}) { - my $onload = 'document.forms.reldt.submit()'; - if ($delay) { - my $js_delay = int(1000 * $delay); - $onload = "setTimeout(function(){ - document.forms.reldt.submit(); - },$js_delay);"; - } - $parms{'add_entries'}={'onload' => $onload}; - } else { - $parms{'redirect'}=[$delay,$feedurl]; - } - $r->print(&Apache::loncommon::start_page('Feedback not sent',undef,\%parms)); - my $windowname = 'loncapaclient'; + $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,$delay) = @_; + my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group,$toolarge) = @_; my $sorttag = ''; my $roletag = ''; my $statustag = ''; @@ -2839,20 +2824,10 @@ sub redirect_back { &Apache::lonenc::check_encrypt(\$feedurl); my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); my %parms=('only_body' => 1); - if ($delay !~ /^\d+(|\.\d+)$/) { - $delay = 0; - } if ($env{'form.modal'}) { - my $onload = 'document.forms.reldt.submit()'; - if ($delay) { - my $js_delay = int(1000 * $delay); - $onload = "setTimeout(function(){ - document.forms.reldt.submit(); - },$js_delay);"; - } - $parms{'add_entries'}={'onload' => $onload}; + $parms{'add_entries'}={'onLoad' => 'document.forms.reldt.submit()'}; } else { - $parms{'redirect'}=[$delay,$feedurl]; + $parms{'redirect'}=[0,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback sent',undef,\%parms); @@ -2880,59 +2855,39 @@ ENDREDIR } sub no_redirect_back { - my ($r,$feedurl,$delay) = @_; + my ($r,$feedurl) = @_; my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); - my $form_for_modal; - my %parms=('only_body' => 1, - 'bgcolor' => '#FFFFFF',); - if ($delay !~ /^\d+(|\.\d+)$/) { - $delay = 0; - } - if ($env{'form.modal'}) { - if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) { - my $onload = 'document.forms.reldt.submit()'; - if ($delay) { - my $js_delay = int(1000 * $delay); - $onload = "setTimeout(function(){ - document.forms.reldt.submit(); - },$js_delay);"; - } - $parms{'add_entries'}={'onload' => $onload}; - my $windowname = 'loncapaclient'; - $form_for_modal = < - -ENDFORM - } - } else { - if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) { - $parms{'redirect'}=[$delay,$feedurl]; - } + + my %onload; + + my %body_options = ('only_body' => 1, + 'bgcolor' => '#FFFFFF', + 'add_entries' => \%onload,); + + if ($feedurl !~ m{^/adm/feedback}) { + $body_options{'redirect'} = [2,$feedurl]; } my $start_page= &Apache::loncommon::start_page('Feedback not sent',undef, - \%parms); - + \%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
-$form_for_modal $end_page ENDNOREDIRTWO } sub screen_header { my ($feedurl,$symb,$group) = @_; - my %default = &Apache::lonlocal::texthash ( - question => 'Question about resource content', - comment => 'Question/Comment/Feedback about course content', - policy => 'Question/Comment/Feedback about course policy', - ); + 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'); @@ -2940,8 +2895,8 @@ sub screen_header { if ($env{'request.course.id'}) { $crstype = &Apache::loncommon::course_type(); if ($crstype eq 'Community') { - $default{'comment'} = &mt('Question/Comment/Feedback about community content'); - $default{'policy'} = &mt('Question/Comment/Feedback about community policy'); + $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'); @@ -2949,76 +2904,58 @@ sub screen_header { } my $msgoptions=''; my $discussoptions=''; - my $checkradio = ''; - my $blockblog; - my (%fdbkoptions,%discoptions); unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { - if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { - $fdbkoptions{'author'} = 1; - } - if (&feedback_available(1)) { - $fdbkoptions{'question'} = 1; - } - if (&feedback_available(0,1)) { - $fdbkoptions{'course'} = 1; - } - if (&feedback_available(0,0,1)) { - $fdbkoptions{'policy'} = 1; - } + 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'); my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $realsymb = &get_realsymb($symb); - if (!$blocked && &discussion_open(undef,$realsymb) && - (&Apache::lonnet::allowed('pch', - $env{'request.course.id'}. - ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || + if (!$blocked && &discussion_open(undef,$realsymb) && + (&Apache::lonnet::allowed('pch', + $env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || (($group ne '') && ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$}) && (&check_group_priv($group,'pgd') eq 'ok')))) { - $discoptions{'nonanon'} = 1; - $discoptions{'anon'} = 1; - $blockblog = &Apache::loncommon::blocking_status('blogs'); - } - } - my $total = scalar(keys(%fdbkoptions)) + scalar(keys(%discoptions)); - return if (!$total); - if ($total == 1) { - $checkradio = ' checked="checked"'; - } - if (keys(%fdbkoptions)) { - if ($fdbkoptions{'author'}) { - $msgoptions = - '
'; - } - foreach my $item ('question','comment','policy') { - my $type = $item; - if ($item eq 'comment') { - $type = 'course'; - } - my $optionhash=$env{'course.'.$env{'request.course.id'}.'.'.$item.'.email.text'}; - if ($fdbkoptions{$type}) { - $msgoptions .= - '
'; - } - } - } - if (keys(%discoptions)) { - if ($discoptions{'nonanon'}) { $discussoptions=''; - } - if ($discoptions{'anon'}) { - $discussoptions .= '
'. - ''.&mt('Change Screenname').''; - } - if (!$blockblog) { - $discussoptions.= &add_blog_checkbox($crstype); + ''; + if (&Apache::lonnet::allowed('pac',$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) { @@ -3106,17 +3043,9 @@ sub feedback_available { } sub send_msg { - my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,$clientip,%to)=@_; + my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,%to)=@_; my $status=''; my $sendsomething=0; - my $delay; - my $senthide; - my %setters; - my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = - &Apache::loncommon::blockcheck(\%setters,'com',$clientip); - if ($by_ip) { - $senthide = 1; - } my $restitle = &get_resource_title($symb,$feedurl); if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; } unless ($title=~/\w/) { $title=&mt('Feedback'); } @@ -3130,8 +3059,7 @@ sub send_msg { } else { unless (&Apache::lonmsg::user_normal_msg($user,$domain, $title.' ['.$restitle.']',$email,$citations,$feedurl, - $attachmenturl,undef,undef,$symb,$restitle,undef, - undef,undef,undef,$senthide)=~/ok/) { + $attachmenturl,undef,undef,$symb,$restitle)=~/ok/) { $status.='
'.&mt('Error sending message to').' '.$key.'
'; } else { $sendsomething++; @@ -3139,24 +3067,6 @@ sub send_msg { } } } - if ($sendsomething && $senthide) { - if ($by_ip) { - my $showdom = &Apache::lonnet::domain($blockdom); - if ($showdom eq '') { - $showdom = $blockdom; - } - $delay = 4; - $status.='
'.&mt("Message content of feedback you send to instructor(s) from your current IP address: [_1] will be unavailable in your 'Sent' folder.",$clientip). - '
'; - } - } # Records of number of feedback messages are kept under the "symb" called "_feedback" # There are two entries within the framework of a course: @@ -3174,7 +3084,7 @@ sub send_msg { } } } - return ($status,$sendsomething,$delay); + return ($status,$sendsomething); } # Routine to get the complete feedback records @@ -3264,7 +3174,7 @@ sub adddiscuss { if (($symb) && ($email)) { my $now = time; if ($env{'form.editdisc'}) { - $contrib{'ip'}=&Apache::lonnet::get_requestor_ip(); + $contrib{'ip'}=$ENV{'REMOTE_ADDR'}; $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; $contrib{'timestamp'} = $now; $contrib{'history'} = ''; @@ -3598,7 +3508,7 @@ sub modify_attachments { document.modattachments.action = document.modattachments.origpage.value; document.modattachments.submit(); } - + END @@ -3641,8 +3551,8 @@ END $r->print(''.$subject.''); $r->print(&Apache::lonhtmlcommon::row_closure()); $r->print(&Apache::lonhtmlcommon::row_title($lt{'adda'})); - $r->print('' - .'' + $r->print('' + .'' .' '.$attachmaxtext); if(($idx)||(ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)){ @@ -3985,9 +3895,8 @@ sub handler { 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); + &redirect_back($r,$feedurl,&mt('Editing not permitted').'
', '0','0','','',$env{'form.previous'},undef,undef,undef, + undef,undef,undef,$group); return OK; } } @@ -4194,7 +4103,7 @@ ENDREDIR unless (($seehidden) || (&editing_allowed($env{'form.hide'},$group))) { &redirect_back($r,$feedurl,&mt('Hiding not permitted').'
', '0','0','','',$env{'form.previous'},'','','','', - undef,undef,$group); + undef,undef,$group,); return OK; } @@ -4626,12 +4535,6 @@ ENDREDIR $r->internal_redirect('/adm/ambiguous'); return OK; } - if ($feedurl eq '') { - &Apache::loncommon::content_type($r,'text/html'); - $r->send_http_header; - &no_redirect_back($r); - return OK; - } # Go ahead with feedback, no ambiguous reference unless ( ( @@ -4646,7 +4549,7 @@ ENDREDIR $r->send_http_header; # Unable to give feedback &Apache::lonenc::check_encrypt(\$feedurl); - &no_redirect_back($r,$feedurl,2); + &no_redirect_back($r,$feedurl); return OK; } # --------------------------------------------------- Print login screen header @@ -4666,7 +4569,7 @@ ENDREDIR if ($options) { &mail_screen($r,$feedurl,$options,$symb,$attachmax{'text'}); } else { - &fail_redirect($r,$feedurl,2); + &fail_redirect($r,$feedurl); } return OK; } @@ -4685,7 +4588,7 @@ ENDREDIR my $usersymb = &Apache::lonenc::check_encrypt($symb); my $useranswer= &Apache::loncommon::get_student_answers( - $symb,$env{'user.name'},$env{'user.domain'}, + $usersymb,$env{'user.name'},$env{'user.domain'}, $env{'request.course.id'}); &Apache::lonnet::delenv('allowed.vgr'); # Get attachments, if any, and not too large @@ -4732,10 +4635,9 @@ ENDREDIR my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl); # Actually send mail - my $clientip = &Apache::lonnet::get_requestor_ip($r); - my ($status,$numsent,$delay)=&send_msg(&clear_out_html($env{'form.subject'}), - $feedurl,$email,$citations, - $attachmenturl,$usersymb,$clientip,%to); + my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}), + $feedurl,$email,$citations, + $attachmenturl,$usersymb,%to); # Discussion? Store that. my $numpost=0; @@ -4743,7 +4645,11 @@ ENDREDIR && $env{'form.discuss'} !~ /^(?:author|question|course|policy)/) || $env{'form.anondiscuss'} ne '') { my $subject = &clear_out_html($env{'form.subject'}); - my $anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} ); + my $anonmode; + if (&Apache::lonnet::allowed('pac',$env{'request.course.id'}. + ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { + $anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} ); + } $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, $subject,$group); $numpost++; @@ -4766,8 +4672,7 @@ ENDREDIR } # 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,$delay); + &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group,$toolarge); } return OK; }