File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.80:
download - view:
text,
annotated -
select for diffs
Wed May 5 21:04:14 2004 UTC (20 years, 1 month ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Posts in discussions now identified as "NEW" if posts were added since user's last visit to resource or bulletin board. "Speech bubbles" in NAVMAP also displayed for each resource or bulletin board if posts have been added since last visit.
User can set display to be all posts, or only unread posts. To support cases where there are several "NEW" posts, the time of the previous visit is passed in a query string during hide/make visible, reply or delete operations so that the differentiation of "NEW" posts is retained until the user leaves the bulletin board. This behavior does not currently apply to discussions associated with resources.
1: # The LearningOnline Network
2: # Feedback
3: #
4: # $Id: lonfeedback.pm,v 1.80 2004/05/05 21:04:14 raeburn Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: ###
29:
30: package Apache::lonfeedback;
31:
32: use strict;
33: use Apache::Constants qw(:common);
34: use Apache::lonmsg();
35: use Apache::loncommon();
36: use Apache::lontexconvert();
37: use Apache::lonlocal;
38:
39: sub list_discussion {
40: my ($mode,$status,$symb,$previous)=@_;
41: # &Apache::lonnet::logthis("status is $status");
42: if (!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
43: || $status eq 'OPEN')) {
44: return '';
45: }
46: my $discussiononly=0;
47: if ($mode eq 'board') { $discussiononly=1; }
48: unless ($ENV{'request.course.id'}) { return ''; }
49: my $crs='/'.$ENV{'request.course.id'};
50: if ($ENV{'request.course.sec'}) {
51: $crs.='_'.$ENV{'request.course.sec'};
52: }
53: $crs=~s/\_/\//g;
54: unless ($symb) {
55: $symb=&Apache::lonnet::symbread();
56: }
57: unless ($symb) { return ''; }
58:
59: # backward compatibility (bulletin boards used to be 'wrapped')
60: my $ressymb=$symb;
61: if ($mode eq 'board') {
62: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
63: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
64: }
65: }
66:
67: # Get discussion display settings for this discussion
68: my $lastkey = $ressymb.'_lastread';
69: my $showkey = $ressymb.'_showonlyunread';
70: my $visitkey = $ressymb.'_visit';
71: my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey],$ENV{'user.domain'},$ENV{'user.name'});
72: my $showonlyunread = 0;
73: my $prevread = 0;
74: my $visit = 0;
75: my $newpostsflag = 0;
76:
77: if ($previous > 0) {
78: $prevread = $previous;
79: } elsif (defined($dischash{$lastkey})) {
80: $prevread = $dischash{$lastkey};
81: }
82:
83: if (defined($dischash{$showkey})) {
84: $showonlyunread = $dischash{$showkey};
85: }
86:
87: if (defined($dischash{$visitkey})) {
88: $visit = $dischash{$visitkey};
89: }
90: $visit ++;
91:
92: my $seeid=&Apache::lonnet::allowed('rin',$crs);
93: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
94: && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
95: my @discussionitems=();
96: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
97: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
98: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
99: my $visible=0;
100: my @depth=();
101: my @original=();
102: my @index=();
103: my @replies=();
104: my %alldiscussion=();
105: my %notshown = ();
106: my $maxdepth=0;
107:
108: my $target='';
109: unless ($ENV{'browser.interface'} eq 'textual' ||
110: $ENV{'environment.remote'} eq 'off' ) {
111: $target='target="LONcom"';
112: }
113:
114: my $now = time;
115: my %discinfo = ();
116: $discinfo{$visitkey} = $visit;
117: $discinfo{$lastkey} = $now;
118:
119: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
120:
121: if ($contrib{'version'}) {
122: for (my $id=1;$id<=$contrib{'version'};$id++) {
123: my $idx=$id;
124: my $posttime = $contrib{$idx.':timestamp'};
125: if ($prevread > 0 && $prevread <= $posttime) {
126: $newpostsflag = 1;
127: }
128: my $hidden=($contrib{'hidden'}=~/\.$idx\./);
129: my $deleted=($contrib{'deleted'}=~/\.$idx\./);
130: my $origindex='0.';
131: if (($contrib{$idx.':replyto'}) && ($ENV{'environment.threadeddiscussion'})) {
132: # this is a follow-up message
133: $original[$idx]=$original[$contrib{$idx.':replyto'}];
134: $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1;
135: $origindex=$index[$contrib{$idx.':replyto'}];
136: if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; }
137: } else {
138: # this is an original message
139: $original[$idx]=0;
140: $depth[$idx]=0;
141: }
142: if ($replies[$depth[$idx]]) {
143: $replies[$depth[$idx]]++;
144: } else {
145: $replies[$depth[$idx]]=1;
146: }
147: unless ((($hidden) && (!$seeid)) || ($deleted)) {
148: $visible++;
149: my $message=$contrib{$idx.':message'};
150: $message=~s/\n/\<br \/\>/g;
151: $message=&Apache::lontexconvert::msgtexconverted($message);
152: my $subject=$contrib{$idx.':subject'};
153: if (defined($subject)) {
154: $subject=~s/\n/\<br \/\>/g;
155: $subject=&Apache::lontexconvert::msgtexconverted($subject);
156: }
157: if ($contrib{$idx.':attachmenturl'}) {
158: my ($fname,$ft)
159: =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/);
160: $message.='<p>'.&mt('Attachment').': <a href="'.
161: &Apache::lonnet::tokenwrapper(
162: $contrib{$idx.':attachmenturl'}).
163: '"><tt>'.$fname.'.'.$ft.'</tt></a></p>';
164: }
165: if ($message) {
166: if ($hidden) {
167: $message='<font color="#888888">'.$message.'</font>';
168: }
169: my $screenname=&Apache::loncommon::screenname(
170: $contrib{$idx.':sendername'},
171: $contrib{$idx.':senderdomain'});
172: my $plainname=&Apache::loncommon::nickname(
173: $contrib{$idx.':sendername'},
174: $contrib{$idx.':senderdomain'});
175:
176: my $sender=&mt('Anonymous');
177: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
178: $sender=&Apache::loncommon::aboutmewrapper(
179: $plainname,
180: $contrib{$idx.':sendername'},
181: $contrib{$idx.':senderdomain'}).' ('.
182: $contrib{$idx.':sendername'}.' at '.
183: $contrib{$idx.':senderdomain'}.')';
184: if ($contrib{$idx.':anonymous'}) {
185: $sender.=' ['.&mt('anonymous').'] '.
186: $screenname;
187: }
188: if ($seeid) {
189: if ($hidden) {
190: $sender.=' <a href="/adm/feedback?unhide='.
191: $ressymb.':::'.$idx;
192: if ($newpostsflag) {
193: $sender .= '&previous='.$prevread;
194: }
195: $sender .= '">'.&mt('Make Visible').'</a>';
196: } else {
197: $sender.=' <a href="/adm/feedback?hide='.
198: $ressymb.':::'.$idx;
199: if ($newpostsflag) {
200: $sender .= '&previous='.$prevread;
201: }
202: $sender .= '">'.&mt('Hide').'</a>';
203: }
204: $sender.=' <a href="/adm/feedback?deldisc='.
205: $ressymb.':::'.$idx;
206: if ($newpostsflag) {
207: $sender .= '&previous='.$prevread;
208: }
209: $sender .= '">'.&mt('Delete').'</a>';
210: }
211: } else {
212: if ($screenname) {
213: $sender='<i>'.$screenname.'</i>';
214: }
215: }
216: if (&Apache::lonnet::allowed('pch',
217: $ENV{'request.course.id'}.
218: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
219: $sender.=' <a href="/adm/feedback?replydisc='.
220: $ressymb.':::'.$idx;
221: if ($newpostsflag) {
222: $sender .= '&previous='.$prevread;
223: }
224: $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
225: }
226: my $vgrlink;
227: if ($viewgrades) {
228: $vgrlink=&Apache::loncommon::submlink('Submissions',
229: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
230: }
231: #figure out at what position this needs to print
232: my $thisindex=$idx;
233: if ($ENV{'environment.threadeddiscussion'}) {
234: $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
235: }
236: $alldiscussion{$thisindex}=$idx;
237: $index[$idx]=$thisindex;
238: my $spansize = 2;
239: if ($showonlyunread && $prevread > $posttime) {
240: $notshown{$idx} = 1;
241: } else {
242: $discussionitems[$idx]='<p><table border="0" width="100%"><tr>';
243: if ($prevread > 0 && $prevread <= $posttime) {
244: $discussionitems[$idx] .= '<td align="left" bgcolor="#FFFFFF"><font color="#FF0000">NEW</font></td>';
245: }
246: $discussionitems[$idx] .= '<td align ="left"> '.
247: '<b>'.$subject.'</b> '.
248: $sender.'</b> '.$vgrlink.' ('.
249: localtime($posttime).')</td></tr>'.
250: '</table><blockquote>'.$message.'</blockquote></p>';
251: }
252: }
253: }
254: }
255: }
256:
257: my $discussion='';
258: if ($visible) {
259: # Print the discusssion
260: $discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
261: if ($visible>2) {
262: my $colspan=$maxdepth+1;
263: $discussion.='<tr><td bgcolor="DDDDBB" colspan="'.$colspan.'">'.
264: '<table border="0" width="100%" bgcolor="#DDDDBB"><tr><td align="left">'.
265: '<a href="/adm/feedback?threadedon='.$ressymb.'">'.&mt('Threaded View').'</a> '.
266: '<a href="/adm/feedback?threadedoff='.$ressymb.'">'.&mt('Chronological View').'</a> </td>'.
267: '<td align="right"><a href="/adm/feedback?';
268: if ($showonlyunread) {
269: $discussion .= 'allposts='.$ressymb;
270: if ($newpostsflag) {
271: $discussion .= '&previous='.$prevread;
272: }
273: $discussion .='">'.&mt('Show all posts').'?';
274: } else {
275: $discussion .= 'onlyunread='.$ressymb;
276: if ($newpostsflag) {
277: $discussion .= '&previous='.$prevread;
278: }
279: $discussion .= '">'.&mt('Show only unread posts').'?';
280: }
281: $discussion .= '</a> </td></tr></table></td></tr>';
282: }
283: my $numhidden = keys %notshown;
284: if ($numhidden > 0) {
285: my $colspan = $maxdepth+1;
286: $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
287: '<a href="/adm/feedback?allposts='.$ressymb;
288: if ($newpostsflag) {
289: $discussion .= '&previous='.$prevread;
290: }
291: $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
292: $numhidden.' '.&mt('previously viewed posts').
293: '<br/></td></tr>';
294: }
295: foreach (sort { $a <=> $b } keys %alldiscussion) {
296: unless ($notshown{$alldiscussion{$_}} eq '1') {
297: $discussion.="\n<tr>";
298: my $thisdepth=$depth[$alldiscussion{$_}];
299: for (1..$thisdepth) {
300: $discussion.='<td> </td>';
301: }
302: my $colspan=$maxdepth-$thisdepth+1;
303: $discussion.='<td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
304: $discussionitems[$alldiscussion{$_}].
305: '</td></tr>';
306: }
307: }
308: $discussion.='</table><br /><br />';
309: }
310: if ($discussiononly) {
311: $discussion.=(<<ENDDISCUSS);
312: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
313: <input type="submit" name="discuss" value="Post Discussion" />
314: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
315: <input type="hidden" name="symb" value="$ressymb" />
316: <input type="hidden" name="sendit" value="true" />
317: <br />
318: <font size="1">Note: in anonymous discussion, your name is visible only to
319: course faculty</font><br />
320: <b>Title:</b> <input type="text" name="subject" value="" size="30" /><br /><br />
321: <textarea name="comment" cols="60" rows="10" wrap="hard"></textarea>
322: <p>
323: Attachment (128 KB max size): <input type="file" name="attachment" />
324: </p>
325: </form>
326: ENDDISCUSS
327: $discussion.=&generate_preview_button();
328: } else {
329: if (&Apache::lonnet::allowed('pch',
330: $ENV{'request.course.id'}.
331: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
332: $discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='.
333: $symb.':::" '.$target.'>'.
334: '<img src="/adm/lonMisc/chat.gif" border="0" />'.
335: &mt('Post Discussion').'</a></td></tr></table>';
336: }
337: }
338: return $discussion;
339: }
340:
341: sub mail_screen {
342: my ($r,$feedurl,$options) = @_;
343: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
344: '','onLoad="window.focus();"');
345: my $title=&Apache::lonnet::gettitle($feedurl);
346: if (!$title) { $title = $feedurl; }
347: my $quote='';
348: my $subject = '';
349: my $prevtag = '';
350: if ($ENV{'form.replydisc'}) {
351: my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
352: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
353: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
354: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
355: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) {
356: my $message=$contrib{$idx.':message'};
357: $message=~s/\n/\<br \/\>/g;
358: $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>';
359: if ($idx > 0) {
360: $subject = 'Re: '.$contrib{$idx.':subject'};
361: }
362: }
363: if ($ENV{'form.previous'}) {
364: $prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
365: }
366: }
367: my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
368: my $send=&mt('Send');
369: $r->print(<<ENDDOCUMENT);
370: <html>
371: <head>
372: <title>The LearningOnline Network with CAPA</title>
373: <meta http-equiv="pragma" content="no-cache"></meta>
374: <script type="text/javascript">
375: //<!--
376: function gosubmit() {
377: var rec=0;
378: if (typeof(document.mailform.elements.author)!="undefined") {
379: if (document.mailform.elements.author.checked) {
380: rec=1;
381: }
382: }
383: if (typeof(document.mailform.elements.question)!="undefined") {
384: if (document.mailform.elements.question.checked) {
385: rec=1;
386: }
387: }
388: if (typeof(document.mailform.elements.course)!="undefined") {
389: if (document.mailform.elements.course.checked) {
390: rec=1;
391: }
392: }
393: if (typeof(document.mailform.elements.policy)!="undefined") {
394: if (document.mailform.elements.policy.checked) {
395: rec=1;
396: }
397: }
398: if (typeof(document.mailform.elements.discuss)!="undefined") {
399: if (document.mailform.elements.discuss.checked) {
400: rec=1;
401: }
402: }
403: if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
404: if (document.mailform.elements.anondiscuss.checked) {
405: rec=1;
406: }
407: }
408:
409: if (rec) {
410: document.mailform.submit();
411: } else {
412: alert('Please check a feedback type.');
413: }
414: }
415: //-->
416: </script>
417: </head>
418: $bodytag
419: <h2><tt>$title</tt></h2>
420: <form action="/adm/feedback" method="post" name="mailform"
421: enctype="multipart/form-data">
422: $prevtag
423: <input type="hidden" name="postdata" value="$feedurl" />
424: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
425: Please check at least one of the following feedback types:
426: $options<hr />
427: $quote
428: <p>My question/comment/feedback:</p>
429: <p>
430: $latexHelp
431: Title: <input type="text" name="subject" size="30" value="$subject" /></p>
432: <p>
433: <textarea name="comment" cols="60" rows="10" wrap="hard">
434: </textarea></p>
435: <p>
436: Attachment (128 KB max size): <input type="file" name="attachment" />
437: </p>
438: <p>
439: <input type="hidden" name="sendit" value="1" />
440: <input type="button" value="$send" onClick='gosubmit();' />
441: </p>
442: </form>
443: ENDDOCUMENT
444: $r->print(&generate_preview_button().'</body></html>');
445: }
446:
447: sub fail_redirect {
448: my ($r,$feedurl) = @_;
449: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
450: $r->print (<<ENDFAILREDIR);
451: <html>
452: <head><title>Feedback not sent</title>
453: <meta http-equiv="pragma" content="no-cache" />
454: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
455: </head>
456: <body bgcolor="#FFFFFF">
457: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
458: <b>Sorry, no recipients ...</b>
459: </body>
460: </html>
461: ENDFAILREDIR
462: }
463:
464: sub redirect_back {
465: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous) = @_;
466: my $prevtag = '';
467: my $qrystr = '';
468: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
469: if ($previous > 0) {
470: $qrystr = 'previous='.$previous;
471: if ($feedurl =~ /\?register=1/) {
472: $feedurl .= '&'.$qrystr;
473: } else {
474: $feedurl .= '?'.$qrystr;
475: }
476: $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
477: }
478: $r->print (<<ENDREDIR);
479: <html>
480: <head>
481: <title>Feedback sent</title>
482: <meta http-equiv="pragma" content="no-cache" />
483: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
484: </head>
485: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
486: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
487: $typestyle
488: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
489: <font color="red">$status</font>
490: <form name="reldt" action="$feedurl" target="loncapaclient">
491: $prevtag
492: </form>
493: </body>
494: </html>
495: ENDREDIR
496: }
497:
498: sub no_redirect_back {
499: my ($r,$feedurl) = @_;
500: $r->print (<<ENDNOREDIR);
501: <html>
502: <head><title>Feedback not sent</title>
503: <meta http-equiv="pragma" content="no-cache" />
504: ENDNOREDIR
505:
506: if ($feedurl!~/^\/adm\/feedback/) {
507: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
508: }
509:
510: $r->print (<<ENDNOREDIRTWO);
511: </head>
512: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
513: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
514: <b>Sorry, no feedback possible on this resource ...</b>
515: </body>
516: </html>
517: ENDNOREDIRTWO
518: }
519:
520: sub screen_header {
521: my ($feedurl) = @_;
522: my $msgoptions='';
523: my $discussoptions='';
524: unless ($ENV{'form.replydisc'}) {
525: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
526: $msgoptions=
527: '<p><input type="checkbox" name="author" /> '.
528: &mt('Feedback to resource author').'</p>';
529: }
530: if (&feedback_available(1)) {
531: $msgoptions.=
532: '<br /><input type="checkbox" name="question" /> '.
533: &mt('Question about resource content');
534: }
535: if (&feedback_available(0,1)) {
536: $msgoptions.=
537: '<br /><input type="checkbox" name="course" /> '.
538: &mt('Question/Comment/Feedback about course content');
539: }
540: if (&feedback_available(0,0,1)) {
541: $msgoptions.=
542: '<br /><input type="checkbox" name="policy" /> '.
543: &mt('Question/Comment/Feedback about course policy');
544: }
545: }
546: if ($ENV{'request.course.id'}) {
547: if (&Apache::lonnet::allowed('pch',
548: $ENV{'request.course.id'}.
549: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
550: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
551: ($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
552: &mt('Contribution to course discussion of resource');
553: $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
554: &mt('Anonymous contribution to course discussion of resource').
555: ' <i>('.&mt('name only visible to course faculty').')</i>';
556: }
557: }
558: if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
559: if ($discussoptions) {
560: $discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
561: return $msgoptions.$discussoptions;
562: }
563:
564: sub resource_output {
565: my ($feedurl) = @_;
566: my $usersaw=&Apache::lonnet::ssi_body($feedurl);
567: $usersaw=~s/\<body[^\>]*\>//gi;
568: $usersaw=~s/\<\/body\>//gi;
569: $usersaw=~s/\<html\>//gi;
570: $usersaw=~s/\<\/html\>//gi;
571: $usersaw=~s/\<head\>//gi;
572: $usersaw=~s/\<\/head\>//gi;
573: $usersaw=~s/action\s*\=/would_be_action\=/gi;
574: return $usersaw;
575: }
576:
577: sub clear_out_html {
578: my ($message,$override)=@_;
579: my $cid=$ENV{'request.course.id'};
580: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
581: ($override)) {
582: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG>
583: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG>
584: my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
585: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
586: M=>1);
587:
588: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
589: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge;
590: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
591: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge;
592: } else {
593: $message=~s/\</\<\;/g;
594: $message=~s/\>/\>\;/g;
595: }
596: return $message;
597: }
598:
599: sub assemble_email {
600: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
601: my $email=<<"ENDEMAIL";
602: Refers to <a href="$feedurl">$feedurl</a>
603:
604: $message
605: ENDEMAIL
606: my $citations=<<"ENDCITE";
607: <h2>Previous attempts of student (if applicable)</h2>
608: $prevattempts
609: <br /><hr />
610: <h2>Original screen output (if applicable)</h2>
611: $usersaw
612: <h2>Correct Answer(s) (if applicable)</h2>
613: $useranswer
614: ENDCITE
615: return ($email,$citations);
616: }
617:
618: sub secapply {
619: my $rec=shift;
620: my $defaultflag=shift;
621: $rec=~s/\s+//g;
622: $rec=~s/\@/\:/g;
623: my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
624: if ($sections) {
625: foreach (split(/\;/,$sections)) {
626: if (($_ eq $ENV{'request.course.sec'}) ||
627: ($defaultflag && ($_ eq '*'))) {
628: return $adr;
629: }
630: }
631: } else {
632: return $rec;
633: }
634: return '';
635: }
636:
637: sub decide_receiver {
638: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
639: my $typestyle='';
640: my %to=();
641: if ($ENV{'form.author'}||$author) {
642: $typestyle.='Submitting as Author Feedback<br>';
643: $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
644: $to{$2.':'.$1}=1;
645: }
646: if ($ENV{'form.question'}||$question) {
647: $typestyle.='Submitting as Question<br>';
648: foreach (split(/\,/,
649: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
650: ) {
651: my $rec=&secapply($_,$defaultflag);
652: if ($rec) { $to{$rec}=1; }
653: }
654: }
655: if ($ENV{'form.course'}||$course) {
656: $typestyle.='Submitting as Comment<br />';
657: foreach (split(/\,/,
658: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
659: ) {
660: my $rec=&secapply($_,$defaultflag);
661: if ($rec) { $to{$rec}=1; }
662: }
663: }
664: if ($ENV{'form.policy'}||$policy) {
665: $typestyle.='Submitting as Policy Feedback<br />';
666: foreach (split(/\,/,
667: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
668: ) {
669: my $rec=&secapply($_,$defaultflag);
670: if ($rec) { $to{$rec}=1; }
671: }
672: }
673: if ((scalar(%to) eq '0') && (!$defaultflag)) {
674: ($typestyle,%to)=
675: &decide_receiver($feedurl,$author,$question,$course,$policy,1);
676: }
677: return ($typestyle,%to);
678: }
679:
680: sub feedback_available {
681: my ($question,$course,$policy)=@_;
682: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
683: return scalar(%to);
684: }
685:
686: sub send_msg {
687: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
688: my $status='';
689: my $sendsomething=0;
690: foreach (keys %to) {
691: if ($_) {
692: my $declutter=&Apache::lonnet::declutter($feedurl);
693: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
694: 'Feedback ['.$declutter.']',$email,$citations,$feedurl,
695: $attachmenturl)=~/ok/) {
696: $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
697: } else {
698: $sendsomething++;
699: }
700: }
701: }
702:
703: my %record=&Apache::lonnet::restore('_feedback');
704: my ($temp)=keys %record;
705: unless ($temp=~/^error\:/) {
706: my %newrecord=();
707: $newrecord{'resource'}=$feedurl;
708: $newrecord{'subnumber'}=$record{'subnumber'}+1;
709: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
710: $status.='<br />'.&mt('Not registered').'<br />';
711: }
712: }
713:
714: return ($status,$sendsomething);
715: }
716:
717: sub adddiscuss {
718: my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
719: my $status='';
720: if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
721: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
722:
723: my %contrib=('message' => $email,
724: 'sendername' => $ENV{'user.name'},
725: 'senderdomain' => $ENV{'user.domain'},
726: 'screenname' => $ENV{'environment.screenname'},
727: 'plainname' => $ENV{'environment.firstname'}.' '.
728: $ENV{'environment.middlename'}.' '.
729: $ENV{'environment.lastname'}.' '.
730: $ENV{'enrironment.generation'},
731: 'attachmenturl'=> $attachmenturl,
732: 'subject' => $subject);
733: if ($ENV{'form.replydisc'}) {
734: $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
735: }
736: if ($anon) {
737: $contrib{'anonymous'}='true';
738: }
739: if (($symb) && ($email)) {
740: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
741: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
742: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
743: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
744: my %storenewentry=($symb => time);
745: $status.='<br />'.&mt('Updating discussion time').': '.
746: &Apache::lonnet::put('discussiontimes',\%storenewentry,
747: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
748: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
749: }
750: my %record=&Apache::lonnet::restore('_discussion');
751: my ($temp)=keys %record;
752: unless ($temp=~/^error\:/) {
753: my %newrecord=();
754: $newrecord{'resource'}=$symb;
755: $newrecord{'subnumber'}=$record{'subnumber'}+1;
756: $status.='<br />'.&mt('Registering').': '.
757: &Apache::lonnet::cstore(\%newrecord,'_discussion');
758: }
759: } else {
760: $status.='Failed.';
761: }
762: return $status.'<br />';
763: }
764:
765: # ----------------------------------------------------------- Preview function
766:
767: sub show_preview {
768: my $r=shift;
769: my $message=&clear_out_html($ENV{'form.comment'});
770: $message=~s/\n/\<br \/\>/g;
771: $message=&Apache::lontexconvert::msgtexconverted($message);
772: my $subject=&clear_out_html($ENV{'form.subject'});
773: $subject=~s/\n/\<br \/\>/g;
774: $subject=&Apache::lontexconvert::msgtexconverted($subject);
775: $r->print('<table border="2"><tr><td>'.
776: '<b>Subject:</b> '.$subject.'<br /><br />'.
777: $message.'</td></tr></table>');
778: }
779:
780: sub generate_preview_button {
781: my $pre=&mt("Show Preview");
782: return(<<ENDPREVIEW);
783: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
784: <input type="hidden" name="subject">
785: <input type="hidden" name="comment" />
786: <input type="button" value="$pre"
787: onClick="this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
788: </form>
789: ENDPREVIEW
790: }
791:
792: sub handler {
793: my $r = shift;
794: if ($r->header_only) {
795: &Apache::loncommon::content_type($r,'text/html');
796: $r->send_http_header;
797: return OK;
798: }
799:
800: # --------------------------- Get query string for limited number of parameters
801:
802: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
803: ['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff','onlyunread','allposts','previous']);
804:
805: if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
806: # ----------------------------------------------------------------- Modify display setting for this discussion
807: &Apache::loncommon::content_type($r,'text/html');
808: $r->send_http_header;
809: my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
810: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
811: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
812: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
813: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
814: my %readinghash = ();
815:
816: if ($contrib{'version'}) {
817: if ($ENV{'form.allposts'}) {
818: $readinghash{$symb.'_showonlyunread'} = 0;
819: } elsif ($ENV{'form.onlyunread'}) {
820: $readinghash{$symb.'_showonlyunread'} = 1;
821: }
822: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%readinghash,$ENV{'user.domain'},$ENV{'user.name'});
823: }
824: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0','',$ENV{'form.previous'});
825: return OK;
826: } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
827: # ----------------------------------------------------------------- Hide/unhide
828: &Apache::loncommon::content_type($r,'text/html');
829: $r->send_http_header;
830:
831: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
832:
833: my ($symb,$idx)=split(/\:\:\:/,$entry);
834: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
835:
836: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
837: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
838: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
839:
840:
841: my $currenthidden=$contrib{'hidden'};
842:
843: if ($ENV{'form.hide'}) {
844: $currenthidden.='.'.$idx.'.';
845: } else {
846: $currenthidden=~s/\.$idx\.//g;
847: }
848: my %newhash=('hidden' => $currenthidden);
849:
850: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
851: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
852: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
853:
854: &redirect_back($r,&Apache::lonnet::clutter($url),
855: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
856: } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
857: &Apache::loncommon::content_type($r,'text/html');
858: $r->send_http_header;
859: if ($ENV{'form.threadedon'}) {
860: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
861: &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
862: } else {
863: &Apache::lonnet::del('environment',['threadeddiscussion']);
864: &Apache::lonnet::delenv('environment\.threadeddiscussion');
865: }
866: my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
867: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
868: &redirect_back($r,&Apache::lonnet::clutter($url),
869: &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
870: } elsif ($ENV{'form.deldisc'}) {
871: # --------------------------------------------------------------- Hide for good
872: &Apache::loncommon::content_type($r,'text/html');
873: $r->send_http_header;
874:
875: my $entry=$ENV{'form.deldisc'};
876:
877: my ($symb,$idx)=split(/\:\:\:/,$entry);
878: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
879:
880: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
881: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
882: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
883:
884:
885: my $currentdeleted=$contrib{'deleted'};
886:
887: $currentdeleted.='.'.$idx.'.';
888:
889: my %newhash=('deleted' => $currentdeleted);
890:
891: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
892: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
893: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
894:
895: &redirect_back($r,&Apache::lonnet::clutter($url),
896: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
897: } elsif ($ENV{'form.preview'}) {
898: # -------------------------------------------------------- User wants a preview
899: $r->content_type('text/html');
900: $r->send_http_header;
901: &show_preview($r);
902: } else {
903: # ------------------------------------------------------------- Normal feedback
904: my $feedurl=$ENV{'form.postdata'};
905: $feedurl=~s/^http\:\/\///;
906: $feedurl=~s/^$ENV{'SERVER_NAME'}//;
907: $feedurl=~s/^$ENV{'HTTP_HOST'}//;
908: $feedurl=~s/\?.+$//;
909:
910: my $symb;
911: if ($ENV{'form.replydisc'}) {
912: $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
913: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
914: $feedurl=&Apache::lonnet::clutter($url);
915: } else {
916: $symb=&Apache::lonnet::symbread($feedurl);
917: }
918: unless ($symb) {
919: $symb=$ENV{'form.symb'};
920: if ($symb) {
921: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
922: $feedurl=&Apache::lonnet::clutter($url);
923: }
924: }
925: my $goahead=1;
926: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
927: unless ($symb) { $goahead=0; }
928: }
929: # backward compatibility (bulltin boards used to be 'wrapped')
930: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
931: $feedurl=~s|^/adm/wrapper||;
932: }
933: if ($goahead) {
934: # Go ahead with feedback, no ambiguous reference
935: &Apache::loncommon::content_type($r,'text/html');
936: $r->send_http_header;
937:
938: if (
939: (
940: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
941: )
942: ||
943: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
944: ||
945: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
946: ) {
947: # --------------------------------------------------- Print login screen header
948: unless ($ENV{'form.sendit'}) {
949: my $options=&screen_header($feedurl);
950: if ($options) {
951: &mail_screen($r,$feedurl,$options);
952: } else {
953: &fail_redirect($r,$feedurl);
954: }
955: } else {
956:
957: # Get previous user input
958: my $prevattempts=&Apache::loncommon::get_previous_attempt(
959: $symb,$ENV{'user.name'},$ENV{'user.domain'},
960: $ENV{'request.course.id'});
961:
962: # Get output from resource
963: my $usersaw=&resource_output($feedurl);
964:
965: # Get resource answer (need to allow student to view grades for this to work)
966: &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
967: my $useranswer=&Apache::loncommon::get_student_answers(
968: $symb,$ENV{'user.name'},$ENV{'user.domain'},
969: $ENV{'request.course.id'});
970: &Apache::lonnet::delenv('allowed.vgr');
971: # Get attachments, if any, and not too large
972: my $attachmenturl='';
973: if ($ENV{'form.attachment.filename'}) {
974: unless (length($ENV{'form.attachment'})>131072) {
975: $attachmenturl=&Apache::lonnet::userfileupload('attachment');
976: }
977: }
978: # Filter HTML out of message (could be nasty)
979: my $message=&clear_out_html($ENV{'form.comment'});
980:
981: # Assemble email
982: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
983: $usersaw,$useranswer);
984:
985: # Who gets this?
986: my ($typestyle,%to) = &decide_receiver($feedurl);
987:
988: # Actually send mail
989: my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
990: $attachmenturl,%to);
991:
992: # Discussion? Store that.
993:
994: my $numpost=0;
995: if ($ENV{'form.discuss'}) {
996: my $subject = &clear_out_html($ENV{'form.subject'});
997: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
998: $numpost++;
999: }
1000:
1001: if ($ENV{'form.anondiscuss'}) {
1002: my $subject = &clear_out_html($ENV{'form.subject'});
1003: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
1004: $numpost++;
1005: }
1006:
1007:
1008: # Receipt screen and redirect back to where came from
1009: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
1010:
1011: }
1012: } else {
1013: # Unable to give feedback
1014: &no_redirect_back($r,$feedurl);
1015: }
1016: } else {
1017: # Ambiguous Problem Resource
1018: if ( &Apache::lonnet::mod_perl_version() == 2 ) {
1019: &Apache::lonnet::cleanenv();
1020: }
1021: $r->internal_redirect('/adm/ambiguous');
1022: }
1023: }
1024: return OK;
1025: }
1026:
1027: 1;
1028: __END__
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