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