loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.79: download - view: text, annotated - select for diffs
Wed Apr 28 23:59:53 2004 UTC (20 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

nohist db file now used.  Also fix bug 2962. Time now recorded for last visit to discussion. "NEW" tag displayed alongside more recent posts.

1: # The LearningOnline Network 2: # Feedback 3: # 4: # $Id: lonfeedback.pm,v 1.79 2004/04/28 23:59:53 raeburn 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: 59: my %dischash = &Apache::lonnet::restore($symb,'nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'}); 60: my %readids = (); 61: my $showonlyunread; 62: my $prevread = 0; 63: 64: foreach my $key (keys %dischash) { 65: if ($key eq 'lastread') { 66: $prevread = $dischash{$key}; 67: } 68: if ($key eq 'showonlyunread') { 69: $showonlyunread = $dischash{$key}; 70: } else { 71: if ($dischash{$key} eq 'read') { 72: $readids{$key} = 1; 73: } 74: } 75: } 76: 77: my $seeid=&Apache::lonnet::allowed('rin',$crs); 78: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) 79: && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/)); 80: my @discussionitems=(); 81: # backward compatibility (bulletin boards used to be 'wrapped') 82: my $ressymb=$symb; 83: if ($mode eq 'board') { 84: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; 85: } 86: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, 87: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 88: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 89: my $visible=0; 90: my @depth=(); 91: my @original=(); 92: my @index=(); 93: my @replies=(); 94: my %alldiscussion=(); 95: my $maxdepth=0; 96: 97: my $target=''; 98: unless ($ENV{'browser.interface'} eq 'textual' || 99: $ENV{'environment.remote'} eq 'off' ) { 100: $target='target="LONcom"'; 101: } 102: 103: my $now = time; 104: my %discinfo = ( 105: 'lastread' => $now, 106: ); 107: &Apache::lonnet::cstore(\%discinfo,$symb,'nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'}); 108: 109: if ($contrib{'version'}) { 110: for (my $id=1;$id<=$contrib{'version'};$id++) { 111: my $idx=$id; 112: my $hidden=($contrib{'hidden'}=~/\.$idx\./); 113: my $deleted=($contrib{'deleted'}=~/\.$idx\./); 114: my $origindex='0.'; 115: if (($contrib{$idx.':replyto'}) && ($ENV{'environment.threadeddiscussion'})) { 116: # this is a follow-up message 117: $original[$idx]=$original[$contrib{$idx.':replyto'}]; 118: $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1; 119: $origindex=$index[$contrib{$idx.':replyto'}]; 120: if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; } 121: } else { 122: # this is an original message 123: $original[$idx]=0; 124: $depth[$idx]=0; 125: } 126: if ($replies[$depth[$idx]]) { 127: $replies[$depth[$idx]]++; 128: } else { 129: $replies[$depth[$idx]]=1; 130: } 131: unless ((($hidden) && (!$seeid)) || ($deleted)) { 132: $visible++; 133: my $message=$contrib{$idx.':message'}; 134: $message=~s/\n/\<br \/\>/g; 135: $message=&Apache::lontexconvert::msgtexconverted($message); 136: my $subject=$contrib{$idx.':subject'}; 137: if (defined($subject)) { 138: $subject=~s/\n/\<br \/\>/g; 139: $subject=&Apache::lontexconvert::msgtexconverted($subject); 140: } 141: if ($contrib{$idx.':attachmenturl'}) { 142: my ($fname,$ft) 143: =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/); 144: $message.='<p>'.&mt('Attachment').': <a href="'. 145: &Apache::lonnet::tokenwrapper( 146: $contrib{$idx.':attachmenturl'}). 147: '"><tt>'.$fname.'.'.$ft.'</tt></a></p>'; 148: } 149: if ($message) { 150: if ($hidden) { 151: $message='<font color="#888888">'.$message.'</font>'; 152: } 153: my $screenname=&Apache::loncommon::screenname( 154: $contrib{$idx.':sendername'}, 155: $contrib{$idx.':senderdomain'}); 156: my $plainname=&Apache::loncommon::nickname( 157: $contrib{$idx.':sendername'}, 158: $contrib{$idx.':senderdomain'}); 159: 160: my $sender=&mt('Anonymous'); 161: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { 162: $sender=&Apache::loncommon::aboutmewrapper( 163: $plainname, 164: $contrib{$idx.':sendername'}, 165: $contrib{$idx.':senderdomain'}).' ('. 166: $contrib{$idx.':sendername'}.' at '. 167: $contrib{$idx.':senderdomain'}.')'; 168: if ($contrib{$idx.':anonymous'}) { 169: $sender.=' ['.&mt('anonymous').'] '. 170: $screenname; 171: } 172: if ($seeid) { 173: if ($hidden) { 174: $sender.=' <a href="/adm/feedback?unhide='. 175: $ressymb.':::'.$idx.'">'.&mt('Make Visible').'</a>'; 176: } else { 177: $sender.=' <a href="/adm/feedback?hide='. 178: $ressymb.':::'.$idx.'">'.&mt('Hide').'</a>'; 179: } 180: $sender.=' <a href="/adm/feedback?deldisc='. 181: $ressymb.':::'.$idx.'">'.&mt('Delete').'</a>'; 182: } 183: } else { 184: if ($screenname) { 185: $sender='<i>'.$screenname.'</i>'; 186: } 187: } 188: if (&Apache::lonnet::allowed('pch', 189: $ENV{'request.course.id'}. 190: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 191: $sender.=' <a href="/adm/feedback?replydisc='. 192: $ressymb.':::'.$idx.'" '.$target.'>'.&mt('Reply').'</a>'; 193: } 194: my $vgrlink; 195: my $ctlink; 196: if ($readids{$idx} == 1) { 197: $ctlink = '<b>'.&mt('Mark unread').'?</b> '. 198: '<input type="checkbox" name="'. 199: 'postunread_'.$idx.'" />'; 200: } else { 201: $ctlink = '<b>'.&mt('Mark read').'?</b> '. 202: '<input type="checkbox" name="'. 203: 'postread_'.$idx.'" />'; 204: } 205: if ($viewgrades) { 206: $vgrlink=&Apache::loncommon::submlink('Submissions', 207: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb); 208: } 209: #figure out at what position this needs to print 210: my $thisindex=$idx; 211: if ($ENV{'environment.threadeddiscussion'}) { 212: $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2); 213: } 214: $alldiscussion{$thisindex}=$idx; 215: $index[$idx]=$thisindex; 216: my $posttime = $contrib{$idx.':timestamp'}; 217: my $spansize = 2; 218: $discussionitems[$idx]='<p><table border="0" width="100%"><tr>'; 219: if ($prevread > 0 && $prevread < $posttime) { 220: $discussionitems[$idx] .= '<td align="left" bgcolor="#FFFFFF"><font color="#FF0000">NEW</font></td>'; 221: $spansize ++; 222: } 223: $discussionitems[$idx] .= '<td align ="left">  '. 224: '<b>'.$subject.'</b>  '. 225: $sender.'</b> '.$vgrlink.' ('. 226: localtime($posttime).')'. 227: '</td><td align="right">  '. 228: $ctlink.'</td></tr>'; 229: if ($showonlyunread && $readids{$idx}) { 230: $discussionitems[$idx] .= '<tr><td colspan="'.$spansize.'" align="right"><i><font size="-1">Check "Show all posts?" or "Mark unread?", then "Save read settings" to display message</font></i></td></tr></table>'; 231: } else { 232: $discussionitems[$idx] .= '</table><blockquote>'.$message.'</blockquote></p>'; 233: } 234: } 235: } 236: } 237: } 238: my $discussion=''; 239: if ($visible) { 240: # Print a the discusssion 241: $discussion .= '<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$symb.'">'; 242: $discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">'; 243: if ($visible>2) { 244: my $colspan=$maxdepth+1; 245: my $showoption = '<tr><td align="right" bgcolor="#FFFFFF" colspan="'.$colspan.'">'; 246: my $showflag = 'all'; 247: if ($showonlyunread) { 248: $showoption .= '<b>Show all posts?</b><input type="checkbox" 249: name="allposts" value="1"></td></tr>'; 250: } else { 251: $showoption .= '<b>Show only unread posts?</b><input type="checkbox" name="onlyunread" value="1"></td></tr>'; 252: } 253: $discussion.=$showoption; 254: $discussion.='<tr><td bgcolor="DDDDBB" colspan="'.$colspan.'">'. 255: '<table border="0" width="100%" bgcolor="#DDDDBB"><tr><td align="left">'. 256: '<a href="/adm/feedback?threadedon='.$symb.'">'.&mt('Threaded View').'</a>  '. 257: '<a href="/adm/feedback?threadedoff='.$symb.'">'.&mt('Chronological View').'</a>  </td>'. 258: '<td align="right"><a href="/adm/feedback?markread='.$symb.'">'.&mt('Mark all read').'</a>  '. 259: '<a href="/adm/feedback?markunread='.$symb.'">'.&mt('Mark all unread').'</a>  '. 260: '</td></tr></table></td></tr>'; 261: } 262: 263: foreach (sort { $a <=> $b } keys %alldiscussion) { 264: $discussion.="\n<tr>"; 265: my $thisdepth=$depth[$alldiscussion{$_}]; 266: for (1..$thisdepth) { 267: $discussion.='<td>   </td>'; 268: } 269: my $colspan=$maxdepth-$thisdepth+1; 270: $discussion.='<td bgcolor="#CCCCCC" colspan="'.$colspan.'">'. 271: $discussionitems[$alldiscussion{$_}]. 272: '</td></tr>'; 273: } 274: my $colspan=$maxdepth+1; 275: $discussion.='<tr><td bgcolor="#FFFFFF" align="right" colspan="'. 276: $colspan.'"><br /><input type="hidden" name="storereads" value="0">'. '<input type="hidden" name="discsymb" value="'.$symb.'">'. 277: '<input type="button" name="readoptions" '. 278: 'value="Save read settings" onClick="this.form.storereads.value=1;this.form.submit();"></td></tr>'; 279: $discussion .= '</table><br /><br /></form>'; 280: } 281: if ($discussiononly) { 282: $discussion.=(<<ENDDISCUSS); 283: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> 284: <input type="submit" name="discuss" value="Post Discussion" /> 285: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" /> 286: <input type="hidden" name="symb" value="$ressymb" /> 287: <input type="hidden" name="sendit" value="true" /> 288: <br /> 289: <font size="1">Note: in anonymous discussion, your name is visible only to 290: course faculty</font><br /> 291: <b>Title:</b> <input type="text" name="subject" value="" size="30" /><br /><br /> 292: <textarea name="comment" cols="60" rows="10" wrap="hard"></textarea> 293: <p> 294: Attachment (128 KB max size): <input type="file" name="attachment" /> 295: </p> 296: </form> 297: ENDDISCUSS 298: $discussion.=&generate_preview_button(); 299: } else { 300: if (&Apache::lonnet::allowed('pch', 301: $ENV{'request.course.id'}. 302: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 303: $discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='. 304: $symb.':::" '.$target.'>'. 305: '<img src="/adm/lonMisc/chat.gif" border="0" />'. 306: &mt('Post Discussion').'</a></td></tr></table>'; 307: } 308: } 309: return $discussion; 310: } 311: 312: sub mail_screen { 313: my ($r,$feedurl,$options) = @_; 314: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', 315: '','onLoad="window.focus();"'); 316: my $title=&Apache::lonnet::gettitle($feedurl); 317: if (!$title) { $title = $feedurl; } 318: my $quote=''; 319: my $subject = ''; 320: if ($ENV{'form.replydisc'}) { 321: my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'}); 322: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 323: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 324: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 325: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) { 326: my $message=$contrib{$idx.':message'}; 327: $message=~s/\n/\<br \/\>/g; 328: $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>'; 329: if ($idx > 0) { 330: $subject = 'Re: '.$contrib{$idx.':subject'}; 331: } 332: } 333: } 334: my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); 335: my $send=&mt('Send'); 336: $r->print(<<ENDDOCUMENT); 337: <html> 338: <head> 339: <title>The LearningOnline Network with CAPA</title> 340: <meta http-equiv="pragma" content="no-cache"></meta> 341: <script type="text/javascript"> 342: // 383: </script> 384: </head> 385: $bodytag 386: <h2><tt>$title</tt></h2> 387: <form action="/adm/feedback" method="post" name="mailform" 388: enctype="multipart/form-data"> 389: <input type="hidden" name="postdata" value="$feedurl" /> 390: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" /> 391: Please check at least one of the following feedback types: 392: $options<hr /> 393: $quote 394: <p>My question/comment/feedback:</p> 395: <p> 396: $latexHelp 397: Title: <input type="text" name="subject" size="30" value="$subject" /></p> 398: <p> 399: <textarea name="comment" cols="60" rows="10" wrap="hard"> 400: </textarea></p> 401: <p> 402: Attachment (128 KB max size): <input type="file" name="attachment" /> 403: </p> 404: <p> 405: <input type="hidden" name="sendit" value="1" /> 406: <input type="button" value="$send" onClick='gosubmit();' /> 407: </p> 408: </form> 409: ENDDOCUMENT 410: $r->print(&generate_preview_button().'</body></html>'); 411: } 412: 413: sub fail_redirect { 414: my ($r,$feedurl) = @_; 415: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 416: $r->print (<<ENDFAILREDIR); 417: <html> 418: <head><title>Feedback not sent</title> 419: <meta http-equiv="pragma" content="no-cache" /> 420: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" /> 421: </head> 422: <body bgcolor="#FFFFFF"> 423: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 424: <b>Sorry, no recipients ...</b> 425: </body> 426: </html> 427: ENDFAILREDIR 428: } 429: 430: sub redirect_back { 431: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_; 432: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 433: $r->print (<<ENDREDIR); 434: <html> 435: <head> 436: <title>Feedback sent</title> 437: <meta http-equiv="pragma" content="no-cache" /> 438: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 439: </head> 440: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'> 441: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 442: $typestyle 443: <b>Sent $sendsomething message(s), and $sendposts post(s).</b> 444: <font color="red">$status</font> 445: <form name="reldt" action="$feedurl" target="loncapaclient"> 446: </form> 447: </body> 448: </html> 449: ENDREDIR 450: } 451: 452: sub no_redirect_back { 453: my ($r,$feedurl) = @_; 454: $r->print (<<ENDNOREDIR); 455: <html> 456: <head><title>Feedback not sent</title> 457: <meta http-equiv="pragma" content="no-cache" /> 458: ENDNOREDIR 459: 460: if ($feedurl!~/^\/adm\/feedback/) { 461: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">'); 462: } 463: 464: $r->print (<<ENDNOREDIRTWO); 465: </head> 466: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'> 467: <img align="right" src="/adm/lonIcons/lonlogos.gif" /> 468: <b>Sorry, no feedback possible on this resource ...</b> 469: </body> 470: </html> 471: ENDNOREDIRTWO 472: } 473: 474: sub screen_header { 475: my ($feedurl) = @_; 476: my $msgoptions=''; 477: my $discussoptions=''; 478: unless ($ENV{'form.replydisc'}) { 479: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { 480: $msgoptions= 481: '<p><input type="checkbox" name="author" /> '. 482: &mt('Feedback to resource author').'</p>'; 483: } 484: if (&feedback_available(1)) { 485: $msgoptions.= 486: '<br /><input type="checkbox" name="question" /> '. 487: &mt('Question about resource content'); 488: } 489: if (&feedback_available(0,1)) { 490: $msgoptions.= 491: '<br /><input type="checkbox" name="course" /> '. 492: &mt('Question/Comment/Feedback about course content'); 493: } 494: if (&feedback_available(0,0,1)) { 495: $msgoptions.= 496: '<br /><input type="checkbox" name="policy" /> '. 497: &mt('Question/Comment/Feedback about course policy'); 498: } 499: } 500: if ($ENV{'request.course.id'}) { 501: if (&Apache::lonnet::allowed('pch', 502: $ENV{'request.course.id'}. 503: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 504: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '. 505: ($ENV{'form.replydisc'}?' checked="1"':'').' /> '. 506: &mt('Contribution to course discussion of resource'); 507: $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '. 508: &mt('Anonymous contribution to course discussion of resource'). 509: ' <i>('.&mt('name only visible to course faculty').')</i>'; 510: } 511: } 512: if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; } 513: if ($discussoptions) { 514: $discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; } 515: return $msgoptions.$discussoptions; 516: } 517: 518: sub resource_output { 519: my ($feedurl) = @_; 520: my $usersaw=&Apache::lonnet::ssi_body($feedurl); 521: $usersaw=~s/\<body[^\>]*\>//gi; 522: $usersaw=~s/\<\/body\>//gi; 523: $usersaw=~s/\<html\>//gi; 524: $usersaw=~s/\<\/html\>//gi; 525: $usersaw=~s/\<head\>//gi; 526: $usersaw=~s/\<\/head\>//gi; 527: $usersaw=~s/action\s*\=/would_be_action\=/gi; 528: return $usersaw; 529: } 530: 531: sub clear_out_html { 532: my ($message,$override)=@_; 533: my $cid=$ENV{'request.course.id'}; 534: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || 535: ($override)) { 536: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 537: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> 538: my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, 539: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1, 540: M=>1); 541: 542: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ 543: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; 544: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ 545: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; 546: } else { 547: $message=~s/\</\&lt\;/g; 548: $message=~s/\>/\&gt\;/g; 549: } 550: return $message; 551: } 552: 553: sub assemble_email { 554: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; 555: my $email=<<"ENDEMAIL"; 556: Refers to <a href="$feedurl">$feedurl</a> 557: 558: $message 559: ENDEMAIL 560: my $citations=<<"ENDCITE"; 561: <h2>Previous attempts of student (if applicable)</h2> 562: $prevattempts 563: <br /><hr /> 564: <h2>Original screen output (if applicable)</h2> 565: $usersaw 566: <h2>Correct Answer(s) (if applicable)</h2> 567: $useranswer 568: ENDCITE 569: return ($email,$citations); 570: } 571: 572: sub secapply { 573: my $rec=shift; 574: my $defaultflag=shift; 575: $rec=~s/\s+//g; 576: $rec=~s/\@/\:/g; 577: my ($adr,$sections)=($rec=~/^([^$]+)\(([^$]+)\)/); 578: if ($sections) { 579: foreach (split(/\;/,$sections)) { 580: if (($_ eq $ENV{'request.course.sec'}) || 581: ($defaultflag && ($_ eq '*'))) { 582: return $adr; 583: } 584: } 585: } else { 586: return $rec; 587: } 588: return ''; 589: } 590: 591: sub decide_receiver { 592: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; 593: my $typestyle=''; 594: my %to=(); 595: if ($ENV{'form.author'}||$author) { 596: $typestyle.='Submitting as Author Feedback<br>'; 597: $feedurl=~/^\/res\/(\w+)\/(\w+)\//; 598: $to{$2.':'.$1}=1; 599: } 600: if ($ENV{'form.question'}||$question) { 601: $typestyle.='Submitting as Question<br>'; 602: foreach (split(/\,/, 603: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) 604: ) { 605: my $rec=&secapply($_,$defaultflag); 606: if ($rec) { $to{$rec}=1; } 607: } 608: } 609: if ($ENV{'form.course'}||$course) { 610: $typestyle.='Submitting as Comment<br />'; 611: foreach (split(/\,/, 612: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) 613: ) { 614: my $rec=&secapply($_,$defaultflag); 615: if ($rec) { $to{$rec}=1; } 616: } 617: } 618: if ($ENV{'form.policy'}||$policy) { 619: $typestyle.='Submitting as Policy Feedback<br />'; 620: foreach (split(/\,/, 621: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) 622: ) { 623: my $rec=&secapply($_,$defaultflag); 624: if ($rec) { $to{$rec}=1; } 625: } 626: } 627: if ((scalar(%to) eq '0') && (!$defaultflag)) { 628: ($typestyle,%to)= 629: &decide_receiver($feedurl,$author,$question,$course,$policy,1); 630: } 631: return ($typestyle,%to); 632: } 633: 634: sub feedback_available { 635: my ($question,$course,$policy)=@_; 636: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy); 637: return scalar(%to); 638: } 639: 640: sub send_msg { 641: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_; 642: my $status=''; 643: my $sendsomething=0; 644: foreach (keys %to) { 645: if ($_) { 646: my $declutter=&Apache::lonnet::declutter($feedurl); 647: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), 648: 'Feedback ['.$declutter.']',$email,$citations,$feedurl, 649: $attachmenturl)=~/ok/) { 650: $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />'; 651: } else { 652: $sendsomething++; 653: } 654: } 655: } 656: 657: my %record=&Apache::lonnet::restore('_feedback'); 658: my ($temp)=keys %record; 659: unless ($temp=~/^error\:/) { 660: my %newrecord=(); 661: $newrecord{'resource'}=$feedurl; 662: $newrecord{'subnumber'}=$record{'subnumber'}+1; 663: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { 664: $status.='<br />'.&mt('Not registered').'<br />'; 665: } 666: } 667: 668: return ($status,$sendsomething); 669: } 670: 671: sub adddiscuss { 672: my ($symb,$email,$anon,$attachmenturl,$subject)=@_; 673: my $status=''; 674: if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. 675: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 676: 677: my %contrib=('message' => $email, 678: 'sendername' => $ENV{'user.name'}, 679: 'senderdomain' => $ENV{'user.domain'}, 680: 'screenname' => $ENV{'environment.screenname'}, 681: 'plainname' => $ENV{'environment.firstname'}.' '. 682: $ENV{'environment.middlename'}.' '. 683: $ENV{'environment.lastname'}.' '. 684: $ENV{'enrironment.generation'}, 685: 'attachmenturl'=> $attachmenturl, 686: 'subject' => $subject); 687: if ($ENV{'form.replydisc'}) { 688: $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1]; 689: } 690: if ($anon) { 691: $contrib{'anonymous'}='true'; 692: } 693: if (($symb) && ($email)) { 694: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. 695: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'}, 696: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 697: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 698: my %storenewentry=($symb => time); 699: $status.='<br />'.&mt('Updating discussion time').': '. 700: &Apache::lonnet::put('discussiontimes',\%storenewentry, 701: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 702: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 703: } 704: my %record=&Apache::lonnet::restore('_discussion'); 705: my ($temp)=keys %record; 706: unless ($temp=~/^error\:/) { 707: my %newrecord=(); 708: $newrecord{'resource'}=$symb; 709: $newrecord{'subnumber'}=$record{'subnumber'}+1; 710: $status.='<br />'.&mt('Registering').': '. 711: &Apache::lonnet::cstore(\%newrecord,'_discussion'); 712: } 713: } else { 714: $status.='Failed.'; 715: } 716: return $status.'<br />'; 717: } 718: 719: # ----------------------------------------------------------- Preview function 720: 721: sub show_preview { 722: my $r=shift; 723: my $message=&clear_out_html($ENV{'form.comment'}); 724: $message=~s/\n/\<br \/\>/g; 725: $message=&Apache::lontexconvert::msgtexconverted($message); 726: my $subject=&clear_out_html($ENV{'form.subject'}); 727: $subject=~s/\n/\<br \/\>/g; 728: $subject=&Apache::lontexconvert::msgtexconverted($subject); 729: $r->print('<table border="2"><tr><td>'. 730: '<b>Subject:</b> '.$subject.'<br /><br />'. 731: $message.'</td></tr></table>'); 732: } 733: 734: sub generate_preview_button { 735: my $pre=&mt("Show Preview"); 736: return(<<ENDPREVIEW); 737: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> 738: <input type="hidden" name="subject"> 739: <input type="hidden" name="comment" /> 740: <input type="button" value="$pre" 741: onClick="this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" /> 742: </form> 743: ENDPREVIEW 744: } 745: 746: sub handler { 747: my $r = shift; 748: if ($r->header_only) { 749: &Apache::loncommon::content_type($r,'text/html'); 750: $r->send_http_header; 751: return OK; 752: } 753: 754: # --------------------------- Get query string for limited number of parameters 755: 756: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 757: # ['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff']); 758: ['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff','markread','markunread','storereads','onlyunread','allposts','chgreads']); 759: 760: if (($ENV{'form.markread'}) || ($ENV{'form.markunread'})) { 761: # ----------------------------------------------------------------- Modify read/unread for all 762: &Apache::loncommon::content_type($r,'text/html'); 763: $r->send_http_header; 764: my $symb=$ENV{'form.markread'}?$ENV{'form.markread'}:$ENV{'form.markunread'}; 765: my $ressymb = $symb; 766: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 767: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; 768: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'}, 769: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 770: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 771: my %readinghash = (); 772: 773: if ($contrib{'version'}) { 774: for (my $id=1;$id<=$contrib{'version'};$id++) { 775: my $msgid = $id.':message'; 776: if (defined($contrib{$msgid})) { 777: if ($ENV{'form.markread'}) { 778: $readinghash{$id} = 'read'; 779: } else { 780: $readinghash{$id} = 'unread'; 781: } 782: } 783: } 784: if ($ENV{'form.allposts'}) { 785: $readinghash{'showonlyunread'} = 0; 786: } elsif ($ENV{'form.onlyunread'}) { 787: $readinghash{'showonlyunread'} = 1; 788: } 789: &Apache::lonnet::cstore(\%readinghash,$symb,'nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'}); 790: } 791: 792: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status'),'0','0'); 793: return OK; 794: } else { 795: my $symb = $ENV{'form.discsymb'}; 796: my %readinghash = (); 797: my $chgcount = 0; 798: foreach my $key (keys %ENV) { 799: if ($key =~ m/^form\.postunread_(\d+)/) { 800: $readinghash{$1} = 'unread'; 801: $chgcount ++; 802: } elsif ($key =~ m/^form\.postread_(\d+)/) { 803: $readinghash{$1} = 'read'; 804: $chgcount ++; 805: } 806: } 807: if ($ENV{'form.allposts'}) { 808: $readinghash{'showonlyunread'} = 0; 809: $chgcount ++; 810: } elsif ($ENV{'form.onlyunread'}) { 811: $readinghash{'showonlyunread'} = 1; 812: $chgcount ++; 813: } 814: 815: if ($chgcount > 0) { 816: &Apache::lonnet::cstore(\%readinghash,$symb,'nohist_'.$ENV{'request.course.id'}.'_discuss',$ENV{'user.domain'},$ENV{'user.name'}); 817: } 818: } 819: 820: if ($ENV{'form.chgreads'}) { 821: &Apache::loncommon::content_type($r,'text/html'); 822: $r->send_http_header; 823: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ENV{'form.chgreads'}); 824: &redirect_back($r,&Apache::lonnet::clutter($url), 825: &mt('Changed read status').'<br />','0','0'); 826: } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { 827: # ----------------------------------------------------------------- Hide/unhide 828: &Apache::loncommon::content_type($r,'text/html'); 829: $r->send_http_header; 830: 831: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; 832: 833: my ($symb,$idx)=split(/\:\:\:/,$entry); 834: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 835: 836: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 837: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 838: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 839: 840: 841: my $currenthidden=$contrib{'hidden'}; 842: 843: if ($ENV{'form.hide'}) { 844: $currenthidden.='.'.$idx.'.'; 845: } else { 846: $currenthidden=~s/\.$idx\.//g; 847: } 848: my %newhash=('hidden' => $currenthidden); 849: 850: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 851: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 852: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 853: 854: &redirect_back($r,&Apache::lonnet::clutter($url), 855: &mt('Changed discussion status').'<br />','0','0'); 856: } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) { 857: &Apache::loncommon::content_type($r,'text/html'); 858: $r->send_http_header; 859: if ($ENV{'form.threadedon'}) { 860: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); 861: &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on'); 862: } else { 863: &Apache::lonnet::del('environment',['threadeddiscussion']); 864: &Apache::lonnet::delenv('environment\.threadeddiscussion'); 865: } 866: my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'}; 867: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 868: &redirect_back($r,&Apache::lonnet::clutter($url), 869: &mt('Changed discussion view mode').'<br />','0','0'); 870: } elsif ($ENV{'form.deldisc'}) { 871: # --------------------------------------------------------------- Hide for good 872: &Apache::loncommon::content_type($r,'text/html'); 873: $r->send_http_header; 874: 875: my $entry=$ENV{'form.deldisc'}; 876: 877: my ($symb,$idx)=split(/\:\:\:/,$entry); 878: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 879: 880: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 881: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 882: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 883: 884: 885: my $currentdeleted=$contrib{'deleted'}; 886: 887: $currentdeleted.='.'.$idx.'.'; 888: 889: my %newhash=('deleted' => $currentdeleted); 890: 891: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 892: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 893: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 894: 895: &redirect_back($r,&Apache::lonnet::clutter($url), 896: &mt('Changed discussion status').'<br />','0','0'); 897: } elsif ($ENV{'form.preview'}) { 898: # -------------------------------------------------------- User wants a preview 899: $r->content_type('text/html'); 900: $r->send_http_header; 901: &show_preview($r); 902: } else { 903: # ------------------------------------------------------------- Normal feedback 904: my $feedurl=$ENV{'form.postdata'}; 905: $feedurl=~s/^http\:\/\///; 906: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 907: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 908: $feedurl=~s/\?.+$//; 909: 910: my $symb; 911: if ($ENV{'form.replydisc'}) { 912: $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0]; 913: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 914: $feedurl=&Apache::lonnet::clutter($url); 915: } else { 916: $symb=&Apache::lonnet::symbread($feedurl); 917: } 918: unless ($symb) { 919: $symb=$ENV{'form.symb'}; 920: if ($symb) { 921: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 922: $feedurl=&Apache::lonnet::clutter($url); 923: } 924: } 925: my $goahead=1; 926: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { 927: unless ($symb) { $goahead=0; } 928: } 929: # backward compatibility (bulltin boards used to be 'wrapped') 930: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { 931: $feedurl=~s|^/adm/wrapper||; 932: } 933: if ($goahead) { 934: # Go ahead with feedback, no ambiguous reference 935: &Apache::loncommon::content_type($r,'text/html'); 936: $r->send_http_header; 937: 938: if ( 939: ( 940: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) 941: ) 942: || 943: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) 944: || 945: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) 946: ) { 947: # --------------------------------------------------- Print login screen header 948: unless ($ENV{'form.sendit'}) { 949: my $options=&screen_header($feedurl); 950: if ($options) { 951: &mail_screen($r,$feedurl,$options); 952: } else { 953: &fail_redirect($r,$feedurl); 954: } 955: } else { 956: 957: # Get previous user input 958: my $prevattempts=&Apache::loncommon::get_previous_attempt( 959: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 960: $ENV{'request.course.id'}); 961: 962: # Get output from resource 963: my $usersaw=&resource_output($feedurl); 964: 965: # Get resource answer (need to allow student to view grades for this to work) 966: &Apache::lonnet::appenv(('allowed.vgr'=>'F')); 967: my $useranswer=&Apache::loncommon::get_student_answers( 968: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 969: $ENV{'request.course.id'}); 970: &Apache::lonnet::delenv('allowed.vgr'); 971: # Get attachments, if any, and not too large 972: my $attachmenturl=''; 973: if ($ENV{'form.attachment.filename'}) { 974: unless (length($ENV{'form.attachment'})>131072) { 975: $attachmenturl=&Apache::lonnet::userfileupload('attachment'); 976: } 977: } 978: # Filter HTML out of message (could be nasty) 979: my $message=&clear_out_html($ENV{'form.comment'}); 980: 981: # Assemble email 982: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, 983: $usersaw,$useranswer); 984: 985: # Who gets this? 986: my ($typestyle,%to) = &decide_receiver($feedurl); 987: 988: # Actually send mail 989: my ($status,$numsent)=&send_msg($feedurl,$email,$citations, 990: $attachmenturl,%to); 991: 992: # Discussion? Store that. 993: 994: my $numpost=0; 995: if ($ENV{'form.discuss'}) { 996: my $subject = &clear_out_html($ENV{'form.subject'}); 997: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject); 998: $numpost++; 999: } 1000: 1001: if ($ENV{'form.anondiscuss'}) { 1002: my $subject = &clear_out_html($ENV{'form.subject'}); 1003: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject); 1004: $numpost++; 1005: } 1006: 1007: 1008: # Receipt screen and redirect back to where came from 1009: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status); 1010: 1011: } 1012: } else { 1013: # Unable to give feedback 1014: &no_redirect_back($r,$feedurl); 1015: } 1016: } else { 1017: # Ambiguous Problem Resource 1018: if ( &Apache::lonnet::mod_perl_version() == 2 ) { 1019: &Apache::lonnet::cleanenv(); 1020: } 1021: $r->internal_redirect('/adm/ambiguous'); 1022: } 1023: } 1024: return OK; 1025: } 1026: 1027: 1; 1028: __END__