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 mail_screen {
21: my ($r,$feedurl,$options) = @_;
22: $r->print(<<ENDDOCUMENT);
23: <html>
24: <head>
25: <title>The LearningOnline Network with CAPA</title>
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>
57: </head>
58: <body bgcolor="#FFFFFF" onLoad="window.focus();">
59: <img align=right src=/adm/lonIcons/lonlogos.gif>
60: <h1>Feedback</h1>
61: <h2><tt>$feedurl</tt></h2>
62: <form action="/adm/feedback" method=post name=mailform>
63: <input type=hidden name=postdata value="$feedurl">
64: Please check at least one of the following feedback types:
65: $options<hr>
66: My question/comment/feedback:<p>
67: <textarea name=comment cols=60 rows=10>
68: </textarea><p>
69: <input type=hidden name=sendit value=1>
70: <input type=button value="Send Feedback" onClick='gosubmit();'></input>
71: </form>
72: </body>
73: </html>
74: ENDDOCUMENT
75: }
76:
77: sub fail_redirect {
78: my ($r,$feedurl) = @_;
79: $r->print (<<ENDFAILREDIR);
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: }
90:
91: sub redirect_back {
92: my ($r,$feedurl,$typestyle,$sendsomething,$status) = @_;
93: $r->print (<<ENDREDIR);
94: <head>
95: <title>Feedback sent</title>
96: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
97: </head>
98: <html>
99: <body bgcolor="#FFFFFF">
100: $typestyle
101: <b>Sent $sendsomething message(s).</b>
102: <font color=red>$status</font>
103: </body>
104: </html>
105: ENDREDIR
106: }
107:
108: sub no_redirect_back {
109: my ($r,$feedurl) = @_;
110: $r->print (<<ENDNOREDIR);
111: <head><title>Feedback not sent</title>
112: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
113: </head>
114: <html>
115: <body bgcolor="#FFFFFF">
116: Sorry, no feedback possible on this resource ...
117: </body>
118: </html>
119: ENDNOREDIR
120: }
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;
324: }
325:
326: 1;
327: __END__
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