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