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