loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.77: download - view: text, annotated - select for diffs
Fri Feb 13 15:03:39 2004 UTC (20 years, 4 months ago) by www
Branches: MAIN
CVS tags: HEAD

Bug #2712: reply works on bulletin boards
Bug #2696: reply to anonymous postings possible

1: # The LearningOnline Network 2: # Feedback 3: # 4: # $Id: lonfeedback.pm,v 1.77 2004/02/13 15:03:39 www Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: ### 29: 30: package Apache::lonfeedback; 31: 32: use strict; 33: use Apache::Constants qw(:common); 34: use Apache::lonmsg(); 35: use Apache::loncommon(); 36: use Apache::lontexconvert(); 37: use Apache::lonlocal; 38: 39: sub list_discussion { 40: my ($mode,$status,$symb)=@_; 41: # &Apache::lonnet::logthis("status is $status"); 42: if (!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' 43: || $status eq 'OPEN')) { 44: return ''; 45: } 46: my $discussiononly=0; 47: if ($mode eq 'board') { $discussiononly=1; } 48: unless ($ENV{'request.course.id'}) { return ''; } 49: my $crs='/'.$ENV{'request.course.id'}; 50: if ($ENV{'request.course.sec'}) { 51: $crs.='_'.$ENV{'request.course.sec'}; 52: } 53: $crs=~s/\_/\//g; 54: unless ($symb) { 55: $symb=&Apache::lonnet::symbread(); 56: } 57: unless ($symb) { return ''; } 58: my $seeid=&Apache::lonnet::allowed('rin',$crs); 59: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) 60: && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/)); 61: my @discussionitems=(); 62: # backward compatibility (bulletin boards used to be 'wrapped') 63: my $ressymb=$symb; 64: if ($mode eq 'board') { 65: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; 66: } 67: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, 68: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 69: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 70: my $visible=0; 71: my @depth=(); 72: my @original=(); 73: my @index=(); 74: my @replies=(); 75: my %alldiscussion=(); 76: my $maxdepth=0; 77: 78: my $target=''; 79: unless ($ENV{'browser.interface'} eq 'textual' || 80: $ENV{'environment.remote'} eq 'off' ) { 81: $target='target="LONcom"'; 82: } 83: if ($contrib{'version'}) { 84: for (my $id=1;$id<=$contrib{'version'};$id++) { 85: my $idx=$id; 86: my $hidden=($contrib{'hidden'}=~/\.$idx\./); 87: my $deleted=($contrib{'deleted'}=~/\.$idx\./); 88: my $origindex='0.'; 89: if (($contrib{$idx.':replyto'}) && ($ENV{'environment.threadeddiscussion'})) { 90: # this is a follow-up message 91: $original[$idx]=$original[$contrib{$idx.':replyto'}]; 92: $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1; 93: $origindex=$index[$contrib{$idx.':replyto'}]; 94: if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; } 95: } else { 96: # this is an original message 97: $original[$idx]=0; 98: $depth[$idx]=0; 99: } 100: if ($replies[$depth[$idx]]) { 101: $replies[$depth[$idx]]++; 102: } else { 103: $replies[$depth[$idx]]=1; 104: } 105: unless ((($hidden) && (!$seeid)) || ($deleted)) { 106: $visible++; 107: my $message=$contrib{$idx.':message'}; 108: $message=~s/\n/\<br \/\>/g; 109: $message=&Apache::lontexconvert::msgtexconverted($message); 110: if ($contrib{$idx.':attachmenturl'}) { 111: my ($fname,$ft) 112: =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/); 113: $message.='<p>'.&mt('Attachment').': <a href="'. 114: &Apache::lonnet::tokenwrapper( 115: $contrib{$idx.':attachmenturl'}). 116: '"><tt>'.$fname.'.'.$ft.'</tt></a></p>'; 117: } 118: if ($message) { 119: if ($hidden) { 120: $message='<font color="#888888">'.$message.'</font>'; 121: } 122: my $screenname=&Apache::loncommon::screenname( 123: $contrib{$idx.':sendername'}, 124: $contrib{$idx.':senderdomain'}); 125: my $plainname=&Apache::loncommon::nickname( 126: $contrib{$idx.':sendername'}, 127: $contrib{$idx.':senderdomain'}); 128: 129: my $sender=&mt('Anonymous'); 130: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { 131: $sender=&Apache::loncommon::aboutmewrapper( 132: $plainname, 133: $contrib{$idx.':sendername'}, 134: $contrib{$idx.':senderdomain'}).' ('. 135: $contrib{$idx.':sendername'}.' at '. 136: $contrib{$idx.':senderdomain'}.')'; 137: if ($contrib{$idx.':anonymous'}) { 138: $sender.=' ['.&mt('anonymous').'] '. 139: $screenname; 140: } 141: if ($seeid) { 142: if ($hidden) { 143: $sender.=' <a href="/adm/feedback?unhide='. 144: $ressymb.':::'.$idx.'">'.&mt('Make Visible').'</a>'; 145: } else { 146: $sender.=' <a href="/adm/feedback?hide='. 147: $ressymb.':::'.$idx.'">'.&mt('Hide').'</a>'; 148: } 149: $sender.=' <a href="/adm/feedback?deldisc='. 150: $ressymb.':::'.$idx.'">'.&mt('Delete').'</a>'; 151: } 152: } else { 153: if ($screenname) { 154: $sender='<i>'.$screenname.'</i>'; 155: } 156: } 157: if (&Apache::lonnet::allowed('pch', 158: $ENV{'request.course.id'}. 159: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 160: $sender.=' <a href="/adm/feedback?replydisc='. 161: $ressymb.':::'.$idx.'" '.$target.'>'.&mt('Reply').'</a>'; 162: } 163: my $vgrlink; 164: if ($viewgrades) { 165: $vgrlink=&Apache::loncommon::submlink('Submissions', 166: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb); 167: } 168: #figure out at what position this needs to print 169: my $thisindex=$idx; 170: if ($ENV{'environment.threadeddiscussion'}) { 171: $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2); 172: } 173: $alldiscussion{$thisindex}=$idx; 174: $index[$idx]=$thisindex; 175: $discussionitems[$idx]='<p><b>'.$sender.'</b> '.$vgrlink.' ('. 176: localtime($contrib{$idx.':timestamp'}). 177: '):<blockquote>'.$message. 178: '</blockquote></p>'; 179: } 180: } 181: } 182: } 183: my $discussion=''; 184: if ($visible) { 185: # Print a the discusssion 186: $discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">'; 187: if ($visible>2) { 188: my $colspan=$maxdepth+1; 189: $discussion.='<tr><td bgcolor="DDDDBB" colspan="'.$colspan.'">'. 190: '<a href="/adm/feedback?threadedon='.$symb.'">'.&mt('Threaded View').'</a>  '. 191: '<a href="/adm/feedback?threadedoff='.$symb.'">'.&mt('Chronological View').'</a>'. 192: '</td></tr>'; 193: } 194: 195: foreach (sort { $a <=> $b } keys %alldiscussion) { 196: $discussion.="\n<tr>"; 197: my $thisdepth=$depth[$alldiscussion{$_}]; 198: for (1..$thisdepth) { 199: $discussion.='<td>   </td>'; 200: } 201: my $colspan=$maxdepth-$thisdepth+1; 202: $discussion.="<td bgcolor='#CCCCCC' colspan='".$colspan."'>".$discussionitems[$alldiscussion{$_}]. 203: "</td></tr>"; 204: } 205: $discussion.='</table>'; 206: } 207: if ($discussiononly) { 208: $discussion.=(<<ENDDISCUSS); 209: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> 210: <input type="submit" name="discuss" value="Post Discussion" /> 211: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" /> 212: <input type="hidden" name="symb" value="$ressymb" /> 213: <input type="hidden" name="sendit" value="true" /> 214: <br /> 215: <font size="1">Note: in anonymous discussion, your name is visible only to 216: course faculty</font><br /> 217: <textarea name="comment" cols="60" rows="10" wrap="hard"></textarea> 218: <p> 219: Attachment (128 KB max size): <input type="file" name="attachment" /> 220: </p> 221: </form> 222: ENDDISCUSS 223: $discussion.=&generate_preview_button(); 224: } else { 225: if (&Apache::lonnet::allowed('pch', 226: $ENV{'request.course.id'}. 227: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 228: $discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='. 229: $symb.':::" '.$target.'>'. 230: '<img src="/adm/lonMisc/chat.gif" border="0" />'. 231: &mt('Post Discussion').'</a></td></tr></table>'; 232: } 233: } 234: return $discussion; 235: } 236: 237: sub mail_screen { 238: my ($r,$feedurl,$options) = @_; 239: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', 240: '','onLoad="window.focus();"'); 241: my $title=&Apache::lonnet::gettitle($feedurl); 242: if (!$title) { $title = $feedurl; } 243: my $quote=''; 244: if ($ENV{'form.replydisc'}) { 245: my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'}); 246: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 247: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 248: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 249: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) { 250: my $message=$contrib{$idx.':message'}; 251: $message=~s/\n/\<br \/\>/g; 252: $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>'; 253: } 254: } 255: my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); 256: my $send=&mt('Send'); 257: $r->print(<<ENDDOCUMENT); 258: <html> 259: <head> 260: <title>The LearningOnline Network with CAPA</title> 261: <meta http-equiv="pragma" content="no-cache"></meta> 262: <script type="text/javascript"> 263: // 304: </script> 305: </head> 306: $bodytag 307: <h2><tt>$title</tt></h2> 308: <form action="/adm/feedback" method="post" name="mailform" 309: enctype="multipart/form-data"> 310: <input type="hidden" name="postdata" value="$feedurl" /> 311: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" /> 312: Please check at least one of the following feedback types: 313: $options<hr /> 314: $quote 315: <p>My question/comment/feedback:</p> 316: <p> 317: $latexHelp 318: <textarea name="comment" cols="60" rows="10" wrap="hard"> 319: </textarea></p> 320: <p> 321: Attachment (128 KB max size): <input type="file" name="attachment" /> 322: </p> 323: <p> 324: <input type="hidden" name="sendit" value="1" /> 325: <input type="button" value="$send" onClick='gosubmit();' /> 326: </p> 327: </form> 328: ENDDOCUMENT 329: $r->print(&generate_preview_button().'</body></html>'); 330: } 331: 332: sub fail_redirect { 333: my ($r,$feedurl) = @_; 334: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 335: $r->print (<<ENDFAILREDIR); 336: <html> 337: <head><title>Feedback not sent</title> 338: <meta http-equiv="pragma" content="no-cache" /> 339: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" /> 340: </head> 341: <body bgcolor="#FFFFFF"> 342: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 343: <b>Sorry, no recipients ...</b> 344: </body> 345: </html> 346: ENDFAILREDIR 347: } 348: 349: sub redirect_back { 350: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_; 351: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 352: $r->print (<<ENDREDIR); 353: <html> 354: <head> 355: <title>Feedback sent</title> 356: <meta http-equiv="pragma" content="no-cache" /> 357: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 358: </head> 359: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'> 360: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 361: $typestyle 362: <b>Sent $sendsomething message(s), and $sendposts post(s).</b> 363: <font color="red">$status</font> 364: <form name="reldt" action="$feedurl" target="loncapaclient"> 365: </form> 366: </body> 367: </html> 368: ENDREDIR 369: } 370: 371: sub no_redirect_back { 372: my ($r,$feedurl) = @_; 373: $r->print (<<ENDNOREDIR); 374: <html> 375: <head><title>Feedback not sent</title> 376: <meta http-equiv="pragma" content="no-cache" /> 377: ENDNOREDIR 378: 379: if ($feedurl!~/^\/adm\/feedback/) { 380: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">'); 381: } 382: 383: $r->print (<<ENDNOREDIRTWO); 384: </head> 385: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'> 386: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 387: <b>Sorry, no feedback possible on this resource ...</b> 388: </body> 389: </html> 390: ENDNOREDIRTWO 391: } 392: 393: sub screen_header { 394: my ($feedurl) = @_; 395: my $msgoptions=''; 396: my $discussoptions=''; 397: unless ($ENV{'form.replydisc'}) { 398: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { 399: $msgoptions= 400: '<p><input type="checkbox" name="author" /> '. 401: &mt('Feedback to resource author').'</p>'; 402: } 403: if (&feedback_available(1)) { 404: $msgoptions.= 405: '<br /><input type="checkbox" name="question" /> '. 406: &mt('Question about resource content'); 407: } 408: if (&feedback_available(0,1)) { 409: $msgoptions.= 410: '<br /><input type="checkbox" name="course" /> '. 411: &mt('Question/Comment/Feedback about course content'); 412: } 413: if (&feedback_available(0,0,1)) { 414: $msgoptions.= 415: '<br /><input type="checkbox" name="policy" /> '. 416: &mt('Question/Comment/Feedback about course policy'); 417: } 418: } 419: if ($ENV{'request.course.id'}) { 420: if (&Apache::lonnet::allowed('pch', 421: $ENV{'request.course.id'}. 422: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 423: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '. 424: ($ENV{'form.replydisc'}?' checked="1"':'').' /> '. 425: &mt('Contribution to course discussion of resource'); 426: $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '. 427: &mt('Anonymous contribution to course discussion of resource'). 428: ' <i>('.&mt('name only visible to course faculty').')</i>'; 429: } 430: } 431: if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; } 432: if ($discussoptions) { 433: $discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; } 434: return $msgoptions.$discussoptions; 435: } 436: 437: sub resource_output { 438: my ($feedurl) = @_; 439: my $usersaw=&Apache::lonnet::ssi_body($feedurl); 440: $usersaw=~s/\<body[^\>]*\>//gi; 441: $usersaw=~s/\<\/body\>//gi; 442: $usersaw=~s/\<html\>//gi; 443: $usersaw=~s/\<\/html\>//gi; 444: $usersaw=~s/\<head\>//gi; 445: $usersaw=~s/\<\/head\>//gi; 446: $usersaw=~s/action\s*\=/would_be_action\=/gi; 447: return $usersaw; 448: } 449: 450: sub clear_out_html { 451: my ($message,$override)=@_; 452: my $cid=$ENV{'request.course.id'}; 453: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || 454: ($override)) { 455: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 456: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> 457: my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, 458: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1, 459: M=>1); 460: 461: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ 462: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; 463: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ 464: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; 465: } else { 466: $message=~s/\</\&lt\;/g; 467: $message=~s/\>/\&gt\;/g; 468: } 469: return $message; 470: } 471: 472: sub assemble_email { 473: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; 474: my $email=<<"ENDEMAIL"; 475: Refers to <a href="$feedurl">$feedurl</a> 476: 477: $message 478: ENDEMAIL 479: my $citations=<<"ENDCITE"; 480: <h2>Previous attempts of student (if applicable)</h2> 481: $prevattempts 482: <br /><hr /> 483: <h2>Original screen output (if applicable)</h2> 484: $usersaw 485: <h2>Correct Answer(s) (if applicable)</h2> 486: $useranswer 487: ENDCITE 488: return ($email,$citations); 489: } 490: 491: sub secapply { 492: my $rec=shift; 493: my $defaultflag=shift; 494: $rec=~s/\s+//g; 495: $rec=~s/\@/\:/g; 496: my ($adr,$sections)=($rec=~/^([^$]+)\(([^$]+)\)/); 497: if ($sections) { 498: foreach (split(/\;/,$sections)) { 499: if (($_ eq $ENV{'request.course.sec'}) || 500: ($defaultflag && ($_ eq '*'))) { 501: return $adr; 502: } 503: } 504: } else { 505: return $rec; 506: } 507: return ''; 508: } 509: 510: sub decide_receiver { 511: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; 512: my $typestyle=''; 513: my %to=(); 514: if ($ENV{'form.author'}||$author) { 515: $typestyle.='Submitting as Author Feedback<br>'; 516: $feedurl=~/^\/res\/(\w+)\/(\w+)\//; 517: $to{$2.':'.$1}=1; 518: } 519: if ($ENV{'form.question'}||$question) { 520: $typestyle.='Submitting as Question<br>'; 521: foreach (split(/\,/, 522: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) 523: ) { 524: my $rec=&secapply($_,$defaultflag); 525: if ($rec) { $to{$rec}=1; } 526: } 527: } 528: if ($ENV{'form.course'}||$course) { 529: $typestyle.='Submitting as Comment<br />'; 530: foreach (split(/\,/, 531: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) 532: ) { 533: my $rec=&secapply($_,$defaultflag); 534: if ($rec) { $to{$rec}=1; } 535: } 536: } 537: if ($ENV{'form.policy'}||$policy) { 538: $typestyle.='Submitting as Policy Feedback<br />'; 539: foreach (split(/\,/, 540: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) 541: ) { 542: my $rec=&secapply($_,$defaultflag); 543: if ($rec) { $to{$rec}=1; } 544: } 545: } 546: if ((scalar(%to) eq '0') && (!$defaultflag)) { 547: ($typestyle,%to)= 548: &decide_receiver($feedurl,$author,$question,$course,$policy,1); 549: } 550: return ($typestyle,%to); 551: } 552: 553: sub feedback_available { 554: my ($question,$course,$policy)=@_; 555: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy); 556: return scalar(%to); 557: } 558: 559: sub send_msg { 560: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_; 561: my $status=''; 562: my $sendsomething=0; 563: foreach (keys %to) { 564: if ($_) { 565: my $declutter=&Apache::lonnet::declutter($feedurl); 566: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), 567: 'Feedback ['.$declutter.']',$email,$citations,$feedurl, 568: $attachmenturl)=~/ok/) { 569: $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />'; 570: } else { 571: $sendsomething++; 572: } 573: } 574: } 575: 576: my %record=&Apache::lonnet::restore('_feedback'); 577: my ($temp)=keys %record; 578: unless ($temp=~/^error\:/) { 579: my %newrecord=(); 580: $newrecord{'resource'}=$feedurl; 581: $newrecord{'subnumber'}=$record{'subnumber'}+1; 582: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { 583: $status.='<br />'.&mt('Not registered').'<br />'; 584: } 585: } 586: 587: return ($status,$sendsomething); 588: } 589: 590: sub adddiscuss { 591: my ($symb,$email,$anon,$attachmenturl)=@_; 592: my $status=''; 593: if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. 594: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 595: 596: my %contrib=('message' => $email, 597: 'sendername' => $ENV{'user.name'}, 598: 'senderdomain' => $ENV{'user.domain'}, 599: 'screenname' => $ENV{'environment.screenname'}, 600: 'plainname' => $ENV{'environment.firstname'}.' '. 601: $ENV{'environment.middlename'}.' '. 602: $ENV{'environment.lastname'}.' '. 603: $ENV{'enrironment.generation'}, 604: 'attachmenturl'=> $attachmenturl); 605: if ($ENV{'form.replydisc'}) { 606: $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1]; 607: } 608: if ($anon) { 609: $contrib{'anonymous'}='true'; 610: } 611: if (($symb) && ($email)) { 612: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. 613: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'}, 614: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 615: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 616: my %storenewentry=($symb => time); 617: $status.='<br />'.&mt('Updating discussion time').': '. 618: &Apache::lonnet::put('discussiontimes',\%storenewentry, 619: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 620: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 621: } 622: my %record=&Apache::lonnet::restore('_discussion'); 623: my ($temp)=keys %record; 624: unless ($temp=~/^error\:/) { 625: my %newrecord=(); 626: $newrecord{'resource'}=$symb; 627: $newrecord{'subnumber'}=$record{'subnumber'}+1; 628: $status.='<br />'.&mt('Registering').': '. 629: &Apache::lonnet::cstore(\%newrecord,'_discussion'); 630: } 631: } else { 632: $status.='Failed.'; 633: } 634: return $status.'<br />'; 635: } 636: 637: # ----------------------------------------------------------- Preview function 638: 639: sub show_preview { 640: my $r=shift; 641: my $message=&clear_out_html($ENV{'form.comment'}); 642: $message=~s/\n/\<br \/\>/g; 643: $message=&Apache::lontexconvert::msgtexconverted($message); 644: $r->print('<table border="2"><tr><td>'. 645: $message.'</td></tr></table>'); 646: } 647: 648: sub generate_preview_button { 649: my $pre=&mt("Show Preview"); 650: return(<<ENDPREVIEW); 651: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> 652: <input type="hidden" name="comment" /> 653: <input type="button" value="$pre" 654: onClick="this.form.comment.value=document.mailform.comment.value;this.form.submit();" /> 655: </form> 656: ENDPREVIEW 657: } 658: 659: sub handler { 660: my $r = shift; 661: if ($r->header_only) { 662: &Apache::loncommon::content_type($r,'text/html'); 663: $r->send_http_header; 664: return OK; 665: } 666: 667: # --------------------------- Get query string for limited number of parameters 668: 669: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 670: ['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff']); 671: 672: if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { 673: # ----------------------------------------------------------------- Hide/unhide 674: &Apache::loncommon::content_type($r,'text/html'); 675: $r->send_http_header; 676: 677: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; 678: 679: my ($symb,$idx)=split(/\:\:\:/,$entry); 680: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 681: 682: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 683: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 684: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 685: 686: 687: my $currenthidden=$contrib{'hidden'}; 688: 689: if ($ENV{'form.hide'}) { 690: $currenthidden.='.'.$idx.'.'; 691: } else { 692: $currenthidden=~s/\.$idx\.//g; 693: } 694: my %newhash=('hidden' => $currenthidden); 695: 696: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 697: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 698: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 699: 700: &redirect_back($r,&Apache::lonnet::clutter($url), 701: &mt('Changed discussion status').'<br />','0','0'); 702: } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) { 703: &Apache::loncommon::content_type($r,'text/html'); 704: $r->send_http_header; 705: if ($ENV{'form.threadedon'}) { 706: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); 707: &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on'); 708: } else { 709: &Apache::lonnet::del('environment',['threadeddiscussion']); 710: &Apache::lonnet::delenv('environment\.threadeddiscussion'); 711: } 712: my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'}; 713: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 714: &redirect_back($r,&Apache::lonnet::clutter($url), 715: &mt('Changed discussion view mode').'<br />','0','0'); 716: } elsif ($ENV{'form.deldisc'}) { 717: # --------------------------------------------------------------- Hide for good 718: &Apache::loncommon::content_type($r,'text/html'); 719: $r->send_http_header; 720: 721: my $entry=$ENV{'form.deldisc'}; 722: 723: my ($symb,$idx)=split(/\:\:\:/,$entry); 724: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 725: 726: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 727: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 728: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 729: 730: 731: my $currentdeleted=$contrib{'deleted'}; 732: 733: $currentdeleted.='.'.$idx.'.'; 734: 735: my %newhash=('deleted' => $currentdeleted); 736: 737: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 738: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 739: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 740: 741: &redirect_back($r,&Apache::lonnet::clutter($url), 742: &mt('Changed discussion status').'<br />','0','0'); 743: } elsif ($ENV{'form.preview'}) { 744: # -------------------------------------------------------- User wants a preview 745: $r->content_type('text/html'); 746: $r->send_http_header; 747: &show_preview($r); 748: } else { 749: # ------------------------------------------------------------- Normal feedback 750: my $feedurl=$ENV{'form.postdata'}; 751: $feedurl=~s/^http\:\/\///; 752: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 753: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 754: $feedurl=~s/\?.+$//; 755: 756: my $symb; 757: if ($ENV{'form.replydisc'}) { 758: $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0]; 759: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 760: $feedurl=&Apache::lonnet::clutter($url); 761: } else { 762: $symb=&Apache::lonnet::symbread($feedurl); 763: } 764: unless ($symb) { 765: $symb=$ENV{'form.symb'}; 766: if ($symb) { 767: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 768: $feedurl=&Apache::lonnet::clutter($url); 769: } 770: } 771: my $goahead=1; 772: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { 773: unless ($symb) { $goahead=0; } 774: } 775: # backward compatibility (bulltin boards used to be 'wrapped') 776: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { 777: $feedurl=~s|^/adm/wrapper||; 778: } 779: if ($goahead) { 780: # Go ahead with feedback, no ambiguous reference 781: &Apache::loncommon::content_type($r,'text/html'); 782: $r->send_http_header; 783: 784: if ( 785: ( 786: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) 787: ) 788: || 789: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) 790: || 791: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) 792: ) { 793: # --------------------------------------------------- Print login screen header 794: unless ($ENV{'form.sendit'}) { 795: my $options=&screen_header($feedurl); 796: if ($options) { 797: &mail_screen($r,$feedurl,$options); 798: } else { 799: &fail_redirect($r,$feedurl); 800: } 801: } else { 802: 803: # Get previous user input 804: my $prevattempts=&Apache::loncommon::get_previous_attempt( 805: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 806: $ENV{'request.course.id'}); 807: 808: # Get output from resource 809: my $usersaw=&resource_output($feedurl); 810: 811: # Get resource answer (need to allow student to view grades for this to work) 812: &Apache::lonnet::appenv(('allowed.vgr'=>'F')); 813: my $useranswer=&Apache::loncommon::get_student_answers( 814: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 815: $ENV{'request.course.id'}); 816: &Apache::lonnet::delenv('allowed.vgr'); 817: # Get attachments, if any, and not too large 818: my $attachmenturl=''; 819: if ($ENV{'form.attachment.filename'}) { 820: unless (length($ENV{'form.attachment'})>131072) { 821: $attachmenturl=&Apache::lonnet::userfileupload('attachment'); 822: } 823: } 824: # Filter HTML out of message (could be nasty) 825: my $message=&clear_out_html($ENV{'form.comment'}); 826: 827: # Assemble email 828: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, 829: $usersaw,$useranswer); 830: 831: # Who gets this? 832: my ($typestyle,%to) = &decide_receiver($feedurl); 833: 834: # Actually send mail 835: my ($status,$numsent)=&send_msg($feedurl,$email,$citations, 836: $attachmenturl,%to); 837: 838: # Discussion? Store that. 839: 840: my $numpost=0; 841: if ($ENV{'form.discuss'}) { 842: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl); 843: $numpost++; 844: } 845: 846: if ($ENV{'form.anondiscuss'}) { 847: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl); 848: $numpost++; 849: } 850: 851: 852: # Receipt screen and redirect back to where came from 853: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status); 854: 855: } 856: } else { 857: # Unable to give feedback 858: &no_redirect_back($r,$feedurl); 859: } 860: } else { 861: # Ambiguous Problem Resource 862: if ( &Apache::lonnet::mod_perl_version() == 2 ) { 863: &Apache::lonnet::cleanenv(); 864: } 865: $r->internal_redirect('/adm/ambiguous'); 866: } 867: } 868: return OK; 869: } 870: 871: 1; 872: __END__