loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.9: download - view: text, annotated - select for diffs
Tue Feb 13 18:18:40 2001 UTC (23 years, 3 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

- moved get_previous_attempt out of feedback

1: # The LearningOnline Network 2: # Feedback 3: # 4: # (Internal Server Error Handler 5: # 6: # (Login Screen 7: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, 8: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) 9: # 10: # 3/1/1 Gerd Kortemeyer) 11: # 12: # 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer 13: # 2/9 Guy Albertelli 14: # 2/10 Gerd Kortemeyer 15: # 2/13 Guy Albertelli 16: 17: package Apache::lonfeedback; 18: 19: use strict; 20: use Apache::Constants qw(:common); 21: use Apache::lonmsg(); 22: use Apache::loncommon(); 23: 24: sub mail_screen { 25: my ($r,$feedurl,$options) = @_; 26: $r->print(<<ENDDOCUMENT); 27: <html> 28: <head> 29: <title>The LearningOnline Network with CAPA</title> 30: <meta http-equiv="pragma" content="no-cache"></meta> 31: <script> 32: function gosubmit() { 33: var rec=0; 34: if (document.mailform.elements.author!=undefined) { 35: if (document.mailform.elements.author.checked) { 36: rec=1; 37: } 38: } 39: if (document.mailform.elements.question!=undefined) { 40: if (document.mailform.elements.question.checked) { 41: rec=1; 42: } 43: } 44: if (document.mailform.elements.course!=undefined) { 45: if (document.mailform.elements.course.checked) { 46: rec=1; 47: } 48: } 49: if (document.mailform.elements.policy!=undefined) { 50: if (document.mailform.elements.policy.checked) { 51: rec=1; 52: } 53: } 54: 55: if (rec) { 56: document.mailform.submit(); 57: } else { 58: alert('Please check a feedback type.'); 59: } 60: } 61: </script> 62: </head> 63: <body bgcolor="#FFFFFF" onLoad="window.focus();"> 64: <img align=right src=/adm/lonIcons/lonlogos.gif> 65: <h1>Feedback</h1> 66: <h2><tt>$feedurl</tt></h2> 67: <form action="/adm/feedback" method=post name=mailform> 68: <input type=hidden name=postdata value="$feedurl"> 69: Please check at least one of the following feedback types: 70: $options<hr> 71: My question/comment/feedback:<p> 72: <textarea name=comment cols=60 rows=10> 73: </textarea><p> 74: <input type=hidden name=sendit value=1> 75: <input type=button value="Send Feedback" onClick='gosubmit();'></input> 76: </form> 77: </body> 78: </html> 79: ENDDOCUMENT 80: } 81: 82: sub fail_redirect { 83: my ($r,$feedurl) = @_; 84: $r->print (<<ENDFAILREDIR); 85: <head><title>Feedback not sent</title> 86: <meta http-equiv="pragma" content="no-cache"></meta> 87: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 88: </head> 89: <html> 90: <body bgcolor="#FFFFFF"> 91: <img align=right src=/adm/lonIcons/lonlogos.gif> 92: <b>Sorry, no recipients ...</b> 93: </body> 94: </html> 95: ENDFAILREDIR 96: } 97: 98: sub redirect_back { 99: my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_; 100: $r->print (<<ENDREDIR); 101: <head> 102: <title>Feedback sent</title> 103: <meta http-equiv="pragma" content="no-cache"></meta> 104: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 105: </head> 106: <html> 107: <body bgcolor="#FFFFFF"> 108: <img align=right src=/adm/lonIcons/lonlogos.gif> 109: $typestyle 110: <b>Sent $sendsomething message(s).</b> 111: <font color=red>$status</font> 112: </body> 113: </html> 114: ENDREDIR 115: } 116: 117: sub no_redirect_back { 118: my ($r,$feedurl) = @_; 119: $r->print (<<ENDNOREDIR); 120: <head><title>Feedback not sent</title> 121: <meta http-equiv="pragma" content="no-cache"></meta> 122: ENDNOREDIR 123: 124: if ($feedurl!~/^\/adm\/feedback/) { 125: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">'); 126: } 127: 128: $r->print (<<ENDNOREDIRTWO); 129: </head> 130: <html> 131: <body bgcolor="#FFFFFF"> 132: <img align=right src=/adm/lonIcons/lonlogos.gif> 133: <b>Sorry, no feedback possible on this resource ...</b> 134: </body> 135: </html> 136: ENDNOREDIRTWO 137: } 138: 139: sub screen_header { 140: my ($feedurl) = @_; 141: my $options=''; 142: if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) { 143: $options= 144: '<p><input type=checkbox name=author> Feedback to resource author'; 145: } 146: if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) { 147: $options.= 148: '<br><input type=checkbox name=question> Question about resource content'; 149: } 150: if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) { 151: $options.= 152: '<br><input type=checkbox name=course> '. 153: 'Question/Comment/Feedback about course content'; 154: } 155: if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) { 156: $options.= 157: '<br><input type=checkbox name=policy> '. 158: 'Question/Comment/Feedback about course policy'; 159: } 160: return $options; 161: } 162: 163: sub resource_output { 164: my ($feedurl) = @_; 165: my $usersaw=&Apache::lonnet::ssi($feedurl); 166: $usersaw=~s/\<body[^\>]*\>//gi; 167: $usersaw=~s/\<\/body\>//gi; 168: $usersaw=~s/\<html\>//gi; 169: $usersaw=~s/\<\/html\>//gi; 170: $usersaw=~s/\<head\>//gi; 171: $usersaw=~s/\<\/head\>//gi; 172: $usersaw=~s/action\s*\=/would_be_action\=/gi; 173: return $usersaw; 174: } 175: 176: sub clear_out_html { 177: my $message=$ENV{'form.comment'}; 178: $message=~s/\</\&lt\;/g; 179: $message=~s/\>/\&gt\;/g; 180: return $message; 181: } 182: 183: sub assemble_email { 184: my ($feedurl,$message,$prevattempts,$usersaw)=@_; 185: my $email=<<"ENDEMAIL"; 186: Refers to <a href="$feedurl">$feedurl</a> 187: 188: $message 189: ENDEMAIL 190: my $citations=<<"ENDCITE"; 191: <h2>Previous attempts of student (if applicable)</h2> 192: $prevattempts 193: <p><hr> 194: <h2>Original screen output (if applicable)</h2> 195: $usersaw 196: ENDCITE 197: return ($email,$citations); 198: } 199: 200: sub decide_receiver { 201: my ($feedurl) = @_; 202: my $typestyle=''; 203: my %to=(); 204: if ($ENV{'form.author'}) { 205: $typestyle.='Submitting as Author Feedback<br>'; 206: $feedurl=~/^\/res\/(\w+)\/(\w+)\//; 207: $to{$2.':'.$1}=1; 208: } 209: if ($ENV{'form.question'}) { 210: $typestyle.='Submitting as Question<br>'; 211: map { 212: $to{$_}=1; 213: } split(/\,/, 214: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}); 215: } 216: if ($ENV{'form.course'}) { 217: $typestyle.='Submitting as Comment<br>'; 218: map { 219: $to{$_}=1; 220: } split(/\,/, 221: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}); 222: } 223: if ($ENV{'form.policy'}) { 224: $typestyle.='Submitting as Policy Feedback<br>'; 225: map { 226: $to{$_}=1; 227: } split(/\,/, 228: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}); 229: } 230: return ($typestyle,%to); 231: } 232: 233: sub send_msg { 234: my ($feedurl,$email,$citations,%to)=@_; 235: my $status=''; 236: my $sendsomething=0; 237: map { 238: if ($_) { 239: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_), 240: 'Feedback '.$feedurl,$email,$citations) eq 'ok') { 241: $status.='<br>Error sending message to '.$_.'<br>'; 242: } else { 243: #$status.='<br>Message sent to '.$_.'<br>'; 244: $sendsomething++; 245: } 246: } 247: } keys %to; 248: return ($status,$sendsomething); 249: } 250: 251: sub handler { 252: my $r = shift; 253: if ($r->header_only) { 254: $r->content_type('text/html'); 255: $r->send_http_header; 256: return OK; 257: } 258: 259: my $feedurl=$ENV{'form.postdata'}; 260: $feedurl=~s/^http\:\/\///; 261: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 262: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 263: 264: my $symb=&Apache::lonnet::symbread($feedurl); 265: my $goahead=1; 266: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) { 267: unless ($symb) { $goahead=0; } 268: } 269: 270: if ($goahead) { 271: # Go ahead with feedback, no ambiguous reference 272: $r->content_type('text/html'); 273: $r->send_http_header; 274: 275: if ( 276: ( 277: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) 278: ) 279: || 280: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:)) 281: ) { 282: # --------------------------------------------------- Print login screen header 283: unless ($ENV{'form.sendit'}) { 284: my $options=&screen_header($feedurl); 285: if ($options) { 286: &mail_screen($r,$feedurl,$options); 287: } else { 288: &fail_redirect($r,$feedurl); 289: } 290: } else { 291: 292: # Get previous user input 293: my $prevattempts=&Apache::loncommon::get_previous_attempt( 294: $symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'user.home'}, 295: $ENV{'request.course.id'}); 296: 297: # Get output from resource 298: my $usersaw=&resource_output($feedurl); 299: 300: # Filter HTML out of message (could be nasty) 301: my $message=&clear_out_html; 302: 303: # Assemble email 304: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts, 305: $usersaw); 306: 307: # Who gets this? 308: my ($typestyle,%to) = &decide_receiver($feedurl); 309: 310: # Actually send mail 311: my ($status,$numsent)=&send_msg($feedurl,$email,$citations,%to); 312: 313: # Receipt screen and redirect back to where came from 314: &redirect_back($r,$feedurl,$typestyle,$numsent,$status); 315: 316: } 317: } else { 318: # Unable to give feedback 319: &no_redirect_back($r,$feedurl); 320: } 321: } else { 322: # Ambiguous Problem Resource 323: $r->internal_redirect('/adm/ambiguous'); 324: } 325: return OK; 326: } 327: 328: 1; 329: __END__ 330: 331: 332: