loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.5: download - view: text, annotated - select for diffs
Thu Feb 8 21:35:24 2001 UTC (23 years, 4 months ago) by www
Branches: MAIN
CVS tags: HEAD

Bug Fixes and additional controls

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: # 14: package Apache::lonfeedback; 15: 16: use strict; 17: use Apache::Constants qw(:common); 18: use Apache::lonmsg(); 19: 20: sub handler { 21: my $r = shift; 22: $r->content_type('text/html'); 23: $r->send_http_header; 24: return OK if $r->header_only; 25: 26: my $feedurl=$ENV{'form.postdata'}; 27: $feedurl=~s/^http\:\/\///; 28: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 29: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 30: 31: if ((($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) 32: || ($ENV{'request.course.id'})) { 33: # --------------------------------------------------- Print login screen header 34: unless ($ENV{'form.sendit'}) { 35: my $options=''; 36: if (($feedurl=~/^\/res/) && ($feedurl!~/^\/res\/adm/)) { 37: $options= 38: '<p><input type=checkbox name=author> Feedback to resource author'; 39: } 40: if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) { 41: $options.= 42: '<br><input type=checkbox name=question> Question about resource content'; 43: } 44: if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) { 45: $options.= 46: '<br><input type=checkbox name=course> '. 47: 'Question/Comment/Feedback about course content'; 48: } 49: if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) { 50: $options.= 51: '<br><input type=checkbox name=policy> '. 52: 'Question/Comment/Feedback about course policy'; 53: } 54: if ($options) { 55: $r->print(<<ENDDOCUMENT); 56: <html> 57: <head> 58: <title>The LearningOnline Network with CAPA</title> 59: <script> 60: function gosubmit() { 61: var rec=0; 62: if (document.mailform.elements.author!=undefined) { 63: if (document.mailform.elements.author.checked) { 64: rec=1; 65: } 66: } 67: if (document.mailform.elements.question!=undefined) { 68: if (document.mailform.elements.question.checked) { 69: rec=1; 70: } 71: } 72: if (document.mailform.elements.course!=undefined) { 73: if (document.mailform.elements.course.checked) { 74: rec=1; 75: } 76: } 77: if (document.mailform.elements.policy!=undefined) { 78: if (document.mailform.elements.policy.checked) { 79: rec=1; 80: } 81: } 82: 83: if (rec) { 84: document.mailform.submit(); 85: } else { 86: alert('Please check a feedback type.'); 87: } 88: } 89: </script> 90: </head> 91: <body bgcolor="#FFFFFF" onLoad="window.focus();"> 92: <img align=right src=/adm/lonIcons/lonlogos.gif> 93: <h1>Feedback</h1> 94: <h2><tt>$feedurl</tt></h2> 95: <form action="/adm/feedback" method=post name=mailform> 96: <input type=hidden name=postdata value="$feedurl"> 97: Please check at least one of the following feedback types: 98: $options<hr> 99: My question/comment/feedback:<p> 100: <textarea name=comment cols=60 rows=10> 101: </textarea><p> 102: <input type=hidden name=sendit value=1> 103: <input type=button value="Send Feedback" onClick='gosubmit();'></input> 104: </form> 105: </body> 106: </html> 107: ENDDOCUMENT 108: } else { 109: print (<<ENDFAILREDIR); 110: <head><title>Feedback not sent</title> 111: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 112: </head> 113: <html> 114: <body bgcolor="#FFFFFF"> 115: Sorry, no recipients ... 116: </body> 117: </html> 118: ENDFAILREDIR 119: 120: } 121: } else { 122: # 123: # Get previous user input 124: # 125: my $symb=&Apache::lonnet::symbread($feedurl); 126: my $prevattempts=''; 127: if ($symb) { 128: my $answer=&Apache::lonnet::reply( 129: "restore:".$ENV{'user.domain'}.':'.$ENV{'user.name'}.':'. 130: $ENV{'request.course.id'}.':'. 131: &Apache::lonnet::escape($symb), 132: $ENV{'user.home'}); 133: my %returnhash=(); 134: map { 135: my ($name,$value)=split(/\=/,$_); 136: $returnhash{&Apache::lonnet::unescape($name)}= 137: &Apache::lonnet::unescape($value); 138: } split(/\&/,$answer); 139: my %lasthash=(); 140: my $version; 141: for ($version=1;$version<=$returnhash{'version'};$version++) { 142: map { 143: $lasthash{$_}=$returnhash{$version.':'.$_}; 144: } split(/\:/,$returnhash{$version.':keys'}); 145: } 146: $prevattempts='<table border=2></tr><th>History</th>'; 147: map { 148: $prevattempts.='<th>'.$_.'</th>'; 149: } keys %lasthash; 150: for ($version=1;$version<=$returnhash{'version'};$version++) { 151: $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>'; 152: map { 153: $prevattempts.='<td>'.$returnhash{$version.':'.$_}.'</td>'; 154: } keys %lasthash; 155: } 156: $prevattempts.='</tr><tr><th>Current</th>'; 157: map { 158: $prevattempts.='<td>'.$lasthash{$_}.'</td>'; 159: } keys %lasthash; 160: $prevattempts.='</tr></table>'; 161: } 162: # 163: # Get output from resource 164: # 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: # 174: # Filter HTML out of message (could be nasty) 175: # 176: my $message=$ENV{'form.comment'}; 177: $message=~s/\</\&lt\;/g; 178: $message=~s/\>/\&gt\;/g; 179: 180: # 181: # Assemble email 182: # 183: my $email=<<"ENDEMAIL"; 184: Refers to <a href="$feedurl">$feedurl</a> 185: 186: $message 187: ENDEMAIL 188: my $citations=<<"ENDCITE"; 189: <h2>Previous attempts of student (if applicable)</h2> 190: $prevattempts 191: <p><hr> 192: <h2>Original screen output (if applicable)</h2> 193: $usersaw 194: ENDCITE 195: # 196: # Who gets this? 197: # 198: my $typestyle=''; 199: my %to=(); 200: if ($ENV{'form.author'}) { 201: $typestyle.='Author Feedback<br>'; 202: $feedurl=~/^\/res\/(\w+)\/(\w+)\//; 203: $to{$2.':'.$1}=1; 204: } 205: if ($ENV{'form.question'}) { 206: $typestyle.='Question<br>'; 207: map { 208: $to{$_}=1; 209: } split(/\,/, 210: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}); 211: } 212: if ($ENV{'form.course'}) { 213: $typestyle.='Comment<br>'; 214: map { 215: $to{$_}=1; 216: } split(/\,/, 217: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}); 218: } 219: if ($ENV{'form.policy'}) { 220: $typestyle.='Policy<br>'; 221: map { 222: $to{$_}=1; 223: } split(/\,/, 224: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}); 225: } 226: # 227: # Actually send mail 228: # 229: my $status=''; 230: my $sendsomething=0; 231: map { 232: if ($_) { 233: unless ( 234: &Apache::lonmsg::user_normal_msg(split(/\:/,$_),'Feedback '.$feedurl, 235: $email,$citations) eq 'ok') { 236: $status.='<br>Error sending message to '.$_.'<br>'; 237: } else { 238: $sendsomething++; 239: } 240: } 241: } keys %to; 242: # 243: # Receipt screen and redirect back to where came from 244: # 245: print (<<ENDREDIR); 246: <head> 247: <title>Feedback sent</title> 248: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 249: </head> 250: <html> 251: <body bgcolor="#FFFFFF"> 252: $typestyle 253: <b>Sent $sendsomething message(s).</b> 254: <font color=red>$status</font> 255: </body> 256: </html> 257: ENDREDIR 258: } 259: } else { 260: print (<<ENDNOREDIR); 261: <head><title>Feedback not sent</title> 262: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl"> 263: </head> 264: <html> 265: <body bgcolor="#FFFFFF"> 266: Sorry, no feedback possible on this resource ... 267: </body> 268: </html> 269: ENDNOREDIR 270: } 271: return OK; 272: } 273: 274: 1; 275: __END__ 276: 277: 278: