loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.56: download - view: text, annotated - select for diffs
Mon Sep 15 18:43:54 2003 UTC (20 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD

Bug #2190: call to &Apache::exists_config_define is not defined before child
completed another request.

At least things don't crash anymore - found no way of getting around error
messages, neither with eval nor with defined.

1: # The LearningOnline Network 2: # Feedback 3: # 4: # $Id: lonfeedback.pm,v 1.56 2003/09/15 18:43:54 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: # (Internal Server Error Handler 29: # 30: # (Login Screen 31: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, 32: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) 33: # 34: # 3/1/1 Gerd Kortemeyer) 35: # 36: # 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer 37: # 2/9 Guy Albertelli 38: # 2/10 Gerd Kortemeyer 39: # 2/13 Guy Albertelli 40: # 7/25 Gerd Kortemeyer 41: # 7/26 Guy Albertelli 42: # 7/26,8/10,10/1,11/5,11/6,12/27,12/29 Gerd Kortemeyer 43: # YEAR=2002 44: # 1/1,1/16 Gerd Kortemeyer 45: # 46: 47: package Apache::lonfeedback; 48: 49: use strict; 50: use Apache::Constants qw(:common); 51: use Apache::lonmsg(); 52: use Apache::loncommon(); 53: use Apache::lontexconvert(); 54: 55: sub list_discussion { 56: my ($discussiononly,$symb)=@_; 57: unless ($ENV{'request.course.id'}) { return ''; } 58: my $crs='/'.$ENV{'request.course.id'}; 59: if ($ENV{'request.course.sec'}) { 60: $crs.='_'.$ENV{'request.course.sec'}; 61: } 62: $crs=~s/\_/\//g; 63: unless ($symb) { 64: $symb=&Apache::lonnet::symbread(); 65: } 66: unless ($symb) { return ''; } 67: my $seeid=&Apache::lonnet::allowed('rin',$crs); 68: my $viewgrades=&Apache::lonnet::allowed('vgr',$crs); 69: my $discussion=''; 70: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 71: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 72: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 73: if ($contrib{'version'}) { 74: unless ($discussiononly) { 75: $discussion.= 76: '<address><hr />'; 77: } 78: my $idx; 79: for ($idx=1;$idx<=$contrib{'version'};$idx++) { 80: my $hidden=($contrib{'hidden'}=~/\.$idx\./); 81: my $deleted=($contrib{'deleted'}=~/\.$idx\./); 82: unless ((($hidden) && (!$seeid)) || ($deleted)) { 83: my $message=$contrib{$idx.':message'}; 84: $message=~s/\n/\<br \/\>/g; 85: $message=&Apache::lontexconvert::msgtexconverted($message); 86: if ($contrib{$idx.':attachmenturl'}) { 87: my ($fname,$ft) 88: =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/); 89: $message.='<p>Attachment: <a href="'. 90: &Apache::lonnet::tokenwrapper( 91: $contrib{$idx.':attachmenturl'}). 92: '"><tt>'.$fname.'.'.$ft.'</tt></a>'; 93: } 94: if ($message) { 95: if ($hidden) { 96: $message='<font color="#888888">'.$message.'</font>'; 97: } 98: my $screenname=&Apache::loncommon::screenname( 99: $contrib{$idx.':sendername'}, 100: $contrib{$idx.':senderdomain'}); 101: my $plainname=&Apache::loncommon::nickname( 102: $contrib{$idx.':sendername'}, 103: $contrib{$idx.':senderdomain'}); 104: 105: my $sender='Anonymous'; 106: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) { 107: $sender=&Apache::loncommon::aboutmewrapper( 108: $plainname, 109: $contrib{$idx.':sendername'}, 110: $contrib{$idx.':senderdomain'}).' ('. 111: $contrib{$idx.':sendername'}.' at '. 112: $contrib{$idx.':senderdomain'}.')'; 113: if ($contrib{$idx.':anonymous'}) { 114: $sender.=' [anonymous] '. 115: $screenname; 116: } 117: if ($seeid) { 118: if ($hidden) { 119: $sender.=' <a href="/adm/feedback?unhide='. 120: $symb.':::'.$idx.'">Make Visible</a>'; 121: } else { 122: $sender.=' <a href="/adm/feedback?hide='. 123: $symb.':::'.$idx.'">Hide</a>'; 124: } 125: $sender.=' <a href="/adm/feedback?deldisc='. 126: $symb.':::'.$idx.'">Delete</a>'; 127: } 128: } else { 129: if ($screenname) { 130: $sender='<i>'.$screenname.'</i>'; 131: } 132: } 133: my $vgrlink; 134: if ($viewgrades) { 135: $vgrlink=&Apache::loncommon::submlink('Submissions', 136: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb); 137: } 138: $discussion.='<p><b>'.$sender.'</b> '.$vgrlink.' ('. 139: localtime($contrib{$idx.':timestamp'}). 140: '):<blockquote>'.$message. 141: '</blockquote></p>'; 142: } 143: } 144: } 145: unless ($discussiononly) { 146: $discussion.='</address>'; 147: } 148: } 149: if ($discussiononly) { 150: $discussion.=(<<ENDDISCUSS); 151: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> 152: <input type="submit" name="discuss" value="Post Discussion" /> 153: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" /> 154: <input type="hidden" name="symb" value="$symb" /> 155: <input type="hidden" name="sendit" value="true" /> 156: <br /> 157: <font size="1">Note: in anonymous discussion, your name is visible only to 158: course faculty</font><br /> 159: <textarea name=comment cols=60 rows=10 wrap=hard></textarea> 160: <p> 161: Attachment (128 KB max size): <input type="file" name="attachment" /> 162: </p> 163: </form> 164: ENDDISCUSS 165: $discussion.=&generate_preview_button(); 166: } 167: return $discussion; 168: } 169: 170: sub mail_screen { 171: my ($r,$feedurl,$options) = @_; 172: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion', 173: '','onLoad="window.focus();"'); 174: my $title=&Apache::lonnet::gettitle($feedurl); 175: if (!$title) { $title = $feedurl; } 176: my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); 177: $r->print(<<ENDDOCUMENT); 178: <html> 179: <head> 180: <title>The LearningOnline Network with CAPA</title> 181: <meta http-equiv="pragma" content="no-cache"></meta> 182: <script> 183: function gosubmit() { 184: var rec=0; 185: if (typeof(document.mailform.elements.author)!="undefined") { 186: if (document.mailform.elements.author.checked) { 187: rec=1; 188: } 189: } 190: if (typeof(document.mailform.elements.question)!="undefined") { 191: if (document.mailform.elements.question.checked) { 192: rec=1; 193: } 194: } 195: if (typeof(document.mailform.elements.course)!="undefined") { 196: if (document.mailform.elements.course.checked) { 197: rec=1; 198: } 199: } 200: if (typeof(document.mailform.elements.policy)!="undefined") { 201: if (document.mailform.elements.policy.checked) { 202: rec=1; 203: } 204: } 205: if (typeof(document.mailform.elements.discuss)!="undefined") { 206: if (document.mailform.elements.discuss.checked) { 207: rec=1; 208: } 209: } 210: if (typeof(document.mailform.elements.anondiscuss)!="undefined") { 211: if (document.mailform.elements.anondiscuss.checked) { 212: rec=1; 213: } 214: } 215: 216: if (rec) { 217: document.mailform.submit(); 218: } else { 219: alert('Please check a feedback type.'); 220: } 221: } 222: </script> 223: </head> 224: $bodytag 225: <h2><tt>$title</tt></h2> 226: <form action="/adm/feedback" method="post" name="mailform" 227: enctype="multipart/form-data"> 228: <input type=hidden name=postdata value="$feedurl"> 229: Please check at least one of the following feedback types: 230: $options<hr> 231: My question/comment/feedback:<p> 232: $latexHelp 233: <textarea name=comment cols=60 rows=10 wrap=hard> 234: </textarea><p> 235: Attachment (128 KB max size): <input type="file" name="attachment" /> 236: </p> 237: <p> 238: <input type="hidden" name="sendit" value="1" /> 239: <input type=button value="Send Feedback" onClick='gosubmit();' /> 240: </p> 241: </form> 242: ENDDOCUMENT 243: $r->print(&generate_preview_button().'</body></html>'); 244: } 245: 246: sub fail_redirect { 247: my ($r,$feedurl) = @_; 248: $r->print (<<ENDFAILREDIR); 249: <head><title>Feedback not sent</title> 250: <meta http-equiv="pragma" content="no-cache"></meta> 251: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 252: </head> 253: <html> 254: <body bgcolor="#FFFFFF"> 255: <img align=right src=/adm/lonIcons/lonlogos.gif> 256: <b>Sorry, no recipients ...</b> 257: </body> 258: </html> 259: ENDFAILREDIR 260: } 261: 262: sub redirect_back { 263: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_; 264: $r->print (<<ENDREDIR); 265: <head> 266: <title>Feedback sent</title> 267: <meta http-equiv="pragma" content="no-cache"></meta> 268: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 269: </head> 270: <html> 271: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'> 272: <img align=right src=/adm/lonIcons/lonlogos.gif> 273: $typestyle 274: <b>Sent $sendsomething message(s), and $sendposts post(s).</b> 275: <font color=red>$status</font> 276: <form name="reldt" action="$feedurl" target="loncapaclient"> 277: </form> 278: </body> 279: </html> 280: ENDREDIR 281: } 282: 283: sub no_redirect_back { 284: my ($r,$feedurl) = @_; 285: $r->print (<<ENDNOREDIR); 286: <head><title>Feedback not sent</title> 287: <meta http-equiv="pragma" content="no-cache"></meta> 288: ENDNOREDIR 289: 290: if ($feedurl!~/^\/adm\/feedback/) { 291: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">'); 292: } 293: 294: $r->print (<<ENDNOREDIRTWO); 295: </head> 296: <html> 297: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'> 298: <img align=right src=/adm/lonIcons/lonlogos.gif> 299: <b>Sorry, no feedback possible on this resource ...</b> 300: </body> 301: </html> 302: ENDNOREDIRTWO 303: } 304: 305: sub screen_header { 306: my ($feedurl) = @_; 307: my $msgoptions=''; 308: my $discussoptions=''; 309: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) { 310: $msgoptions= 311: '<p><input type=checkbox name=author> Feedback to resource author'; 312: } 313: if (&feedback_available(1)) { 314: $msgoptions.= 315: '<br><input type=checkbox name=question> Question about resource content'; 316: } 317: if (&feedback_available(0,1)) { 318: $msgoptions.= 319: '<br><input type=checkbox name=course> '. 320: 'Question/Comment/Feedback about course content'; 321: } 322: if (&feedback_available(0,0,1)) { 323: $msgoptions.= 324: '<br><input type=checkbox name=policy> '. 325: 'Question/Comment/Feedback about course policy'; 326: } 327: 328: if ($ENV{'request.course.id'}) { 329: if (&Apache::lonnet::allowed('pch', 330: $ENV{'request.course.id'}. 331: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 332: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;"> '. 333: 'Contribution to course discussion of resource'; 334: $discussoptions.='<br><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;"> '. 335: 'Anonymous contribution to course discussion of resource'. 336: ' <i>(name only visible to course faculty)</i>'; 337: } 338: } 339: if ($msgoptions) { $msgoptions='<h2>Sending Messages</h2>'.$msgoptions; } 340: if ($discussoptions) { 341: $discussoptions='<h2>Discussion Contributions</h2>'.$discussoptions; } 342: return $msgoptions.$discussoptions; 343: } 344: 345: sub resource_output { 346: my ($feedurl) = @_; 347: my $usersaw=&Apache::lonnet::ssi_body($feedurl); 348: $usersaw=~s/\<body[^\>]*\>//gi; 349: $usersaw=~s/\<\/body\>//gi; 350: $usersaw=~s/\<html\>//gi; 351: $usersaw=~s/\<\/html\>//gi; 352: $usersaw=~s/\<head\>//gi; 353: $usersaw=~s/\<\/head\>//gi; 354: $usersaw=~s/action\s*\=/would_be_action\=/gi; 355: return $usersaw; 356: } 357: 358: sub clear_out_html { 359: my ($message,$override)=@_; 360: my $cid=$ENV{'request.course.id'}; 361: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || 362: ($override)) { 363: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 364: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> 365: my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, 366: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1); 367: 368: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ 369: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; 370: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ 371: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; 372: } else { 373: $message=~s/\<\/*m\s*\>//g; 374: $message=~s/\</\&lt\;/g; 375: $message=~s/\>/\&gt\;/g; 376: } 377: return $message; 378: } 379: 380: sub assemble_email { 381: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_; 382: my $email=<<"ENDEMAIL"; 383: Refers to <a href="$feedurl">$feedurl</a> 384: 385: $message 386: ENDEMAIL 387: my $citations=<<"ENDCITE"; 388: <h2>Previous attempts of student (if applicable)</h2> 389: $prevattempts 390: <p><hr> 391: <h2>Original screen output (if applicable)</h2> 392: $usersaw 393: <h2>Correct Answer(s) (if applicable)</h2> 394: $useranswer 395: ENDCITE 396: return ($email,$citations); 397: } 398: 399: sub secapply { 400: my $rec=shift; 401: my $defaultflag=shift; 402: $rec=~s/\s+//g; 403: $rec=~s/\@/\:/g; 404: my ($adr,$sections)=($rec=~/^([^$]+)\(([^$]+)\)/); 405: if ($sections) { 406: foreach (split(/\;/,$sections)) { 407: if (($_ eq $ENV{'request.course.sec'}) || 408: ($defaultflag && ($_ eq '*'))) { 409: return $adr; 410: } 411: } 412: } else { 413: return $rec; 414: } 415: return ''; 416: } 417: 418: sub decide_receiver { 419: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; 420: my $typestyle=''; 421: my %to=(); 422: if ($ENV{'form.author'}||$author) { 423: $typestyle.='Submitting as Author Feedback<br>'; 424: $feedurl=~/^\/res\/(\w+)\/(\w+)\//; 425: $to{$2.':'.$1}=1; 426: } 427: if ($ENV{'form.question'}||$question) { 428: $typestyle.='Submitting as Question<br>'; 429: foreach (split(/\,/, 430: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) 431: ) { 432: my $rec=&secapply($_,$defaultflag); 433: if ($rec) { $to{$rec}=1; } 434: } 435: } 436: if ($ENV{'form.course'}||$course) { 437: $typestyle.='Submitting as Comment<br>'; 438: foreach (split(/\,/, 439: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) 440: ) { 441: my $rec=&secapply($_,$defaultflag); 442: if ($rec) { $to{$rec}=1; } 443: } 444: } 445: if ($ENV{'form.policy'}||$policy) { 446: $typestyle.='Submitting as Policy Feedback<br>'; 447: foreach (split(/\,/, 448: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) 449: ) { 450: my $rec=&secapply($_,$defaultflag); 451: if ($rec) { $to{$rec}=1; } 452: } 453: } 454: if ((scalar(%to) eq '0') && (!$defaultflag)) { 455: ($typestyle,%to)= 456: &decide_receiver($feedurl,$author,$question,$course,$policy,1); 457: } 458: return ($typestyle,%to); 459: } 460: 461: sub feedback_available { 462: my ($question,$course,$policy)=@_; 463: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy); 464: return scalar(%to); 465: } 466: 467: sub send_msg { 468: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_; 469: my $status=''; 470: my $sendsomething=0; 471: foreach (keys %to) { 472: if ($_) { 473: my $declutter=&Apache::lonnet::declutter($feedurl); 474: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), 475: 'Feedback ['.$declutter.']',$email,$citations,$feedurl, 476: $attachmenturl)=~/ok/) { 477: $status.='<br>Error sending message to '.$_.'<br>'; 478: } else { 479: $sendsomething++; 480: } 481: } 482: } 483: 484: my %record=&Apache::lonnet::restore('_feedback'); 485: my ($temp)=keys %record; 486: unless ($temp=~/^error\:/) { 487: my %newrecord=(); 488: $newrecord{'resource'}=$feedurl; 489: $newrecord{'subnumber'}=$record{'subnumber'}+1; 490: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { 491: $status.='<br>Not registered<br>'; 492: } 493: } 494: 495: return ($status,$sendsomething); 496: } 497: 498: sub adddiscuss { 499: my ($symb,$email,$anon,$attachmenturl)=@_; 500: my $status=''; 501: if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. 502: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) { 503: 504: my %contrib=('message' => $email, 505: 'sendername' => $ENV{'user.name'}, 506: 'senderdomain' => $ENV{'user.domain'}, 507: 'screenname' => $ENV{'environment.screenname'}, 508: 'plainname' => $ENV{'environment.firstname'}.' '. 509: $ENV{'environment.middlename'}.' '. 510: $ENV{'environment.lastname'}.' '. 511: $ENV{'enrironment.generation'}, 512: 'attachmenturl'=> $attachmenturl); 513: if ($anon) { 514: $contrib{'anonymous'}='true'; 515: } 516: if (($symb) && ($email)) { 517: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. 518: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'}, 519: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 520: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 521: my %storenewentry=($symb => time); 522: $status.='<br>Updating discussion time: '. 523: &Apache::lonnet::put('discussiontimes',\%storenewentry, 524: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 525: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 526: } 527: my %record=&Apache::lonnet::restore('_discussion'); 528: my ($temp)=keys %record; 529: unless ($temp=~/^error\:/) { 530: my %newrecord=(); 531: $newrecord{'resource'}=$symb; 532: $newrecord{'subnumber'}=$record{'subnumber'}+1; 533: $status.='<br>Registering: '. 534: &Apache::lonnet::cstore(\%newrecord,'_discussion'); 535: } 536: } else { 537: $status.='Failed.'; 538: } 539: return $status.'<br>'; 540: } 541: 542: # ----------------------------------------------------------- Preview function 543: 544: sub show_preview { 545: my $r=shift; 546: my $message=&clear_out_html($ENV{'form.comment'}); 547: $message=~s/\n/\<br \/\>/g; 548: $message=&Apache::lontexconvert::msgtexconverted($message); 549: $r->print('<table border="2"><tr><td>'. 550: $message.'</td></tr></table>'); 551: } 552: 553: sub generate_preview_button { 554: return(<<ENDPREVIEW); 555: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> 556: <input type="hidden" name="comment" /> 557: <input type="button" value="Show Preview" 558: onClick="this.form.comment.value=document.mailform.comment.value;this.form.submit();" /> 559: </form> 560: ENDPREVIEW 561: } 562: sub handler { 563: my $r = shift; 564: if ($r->header_only) { 565: $r->content_type('text/html'); 566: $r->send_http_header; 567: return OK; 568: } 569: 570: # --------------------------- Get query string for limited number of parameters 571: 572: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 573: ['hide','unhide','deldisc','postdata','preview']); 574: 575: if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) { 576: # ----------------------------------------------------------------- Hide/unhide 577: $r->content_type('text/html'); 578: $r->send_http_header; 579: 580: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'}; 581: 582: my ($symb,$idx)=split(/\:\:\:/,$entry); 583: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 584: 585: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 586: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 587: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 588: 589: 590: my $currenthidden=$contrib{'hidden'}; 591: 592: if ($ENV{'form.hide'}) { 593: $currenthidden.='.'.$idx.'.'; 594: } else { 595: $currenthidden=~s/\.$idx\.//g; 596: } 597: my %newhash=('hidden' => $currenthidden); 598: 599: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 600: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 601: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 602: 603: &redirect_back($r,&Apache::lonnet::clutter($url), 604: 'Changed discussion status<p>','0','0'); 605: } elsif ($ENV{'form.deldisc'}) { 606: # --------------------------------------------------------------- Hide for good 607: $r->content_type('text/html'); 608: $r->send_http_header; 609: 610: my $entry=$ENV{'form.deldisc'}; 611: 612: my ($symb,$idx)=split(/\:\:\:/,$entry); 613: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 614: 615: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'}, 616: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 617: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 618: 619: 620: my $currentdeleted=$contrib{'deleted'}; 621: 622: $currentdeleted.='.'.$idx.'.'; 623: 624: my %newhash=('deleted' => $currentdeleted); 625: 626: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'}, 627: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 628: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 629: 630: &redirect_back($r,&Apache::lonnet::clutter($url), 631: 'Changed discussion status<p>','0','0'); 632: } elsif ($ENV{'form.preview'}) { 633: # -------------------------------------------------------- User wants a preview 634: &show_preview($r); 635: } else { 636: # ------------------------------------------------------------- Normal feedback 637: my $feedurl=$ENV{'form.postdata'}; 638: $feedurl=~s/^http\:\/\///; 639: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 640: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 641: 642: my $symb=&Apache::lonnet::symbread($feedurl); 643: unless ($symb) { 644: $symb=$ENV{'form.symb'}; 645: if ($symb) { 646: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 647: $feedurl=&Apache::lonnet::clutter($url); 648: } 649: } 650: my $goahead=1; 651: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { 652: unless ($symb) { $goahead=0; } 653: } 654: 655: if ($goahead) { 656: # Go ahead with feedback, no ambiguous reference 657: $r->content_type('text/html'); 658: $r->send_http_header; 659: 660: if ( 661: ( 662: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) 663: ) 664: || 665: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) 666: || 667: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) 668: ) { 669: # --------------------------------------------------- Print login screen header 670: unless ($ENV{'form.sendit'}) { 671: my $options=&screen_header($feedurl); 672: if ($options) { 673: &mail_screen($r,$feedurl,$options); 674: } else { 675: &fail_redirect($r,$feedurl); 676: } 677: } else { 678: 679: # Get previous user input 680: my $prevattempts=&Apache::loncommon::get_previous_attempt( 681: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 682: $ENV{'request.course.id'}); 683: 684: # Get output from resource 685: my $usersaw=&resource_output($feedurl); 686: 687: # Get resource answer (need to allow student to view grades for this to work) 688: &Apache::lonnet::appenv(('allowed.vgr'=>'F')); 689: my $useranswer=&Apache::loncommon::get_student_answers( 690: $symb,$ENV{'user.name'},$ENV{'user.domain'}, 691: $ENV{'request.course.id'}); 692: &Apache::lonnet::delenv('allowed.vgr'); 693: # Get attachments, if any, and not too large 694: my $attachmenturl=''; 695: if ($ENV{'form.attachment.filename'}) { 696: unless (length($ENV{'form.attachment'})>131072) { 697: $attachmenturl=&Apache::lonnet::userfileupload('attachment'); 698: } 699: } 700: # Filter HTML out of message (could be nasty) 701: my $message=&clear_out_html($ENV{'form.comment'}); 702: 703: # Assemble email 704: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, 705: $usersaw,$useranswer); 706: 707: # Who gets this? 708: my ($typestyle,%to) = &decide_receiver($feedurl); 709: 710: # Actually send mail 711: my ($status,$numsent)=&send_msg($feedurl,$email,$citations, 712: $attachmenturl,%to); 713: 714: # Discussion? Store that. 715: 716: my $numpost=0; 717: if ($ENV{'form.discuss'}) { 718: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl); 719: $numpost++; 720: } 721: 722: if ($ENV{'form.anondiscuss'}) { 723: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl); 724: $numpost++; 725: } 726: 727: 728: # Receipt screen and redirect back to where came from 729: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status); 730: 731: } 732: } else { 733: # Unable to give feedback 734: &no_redirect_back($r,$feedurl); 735: } 736: } else { 737: # Ambiguous Problem Resource 738: 739: &Apache::lonnet::cleanenv(); 740: 741: $r->internal_redirect('/adm/ambiguous'); 742: } 743: } 744: return OK; 745: } 746: 747: 1; 748: __END__