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: # 7/25 Gerd Kortemeyer
17:
18: package Apache::lonfeedback;
19:
20: use strict;
21: use Apache::Constants qw(:common);
22: use Apache::lonmsg();
23: use Apache::loncommon();
24:
25: sub mail_screen {
26: my ($r,$feedurl,$options) = @_;
27: $r->print(<<ENDDOCUMENT);
28: <html>
29: <head>
30: <title>The LearningOnline Network with CAPA</title>
31: <meta http-equiv="pragma" content="no-cache"></meta>
32: <script>
33: function gosubmit() {
34: var rec=0;
35: if (typeof(document.mailform.elements.author!=undefined)) {
36: if (document.mailform.elements.author.checked) {
37: rec=1;
38: }
39: }
40: if (typeof(document.mailform.elements.question!=undefined)) {
41: if (document.mailform.elements.question.checked) {
42: rec=1;
43: }
44: }
45: if (typeof(document.mailform.elements.course!=undefined)) {
46: if (document.mailform.elements.course.checked) {
47: rec=1;
48: }
49: }
50: if (typeof(document.mailform.elements.policy!=undefined)) {
51: if (document.mailform.elements.policy.checked) {
52: rec=1;
53: }
54: }
55: if (typeof(document.mailform.elements.discuss!=undefined)) {
56: if (document.mailform.elements.discuss.checked) {
57: rec=1;
58: }
59: }
60:
61: if (rec) {
62: document.mailform.submit();
63: } else {
64: alert('Please check a feedback type.');
65: }
66: }
67: </script>
68: </head>
69: <body bgcolor="#FFFFFF" onLoad="window.focus();">
70: <img align=right src=/adm/lonIcons/lonlogos.gif>
71: <h1>Feedback</h1>
72: <h2><tt>$feedurl</tt></h2>
73: <form action="/adm/feedback" method=post name=mailform>
74: <input type=hidden name=postdata value="$feedurl">
75: Please check at least one of the following feedback types:
76: $options<hr>
77: My question/comment/feedback:<p>
78: <textarea name=comment cols=60 rows=10>
79: </textarea><p>
80: <input type=hidden name=sendit value=1>
81: <input type=button value="Send Feedback" onClick='gosubmit();'></input>
82: </form>
83: </body>
84: </html>
85: ENDDOCUMENT
86: }
87:
88: sub fail_redirect {
89: my ($r,$feedurl) = @_;
90: $r->print (<<ENDFAILREDIR);
91: <head><title>Feedback not sent</title>
92: <meta http-equiv="pragma" content="no-cache"></meta>
93: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
94: </head>
95: <html>
96: <body bgcolor="#FFFFFF">
97: <img align=right src=/adm/lonIcons/lonlogos.gif>
98: <b>Sorry, no recipients ...</b>
99: </body>
100: </html>
101: ENDFAILREDIR
102: }
103:
104: sub redirect_back {
105: my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_;
106: $r->print (<<ENDREDIR);
107: <head>
108: <title>Feedback sent</title>
109: <meta http-equiv="pragma" content="no-cache"></meta>
110: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
111: </head>
112: <html>
113: <body bgcolor="#FFFFFF">
114: <img align=right src=/adm/lonIcons/lonlogos.gif>
115: $typestyle
116: <b>Sent $sendsomething message(s).</b>
117: <font color=red>$status</font>
118: </body>
119: </html>
120: ENDREDIR
121: }
122:
123: sub no_redirect_back {
124: my ($r,$feedurl) = @_;
125: $r->print (<<ENDNOREDIR);
126: <head><title>Feedback not sent</title>
127: <meta http-equiv="pragma" content="no-cache"></meta>
128: ENDNOREDIR
129:
130: if ($feedurl!~/^\/adm\/feedback/) {
131: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
132: }
133:
134: $r->print (<<ENDNOREDIRTWO);
135: </head>
136: <html>
137: <body bgcolor="#FFFFFF">
138: <img align=right src=/adm/lonIcons/lonlogos.gif>
139: <b>Sorry, no feedback possible on this resource ...</b>
140: </body>
141: </html>
142: ENDNOREDIRTWO
143: }
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.=
154: '<br><input type=checkbox name=question> Question about resource content';
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';
165: }
166: if ($ENV{'request.course.id'}) {
167: $options.='<br><input type=checkbox name=discuss> '.
168: '<b>Contribution to course discussion of resource</b>';
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'}) {
215: $typestyle.='Submitting as Author Feedback<br>';
216: $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
217: $to{$2.':'.$1}=1;
218: }
219: if ($ENV{'form.question'}) {
220: $typestyle.='Submitting as Question<br>';
221: map {
222: $to{$_}=1;
223: } split(/\,/,
224: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'});
225: }
226: if ($ENV{'form.course'}) {
227: $typestyle.='Submitting as Comment<br>';
228: map {
229: $to{$_}=1;
230: } split(/\,/,
231: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'});
232: }
233: if ($ENV{'form.policy'}) {
234: $typestyle.='Submitting as Policy Feedback<br>';
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 ($_) {
249: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
250: 'Feedback '.$feedurl,$email,$citations) eq 'ok') {
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;
263: if ($r->header_only) {
264: $r->content_type('text/html');
265: $r->send_http_header;
266: return OK;
267: }
268:
269: my $feedurl=$ENV{'form.postdata'};
270: $feedurl=~s/^http\:\/\///;
271: $feedurl=~s/^$ENV{'SERVER_NAME'}//;
272: $feedurl=~s/^$ENV{'HTTP_HOST'}//;
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;
284:
285: if (
286: (
287: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
288: )
289: ||
290: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
291: ) {
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
303: my $prevattempts=&Apache::loncommon::get_previous_attempt(
304: $symb,$ENV{'user.name'},$ENV{'user.domain'},
305: $ENV{'request.course.id'});
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
314: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
315: $usersaw);
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
324: &redirect_back($r,$feedurl,$typestyle,$numsent,$status);
325:
326: }
327: } else {
328: # Unable to give feedback
329: &no_redirect_back($r,$feedurl);
330: }
331: } else {
332: # Ambiguous Problem Resource
333: $r->internal_redirect('/adm/ambiguous');
334: }
335: return OK;
336: }
337:
338: 1;
339: __END__
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