File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.101:
download - view:
text,
annotated -
select for diffs
Wed Jul 21 23:57:24 2004 UTC (19 years, 10 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Use filtering to control which posts are displayed. 1. Restrict display of posts to users with specific roles, status, sections OR 2. Select from list of users whoc have posted. User interface needs more work.
1: # The LearningOnline Network
2: # Feedback
3: #
4: # $Id: lonfeedback.pm,v 1.101 2004/07/21 23:57:24 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; # must not have ()
38: use Apache::lonhtmlcommon();
39:
40: sub discussion_open {
41: my ($status)=@_;
42: if (defined($status) &&
43: !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
44: || $status eq 'OPEN')) {
45: return 0;
46: }
47: my $close=&Apache::lonnet::EXT('resource.0.discussend');
48: if (defined($close) && $close ne '' && $close < time) {
49: return 0;
50: }
51: return 1;
52: }
53:
54: sub discussion_visible {
55: my ($status)=@_;
56: if (not &discussion_open($status)) {
57: my $hidden=&Apache::lonnet::EXT('resource.0.discusshide');
58: if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) {
59: return 0;
60: }
61: }
62: return 1;
63: }
64:
65: sub list_discussion {
66: my ($mode,$status,$symb)=@_;
67:
68: my $outputtarget=$ENV{'form.grade_target'};
69: if (not &discussion_visible($status)) { return ''; }
70: my @bgcols = ("#cccccc","#eeeeee");
71: my $discussiononly=0;
72: if ($mode eq 'board') { $discussiononly=1; }
73: unless ($ENV{'request.course.id'}) { return ''; }
74: my $crs='/'.$ENV{'request.course.id'};
75: my $cid=$ENV{'request.course.id'};
76: if ($ENV{'request.course.sec'}) {
77: $crs.='_'.$ENV{'request.course.sec'};
78: }
79: $crs=~s/\_/\//g;
80: unless ($symb) {
81: $symb=&Apache::lonnet::symbread();
82: }
83: unless ($symb) { return ''; }
84: my %usernamesort = ();
85: my %namesort =();
86: my %subjectsort = ();
87: # backward compatibility (bulletin boards used to be 'wrapped')
88: my $ressymb=$symb;
89: if ($mode eq 'board') {
90: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
91: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
92: }
93: }
94:
95: # Get discussion display settings for this discussion
96: my $lastkey = $ressymb.'_lastread';
97: my $showkey = $ressymb.'_showonlyunread';
98: my $visitkey = $ressymb.'_visit';
99: my $ondispkey = $ressymb.'_markondisp';
100: my $userpickkey = $ressymb.'_userpick';
101: my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'});
102: my %discinfo = ();
103: my $showonlyunread = 0;
104: my $markondisp = 0;
105: my $prevread = 0;
106: my $previous = 0;
107: my $visit = 0;
108: my $newpostsflag = 0;
109: my @posters = split/\&/,$dischash{$userpickkey};
110:
111: # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts.
112: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']);
113: my $sortposts = $ENV{'form.sortposts'};
114: my $rolefilter = $ENV{'form.rolefilter'};
115: my $statusfilter = $ENV{'form.statusfilter'};
116: my $sectionpick = $ENV{'form.sectionpick'};
117: my $totposters = $ENV{'form.totposters'};
118: $previous = $ENV{'form.previous'};
119: if ($previous > 0) {
120: $prevread = $previous;
121: } elsif (defined($dischash{$lastkey})) {
122: unless ($dischash{$lastkey} eq '') {
123: $prevread = $dischash{$lastkey};
124: }
125: }
126:
127: # Get information about students and non-stundents in course for filtering display of posts
128: my %roleshash = ();
129: my %roleinfo = ();
130: if ($rolefilter) {
131: %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
132: foreach (keys %roleshash) {
133: my ($role,$uname,$udom,$sec) = split/:/,$_;
134: my ($end,$start) = split/:/,$roleshash{$_};
135: my $now = time;
136: my $status = 'Active';
137: if (($now < $start) || ($end > 0 && $now > $end)) {
138: $status = 'Expired';
139: }
140: push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
141: }
142: my ($classlist) = &Apache::loncoursedata::get_classlist(
143: $ENV{'request.course.id'},
144: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
145: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
146: my $sec_index = &Apache::loncoursedata::CL_SECTION();
147: my $status_index = &Apache::loncoursedata::CL_STATUS();
148: while (my ($student,$data) = each %$classlist) {
149: my ($section,$status) = ($data->[$sec_index],
150: $data->[$status_index]);
151: push @{$roleinfo{$student}}, 'st:'.$section.':'.$status;
152: }
153: }
154:
155: # Get discussion display default settings for user
156: my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'});
157: my $discdisplay=$userenv{'discdisplay'};
158: if ($discdisplay eq 'unread') {
159: $showonlyunread = 1;
160: }
161: my $discmarkread=$userenv{'discmarkread'};
162: if ($discmarkread eq 'ondisp') {
163: $markondisp = 1;
164: }
165:
166: # Override user's default if user specified display setting for this discussion
167: if (defined($dischash{$ondispkey})) {
168: $markondisp = $dischash{$ondispkey};
169: }
170: if ($markondisp) {
171: $discinfo{$lastkey} = time;
172: }
173:
174: if (defined($dischash{$showkey})) {
175: $showonlyunread = $dischash{$showkey};
176: }
177:
178: if (defined($dischash{$visitkey})) {
179: $visit = $dischash{$visitkey};
180: }
181: $visit ++;
182:
183: my $seeid=&Apache::lonnet::allowed('rin',$crs);
184: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
185: && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
186: my @discussionitems=();
187: my %shown = ();
188: my @posteridentity=();
189: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
190: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
191: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
192: my $visible=0;
193: my @depth=();
194: my @original=();
195: my @index=();
196: my @replies=();
197: my %alldiscussion=();
198: my %notshown = ();
199: my %newitem = ();
200: my $maxdepth=0;
201:
202: my $target='';
203: unless ($ENV{'browser.interface'} eq 'textual' ||
204: $ENV{'environment.remote'} eq 'off' ) {
205: $target='target="LONcom"';
206: }
207:
208: my $now = time;
209: $discinfo{$visitkey} = $visit;
210:
211: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
212:
213: if ($contrib{'version'}) {
214: my $oldest = $contrib{'1:timestamp'};
215: if ($prevread eq '0') {
216: $prevread = $oldest-1;
217: }
218: for (my $id=1;$id<=$contrib{'version'};$id++) {
219: my $idx=$id;
220: my $posttime = $contrib{$idx.':timestamp'};
221: if ($prevread <= $posttime) {
222: $newpostsflag = 1;
223: }
224: my $hidden=($contrib{'hidden'}=~/\.$idx\./);
225: my $deleted=($contrib{'deleted'}=~/\.$idx\./);
226: my $origindex='0.';
227: if ($contrib{$idx.':replyto'}) {
228: if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
229: # this is a follow-up message
230: $original[$idx]=$original[$contrib{$idx.':replyto'}];
231: $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1;
232: $origindex=$index[$contrib{$idx.':replyto'}];
233: if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; }
234: } else {
235: $original[$idx]=0;
236: $depth[$idx]=0;
237: }
238: } else {
239: # this is an original message
240: $original[$idx]=0;
241: $depth[$idx]=0;
242: }
243: if ($replies[$depth[$idx]]) {
244: $replies[$depth[$idx]]++;
245: } else {
246: $replies[$depth[$idx]]=1;
247: }
248: unless ((($hidden) && (!$seeid)) || ($deleted)) {
249: $visible++;
250: my $message=$contrib{$idx.':message'};
251: $message=~s/\n/\<br \/\>/g;
252: $message=&Apache::lontexconvert::msgtexconverted($message);
253: my $subject=$contrib{$idx.':subject'};
254: if (defined($subject)) {
255: $subject=~s/\n/\<br \/\>/g;
256: $subject=&Apache::lontexconvert::msgtexconverted($subject);
257: }
258: if ($contrib{$idx.':attachmenturl'}) {
259: my ($fname)
260: =($contrib{$idx.':attachmenturl'}=~m|/([^/]+)$|);
261: &Apache::lonnet::allowuploaded('/adm/feedback',
262: $contrib{$idx.':attachmenturl'});
263: $message.='<p>'.&mt('Attachment').
264: ': <a href="'.$contrib{$idx.':attachmenturl'}.'"><tt>'.
265: $fname.'</tt></a></p>';
266: }
267: if ($message) {
268: if ($hidden) {
269: $message='<font color="#888888">'.$message.'</font>';
270: }
271: my $screenname=&Apache::loncommon::screenname(
272: $contrib{$idx.':sendername'},
273: $contrib{$idx.':senderdomain'});
274: my $plainname=&Apache::loncommon::nickname(
275: $contrib{$idx.':sendername'},
276: $contrib{$idx.':senderdomain'});
277:
278: my $sender=&mt('Anonymous');
279: # Set up for sorting by subject
280: if ($contrib{$idx.':subject'} eq '') {
281: if (defined($subjectsort{'__No subject'})) {
282: push @{$subjectsort{'__No subject'}}, $idx;
283: } else {
284: @{$subjectsort{'__No subject'}} = ("$idx");
285: }
286: } else {
287: if (defined($subjectsort{$contrib{$idx.':subject'}})) {
288: push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx;
289: } else {
290: @{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx");
291: }
292: }
293: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
294: $sender=&Apache::loncommon::aboutmewrapper(
295: $plainname,
296: $contrib{$idx.':sendername'},
297: $contrib{$idx.':senderdomain'}).' ('.
298: $contrib{$idx.':sendername'}.' at '.
299: $contrib{$idx.':senderdomain'}.')';
300: if ($contrib{$idx.':anonymous'}) {
301: $sender.=' ['.&mt('anonymous').'] '.
302: $screenname;
303: }
304: # Set up for sorting by domain, then username
305: unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) {
306: %{$usernamesort{$contrib{$idx.':senderdomain'}}} = ();
307: }
308: if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) {
309: push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx;
310: } else {
311: @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx");
312: }
313: # Set up for sorting by last name, then first name
314: my %names = &Apache::lonnet::get('environment',['firstname','lastname'],
315: $contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
316: my $lastname = $names{'lastname'};
317: my $firstname = $names{'firstname'};
318: if ($lastname eq '') {
319: $lastname = '_';
320: }
321: if ($firstname eq '') {
322: $firstname = '_';
323: }
324: unless (defined($namesort{$lastname})) {
325: %{$namesort{$lastname}} = ();
326: }
327: if (defined($namesort{$lastname}{$firstname})) {
328: push @{$namesort{$lastname}{$firstname}}, $idx;
329: } else {
330: @{$namesort{$lastname}{$firstname}} = ("$idx");
331: }
332: if ($seeid) {
333: if ($hidden) {
334: $sender.=' <a href="/adm/feedback?unhide='.
335: $ressymb.':::'.$idx;
336: if ($newpostsflag) {
337: $sender .= '&previous='.$prevread;
338: }
339: $sender .= '">'.&mt('Make Visible').'</a>';
340: } else {
341: $sender.=' <a href="/adm/feedback?hide='.
342: $ressymb.':::'.$idx;
343: if ($newpostsflag) {
344: $sender .= '&previous='.$prevread;
345: }
346: $sender .= '">'.&mt('Hide').'</a>';
347: }
348: $sender.=' <a href="/adm/feedback?deldisc='.
349: $ressymb.':::'.$idx;
350: if ($newpostsflag) {
351: $sender .= '&previous='.$prevread;
352: }
353: $sender .= '">'.&mt('Delete').'</a>';
354: }
355: } else {
356: if ($screenname) {
357: $sender='<i>'.$screenname.'</i>';
358: }
359: # Set up for sorting by domain, then username for anonymous
360: unless (defined($usernamesort{'__anon'})) {
361: %{$usernamesort{'__anon'}} = ();
362: }
363: if (defined($usernamesort{'__anon'}{'__anon'})) {
364: push @{$usernamesort{'__anon'}{'__anon'}}, $idx;
365: } else {
366: @{$usernamesort{'__anon'}{'__anon'}} = ("$idx");
367: }
368: # Set up for sorting by last name, then first name for anonymous
369: unless (defined($namesort{'__anon'})) {
370: %{$namesort{'__anon'}} = ();
371: }
372: if (defined($namesort{'__anon'}{'__anon'})) {
373: push @{$namesort{'__anon'}{'__anon'}}, $idx;
374: } else {
375: @{$namesort{'__anon'}{'__anon'}} = ("$idx");
376: }
377: }
378: if (&discussion_open($status) &&
379: &Apache::lonnet::allowed('pch',
380: $ENV{'request.course.id'}.
381: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
382: $sender.=' <a href="/adm/feedback?replydisc='.
383: $ressymb.':::'.$idx;
384: if ($newpostsflag) {
385: $sender .= '&previous='.$prevread;
386: }
387: $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
388: }
389: my $vgrlink;
390: if ($viewgrades) {
391: $vgrlink=&Apache::loncommon::submlink('Submissions',
392: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
393: }
394: #figure out at what position this needs to print
395: my $thisindex=$idx;
396: if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
397: $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
398: }
399: $alldiscussion{$thisindex}=$idx;
400: $shown{$idx} = 0;
401: $index[$idx]=$thisindex;
402: my $spansize = 2;
403: if ($showonlyunread && $prevread > $posttime) {
404: $notshown{$idx} = 1;
405: } else {
406: my $uname = $contrib{$idx.':sendername'};
407: my $udom = $contrib{$idx.':senderdomain'};
408: my $poster = $uname.':'.$udom;
409: my $rolematch = '';
410: my $skiptest = 1;
411: if ($totposters > 0) {
412: if (grep/^$poster$/,@posters) {
413: $shown{$idx} = 1;
414: }
415: } else {
416: if ($rolefilter) {
417: if ($rolefilter eq 'all') {
418: $rolematch = '([^:]+)';
419: } else {
420: $rolematch = $rolefilter;
421: $skiptest = 0;
422: }
423: }
424: if ($sectionpick) {
425: if ($sectionpick eq 'all') {
426: $rolematch .= ':([^:]*)';
427: } else {
428: $rolematch .= ':'.$sectionpick;
429: $skiptest = 0;
430: }
431: }
432: if ($statusfilter) {
433: if ($statusfilter eq 'all') {
434: $rolematch .= ':([^:]+)';
435: } else {
436: $rolematch .= ':'.$statusfilter;
437: $skiptest = 0;
438: }
439: }
440: if ($skiptest) {
441: $shown{$idx} = 1;
442: } else {
443: foreach my $role (@{$roleinfo{$poster}}) {
444: if ($role =~ m/^$rolematch$/) {
445: $shown{$idx} = 1;
446: last;
447: }
448: }
449: }
450: }
451: }
452: unless ($notshown{$idx} == 1) {
453: if ($prevread > 0 && $prevread <= $posttime) {
454: $newitem{$idx} = 1;
455: $discussionitems[$idx] .= '
456: <p><table border="0" width="100%">
457: <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
458: } else {
459: $newitem{$idx} = 0;
460: $discussionitems[$idx] .= '
461: <p><table border="0" width="100%">
462: <tr><td align="left"> </td>';
463: }
464: $discussionitems[$idx] .= '<td align ="left"> '.
465: '<b>'.$subject.'</b> '.
466: $sender.'</b> '.$vgrlink.' ('.
467: localtime($posttime).')</td></tr>'.
468: '</table><blockquote>'.$message.'</blockquote></p>';
469: }
470: }
471: }
472: }
473: }
474:
475: my $discussion='';
476:
477: my $function = &Apache::loncommon::get_users_function();
478: my $color = &Apache::loncommon::designparm($function.'.tabbg',
479: $ENV{'user.domain'});
480: my %lt = &Apache::lonlocal::texthash(
481: 'cuse' => 'Current discussion settings',
482: 'allposts' => 'All posts',
483: 'unread' => 'New posts only',
484: 'ondisp' => 'Once displayed',
485: 'onmark' => 'Once marked read',
486: 'disa' => 'Posts to be displayed',
487: 'npce' => 'Posts cease to be marked "NEW"',
488: 'chgt' => 'Change',
489: 'disp' => 'Display',
490: 'nolo' => 'Not new',
491: );
492:
493: my $currdisp = $lt{'allposts'};
494: my $currmark = $lt{'onmark'};
495: my $dispchange = $lt{'unread'};
496: my $markchange = $lt{'ondisp'};
497: my $chglink = '/adm/feedback?modifydisp='.$ressymb;
498: my $displink = 'onlyunread';
499: my $marklink = 'markondisp';
500:
501: if ($markondisp) {
502: $currmark = $lt{'ondisp'};
503: $markchange = $lt{'onmark'};
504: $marklink = 'markonread';
505: }
506:
507: if ($showonlyunread) {
508: $currdisp = $lt{'unread'};
509: $dispchange = $lt{'allposts'};
510: $displink = 'allposts';
511: }
512:
513: $chglink .= '&changes='.$displink.'_'.$marklink;
514:
515: if ($newpostsflag) {
516: $chglink .= '&previous='.$prevread;
517: }
518:
519: if ($visible) {
520: # Print the discusssion
521: if ($outputtarget ne 'tex') {
522: my $colspan=$maxdepth+1;
523: $discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
524: $discussion .='<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'.
525: '<table border="0" width="100%" bgcolor="#DDDDBB"><tr>';
526: if ($visible>2) {
527: $discussion.='<td align="left">'.
528: '<a href="/adm/feedback?threadedon='.$ressymb;
529: if ($newpostsflag) {
530: $discussion .= '&previous='.$prevread;
531: }
532: $discussion .='">'.&mt('Threaded View').'</a> '.
533: '<a href="/adm/feedback?threadedoff='.$ressymb;
534: if ($newpostsflag) {
535: $discussion .= '&previous='.$prevread;
536: }
537: $discussion .='">'.&mt('Chronological View').'</a>
538: <a href= "/adm/feedback?sortfilter='.$ressymb;
539: if ($newpostsflag) {
540: $discussion .= '&previous='.$prevread;
541: }
542: $discussion .='">'.&mt('Sorting/Filtering options').'</a>  ';
543: } else {
544: $discussion .= '<td align="left">';
545: }
546: $discussion .='<a href= "/adm/feedback?export='.$ressymb;
547: if ($newpostsflag) {
548: $discussion .= '&previous='.$prevread;
549: }
550: $discussion .= '">'.&mt('Export').'?</a> </td>';
551: if ($newpostsflag) {
552: if (!$markondisp) {
553: $discussion .='<td align="right"><a href="/adm/feedback?markread='.$ressymb.'">'.&mt('Mark new posts as read').'</a> ';
554: } else {
555: $discussion .= '<td> </td>';
556: }
557: } else {
558: $discussion .= '<td> </td>';
559: }
560: $discussion .= '</tr></table></td></tr>';
561: } else {
562: $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
563: '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'.
564: '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'.
565: '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
566: '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}';
567: }
568: my $numhidden = keys %notshown;
569: if ($numhidden > 0) {
570: my $colspan = $maxdepth+1;
571: $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
572: '<a href="/adm/feedback?allposts='.$ressymb;
573: if ($newpostsflag) {
574: $discussion .= '&previous='.$prevread;
575: }
576: $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
577: $numhidden.' '.&mt('previously viewed posts').
578: '<br/></td></tr>';
579: }
580:
581: # Choose sort mechanism
582: my @showposts = ();
583: if ($sortposts eq 'descdate') {
584: @showposts = (sort { $b <=> $a } keys %alldiscussion);
585: } elsif ($sortposts eq 'thread') {
586: @showposts = (sort { $a <=> $b } keys %alldiscussion);
587: } elsif ($sortposts eq 'subject') {
588: foreach (sort keys %subjectsort) {
589: push @showposts, @{$subjectsort{$_}};
590: }
591: } elsif ($sortposts eq 'username') {
592: foreach my $domain (sort keys %usernamesort) {
593: foreach (sort keys %{$usernamesort{$domain}}) {
594: push @showposts, @{$usernamesort{$domain}{$_}};
595: }
596: }
597: } elsif ($sortposts eq 'lastfirst') {
598: foreach my $last (sort keys %namesort) {
599: foreach (sort keys %{$namesort{$last}}) {
600: push @showposts, @{$namesort{$last}{$_}};
601: }
602: }
603: } else {
604: $sortposts = 'ascdate';
605: @showposts = (sort { $a <=> $b } keys %alldiscussion);
606: }
607: foreach (@showposts) {
608: unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'})) {
609: $alldiscussion{$_} = $_;
610: }
611: unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) {
612: if ($outputtarget ne 'tex') {
613: $discussion.="\n<tr>";
614: } else {
615: $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}';
616: }
617: my $thisdepth=$depth[$alldiscussion{$_}];
618: if ($outputtarget ne 'tex') {
619: for (1..$thisdepth) {
620: $discussion.='<td> </td>';
621: }
622: }
623: my $colspan=$maxdepth-$thisdepth+1;
624: if ($outputtarget ne 'tex') {
625: $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].'" colspan="'.$colspan.'">'.
626: $discussionitems[$alldiscussion{$_}].
627: '</td></tr>';
628: } else {
629: #cleanup block
630: $discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
631: $discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
632: my $threadinsert='';
633: if ($thisdepth > 0) {
634: $threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>';
635: }
636: $discussionitems[$alldiscussion{$_}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/;
637: $discussionitems[$alldiscussion{$_}]=~s/<a([^>]+)>(Hide|Delete|Reply|Submissions)<\/a>//g;
638: $discussionitems[$alldiscussion{$_}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g;
639:
640: #FIXME xmlparse can't be safely called from inside xmlparse
641: # due to the global variables that are use, the safe
642: # space etc. I expect this has unforseen issues that
643: # need resolving.
644:
645: $discussion.=&Apache::lonxml::xmlparse('','tex',$discussionitems[$alldiscussion{$_}]);
646: }
647: }
648: }
649: if ($outputtarget ne 'tex') {
650: my $colspan=$maxdepth+1;
651: $discussion .= <<END;
652: <tr bgcolor="#FFFFFF">
653: <td colspan="$colspan" valign="top">
654: <table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2">
655: <tr>
656: <td align="left">
657: <table border="0" cellpadding="0" cellspacing="4">
658: <tr>
659: <td>
660: <font size="-1"><b>$lt{'cuse'}</b>:</td>
661: <td> </td>
662: END
663: if ($newpostsflag) {
664: $discussion .=
665: '<td><font size="-1">1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i></font></td>';
666: } else {
667: $discussion .=
668: '<td><font size="-1">'.$lt{'disp'}.' - <i>'.$currdisp.'</i></font></td>';
669: }
670: $discussion .= <<END;
671: <td> </td>
672: <td>
673: <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b></td>
674: </tr>
675: </table>
676: </td>
677: </tr>
678: </table>
679: </td>
680: </tr>
681: </table>
682: <br /><br />
683: END
684: }
685: }
686: if ($discussiononly) {
687: $discussion.=(<<ENDDISCUSS);
688: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
689: <input type="submit" name="discuss" value="Post Discussion" />
690: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
691: <input type="hidden" name="symb" value="$ressymb" />
692: <input type="hidden" name="sendit" value="true" />
693: <br />
694: <font size="1">Note: in anonymous discussion, your name is visible only to
695: course faculty</font><br />
696: <b>Title:</b> <input type="text" name="subject" value="" size="30" /><br /><br />
697: <textarea name="comment" cols="80" rows="14" wrap="hard"></textarea>
698: <p>
699: Attachment (128 KB max size): <input type="file" name="attachment" />
700: </p>
701: </form>
702: ENDDISCUSS
703: if ($outputtarget ne 'tex') {
704: $discussion.=&generate_preview_button();
705: }
706: } else {
707: if (&discussion_open($status) &&
708: &Apache::lonnet::allowed('pch',
709: $ENV{'request.course.id'}.
710: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
711: if ($outputtarget ne 'tex') {
712: $discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='.
713: $symb.':::" '.$target.'>'.
714: '<img src="/adm/lonMisc/chat.gif" border="0" />'.
715: &mt('Post Discussion').'</a></td></tr></table>';
716: }
717: }
718: }
719: return $discussion;
720: }
721:
722: sub mail_screen {
723: my ($r,$feedurl,$options) = @_;
724: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
725: '','onLoad="window.focus();"');
726: my $title=&Apache::lonnet::gettitle($feedurl);
727: if (!$title) { $title = $feedurl; }
728: my $quote='';
729: my $subject = '';
730: my $prevtag = '';
731: if ($ENV{'form.replydisc'}) {
732: my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
733: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
734: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
735: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
736: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) {
737: my $message=$contrib{$idx.':message'};
738: $message=~s/\n/\<br \/\>/g;
739: $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>';
740: if ($idx > 0) {
741: $subject = 'Re: '.$contrib{$idx.':subject'};
742: }
743: }
744: if ($ENV{'form.previous'}) {
745: $prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
746: }
747: }
748: my $latexHelp=&Apache::loncommon::helpLatexCheatsheet();
749: my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders();
750: my $onsubmit='';
751: if ((&Apache::lonhtmlcommon::htmlareabrowser()) &&
752: (!&Apache::lonhtmlcommon::htmlareablocked())) {
753: $onsubmit='document.mailform.onsubmit();';
754: }
755: my $send=&mt('Send');
756: $r->print(<<ENDDOCUMENT);
757: <html>
758: <head>
759: <title>The LearningOnline Network with CAPA</title>
760: <meta http-equiv="pragma" content="no-cache"></meta>
761: $htmlheader
762: <script type="text/javascript">
763: //<!--
764: function gosubmit() {
765: var rec=0;
766: if (typeof(document.mailform.elements.author)!="undefined") {
767: if (document.mailform.elements.author.checked) {
768: rec=1;
769: }
770: }
771: if (typeof(document.mailform.elements.question)!="undefined") {
772: if (document.mailform.elements.question.checked) {
773: rec=1;
774: }
775: }
776: if (typeof(document.mailform.elements.course)!="undefined") {
777: if (document.mailform.elements.course.checked) {
778: rec=1;
779: }
780: }
781: if (typeof(document.mailform.elements.policy)!="undefined") {
782: if (document.mailform.elements.policy.checked) {
783: rec=1;
784: }
785: }
786: if (typeof(document.mailform.elements.discuss)!="undefined") {
787: if (document.mailform.elements.discuss.checked) {
788: rec=1;
789: }
790: }
791: if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
792: if (document.mailform.elements.anondiscuss.checked) {
793: rec=1;
794: }
795: }
796:
797: if (rec) {
798: $onsubmit
799: document.mailform.submit();
800: } else {
801: alert('Please check a feedback type.');
802: }
803: }
804: //-->
805: </script>
806: </head>
807: $bodytag
808: <h2><tt>$title</tt></h2>
809: <form action="/adm/feedback" method="post" name="mailform"
810: enctype="multipart/form-data">
811: $prevtag
812: <input type="hidden" name="postdata" value="$feedurl" />
813: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
814: Please check at least one of the following feedback types:
815: $options<hr />
816: $quote
817: <p>My question/comment/feedback:</p>
818: <p>
819: $latexHelp
820: Title: <input type="text" name="subject" size="30" value="$subject" /></p>
821: <p>
822: <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">
823: </textarea></p>
824: <p>
825: Attachment (128 KB max size): <input type="file" name="attachment" />
826: </p>
827: <p>
828: <input type="hidden" name="sendit" value="1" />
829: <input type="button" value="$send" onClick='gosubmit();' />
830: </p>
831: </form>
832: ENDDOCUMENT
833: $r->print(&generate_preview_button().
834: &Apache::lonhtmlcommon::htmlareaselectactive('comment').
835: '</body></html>');
836: }
837:
838: sub print_display_options {
839: my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_;
840: # backward compatibility (bulletin boards used to be 'wrapped')
841: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
842: $feedurl=~s|^/adm/wrapper||;
843: }
844:
845: my $function = &Apache::loncommon::get_users_function();
846: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
847: $ENV{'user.domain'});
848: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
849: '','');
850:
851: my %lt = &Apache::lonlocal::texthash(
852: 'dido' => 'Discussion display options',
853: 'pref' => 'Display Preference',
854: 'curr' => 'Current setting ',
855: 'actn' => 'Action',
856: 'deff' => 'Default for all discussions',
857: 'prca' => 'Preferences can be set for this discussion that determine ....',
858: 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and',
859: 'unwh' => 'Under what circumstances posts are identfied as "New."',
860: 'allposts' => 'All posts',
861: 'unread' => 'New posts only',
862: 'ondisp' => 'Once displayed',
863: 'onmark' => 'Once marked as read',
864: 'disa' => 'Posts displayed?',
865: 'npmr' => 'New posts cease to be identified as "New"?',
866: 'chgt' => 'Change to ',
867: 'mkdf' => 'Set to ',
868: 'yhni' => 'You have not indicated that you wish to change either of the discussion settings',
869: 'ywbr' => 'You will be returned to the previous page if you click OK.'
870: );
871:
872: my $dispchange = $lt{'unread'};
873: my $markchange = $lt{'ondisp'};
874: my $currdisp = $lt{'allposts'};
875: my $currmark = $lt{'onmark'};
876: my $discdisp = 'allposts';
877: my $discmark = 'onmark';
878:
879: if ($dispchg eq 'allposts') {
880: $dispchange = $lt{'allposts'};
881: $currdisp = $lt{'unread'};
882: $discdisp = 'unread';
883: }
884:
885: if ($markchg eq 'markonread') {
886: $markchange = $lt{'onmark'};
887: $currmark = $lt{'ondisp'};
888: $discmark = 'ondisp';
889: }
890: $r->print(<<END);
891: <html>
892: <head>
893: <title>$lt{'dido'}</title>
894: <meta http-equiv="pragma" content="no-cache" />
895: <script>
896: function setDisp() {
897: var prev = "$previous"
898: var chktotal = 0
899: if (document.modifydisp.discdisp.checked == true) {
900: document.modifydisp.$dispchg.value = "$symb"
901: chktotal ++
902: }
903: if (document.modifydisp.discmark.checked == true) {
904: document.modifydisp.$markchg.value = "$symb"
905: chktotal ++
906: }
907: if (chktotal > 0) {
908: document.modifydisp.submit()
909: } else {
910: if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) {
911: if (prev > 0) {
912: location.href = "$feedurl?previous=$previous"
913: } else {
914: location.href = "$feedurl"
915: }
916: }
917: }
918: }
919: </script>
920: </head>
921: $bodytag
922: <form name="modifydisp" method="post" action="/adm/feedback">
923: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
924: <br />
925: <table border="0" cellpadding="0" cellspacing="0">
926: <tr>
927: <td width="100%" bgcolor="#000000">
928: <table width="100%" border="0" cellpadding="1" cellspacing="0">
929: <tr>
930: <td width="100%" bgcolor="#000000">
931: <table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF">
932: <tr bgcolor="$tabcolor">
933: <td><b>$lt{'pref'}</b></td>
934: <td><b>$lt{'curr'}</b></td>
935: <td><b>$lt{'actn'}?</b></td>
936: </tr>
937: <tr bgcolor="#dddddd">
938: <td>$lt{'disa'}</td>
939: <td>$lt{$discdisp}</td>
940: <td><input type="checkbox" name="discdisp" /> $lt{'chgt'} "$dispchange"</td>
941: </tr><tr bgcolor="#eeeeee">
942: <td>$lt{'npmr'}</td>
943: <td>$lt{$discmark}</td>
944: <td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td>
945: </tr>
946: </table>
947: </td>
948: </tr>
949: </table>
950: </td>
951: </tr>
952: </table>
953: <br />
954: <br />
955: <input type="hidden" name="previous" value="$previous" />
956: <input type="hidden" name="$dispchg" value=""/>
957: <input type="hidden" name="$markchg" value=""/>
958: <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" />
959: <br />
960: <br />
961: </form>
962: </body>
963: </html>
964: END
965: return;
966: }
967:
968: sub print_sortfilter_options {
969: my ($r,$symb,$previous,$feedurl) = @_;
970: # backward compatibility (bulletin boards used to be 'wrapped')
971: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
972: $feedurl=~s|^/adm/wrapper||;
973: }
974: my @sections = ();
975: my $section_sel = '';
976: my $numsections = 0;
977: my $numvisible = 5;
978: my ($classlist) = &Apache::loncoursedata::get_classlist(
979: $ENV{'request.course.id'},
980: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
981: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
982:
983: my $sec_index = &Apache::loncoursedata::CL_SECTION();
984: my $status_index = &Apache::loncoursedata::CL_STATUS();
985: my %sectioncount = ();
986: while (my ($student,$data) = each %$classlist) {
987: my ($section,$status) = ($data->[$sec_index],
988: $data->[$status_index]);
989: unless ($section eq '' || $section =~ /^\s*$/) {
990: if (!defined($sectioncount{$section})) {
991: $sectioncount{$section} = 1;
992: $numsections ++;
993: } else {
994: $sectioncount{$section} ++;
995: }
996: }
997: }
998:
999: if ($ENV{'request.course.sec'} !~ /^\s*$/) {
1000: @sections = ($ENV{'request.course.sec'});
1001: $numvisible = 1;
1002: } else {
1003: @sections = sort {$a cmp $b} keys(%sectioncount);
1004: unshift(@sections,'all'); # Put 'all' at the front of the list
1005: if ($numsections < 4) {
1006: $numvisible = $numsections + 1;
1007: }
1008: }
1009: foreach (@sections) {
1010: $section_sel .= " <option value=\"$_\" />$_\n";
1011: }
1012:
1013: my $function = &Apache::loncommon::get_users_function();
1014: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
1015: $ENV{'user.domain'});
1016: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
1017: '','');
1018: my %lt = &Apache::lonlocal::texthash(
1019: 'diso' => 'Discussion sorting and filtering options',
1020: 'diop' => 'Display Options',
1021: 'curr' => 'Current setting ',
1022: 'actn' => 'Action',
1023: 'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
1024: 'soor' => 'Sort order',
1025: 'disp' => 'Specific user roles',
1026: 'actv' => 'Specific role status',
1027: 'spse' => 'Specific sections',
1028: 'psub' => 'Pick specific users (by name)',
1029: 'shal' => 'Show a list of current posters'
1030: );
1031: $r->print(<<END);
1032: <html>
1033: <head>
1034: <title>$lt{'diso'}</title>
1035: <meta http-equiv="pragma" content="no-cache" />
1036: </head>
1037: $bodytag
1038: <form name="modifyshown" method="post" action="/adm/feedback">
1039: <b>$lt{'diso'}</b><br/> $lt{'prca'}
1040: <br /><br />
1041: <table border="0">
1042: <tr>
1043: <td><b>$lt{'soor'}</b></td>
1044: <td> </td>
1045: <td><b>$lt{'disp'}</b></td>
1046: <td> </td>
1047: <td><b>$lt{'actv'}</b></td>
1048: <td> </td>
1049: <td><b>$lt{'spse'}</b></td>
1050: <td> </td>
1051: <td><b>$lt{'psub'}</b></td>
1052: </tr>
1053: <tr>
1054: <td>
1055: <select name="sortposts">
1056: <option value="ascdate" />Date order - oldest first
1057: <option value="descdate" />Date order - newest first
1058: <option value="thread" />Threaded
1059: <option value="subject" />By subject
1060: <option value="username" />By domain and username
1061: <option value="lastfirst" />By last name, first name
1062: </select>
1063: </td>
1064: <td> </td>
1065: <td>
1066: <select name="rolefilter" multiple="true" size="5">
1067: <option value="all" />All users
1068: <option value="st" />Students
1069: <option value="cc" />Course Coordinators
1070: <option value="in" />Instructors
1071: <option value="ta" />TAs
1072: <option value="pr" />Exam proctors
1073: <option value="cr" />Custom roles
1074: </select>
1075: </td>
1076: <td> </td>
1077: <td>
1078: <select name="statusfilter">
1079: <option value="all" />Roles of any status
1080: <option value="Active" />Only active roles
1081: <option value="Expired" />Only inactive roles
1082: </select>
1083: </td>
1084: <td> </td>
1085: <td>
1086: <select name="sectionpick" multiple="true" size="$numvisible">
1087: $section_sel
1088: </select>
1089: </td>
1090: <td> </td>
1091: <td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</td>
1092: </tr>
1093: </table>
1094: <br />
1095: <br />
1096: <input type="hidden" name="previous" value="$previous" />
1097: <input type="hidden" name="applysort" value="$symb" />
1098: <input type="button" name="sub" value="Store Changes" onClick="javascript:document.modifyshown.submit()" />
1099: <br />
1100: <br />
1101: </form>
1102: </body>
1103: </html>
1104: END
1105: }
1106:
1107: sub print_showposters {
1108: my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
1109: # backward compatibility (bulletin boards used to be 'wrapped')
1110: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1111: $feedurl=~s|^/adm/wrapper||;
1112: }
1113: # backward compatibility (bulletin boards used to be 'wrapped')
1114: my $ressymb=$symb;
1115: if ($ressymb =~ /bulletin___\d+___/) {
1116: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1117: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1118: }
1119: }
1120: my $crs='/'.$ENV{'request.course.id'};
1121: $crs=~s/\_/\//g;
1122: my $seeid=&Apache::lonnet::allowed('rin',$crs);
1123: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
1124: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1125: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1126: my %namesort = ();
1127: my %postcounts = ();
1128: my %lt=&Apache::lonlocal::texthash(
1129: 'diso' => 'Discussion filtering options',
1130: );
1131: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
1132: '','');
1133: if ($contrib{'version'}) {
1134: for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
1135: my $hidden=($contrib{'hidden'}=~/\.$idx\./);
1136: my $deleted=($contrib{'deleted'}=~/\.$idx\./);
1137: unless ((($hidden) && (!$seeid)) || ($deleted)) {
1138: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
1139: my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
1140: my $lastname = $names{'lastname'};
1141: my $firstname = $names{'firstname'};
1142: if ($lastname eq '') {
1143: $lastname = '_';
1144: }
1145: if ($firstname eq '') {
1146: $firstname = '_';
1147: }
1148: unless (defined($namesort{$lastname})) {
1149: %{$namesort{$lastname}} = ();
1150: }
1151: my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'};
1152: $postcounts{$poster} ++;
1153: if (defined($namesort{$lastname}{$firstname})) {
1154: if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) {
1155: push @{$namesort{$lastname}{$firstname}}, $poster;
1156: }
1157: } else {
1158: @{$namesort{$lastname}{$firstname}} = ("$poster");
1159: }
1160: }
1161: }
1162: }
1163: }
1164: $r->print(<<END);
1165: <html>
1166: <head>
1167: <title>$lt{'diso'}</title>
1168: <meta http-equiv="pragma" content="no-cache" />
1169: </head>
1170: $bodytag
1171: <form name="pickpostersform" method="post">
1172: <table border="0">
1173: <tr>
1174: <td bgcolor="#777777">
1175: <table border="0" cellpadding="3">
1176: <tr bgcolor="#e6ffff">
1177: <td><b>No.</b></td>
1178: <td><b>Select</b></td>
1179: <td><b>Fullname</b><font color="#999999">(Username/domain)</font></td>
1180: <td><b>Posts</td>
1181: </tr>
1182: END
1183: my $count = 0;
1184: foreach my $last (sort keys %namesort) {
1185: foreach my $first (sort keys %{$namesort{$last}}) {
1186: foreach (sort @{$namesort{$last}{$first}}) {
1187: my ($uname,$udom) = split/:/,$_;
1188: if (!$uname || !$udom) {
1189: next;
1190: } else {
1191: $count ++;
1192: $r->print('<tr bgcolor="#ffffe6"><td align="right">'.$count.'</td><td align="center"><input name="stuinfo" type="checkbox" value="'.$_.'" /></td><td>'.$last.', '.$first.' ('.$uname.','.$udom.')</td><td>'.$postcounts{$_}.'</td></tr>');
1193: }
1194: }
1195: }
1196: }
1197: $r->print(<<END);
1198: </table>
1199: </td>
1200: </tr>
1201: </table>
1202: <br />
1203: <input type="hidden" name="sortposts" value="$sortposts" />
1204: <input type="hidden" name="userpick" value="$symb" />
1205: <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" />
1206: </form>
1207: </body>
1208: </html>
1209: END
1210: }
1211:
1212: sub fail_redirect {
1213: my ($r,$feedurl) = @_;
1214: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
1215: $r->print (<<ENDFAILREDIR);
1216: <html>
1217: <head><title>Feedback not sent</title>
1218: <meta http-equiv="pragma" content="no-cache" />
1219: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
1220: </head>
1221: <body bgcolor="#FFFFFF">
1222: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
1223: <b>Sorry, no recipients ...</b>
1224: </body>
1225: </html>
1226: ENDFAILREDIR
1227: }
1228:
1229: sub redirect_back {
1230: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_;
1231: my $sorttag = '';
1232: my $roletag = '';
1233: my $statustag = '';
1234: my $sectag = '';
1235: my $userpicktag = '';
1236: my $qrystr = '';
1237: my $prevtag = '';
1238: # backward compatibility (bulletin boards used to be 'wrapped')
1239: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1240: $feedurl=~s|^/adm/wrapper||;
1241: }
1242: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
1243: if ($previous > 0) {
1244: $qrystr = 'previous='.$previous;
1245: if ($feedurl =~ /\?register=1/) {
1246: $feedurl .= '&'.$qrystr;
1247: } else {
1248: $feedurl .= '?'.$qrystr;
1249: }
1250: $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
1251: }
1252: if (defined($sort)) {
1253: my $sortqry = 'sortposts='.$sort;
1254: if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
1255: $feedurl .= '&'.$sortqry;
1256: } else {
1257: $feedurl .= '?'.$sortqry;
1258: }
1259: $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />';
1260: if ( (defined($numpicks)) && ($numpicks > 0) ) {
1261: my $userpickqry = 'totposters='.$numpicks;
1262: $feedurl .= '&'.$userpickqry;
1263: $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
1264: } else {
1265: my $roleqry = 'rolefilter='.$rolefilter;
1266: $feedurl .= '&'.$roleqry;
1267: $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
1268: $feedurl .= '&statusfilter='.$statusfilter;
1269: $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
1270: $feedurl .= '§ionpick='.$secpick;
1271: $sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />';
1272: }
1273: }
1274: $r->print (<<ENDREDIR);
1275: <html>
1276: <head>
1277: <title>Feedback sent</title>
1278: <meta http-equiv="pragma" content="no-cache" />
1279: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
1280: </head>
1281: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
1282: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
1283: $typestyle
1284: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
1285: <font color="red">$status</font>
1286: <form name="reldt" action="$feedurl" target="loncapaclient">
1287: $prevtag
1288: $sorttag
1289: $statustag
1290: $roletag
1291: $sectag
1292: $userpicktag
1293: </form>
1294: </body>
1295: </html>
1296: ENDREDIR
1297: }
1298:
1299: sub no_redirect_back {
1300: my ($r,$feedurl) = @_;
1301: $r->print (<<ENDNOREDIR);
1302: <html>
1303: <head><title>Feedback not sent</title>
1304: <meta http-equiv="pragma" content="no-cache" />
1305: ENDNOREDIR
1306:
1307: if ($feedurl!~/^\/adm\/feedback/) {
1308: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
1309: }
1310:
1311: $r->print (<<ENDNOREDIRTWO);
1312: </head>
1313: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
1314: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
1315: <b>Sorry, no feedback possible on this resource ...</b>
1316: </body>
1317: </html>
1318: ENDNOREDIRTWO
1319: }
1320:
1321: sub screen_header {
1322: my ($feedurl) = @_;
1323: my $msgoptions='';
1324: my $discussoptions='';
1325: unless ($ENV{'form.replydisc'}) {
1326: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
1327: $msgoptions=
1328: '<p><input type="checkbox" name="author" /> '.
1329: &mt('Feedback to resource author').'</p>';
1330: }
1331: if (&feedback_available(1)) {
1332: $msgoptions.=
1333: '<br /><input type="checkbox" name="question" /> '.
1334: &mt('Question about resource content');
1335: }
1336: if (&feedback_available(0,1)) {
1337: $msgoptions.=
1338: '<br /><input type="checkbox" name="course" /> '.
1339: &mt('Question/Comment/Feedback about course content');
1340: }
1341: if (&feedback_available(0,0,1)) {
1342: $msgoptions.=
1343: '<br /><input type="checkbox" name="policy" /> '.
1344: &mt('Question/Comment/Feedback about course policy');
1345: }
1346: }
1347: if ($ENV{'request.course.id'}) {
1348: if (&discussion_open() &&
1349: &Apache::lonnet::allowed('pch',
1350: $ENV{'request.course.id'}.
1351: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
1352: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
1353: ($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
1354: &mt('Contribution to course discussion of resource');
1355: $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
1356: &mt('Anonymous contribution to course discussion of resource').
1357: ' <i>('.&mt('name only visible to course faculty').')</i>';
1358: }
1359: }
1360: if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
1361: if ($discussoptions) {
1362: $discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
1363: return $msgoptions.$discussoptions;
1364: }
1365:
1366: sub resource_output {
1367: my ($feedurl) = @_;
1368: my $usersaw=&Apache::lonnet::ssi_body($feedurl);
1369: $usersaw=~s/\<body[^\>]*\>//gi;
1370: $usersaw=~s/\<\/body\>//gi;
1371: $usersaw=~s/\<html\>//gi;
1372: $usersaw=~s/\<\/html\>//gi;
1373: $usersaw=~s/\<head\>//gi;
1374: $usersaw=~s/\<\/head\>//gi;
1375: $usersaw=~s/action\s*\=/would_be_action\=/gi;
1376: return $usersaw;
1377: }
1378:
1379: sub clear_out_html {
1380: my ($message,$override)=@_;
1381: unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
1382: my $cid=$ENV{'request.course.id'};
1383: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
1384: ($override)) {
1385: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG>
1386: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB>
1387: # <SUP>
1388: my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
1389: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
1390: M=>1, SUB=>1, SUP=>1, SPAN=>1,
1391: H1=>1, H2=>1, H3=>1, H4=>1, H5=>1);
1392:
1393: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
1394: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge;
1395: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
1396: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge;
1397: } else {
1398: $message=~s/\</\<\;/g;
1399: $message=~s/\>/\>\;/g;
1400: }
1401: return $message;
1402: }
1403:
1404: sub assemble_email {
1405: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
1406: my $email=<<"ENDEMAIL";
1407: Refers to <a href="$feedurl">$feedurl</a>
1408:
1409: $message
1410: ENDEMAIL
1411: my $citations=<<"ENDCITE";
1412: <h2>Previous attempts of student (if applicable)</h2>
1413: $prevattempts
1414: <br /><hr />
1415: <h2>Original screen output (if applicable)</h2>
1416: $usersaw
1417: <h2>Correct Answer(s) (if applicable)</h2>
1418: $useranswer
1419: ENDCITE
1420: return ($email,$citations);
1421: }
1422:
1423: sub secapply {
1424: my $rec=shift;
1425: my $defaultflag=shift;
1426: $rec=~s/\s+//g;
1427: $rec=~s/\@/\:/g;
1428: my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
1429: if ($sections) {
1430: foreach (split(/\;/,$sections)) {
1431: if (($_ eq $ENV{'request.course.sec'}) ||
1432: ($defaultflag && ($_ eq '*'))) {
1433: return $adr;
1434: }
1435: }
1436: } else {
1437: return $rec;
1438: }
1439: return '';
1440: }
1441:
1442: sub decide_receiver {
1443: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
1444: my $typestyle='';
1445: my %to=();
1446: if ($ENV{'form.author'}||$author) {
1447: $typestyle.='Submitting as Author Feedback<br>';
1448: $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
1449: $to{$2.':'.$1}=1;
1450: }
1451: if ($ENV{'form.question'}||$question) {
1452: $typestyle.='Submitting as Question<br>';
1453: foreach (split(/\,/,
1454: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
1455: ) {
1456: my $rec=&secapply($_,$defaultflag);
1457: if ($rec) { $to{$rec}=1; }
1458: }
1459: }
1460: if ($ENV{'form.course'}||$course) {
1461: $typestyle.='Submitting as Comment<br />';
1462: foreach (split(/\,/,
1463: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
1464: ) {
1465: my $rec=&secapply($_,$defaultflag);
1466: if ($rec) { $to{$rec}=1; }
1467: }
1468: }
1469: if ($ENV{'form.policy'}||$policy) {
1470: $typestyle.='Submitting as Policy Feedback<br />';
1471: foreach (split(/\,/,
1472: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
1473: ) {
1474: my $rec=&secapply($_,$defaultflag);
1475: if ($rec) { $to{$rec}=1; }
1476: }
1477: }
1478: if ((scalar(%to) eq '0') && (!$defaultflag)) {
1479: ($typestyle,%to)=
1480: &decide_receiver($feedurl,$author,$question,$course,$policy,1);
1481: }
1482: return ($typestyle,%to);
1483: }
1484:
1485: sub feedback_available {
1486: my ($question,$course,$policy)=@_;
1487: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
1488: return scalar(%to);
1489: }
1490:
1491: sub send_msg {
1492: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
1493: my $status='';
1494: my $sendsomething=0;
1495: foreach (keys %to) {
1496: if ($_) {
1497: my $declutter=&Apache::lonnet::declutter($feedurl);
1498: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
1499: 'Feedback ['.$declutter.']',$email,$citations,$feedurl,
1500: $attachmenturl)=~/ok/) {
1501: $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
1502: } else {
1503: $sendsomething++;
1504: }
1505: }
1506: }
1507:
1508: my %record=&Apache::lonnet::restore('_feedback');
1509: my ($temp)=keys %record;
1510: unless ($temp=~/^error\:/) {
1511: my %newrecord=();
1512: $newrecord{'resource'}=$feedurl;
1513: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1514: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
1515: $status.='<br />'.&mt('Not registered').'<br />';
1516: }
1517: }
1518:
1519: return ($status,$sendsomething);
1520: }
1521:
1522: sub adddiscuss {
1523: my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
1524: my $status='';
1525: if (&discussion_open() &&
1526: &Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
1527: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
1528:
1529: my %contrib=('message' => $email,
1530: 'sendername' => $ENV{'user.name'},
1531: 'senderdomain' => $ENV{'user.domain'},
1532: 'screenname' => $ENV{'environment.screenname'},
1533: 'plainname' => $ENV{'environment.firstname'}.' '.
1534: $ENV{'environment.middlename'}.' '.
1535: $ENV{'environment.lastname'}.' '.
1536: $ENV{'enrironment.generation'},
1537: 'attachmenturl'=> $attachmenturl,
1538: 'subject' => $subject);
1539: if ($ENV{'form.replydisc'}) {
1540: $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
1541: }
1542: if ($anon) {
1543: $contrib{'anonymous'}='true';
1544: }
1545: if (($symb) && ($email)) {
1546: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
1547: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
1548: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1549: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1550: my %storenewentry=($symb => time);
1551: $status.='<br />'.&mt('Updating discussion time').': '.
1552: &Apache::lonnet::put('discussiontimes',\%storenewentry,
1553: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1554: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1555: }
1556: my %record=&Apache::lonnet::restore('_discussion');
1557: my ($temp)=keys %record;
1558: unless ($temp=~/^error\:/) {
1559: my %newrecord=();
1560: $newrecord{'resource'}=$symb;
1561: $newrecord{'subnumber'}=$record{'subnumber'}+1;
1562: $status.='<br />'.&mt('Registering').': '.
1563: &Apache::lonnet::cstore(\%newrecord,'_discussion');
1564: }
1565: } else {
1566: $status.='Failed.';
1567: }
1568: return $status.'<br />';
1569: }
1570:
1571: # ----------------------------------------------------------- Preview function
1572:
1573: sub show_preview {
1574: my $r=shift;
1575: my $message=&clear_out_html($ENV{'form.comment'});
1576: $message=~s/\n/\<br \/\>/g;
1577: $message=&Apache::lontexconvert::msgtexconverted($message);
1578: my $subject=&clear_out_html($ENV{'form.subject'});
1579: $subject=~s/\n/\<br \/\>/g;
1580: $subject=&Apache::lontexconvert::msgtexconverted($subject);
1581: $r->print('<table border="2"><tr><td>'.
1582: '<b>Subject:</b> '.$subject.'<br /><br />'.
1583: $message.'</td></tr></table>');
1584: }
1585:
1586: sub generate_preview_button {
1587: my $pre=&mt("Show Preview");
1588: return(<<ENDPREVIEW);
1589: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
1590: <input type="hidden" name="subject">
1591: <input type="hidden" name="comment" />
1592: <input type="button" value="$pre"
1593: onClick="document.mailform.onsubmit();this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
1594: </form>
1595: ENDPREVIEW
1596: }
1597:
1598: sub handler {
1599: my $r = shift;
1600: if ($r->header_only) {
1601: &Apache::loncommon::content_type($r,'text/html');
1602: $r->send_http_header;
1603: return OK;
1604: }
1605:
1606: # --------------------------- Get query string for limited number of parameters
1607:
1608: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1609: ['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff','onlyunread','allposts','previous','markread','markonread','markondisp','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick']);
1610: if ($ENV{'form.posterlist'}) {
1611: &Apache::loncommon::content_type($r,'text/html');
1612: $r->send_http_header;
1613: my $symb=$ENV{'form.posterlist'};
1614: my $sortposts = $ENV{'form.sortposts'};
1615: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1616: my $previous=$ENV{'form.previous'};
1617: my $feedurl = &Apache::lonnet::clutter($url);
1618: # backward compatibility (bulletin boards used to be 'wrapped')
1619: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1620: $feedurl=~s|^/adm/wrapper||;
1621: }
1622: &print_showposters($r,$symb,$previous,$feedurl,$sortposts);
1623: return OK;
1624: }
1625: if ($ENV{'form.userpick'}) {
1626: &Apache::loncommon::content_type($r,'text/html');
1627: $r->send_http_header;
1628: my $symb=$ENV{'form.userpick'};
1629: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1630: my $previous=$ENV{'form.previous'};
1631: # backward compatibility (bulletin boards used to be 'wrapped')
1632: my $ressymb=$symb;
1633: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1634: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1635: }
1636: my $sort=$ENV{'form.sortposts'};
1637: my @posters = ();
1638: if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') {
1639: @posters = $ENV{'form.stuinfo'};
1640: } else {
1641: $posters[0] = $ENV{'form.stuinfo'};
1642: }
1643: my $numpicks = @posters;
1644: if (defined($ENV{'form.userpick'})) {
1645: my %discinfo = ();
1646: $discinfo{$ressymb.'_userpick'} = join('&',@posters);
1647: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
1648: }
1649: my $feedurl = &Apache::lonnet::clutter($url);
1650: # backward compatibility (bulletin boards used to be 'wrapped')
1651: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1652: $feedurl=~s|^/adm/wrapper||;
1653: }
1654: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks);
1655: return OK;
1656: }
1657: if ($ENV{'form.applysort'}) {
1658: &Apache::loncommon::content_type($r,'text/html');
1659: $r->send_http_header;
1660: my $symb=$ENV{'form.applysort'};
1661: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1662: my $previous=$ENV{'form.previous'};
1663: my $sort = $ENV{'form.sortposts'};
1664: my $rolefilter = $ENV{'form.rolefilter'};
1665: my $statusfilter = $ENV{'form.statusfilter'};
1666: my $secpick = $ENV{'form.sectionpick'};
1667: my $feedurl = &Apache::lonnet::clutter($url);
1668: # backward compatibility (bulletin boards used to be 'wrapped')
1669: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1670: $feedurl=~s|^/adm/wrapper||;
1671: }
1672: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick);
1673: return OK;
1674: } elsif ($ENV{'form.sortfilter'}) {
1675: &Apache::loncommon::content_type($r,'text/html');
1676: $r->send_http_header;
1677: my $symb=$ENV{'form.sortfilter'};
1678: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1679: my $previous=$ENV{'form.previous'};
1680: my $feedurl = &Apache::lonnet::clutter($url);
1681: # backward compatibility (bulletin boards used to be 'wrapped')
1682: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1683: $feedurl=~s|^/adm/wrapper||;
1684: }
1685: &print_sortfilter_options($r,$symb,$previous,$feedurl);
1686: return OK;
1687: } elsif ($ENV{'form.navmaps'}) {
1688: my %discinfo = ();
1689: my @resources = ();
1690: if ($ENV{'form.navmaps'} =~ /:/) {
1691: @resources = split/:/,$ENV{'form.navmaps'};
1692: } else {
1693: @resources = ("$ENV{'form.navmaps'}");
1694: }
1695: my $numitems = @resources;
1696: my $feedurl = '/adm/navmaps';
1697: if ($ENV{'form.navurl'}) {
1698: $feedurl .= '?'.$ENV{'form.navurl'};
1699: }
1700: my %lt = &Apache::lonlocal::texthash(
1701: 'mnpa' => 'Marked "New" posts as read in a total of',
1702: 'robb' => 'resources/bulletin boards.'
1703: );
1704: foreach (@resources) {
1705: # backward compatibility (bulletin boards used to be 'wrapped')
1706: my $ressymb=$_;
1707: if ($ressymb =~ m/bulletin___\d+___/) {
1708: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1709: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
1710: }
1711: }
1712: my $lastkey = $ressymb.'_lastread';
1713: $discinfo{$lastkey} = time;
1714: }
1715: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
1716: &Apache::loncommon::content_type($r,'text/html');
1717: $r->send_http_header;
1718: $r->print (<<ENDREDIR);
1719: <html>
1720: <head>
1721: <title>New posts marked as read</title>
1722: <meta http-equiv="pragma" content="no-cache" />
1723: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
1724: </head>
1725: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
1726: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
1727: <b>$lt{'mnpa'} $numitems $lt{'robb'}</b>
1728: <form name="reldt" action="$feedurl" target="loncapaclient">
1729: </form>
1730: </body>
1731: </html>
1732: ENDREDIR
1733: return OK;
1734: } elsif ($ENV{'form.modifydisp'}) {
1735: &Apache::loncommon::content_type($r,'text/html');
1736: $r->send_http_header;
1737: my $symb=$ENV{'form.modifydisp'};
1738: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1739: my $previous=$ENV{'form.previous'};
1740: my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'};
1741: my $feedurl = &Apache::lonnet::clutter($url);
1742: # backward compatibility (bulletin boards used to be 'wrapped')
1743: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1744: $feedurl=~s|^/adm/wrapper||;
1745: }
1746: &print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl);
1747: return OK;
1748: } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
1749: &Apache::loncommon::content_type($r,'text/html');
1750: $r->send_http_header;
1751: my $previous=$ENV{'form.previous'};
1752: my ($map,$ind,$url);
1753: if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) {
1754: # ---------------------- Modify setting for identification of 'NEW' posts in this discussion
1755: my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'};
1756: my $ressymb = $symb;
1757: ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1758: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1759: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1760: }
1761: my %discinfo = ();
1762: my $lastkey = $ressymb.'_lastread';
1763: my $ondispkey = $ressymb.'_markondisp';
1764: if ($ENV{'form.markondisp'}) {
1765: $discinfo{$lastkey} = time;
1766: $discinfo{$ondispkey} = 1;
1767: } elsif ($ENV{'form.markonread'}) {
1768: if ( $previous > 0 ) {
1769: $discinfo{$lastkey} = $previous;
1770: }
1771: $discinfo{$ondispkey} = 0;
1772: }
1773: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
1774: }
1775: if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
1776: # ----------------------------------------------------------------- Modify display setting for this discussion
1777: my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
1778: my $ressymb = $symb;
1779: ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1780: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1781: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1782: }
1783: my %discinfo = ();
1784: if ($ENV{'form.allposts'}) {
1785: $discinfo{$ressymb.'_showonlyunread'} = 0;
1786: } elsif ($ENV{'form.onlyunread'}) {
1787: $discinfo{$ressymb.'_showonlyunread'} = 1;
1788: }
1789: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
1790: }
1791: if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
1792: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous);
1793: } else {
1794: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0');
1795: }
1796: return OK;
1797: } elsif ($ENV{'form.markread'}) {
1798: # ----------------------------------------------------------------- Mark new posts as read
1799: &Apache::loncommon::content_type($r,'text/html');
1800: $r->send_http_header;
1801: my $symb=$ENV{'form.markread'};
1802: my $ressymb = $symb;
1803: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1804: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1805: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1806: }
1807: my %discinfo = ();
1808: my $lastkey = $ressymb.'_lastread';
1809: $discinfo{$lastkey} = time;
1810: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
1811: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0');
1812: return OK;
1813: } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
1814: # ----------------------------------------------------------------- Hide/unhide
1815: &Apache::loncommon::content_type($r,'text/html');
1816: $r->send_http_header;
1817:
1818: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
1819:
1820: my ($symb,$idx)=split(/\:\:\:/,$entry);
1821: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1822:
1823: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
1824: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1825: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1826:
1827:
1828: my $currenthidden=$contrib{'hidden'};
1829:
1830: if ($ENV{'form.hide'}) {
1831: $currenthidden.='.'.$idx.'.';
1832: } else {
1833: $currenthidden=~s/\.$idx\.//g;
1834: }
1835: my %newhash=('hidden' => $currenthidden);
1836:
1837: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
1838: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1839: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1840:
1841: &redirect_back($r,&Apache::lonnet::clutter($url),
1842: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
1843: } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
1844: &Apache::loncommon::content_type($r,'text/html');
1845: $r->send_http_header;
1846: if ($ENV{'form.threadedon'}) {
1847: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
1848: &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
1849: } else {
1850: &Apache::lonnet::del('environment',['threadeddiscussion']);
1851: &Apache::lonnet::delenv('environment\.threadeddiscussion');
1852: }
1853: my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
1854: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1855: &redirect_back($r,&Apache::lonnet::clutter($url),
1856: &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
1857: } elsif ($ENV{'form.deldisc'}) {
1858: # --------------------------------------------------------------- Hide for good
1859: &Apache::loncommon::content_type($r,'text/html');
1860: $r->send_http_header;
1861:
1862: my $entry=$ENV{'form.deldisc'};
1863:
1864: my ($symb,$idx)=split(/\:\:\:/,$entry);
1865: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
1866:
1867: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
1868: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1869: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1870:
1871:
1872: my $currentdeleted=$contrib{'deleted'};
1873:
1874: $currentdeleted.='.'.$idx.'.';
1875:
1876: my %newhash=('deleted' => $currentdeleted);
1877:
1878: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
1879: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1880: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1881:
1882: &redirect_back($r,&Apache::lonnet::clutter($url),
1883: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
1884: } elsif ($ENV{'form.preview'}) {
1885: # -------------------------------------------------------- User wants a preview
1886: $r->content_type('text/html');
1887: $r->send_http_header;
1888: &show_preview($r);
1889: } else {
1890: # ------------------------------------------------------------- Normal feedback
1891: my $feedurl=$ENV{'form.postdata'};
1892: $feedurl=~s/^http\:\/\///;
1893: $feedurl=~s/^$ENV{'SERVER_NAME'}//;
1894: $feedurl=~s/^$ENV{'HTTP_HOST'}//;
1895: $feedurl=~s/\?.+$//;
1896:
1897: my $symb;
1898: if ($ENV{'form.replydisc'}) {
1899: $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
1900: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
1901: $feedurl=&Apache::lonnet::clutter($url);
1902: } else {
1903: $symb=&Apache::lonnet::symbread($feedurl);
1904: }
1905: unless ($symb) {
1906: $symb=$ENV{'form.symb'};
1907: if ($symb) {
1908: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
1909: $feedurl=&Apache::lonnet::clutter($url);
1910: }
1911: }
1912: my $goahead=1;
1913: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1914: unless ($symb) { $goahead=0; }
1915: }
1916: # backward compatibility (bulletin boards used to be 'wrapped')
1917: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1918: $feedurl=~s|^/adm/wrapper||;
1919: }
1920: if ($goahead) {
1921: # Go ahead with feedback, no ambiguous reference
1922: &Apache::loncommon::content_type($r,'text/html');
1923: $r->send_http_header;
1924:
1925: if (
1926: (
1927: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
1928: )
1929: ||
1930: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
1931: ||
1932: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
1933: ) {
1934: # --------------------------------------------------- Print login screen header
1935: unless ($ENV{'form.sendit'}) {
1936: my $options=&screen_header($feedurl);
1937: if ($options) {
1938: &mail_screen($r,$feedurl,$options);
1939: } else {
1940: &fail_redirect($r,$feedurl);
1941: }
1942: } else {
1943:
1944: # Get previous user input
1945: my $prevattempts=&Apache::loncommon::get_previous_attempt(
1946: $symb,$ENV{'user.name'},$ENV{'user.domain'},
1947: $ENV{'request.course.id'});
1948:
1949: # Get output from resource
1950: my $usersaw=&resource_output($feedurl);
1951:
1952: # Get resource answer (need to allow student to view grades for this to work)
1953: &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
1954: my $useranswer=&Apache::loncommon::get_student_answers(
1955: $symb,$ENV{'user.name'},$ENV{'user.domain'},
1956: $ENV{'request.course.id'});
1957: &Apache::lonnet::delenv('allowed.vgr');
1958: # Get attachments, if any, and not too large
1959: my $attachmenturl='';
1960: if ($ENV{'form.attachment.filename'}) {
1961: unless (length($ENV{'form.attachment'})>131072) {
1962: $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback');
1963: }
1964: }
1965: # Filter HTML out of message (could be nasty)
1966: my $message=&clear_out_html($ENV{'form.comment'});
1967:
1968: # Assemble email
1969: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
1970: $usersaw,$useranswer);
1971:
1972: # Who gets this?
1973: my ($typestyle,%to) = &decide_receiver($feedurl);
1974:
1975: # Actually send mail
1976: my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
1977: $attachmenturl,%to);
1978:
1979: # Discussion? Store that.
1980:
1981: my $numpost=0;
1982: if ($ENV{'form.discuss'}) {
1983: my $subject = &clear_out_html($ENV{'form.subject'});
1984: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
1985: $numpost++;
1986: }
1987:
1988: if ($ENV{'form.anondiscuss'}) {
1989: my $subject = &clear_out_html($ENV{'form.subject'});
1990: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
1991: $numpost++;
1992: }
1993:
1994:
1995: # Receipt screen and redirect back to where came from
1996: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
1997:
1998: }
1999: } else {
2000: # Unable to give feedback
2001: &no_redirect_back($r,$feedurl);
2002: }
2003: } else {
2004: # Ambiguous Problem Resource
2005: if ( &Apache::lonnet::mod_perl_version() == 2 ) {
2006: &Apache::lonnet::cleanenv();
2007: }
2008: $r->internal_redirect('/adm/ambiguous');
2009: }
2010: }
2011: return OK;
2012: }
2013:
2014: 1;
2015: __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