File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.128:
download - view:
text,
annotated -
select for diffs
Mon Oct 4 21:35:52 2004 UTC (19 years, 7 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Fix bug #3515. identification of resources with discussion now occurs in lonfeedback after 'Mark all posts as read call'. To simplify further we might want to eliminate the extra code in lonnavmaps, called when sort is by "Has Discussion" and always do the resource->has_discussion call in lonfeedback.
1: # The LearningOnline Network
2: # Feedback
3: #
4: # $Id: lonfeedback.pm,v 1.128 2004/10/04 21:35:52 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: use Apache::lonnavmaps;
40: use HTML::LCParser();
41: use Apache::lonspeller();
42: use Cwd;
43:
44: sub discussion_open {
45: my ($status,$symb)=@_;
46: if (defined($status) &&
47: !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
48: || $status eq 'OPEN')) {
49: return 0;
50: }
51: my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb);
52: if (defined($close) && $close ne '' && $close < time) {
53: return 0;
54: }
55: return 1;
56: }
57:
58: sub discussion_visible {
59: my ($status)=@_;
60: if (not &discussion_open($status)) {
61: my $hidden=&Apache::lonnet::EXT('resource.0.discusshide');
62: if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) {
63: if (!$ENV{'request.role.adv'}) { return 0; }
64: }
65: }
66: return 1;
67: }
68:
69: sub list_discussion {
70: my ($mode,$status,$symb)=@_;
71: my $outputtarget=$ENV{'form.grade_target'};
72: if (defined($ENV{'form.export'})) {
73: if($ENV{'form.export'}) {
74: $outputtarget = 'export';
75: }
76: }
77: if (not &discussion_visible($status)) { return ''; }
78: my @bgcols = ("#cccccc","#eeeeee");
79: my $discussiononly=0;
80: if ($mode eq 'board') { $discussiononly=1; }
81: unless ($ENV{'request.course.id'}) { return ''; }
82: my $crs='/'.$ENV{'request.course.id'};
83: my $cid=$ENV{'request.course.id'};
84: if ($ENV{'request.course.sec'}) {
85: $crs.='_'.$ENV{'request.course.sec'};
86: }
87: $crs=~s/\_/\//g;
88: unless ($symb) {
89: $symb=&Apache::lonnet::symbread();
90: }
91: unless ($symb) { return ''; }
92: my %usernamesort = ();
93: my %namesort =();
94: my %subjectsort = ();
95: # backward compatibility (bulletin boards used to be 'wrapped')
96: my $ressymb=$symb;
97: if ($mode eq 'board') {
98: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
99: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
100: }
101: }
102:
103: # Get discussion display settings for this discussion
104: my $lastkey = $ressymb.'_lastread';
105: my $showkey = $ressymb.'_showonlyunread';
106: my $markkey = $ressymb.'_showonlyunmark',
107: my $visitkey = $ressymb.'_visit';
108: my $ondispkey = $ressymb.'_markondisp';
109: my $userpickkey = $ressymb.'_userpick';
110: my $toggkey = $ressymb.'_readtoggle';
111: my $readkey = $ressymb.'_read';
112:
113: my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$ENV{'user.domain'},$ENV{'user.name'});
114: my %discinfo = ();
115: my $showonlyunread = 0;
116: my $showunmark = 0;
117: my $markondisp = 0;
118: my $prevread = 0;
119: my $previous = 0;
120: my $visit = 0;
121: my $newpostsflag = 0;
122: my @posters = split/\&/,$dischash{$userpickkey};
123:
124: # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts.
125: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']);
126: my $sortposts = $ENV{'form.sortposts'};
127: my $rolefilter = $ENV{'form.rolefilter'};
128: my $statusfilter = $ENV{'form.statusfilter'};
129: my $sectionpick = $ENV{'form.sectionpick'};
130: my $totposters = $ENV{'form.totposters'};
131: $previous = $ENV{'form.previous'};
132: if ($previous > 0) {
133: $prevread = $previous;
134: } elsif (defined($dischash{$lastkey})) {
135: unless ($dischash{$lastkey} eq '') {
136: $prevread = $dischash{$lastkey};
137: }
138: }
139:
140: # Get information about students and non-students in course for filtering display of posts
141: my %roleshash = ();
142: my %roleinfo = ();
143: if ($rolefilter) {
144: %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
145: foreach (keys %roleshash) {
146: my ($role,$uname,$udom,$sec) = split/:/,$_;
147: my ($end,$start) = split/:/,$roleshash{$_};
148: my $now = time;
149: my $status = 'Active';
150: if (($now < $start) || ($end > 0 && $now > $end)) {
151: $status = 'Expired';
152: }
153: push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
154: }
155: my ($classlist) = &Apache::loncoursedata::get_classlist(
156: $ENV{'request.course.id'},
157: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
158: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
159: my $sec_index = &Apache::loncoursedata::CL_SECTION();
160: my $status_index = &Apache::loncoursedata::CL_STATUS();
161: while (my ($student,$data) = each %$classlist) {
162: my ($section,$status) = ($data->[$sec_index],
163: $data->[$status_index]);
164: push @{$roleinfo{$student}}, 'st:'.$section.':'.$status;
165: }
166: }
167:
168: # Get discussion display default settings for user
169: if ($ENV{'environment.discdisplay'} eq 'unread') {
170: $showonlyunread = 1;
171: }
172: if ($ENV{'environment.discmarkread'} eq 'ondisp') {
173: $markondisp = 1;
174: }
175:
176: # Override user's default if user specified display setting for this discussion
177: if (defined($dischash{$ondispkey})) {
178: unless ($dischash{$ondispkey} eq '') {
179: $markondisp = $dischash{$ondispkey};
180: }
181: }
182: if ($markondisp) {
183: $discinfo{$lastkey} = time;
184: }
185:
186: if (defined($dischash{$showkey})) {
187: unless ($dischash{$showkey} eq '') {
188: $showonlyunread = $dischash{$showkey};
189: }
190: }
191:
192: if (defined($dischash{$markkey})) {
193: unless ($dischash{$markkey} eq '') {
194: $showunmark = $dischash{$markkey};
195: }
196: }
197:
198: if (defined($dischash{$visitkey})) {
199: unless ($dischash{$visitkey} eq '') {
200: $visit = $dischash{$visitkey};
201: }
202: }
203: $visit ++;
204:
205: my $seeid=&Apache::lonnet::allowed('rin',$crs);
206: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
207: && ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
208: my @discussionitems=();
209: my %shown = ();
210: my @posteridentity=();
211:
212: my $current=0;
213: my $visible=0;
214: my @depth=();
215: my @replies = ();
216: my %alldiscussion=();
217: my %imsitems=();
218: my %imsfiles=();
219: my %notshown = ();
220: my %newitem = ();
221: my $maxdepth=0;
222:
223: my $target='';
224: unless ($ENV{'browser.interface'} eq 'textual' ||
225: $ENV{'environment.remote'} eq 'off' ) {
226: $target='target="LONcom"';
227: }
228:
229: my $now = time;
230: $discinfo{$visitkey} = $visit;
231:
232: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
233: &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget);
234:
235: my $discussion='';
236: my $manifestfile;
237: my $manifestok=0;
238: my $tempexport;
239: my $imsresources;
240: my $copyresult;
241:
242: my $function = &Apache::loncommon::get_users_function();
243: my $color = &Apache::loncommon::designparm($function.'.tabbg',
244: $ENV{'user.domain'});
245: my %lt = &Apache::lonlocal::texthash(
246: 'cuse' => 'Current discussion settings',
247: 'allposts' => 'All posts',
248: 'unread' => 'New posts only',
249: 'unmark' => 'Unread only',
250: 'ondisp' => 'Once displayed',
251: 'onmark' => 'Once marked not NEW',
252: 'toggoff' => 'Off',
253: 'toggon' => 'On',
254: 'disa' => 'Posts to be displayed',
255: 'npce' => 'Posts cease to be marked "NEW"',
256: 'epcb' => 'Each post can be toggled read/unread',
257: 'chgt' => 'Change',
258: 'disp' => 'Display',
259: 'nolo' => 'Not new',
260: 'togg' => 'Toggle read/unread',
261: );
262:
263: my $currdisp = $lt{'allposts'};
264: my $currmark = $lt{'onmark'};
265: my $currtogg = $lt{'toggoff'};
266: my $dispchange = $lt{'unread'};
267: my $markchange = $lt{'ondisp'};
268: my $toggchange = $lt{'toggon'};
269: my $chglink = '/adm/feedback?modifydisp='.$ressymb;
270: my $displinkA = 'onlyunread';
271: my $displinkB = 'onlyunmark';
272: my $marklink = 'markondisp';
273: my $togglink = 'toggon';
274:
275: if ($markondisp) {
276: $currmark = $lt{'ondisp'};
277: $markchange = $lt{'onmark'};
278: $marklink = 'markonread';
279: }
280:
281: if ($showonlyunread) {
282: $currdisp = $lt{'unread'};
283: $dispchange = $lt{'allposts'};
284: $displinkA = 'allposts';
285: }
286:
287: if ($showunmark) {
288: $currdisp = $lt{'unmark'};
289: $dispchange = $lt{'unmark'};
290: $displinkA='allposts';
291: $displinkB='onlyunread';
292: $showonlyunread = 0;
293: }
294:
295: if ($dischash{$toggkey}) {
296: $currtogg = $lt{'toggon'};
297: $toggchange = $lt{'toggoff'};
298: $togglink = 'toggoff';
299: }
300:
301: $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink;
302:
303: if ($newpostsflag) {
304: $chglink .= '&previous='.$prevread;
305: }
306:
307: if ($visible) {
308: # Print the discusssion
309: if ($outputtarget eq 'tex') {
310: $discussion.='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
311: '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'.
312: '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'.
313: '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
314: '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}</tex>';
315: } elsif ($outputtarget eq 'export') {
316: # Create temporary directory if this is an export
317: my $now = time;
318: $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports';
319: if (!-e $tempexport) {
320: mkdir($tempexport,0700);
321: }
322: $tempexport .= '/'.$now;
323: if (!-e $tempexport) {
324: mkdir($tempexport,0700);
325: }
326: $tempexport .= '/'.$ENV{'user.domain'}.'_'.$ENV{'user.name'};
327: if (!-e $tempexport) {
328: mkdir($tempexport,0700);
329: }
330: # open manifest file
331: my $manifest = '/imsmanifest.xml';
332: my $manifestfilename = $tempexport.$manifest;
333: if ($manifestfile = Apache::File->new('>'.$manifestfilename)) {
334: $manifestok=1;
335: print $manifestfile qq|
336: <?xml version="1.0" encoding="UTF-8"?>
337: <manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"
338: xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
339: identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1
340: imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">
341: <organizations default="$ressymb">
342: <organization identifier="$ressymb">
343: <title>Discussion for $ressymb</title>\n|;
344: } else {
345: $discussion .= 'An error occurred opening the manifest file.<br />';
346: }
347: } else {
348: my $colspan=$maxdepth+1;
349: $discussion.= qq|
350: <script>
351: function studentdelete (symb,idx,newflag,previous) {
352: var symbparm = symb+':::'+idx
353: var prevparm = ""
354: if (newflag == 1) {
355: prevparm = "&previous="+previous
356: }
357: if (confirm("Are you sure you want to delete this post?\\nDeleted posts will no longer be visible to you and other students,\\nbut will continue to be visible to your instructor")) {
358: document.location.href = "/adm/feedback?hide="+symbparm+prevparm
359: }
360: }
361: </script>
362: |;
363: $discussion.='<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$symb.'"><table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
364: $discussion .='<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'.
365: '<table border="0" width="100%" bgcolor="#DDDDBB"><tr>';
366: if ($visible>2) {
367: $discussion.='<td align="left">'.
368: '<a href="/adm/feedback?threadedon='.$ressymb;
369: if ($newpostsflag) {
370: $discussion .= '&previous='.$prevread;
371: }
372: $discussion .='">'.&mt('Threaded View').'</a> '.
373: '<a href="/adm/feedback?threadedoff='.$ressymb;
374: if ($newpostsflag) {
375: $discussion .= '&previous='.$prevread;
376: }
377: $discussion .='">'.&mt('Chronological View').'</a>
378: <a href= "/adm/feedback?sortfilter='.$ressymb;
379: if ($newpostsflag) {
380: $discussion .= '&previous='.$prevread;
381: }
382: $discussion .='">'.&mt('Sorting/Filtering options').'</a>  ';
383: } else {
384: $discussion .= '<td align="left">';
385: }
386: $discussion .='<a href= "/adm/feedback?export='.$ressymb;
387: if ($newpostsflag) {
388: $discussion .= '&previous='.$prevread;
389: }
390: $discussion .= '">'.&mt('Export').'?</a> </td>';
391: if ($newpostsflag) {
392: if (!$markondisp) {
393: $discussion .='<td align="right"><a href="/adm/feedback?markread='.$ressymb.'">'.&mt('Mark NEW posts no longer new').'</a> ';
394: } else {
395: $discussion .= '<td> </td>';
396: }
397: } else {
398: $discussion .= '<td> </td>';
399: }
400: $discussion .= '</tr></table></td></tr>';
401:
402: my $numhidden = keys %notshown;
403: if ($numhidden > 0) {
404: my $colspan = $maxdepth+1;
405: $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
406: '<a href="/adm/feedback?allposts='.$ressymb;
407: if ($newpostsflag) {
408: $discussion .= '&previous='.$prevread;
409: }
410: $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
411: $numhidden.' ';
412: if ($showunmark) {
413: $discussion .= &mt('posts previously marked read');
414: } else {
415: $discussion .= &mt('previously viewed posts');
416: }
417: $discussion .= '<br/></td></tr>';
418: }
419: }
420:
421: # Choose sort mechanism
422: my @showposts = ();
423: if ($sortposts eq 'descdate') {
424: @showposts = (sort { $b <=> $a } keys %alldiscussion);
425: } elsif ($sortposts eq 'thread') {
426: @showposts = (sort { $a <=> $b } keys %alldiscussion);
427: } elsif ($sortposts eq 'subject') {
428: foreach (sort keys %subjectsort) {
429: push @showposts, @{$subjectsort{$_}};
430: }
431: } elsif ($sortposts eq 'username') {
432: foreach my $domain (sort keys %usernamesort) {
433: foreach (sort keys %{$usernamesort{$domain}}) {
434: push @showposts, @{$usernamesort{$domain}{$_}};
435: }
436: }
437: } elsif ($sortposts eq 'lastfirst') {
438: foreach my $last (sort keys %namesort) {
439: foreach (sort keys %{$namesort{$last}}) {
440: push @showposts, @{$namesort{$last}{$_}};
441: }
442: }
443: } else {
444: $sortposts = 'ascdate';
445: @showposts = (sort { $a <=> $b } keys %alldiscussion);
446: }
447: my $currdepth = 0;
448: my $firstidx = $alldiscussion{$showposts[0]};
449: foreach (@showposts) {
450: unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'}) || ($outputtarget eq 'export')) {
451: $alldiscussion{$_} = $_;
452: }
453: unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) {
454: if ($outputtarget ne 'tex' && $outputtarget ne 'export') {
455: $discussion.="\n<tr>";
456: }
457: my $thisdepth=$depth[$alldiscussion{$_}];
458: if ($outputtarget ne 'tex' && $outputtarget ne 'export') {
459: for (1..$thisdepth) {
460: $discussion.='<td> </td>';
461: }
462: }
463: my $colspan=$maxdepth-$thisdepth+1;
464: if ($outputtarget eq 'tex') {
465: #cleanup block
466: $discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
467: $discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
468: my $threadinsert='';
469: if ($thisdepth > 0) {
470: $threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>';
471: }
472: $discussionitems[$alldiscussion{$_}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/;
473: $discussionitems[$alldiscussion{$_}]=~s/<a([^>]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g;
474: $discussionitems[$alldiscussion{$_}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g;
475:
476: $discussionitems[$alldiscussion{$_}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$discussionitems[$alldiscussion{$_}];
477: $discussion.=$discussionitems[$alldiscussion{$_}];
478: } elsif ($outputtarget eq 'export') {
479: my $postfilename = $alldiscussion{$_}.'-'.$imsitems{$alldiscussion{$_}}{'timestamp'}.'.html';
480: if ($manifestok) {
481: if (($depth[$alldiscussion{$_}] <= $currdepth) && ($alldiscussion{$_} != $firstidx)) {
482: print $manifestfile ' </item>'."\n";
483: }
484: $currdepth = $depth[$alldiscussion{$_}];
485: print $manifestfile "\n".
486: '<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$_}.'" isvisible="'.
487: $imsitems{$alldiscussion{$_}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$_}.'">'.
488: '<title>'.$imsitems{$alldiscussion{$_}}{'title'}.'</title>';
489: $imsresources .= "\n".
490: '<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$_}.'" type="webcontent" href="'.$postfilename.'">'.
491: '<file href="'.$alldiscussion{$_}.'.html">'."\n".
492: $imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n".
493: '</resource>';
494: }
495: my $postingfile;
496: my $postingfilename = $tempexport.'/'.$postfilename;
497: if ($postingfile = Apache::File->new('>'.$postingfilename)) {
498: print $postingfile '<html><head><title>Discussion Post</title></head><body>'.
499: $imsitems{$alldiscussion{$_}}{'title'}.' '.
500: $imsitems{$alldiscussion{$_}}{'sender'}.
501: $imsitems{$alldiscussion{$_}}{'timestamp'}.'<br /><br />'.
502: $imsitems{$alldiscussion{$_}}{'message'}.'<br />'.
503: $imsitems{$alldiscussion{$_}}{'attach'}.'</body></html>'."\n";
504: close($postingfile);
505: } else {
506: $discussion .= 'An error occurred opening the export file for posting '.$alldiscussion{$_}.'<br />';
507: }
508: $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$_}}{'allattachments'},$tempexport);
509: } else {
510: $discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].
511: '" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$_}].
512: '</td></tr>';
513: }
514: }
515: }
516: unless ($outputtarget eq 'tex' || $outputtarget eq 'export') {
517: my $colspan=$maxdepth+1;
518: $discussion .= <<END;
519: <tr bgcolor="#FFFFFF">
520: <td colspan="$colspan" valign="top">
521: <table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2">
522: <tr>
523: <td align="left">
524: <table border="0" cellpadding="0" cellspacing="4">
525: <tr>
526: <td>
527: <font size="-1"><b>$lt{'cuse'}</b>:</td>
528: <td> </td>
529: <td><font size="-1">
530: END
531: if ($newpostsflag) {
532: $discussion .=
533: '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i>';
534: if ($dischash{$toggkey}) {
535: $discussion .= ' 3. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>';
536: }
537: } else {
538: if ($dischash{$toggkey}) {
539: $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>';
540: } else {
541: $discussion .=
542: $lt{'disp'}.' - <i>'.$currdisp.'</i>';
543: }
544: }
545: $discussion .= <<END;
546: </font></td>
547: <td> </td>
548: <td>
549: <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b>
550: </td>
551: </tr>
552: </table>
553: </td>
554: END
555: if ($dischash{$toggkey}) {
556: my $storebutton = &mt('Store read/unread changes');
557: $discussion.='<td align="right">'.
558: '<input type="hidden" name="discsymb" value="'.$ressymb.'">'."\n".
559: '<input type="button" name="readoptions" value="'.$storebutton.'"'.
560: ' onClick="this.form.submit();">'."\n".
561: '</td>';
562: }
563: $discussion .= (<<END);
564: </tr>
565: </table>
566: </td>
567: </tr>
568: </table>
569: <br /><br /></form>
570: END
571: }
572: if ($outputtarget eq 'export') {
573: if ($manifestok) {
574: while ($currdepth > 0) {
575: print $manifestfile " </item>\n";
576: $currdepth --;
577: }
578: print $manifestfile qq|
579: </organization>
580: </organizations>
581: <resources>
582: $imsresources
583: </resources>
584: </manifest>
585: |;
586: close($manifestfile);
587:
588: #Create zip file in prtspool
589:
590: my $imszipfile = '/prtspool/'.
591: $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
592: time.'_'.rand(1000000000).'.zip';
593: # zip can cause an sh launch which can pass along all of %ENV
594: # which can be too large for /bin/sh to handle
595: my %oldENV=%ENV;
596: undef(%ENV);
597: my $cwd = &getcwd();
598: my $imszip = '/home/httpd/'.$imszipfile;
599: chdir $tempexport;
600: open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
601: close(OUTPUT);
602: chdir $cwd;
603: %ENV=%oldENV;
604: undef(%oldENV);
605: $discussion .= 'Download the zip file from <a href="'.$imszipfile.'">Discussion Posting Archive</a><br />';
606: if ($copyresult) {
607: $discussion .= 'The following errors occurred during export - <br />'.$copyresult;
608: }
609: } else {
610: $discussion .= '<br />Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.<br />';
611: }
612: return $discussion;
613: }
614: }
615: if ($discussiononly) {
616: my $now = time;
617: my $attachnum = 0;
618: my $newattachmsg = '';
619: my @currnewattach = ();
620: my @currdelold = ();
621: my $comment = '';
622: my $subject = '';
623: if ($ENV{'form.origpage'}) {
624: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']);
625: $subject = &Apache::lonnet::unescape($ENV{'form.subject'});
626: $comment = &Apache::lonnet::unescape($ENV{'form.comment'});
627: my @keepold = ();
628: &process_attachments(\@currnewattach,\@currdelold,\@keepold);
629: if (@currnewattach > 0) {
630: $attachnum += @currnewattach;
631: }
632: }
633: if (&discussion_open($status)) {
634: $discussion.=(<<ENDDISCUSS);
635: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
636: <input type="submit" name="discuss" value="Post Discussion" />
637: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
638: <input type="hidden" name="symb" value="$ressymb" />
639: <input type="hidden" name="sendit" value="true" />
640: <input type="hidden" name="timestamp" value="$now" />
641: <br /><a name="newpost"></a>
642: <font size="1">Note: in anonymous discussion, your name is visible only
643: to course faculty</font><br />
644: <b>Title:</b> <input type="text" name="subject" value="$subject" size="30" /><br /><br />
645: <textarea name="comment" cols="80" rows="14" wrap="hard">$comment</textarea>
646: ENDDISCUSS
647: if ($ENV{'form.origpage'}) {
648: $discussion.='<input type="hidden" name="origpage" value="'.$ENV{'form.origpage'}.'" />'."\n";
649: foreach (@currnewattach) {
650: $discussion.='<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n";
651: }
652: }
653: $discussion.="</form>\n";
654: if ($outputtarget ne 'tex') {
655: $discussion.=&generate_attachments_button('',$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,'',$mode);
656: if (@currnewattach > 0) {
657: $newattachmsg .= '<b>New attachments</b><br />';
658: if (@currnewattach > 1) {
659: $newattachmsg .= '<ol>';
660: foreach my $item (@currnewattach) {
661: $item =~ m#.*/([^/]+)$#;
662: $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n";
663: }
664: $newattachmsg .= '</ol>'."\n";
665: } else {
666: $currnewattach[0] =~ m#.*/([^/]+)$#;
667: $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n";
668: }
669: }
670: $discussion.=$newattachmsg;
671: $discussion.=&generate_preview_button();
672: }
673: }
674: } else {
675: if (&discussion_open($status) &&
676: &Apache::lonnet::allowed('pch',
677: $ENV{'request.course.id'}.
678: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
679: if ($outputtarget ne 'tex') {
680: $discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='.
681: $symb.':::" '.$target.'>'.
682: '<img src="/adm/lonMisc/chat.gif" border="0" />'.
683: &mt('Post Discussion').'</a></td></tr></table>';
684: }
685: }
686: }
687: return $discussion;
688: }
689:
690: sub build_posting_display {
691: my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget) = @_;
692:
693: my @original=();
694: my @index=();
695:
696: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
697: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
698: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
699:
700: if ($contrib{'version'}) {
701: my $oldest = $contrib{'1:timestamp'};
702: if ($prevread eq '0') {
703: $prevread = $oldest-1;
704: }
705: for (my $id=1;$id<=$contrib{'version'};$id++) {
706: my $idx=$id;
707: my $posttime = $contrib{$idx.':timestamp'};
708: if ($prevread <= $posttime) {
709: $$newpostsflag = 1;
710: }
711: my $hidden=($contrib{'hidden'}=~/\.$idx\./);
712: my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./);
713: my $deleted=($contrib{'deleted'}=~/\.$idx\./);
714: my $origindex='0.';
715: my $numoldver=0;
716: if ($contrib{$idx.':replyto'}) {
717: if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) {
718: # this is a follow-up message
719: $original[$idx]=$original[$contrib{$idx.':replyto'}];
720: $$depth[$idx]=$$depth[$contrib{$idx.':replyto'}]+1;
721: $origindex=$index[$contrib{$idx.':replyto'}];
722: if ($$depth[$idx]>$$maxdepth) { $$maxdepth=$$depth[$idx]; }
723: } else {
724: $original[$idx]=0;
725: $$depth[$idx]=0;
726: }
727: } else {
728: # this is an original message
729: $original[$idx]=0;
730: $$depth[$idx]=0;
731: }
732: if ($$replies[$$depth[$idx]]) {
733: $$replies[$$depth[$idx]]++;
734: } else {
735: $$replies[$$depth[$idx]]=1;
736: }
737: unless ((($hidden) && (!$seeid)) || ($deleted)) {
738: $$visible++;
739: if ($contrib{$idx.':history'}) {
740: if ($contrib{$idx.':history'} =~ /:/) {
741: my @oldversions = split/:/,$contrib{$idx.':history'};
742: $numoldver = @oldversions;
743: } else {
744: $numoldver = 1;
745: }
746: }
747: $$current = $numoldver;
748: my %messages = ();
749: my %subjects = ();
750: my %attachtxt = ();
751: my %allattachments = ();
752: my ($screenname,$plainname);
753: my $sender = &mt('Anonymous');
754: my ($message,$subject,$vgrlink,$ctlink);
755: &get_post_contents(\%contrib,$idx,$seeid,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,$numoldver);
756:
757:
758: # Set up for sorting by subject
759: unless ($outputtarget eq 'export') {
760: $message=$messages{$numoldver};
761: $message.=$attachtxt{$numoldver};
762: $subject=$subjects{$numoldver};
763: if ($message) {
764: if ($hidden) {
765: $message='<font color="#888888">'.$message.'</font>';
766: if ($studenthidden) {
767: $message .='<br /><br />Deleted by poster (student).';
768: }
769: }
770:
771: if ($subject eq '') {
772: if (defined($$subjectsort{'__No subject'})) {
773: push @{$$subjectsort{'__No subject'}}, $idx;
774: } else {
775: @{$$subjectsort{'__No subject'}} = ("$idx");
776: }
777: } else {
778: if (defined($$subjectsort{$subject})) {
779: push @{$$subjectsort{$subject}}, $idx;
780: } else {
781: @{$$subjectsort{$subject}} = ("$idx");
782: }
783: }
784: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
785: $sender=&Apache::loncommon::aboutmewrapper(
786: $plainname,
787: $contrib{$idx.':sendername'},
788: $contrib{$idx.':senderdomain'}).' ('.
789: $contrib{$idx.':sendername'}.' at '.
790: $contrib{$idx.':senderdomain'}.')';
791: if ($contrib{$idx.':anonymous'}) {
792: $sender.=' ['.&mt('anonymous').'] '.
793: $screenname;
794: }
795:
796: # Set up for sorting by domain, then username
797: unless (defined($$usernamesort{$contrib{$idx.':senderdomain'}})) {
798: %{$$usernamesort{$contrib{$idx.':senderdomain'}}} = ();
799: }
800: if (defined($$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) {
801: push @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx;
802: } else {
803: @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx");
804: }
805: # Set up for sorting by last name, then first name
806: my %names = &Apache::lonnet::get('environment',
807: ['firstname','lastname'],$contrib{$idx.':senderdomain'},
808: ,$contrib{$idx.':sendername'});
809: my $lastname = $names{'lastname'};
810: my $firstname = $names{'firstname'};
811: if ($lastname eq '') {
812: $lastname = '_';
813: }
814: if ($firstname eq '') {
815: $firstname = '_';
816: }
817: unless (defined($$namesort{$lastname})) {
818: %{$$namesort{$lastname}} = ();
819: }
820: if (defined($$namesort{$lastname}{$firstname})) {
821: push @{$$namesort{$lastname}{$firstname}}, $idx;
822: } else {
823: @{$$namesort{$lastname}{$firstname}} = ("$idx");
824: }
825: if ($ENV{'course.'.$ENV{'request.course.id'}.'.allow_discussion_post_editing'} =~ m/yes/i) {
826: if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) {
827: $sender.=' <a href="/adm/feedback?editdisc='.
828: $ressymb.':::'.$idx;
829: if ($newpostsflag) {
830: $sender .= '&previous='.$prevread;
831: }
832: $sender .= '" '.$target.'>'.&mt('Edit').'</a>';
833: unless ($seeid) {
834: $sender.=" <a href=\"javascript:studentdelete('$ressymb','$idx','$newpostsflag','$prevread')";
835: $sender .= '">'.&mt('Delete').'</a>';
836: }
837: }
838: }
839: if ($seeid) {
840: if ($hidden) {
841: unless ($studenthidden) {
842: $sender.=' <a href="/adm/feedback?unhide='.
843: $ressymb.':::'.$idx;
844: if ($newpostsflag) {
845: $sender .= '&previous='.$prevread;
846: }
847: $sender .= '">'.&mt('Make Visible').'</a>';
848: }
849: } else {
850: $sender.=' <a href="/adm/feedback?hide='.
851: $ressymb.':::'.$idx;
852: if ($newpostsflag) {
853: $sender .= '&previous='.$prevread;
854: }
855: $sender .= '">'.&mt('Hide').'</a>';
856: }
857: $sender.=' <a href="/adm/feedback?deldisc='.
858: $ressymb.':::'.$idx;
859: if ($newpostsflag) {
860: $sender .= '&previous='.$prevread;
861: }
862: $sender .= '">'.&mt('Delete').'</a>';
863: }
864: } else {
865: if ($screenname) {
866: $sender='<i>'.$screenname.'</i>';
867: }
868: # Set up for sorting by domain, then username for anonymous
869: unless (defined($$usernamesort{'__anon'})) {
870: %{$$usernamesort{'__anon'}} = ();
871: }
872: if (defined($$usernamesort{'__anon'}{'__anon'})) {
873: push @{$$usernamesort{'__anon'}{'__anon'}}, $idx;
874: } else {
875: @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx");
876: }
877: # Set up for sorting by last name, then first name for anonymous
878: unless (defined($$namesort{'__anon'})) {
879: %{$$namesort{'__anon'}} = ();
880: }
881: if (defined($$namesort{'__anon'}{'__anon'})) {
882: push @{$$namesort{'__anon'}{'__anon'}}, $idx;
883: } else {
884: @{$$namesort{'__anon'}{'__anon'}} = ("$idx");
885: }
886: }
887: if (&discussion_open($status) &&
888: &Apache::lonnet::allowed('pch',
889: $ENV{'request.course.id'}.
890: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
891: $sender.=' <a href="/adm/feedback?replydisc='.
892: $ressymb.':::'.$idx;
893: if ($newpostsflag) {
894: $sender .= '&previous='.$prevread;
895: }
896: $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
897: }
898: if ($viewgrades) {
899: $vgrlink=&Apache::loncommon::submlink('Submissions',
900: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb);
901: }
902: if ($$dischash{$readkey}=~/\.$idx\./) {
903: $ctlink = '<b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" />';
904: } else {
905: $ctlink = '<b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" />';
906: }
907: }
908: #figure out at what position this needs to print
909: }
910: if ($outputtarget eq 'export' || $message) {
911: my $thisindex=$idx;
912: if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) {
913: $thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2);
914: }
915: $$alldiscussion{$thisindex}=$idx;
916: $$shown{$idx} = 0;
917: $index[$idx]=$thisindex;
918: }
919: if ($outputtarget eq 'export') {
920: %{$$imsitems{$idx}} = ();
921: $$imsitems{$idx}{'isvisible'}='true';
922: if ($hidden) {
923: $$imsitems{$idx}{'isvisible'}='false';
924: }
925: $$imsitems{$idx}{'title'}=$subjects{$numoldver};
926: $$imsitems{$idx}{'message'}=$messages{$numoldver};
927: $$imsitems{$idx}{'attach'}=$attachtxt{$numoldver};
928: $$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'};
929: $$imsitems{$idx}{'sender'}=$plainname.' ('.
930: $contrib{$idx.':sendername'}.' at '.
931: $contrib{$idx.':senderdomain'}.')';
932: $$imsitems{$idx}{'isanonymous'}='false';
933: if ($contrib{$idx.':anonymous'}) {
934: $$imsitems{$idx}{'isanonymous'}='true';
935: }
936: $$imsitems{$idx}{'currversion'}=$numoldver;
937: %{$$imsitems{$idx}{'allattachments'}}=%allattachments;
938: unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') {
939: $$shown{$idx} = 1;
940: }
941: } else {
942: if ($message) {
943: my $spansize = 2;
944: if ($showonlyunread && $prevread > $posttime) {
945: $$notshown{$idx} = 1;
946: } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) {
947: $$notshown{$idx} = 1;
948: } else {
949: # apply filters
950: my $uname = $contrib{$idx.':sendername'};
951: my $udom = $contrib{$idx.':senderdomain'};
952: my $poster = $uname.':'.$udom;
953: my $rolematch = '';
954: my $skiptest = 1;
955: if ($totposters > 0) {
956: if (grep/^$poster$/,@{$posters}) {
957: $$shown{$idx} = 1;
958: }
959: } else {
960: if ($rolefilter) {
961: if ($rolefilter eq 'all') {
962: $rolematch = '([^:]+)';
963: } else {
964: $rolematch = $rolefilter;
965: $skiptest = 0;
966: }
967: }
968: if ($sectionpick) {
969: if ($sectionpick eq 'all') {
970: $rolematch .= ':([^:]*)';
971: } else {
972: $rolematch .= ':'.$sectionpick;
973: $skiptest = 0;
974: }
975: }
976: if ($statusfilter) {
977: if ($statusfilter eq 'all') {
978: $rolematch .= ':([^:]+)';
979: } else {
980: $rolematch .= ':'.$statusfilter;
981: $skiptest = 0;
982: }
983: }
984: if ($skiptest) {
985: $$shown{$idx} = 1;
986: } else {
987: foreach my $role (@{$$roleinfo{$poster}}) {
988: if ($role =~ m/^$rolematch$/) {
989: $$shown{$idx} = 1;
990: last;
991: }
992: }
993: }
994: }
995: }
996: unless ($$notshown{$idx} == 1) {
997: if ($prevread > 0 && $prevread <= $posttime) {
998: $$newitem{$idx} = 1;
999: $$discussionitems[$idx] .= '
1000: <p><table border="0" width="100%">
1001: <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
1002: } else {
1003: $$newitem{$idx} = 0;
1004: $$discussionitems[$idx] .= '
1005: <p><table border="0" width="100%">
1006: <tr><td align="left"> </td>';
1007: }
1008: $$discussionitems[$idx] .= '<td align ="left"> '.
1009: '<b>'.$subject.'</b> '.
1010: $sender.'</b> '.$vgrlink.' ('.
1011: &Apache::lonlocal::locallocaltime($posttime).')</td>';
1012: if ($$dischash{$toggkey}) {
1013: $$discussionitems[$idx].='<td align="right"> '.
1014: $ctlink.'</td>';
1015: }
1016: $$discussionitems[$idx].= '</tr></table><blockquote>'.
1017: $message.'</blockquote></p>';
1018: if ($contrib{$idx.':history'}) {
1019: my @postversions = ();
1020: $$discussionitems[$idx] .= &mt('This post has been edited by the author.');
1021: if ($seeid) {
1022: $$discussionitems[$idx] .= ' <a href="/adm/feedback?allversions='.$ressymb.':::'.$idx.'">'.&mt('Display all versions').'</a>';
1023: }
1024: $$discussionitems[$idx].='<br/>'.&mt('Earlier version(s) were posted on: ');
1025: if ($contrib{$idx.':history'} =~ m/:/) {
1026: @postversions = split/:/,$contrib{$idx.':history'};
1027: } else {
1028: @postversions = ("$contrib{$idx.':history'}");
1029: }
1030: for (my $i=0; $i<@postversions; $i++) {
1031: my $version = $i+1;
1032: $$discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' ';
1033: }
1034: }
1035: }
1036: }
1037: }
1038: }
1039: }
1040: }
1041: }
1042:
1043: sub get_post_contents {
1044: my ($contrib,$idx,$seeid,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_;
1045: my $discussion = '';
1046: my $start=$numver;
1047: my $end=$numver + 1;
1048: %{$$imsfiles{$idx}}=();
1049: if ($type eq 'allversions') {
1050: unless($seeid) {
1051: $discussion=&mt('You do not have privileges to view all versions of posts.').&mt('Please select a different role');
1052: return $discussion;
1053: }
1054: }
1055: # $$screenname=&Apache::loncommon::screenname(
1056: # $$contrib{$idx.':sendername'},
1057: # $$contrib{$idx.':senderdomain'});
1058: # $$plainname=&Apache::loncommon::nickname(
1059: # $$contrib{$idx.':sendername'},
1060: # $$contrib{$idx.':senderdomain'});
1061: ($$screenname,$$plainname)=($$contrib{$idx.':screenname'},
1062: $$contrib{$idx.':plainname'});
1063: my $sender=&Apache::loncommon::aboutmewrapper(
1064: $$plainname,
1065: $$contrib{$idx.':sendername'},
1066: $$contrib{$idx.':senderdomain'}).' ('.
1067: $$contrib{$idx.':sendername'}.' at '.
1068: $$contrib{$idx.':senderdomain'}.')';
1069: my $attachmenturls = $$contrib{$idx.':attachmenturl'};
1070: my @postversions = ();
1071: if ($type eq 'allversions' || $type eq 'export') {
1072: $start = 0;
1073: if ($$contrib{$idx.':history'}) {
1074: if ($$contrib{$idx.':history'} =~ m/:/) {
1075: @postversions = split/:/,$$contrib{$idx.':history'};
1076: } else {
1077: @postversions = ("$$contrib{$idx.':history'}");
1078: }
1079: }
1080: &get_post_versions($messages,$$contrib{$idx.':message'},1);
1081: &get_post_versions($subjects,$$contrib{$idx.':subject'},1);
1082: push @postversions,$$contrib{$idx.':timestamp'};
1083: $end = @postversions;
1084: } else {
1085: &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver);
1086: &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver);
1087: }
1088:
1089: if ($$contrib{$idx.':anonymous'}) {
1090: $sender.=' ['.&mt('anonymous').'] '.$$screenname;
1091: }
1092: if ($type eq 'allversions') {
1093: $discussion=('<b>'.$sender.'</b><br /><ul>');
1094: }
1095: for (my $i=$start; $i<$end; $i++) {
1096: my ($timesent,$attachmsg);
1097: my %currattach = ();
1098: $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]);
1099: $$messages{$i}=~s/\n/\<br \/\>/g;
1100: $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i});
1101: $$subjects{$i}=~s/\n/\<br \/\>/g;
1102: $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i});
1103: if ($attachmenturls) {
1104: &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach);
1105: }
1106: if ($type eq 'export') {
1107: $$imsfiles{$idx}{$i} = '';
1108: if ($attachmsg) {
1109: $$attachtxt{$i} = '<br />Attachments:<br />';
1110: foreach (sort keys %currattach) {
1111: if ($$allattachments{$_}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
1112: my $fname = $1.$3.'/'.$4;
1113: $$imsfiles{$idx}{$i} .= '<file href="'.$fname.'">'."\n";
1114: $$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />';
1115: }
1116: }
1117: }
1118: } else {
1119: if ($attachmsg) {
1120: $$attachtxt{$i} = '<br />Attachments:'.$attachmsg.'<br />';
1121: } else {
1122: $$attachtxt{$i} = '';
1123: }
1124: }
1125: if ($type eq 'allversions') {
1126: $discussion.= <<"END";
1127: <li><b>$$subjects{$i}</b>, $timesent<br />
1128: $$messages{$i}<br />
1129: $$attachtxt{$i}</li>
1130: END
1131: }
1132: }
1133: if ($type eq 'allversions') {
1134: $discussion.=('</ul></body></html>');
1135: return $discussion;
1136: } else {
1137: return;
1138: }
1139: }
1140:
1141: sub replicate_attachments {
1142: my ($attachrefs,$tempexport) = @_;
1143: my $response;
1144: foreach my $id (keys %{$attachrefs}) {
1145: if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
1146: my $path = $tempexport;
1147: my $tail = $1.'/'.$2.$4;
1148: my @extras = split/\//,$tail;
1149: my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5;
1150: if (!-e $destination) {
1151: my $i= 0;
1152: while ($i<@extras) {
1153: $path .= '/'.$extras[$i];
1154: if (!-e $path) {
1155: mkdir($path,0700);
1156: }
1157: $i ++;
1158: }
1159: my ($content,$rtncode);
1160: my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode);
1161: if ($uploadreply eq 'ok') {
1162: my $attachcopy;
1163: if ($attachcopy = Apache::File->new('>'.$destination)) {
1164: print $attachcopy $content;
1165: close($attachcopy);
1166: } else {
1167: $response .= 'Error copying file attachment - '.$5.' to IMS package: '.$!.'<br />'."\n";
1168: }
1169: } else {
1170: &Apache::lonnet::logthis("Replication of attachment failed when building IMS export of discussion posts - domain: $1, course: $2, file: $$attachrefs{$id}{'filename'} -error: $rtncode");
1171: $response .= 'Error copying file attachment - '.$5.' to IMS package: '.$rtncode.'<br />'."\n";
1172: }
1173: }
1174: }
1175: }
1176: return $response;
1177: }
1178:
1179: sub mail_screen {
1180: my ($r,$feedurl,$options) = @_;
1181: if (exists($ENV{'form.origpage'})) {
1182: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss']);
1183: }
1184: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
1185: '','onLoad="window.focus();setposttype();"');
1186: my $title=&Apache::lonnet::gettitle($feedurl);
1187: if (!$title) { $title = $feedurl; }
1188: my $quote='';
1189: my $subject = '';
1190: my $comment = '';
1191: my $prevtag = '';
1192: my $parentmsg = '';
1193: my ($symb,$idx,$attachmenturls);
1194: my $numoldver = 0;
1195: my $attachmsg = '';
1196: my $newattachmsg = '';
1197: my @currnewattach = ();
1198: my @currdelold = ();
1199: my @keepold = ();
1200: my %attachments = ();
1201: my %currattach = ();
1202: my $attachnum = 0;
1203: my $anonchk = (<<END);
1204: function anonchk() {
1205: if (document.mailform.anondiscuss.checked == true) {
1206: document.attachment.anondiscuss.value = '1'
1207: }
1208: if (document.mailform.discuss.checked == true) {
1209: document.attachment.discuss.value = '1'
1210: }
1211: return
1212: }
1213: END
1214: my $anonscript;
1215: if (exists($ENV{'form.origpage'})) {
1216: $anonscript = (<<END);
1217: function setposttype() {
1218: var anondisc = $ENV{'form.anondiscuss'};
1219: var disc = $ENV{'form.discuss'};
1220: if (anondisc == 1) {
1221: document.mailform.anondiscuss.checked = true
1222: }
1223: if (disc == 1) {
1224: document.mailform.discuss.checked = true
1225: }
1226: return
1227: }
1228: END
1229: } else {
1230: $anonscript = (<<END);
1231: function setposttype() {
1232: return
1233: }
1234: END
1235: }
1236: if (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) {
1237: if ($ENV{'form.replydisc'}) {
1238: ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
1239: } else {
1240: ($symb,$idx)=split(/\:\:\:/,$ENV{'form.editdisc'});
1241: }
1242: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
1243: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1244: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1245: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) {
1246: if ($contrib{$idx.':history'}) {
1247: if ($contrib{$idx.':history'} =~ /:/) {
1248: my @oldversions = split/:/,$contrib{$idx.':history'};
1249: $numoldver = @oldversions;
1250: } else {
1251: $numoldver = 1;
1252: }
1253: }
1254: if ($ENV{'form.replydisc'}) {
1255: if ($contrib{$idx.':history'}) {
1256: if ($contrib{$idx.':history'} =~ /:/) {
1257: my @oldversions = split/:/,$contrib{$idx.':history'};
1258: $numoldver = @oldversions;
1259: } else {
1260: $numoldver = 1;
1261: }
1262: }
1263: my $message;
1264: if ($idx > 0) {
1265: my %msgversions = ();
1266: &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver);
1267: $message = $msgversions{$numoldver};
1268: }
1269: $message=~s/\n/\<br \/\>/g;
1270: $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>';
1271: if ($idx > 0) {
1272: my %subversions = ();
1273: &get_post_versions(\%subversions,$contrib{$idx.':subject'},1,$numoldver);
1274: $subject = 'Re: '.$subversions{$numoldver};
1275: }
1276: $subject = &HTML::Entities::encode($subject,'<>&"');
1277: } else {
1278: $attachmenturls = $contrib{$idx.':attachmenturl'};
1279: if ($idx > 0) {
1280: my %msgversions = ();
1281: &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver);
1282: $comment = $msgversions{$numoldver};
1283: my %subversions = ();
1284: &get_post_versions(\%subversions,$contrib{$idx.':subject'},0,$numoldver);
1285: $subject = $subversions{$numoldver};
1286: }
1287: if (defined($contrib{$idx.':replyto'})) {
1288: $parentmsg = $contrib{$idx.':replyto'};
1289: }
1290: unless (exists($ENV{'form.origpage'})) {
1291: my $anonflag = 0;
1292: if ($contrib{$idx.':anonymous'}) {
1293: $anonflag = 1;
1294: }
1295: $anonscript = (<<END);
1296: function setposttype () {
1297: var currtype = $anonflag
1298: if (currtype == 1) {
1299: document.mailform.elements.discuss.checked = false
1300: document.mailform.elements.anondiscuss.checked = true
1301: }
1302: if (currtype == 0) {
1303: document.mailform.elements.anondiscuss.checked = false
1304: document.mailform.elements.discuss.checked = true
1305: }
1306: return
1307: }
1308: END
1309: }
1310: }
1311: }
1312: if ($ENV{'form.previous'}) {
1313: $prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
1314: }
1315: }
1316:
1317: if ($ENV{'form.origpage'}) {
1318: $subject = &Apache::lonnet::unescape($ENV{'form.subject'});
1319: $comment = &Apache::lonnet::unescape($ENV{'form.comment'});
1320: &process_attachments(\@currnewattach,\@currdelold,\@keepold);
1321: }
1322: my $latexHelp=&Apache::loncommon::helpLatexCheatsheet();
1323: my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders();
1324: my $send=&mt('Send');
1325: $r->print(<<END);
1326: <html>
1327: <head>
1328: <title>The LearningOnline Network with CAPA</title>
1329: <meta http-equiv="pragma" content="no-cache"></meta>
1330: $htmlheader
1331: <script type="text/javascript">
1332: //<!--
1333: function gosubmit() {
1334: var rec=0;
1335: if (typeof(document.mailform.elements.author)!="undefined") {
1336: if (document.mailform.elements.author.checked) {
1337: rec=1;
1338: }
1339: }
1340: if (typeof(document.mailform.elements.question)!="undefined") {
1341: if (document.mailform.elements.question.checked) {
1342: rec=1;
1343: }
1344: }
1345: if (typeof(document.mailform.elements.course)!="undefined") {
1346: if (document.mailform.elements.course.checked) {
1347: rec=1;
1348: }
1349: }
1350: if (typeof(document.mailform.elements.policy)!="undefined") {
1351: if (document.mailform.elements.policy.checked) {
1352: rec=1;
1353: }
1354: }
1355: if (typeof(document.mailform.elements.discuss)!="undefined") {
1356: if (document.mailform.elements.discuss.checked) {
1357: rec=1;
1358: }
1359: }
1360: if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
1361: if (document.mailform.elements.anondiscuss.checked) {
1362: rec=1;
1363: }
1364: }
1365:
1366: if (rec) {
1367: if (typeof(document.mailform.onsubmit)=='function') {
1368: document.mailform.onsubmit();
1369: }
1370: document.mailform.submit();
1371: } else {
1372: alert('Please check a feedback type.');
1373: }
1374: }
1375: $anonchk
1376: $anonscript
1377: //-->
1378: </script>
1379: </head>
1380: $bodytag
1381: <h2><tt>$title</tt></h2>
1382: <form action="/adm/feedback" method="post" name="mailform"
1383: enctype="multipart/form-data">
1384: $prevtag
1385: <input type="hidden" name="postdata" value="$feedurl" />
1386: END
1387: if ($ENV{'form.replydisc'}) {
1388: $r->print(<<END);
1389: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
1390: END
1391: } elsif ($ENV{'form.editdisc'}) {
1392: $r->print(<<END);
1393: <input type="hidden" name="editdisc" value ="$ENV{'form.editdisc'}" />
1394: <input type="hidden" name="parentmsg" value ="$parentmsg" />
1395: END
1396: }
1397: $r->print(<<END);
1398: Please check at least one of the following feedback types:
1399: $options<hr />
1400: $quote
1401: <p>My question/comment/feedback:</p>
1402: <p>
1403: $latexHelp
1404: Title: <input type="text" name="subject" size="30" value="$subject" /></p>
1405: <p>
1406: <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">$comment
1407: </textarea></p>
1408: <p>
1409: END
1410: if ( ($ENV{'form.editdisc'}) || ($ENV{'form.replydisc'}) ) {
1411: if ($ENV{'form.origpage'}) {
1412: foreach (@currnewattach) {
1413: $r->print('<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n");
1414: }
1415: foreach (@currdelold) {
1416: $r->print('<input type="hidden" name="deloldattach" value="'.$_.'" />'."\n");
1417: }
1418: }
1419: if ($ENV{'form.editdisc'}) {
1420: if ($attachmenturls) {
1421: &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold);
1422: $attachnum = scalar(keys %currattach);
1423: foreach (keys %currattach) {
1424: $r->print('<input type="hidden" name="keepold" value="'.$_.'" />'."\n");
1425: }
1426: }
1427: }
1428: } else {
1429: $r->print(<<END);
1430: Attachment (128 KB max size): <input type="file" name="attachment" />
1431: </p>
1432: END
1433: }
1434: $r->print(<<END);
1435: <p>
1436: <input type="hidden" name="sendit" value="1" />
1437: <input type="button" value="$send" onClick='gosubmit();' />
1438: </p>
1439: </form>
1440: END
1441: if ($ENV{'form.editdisc'} || $ENV{'form.replydisc'}) {
1442: my $now = time;
1443: my $ressymb = $symb;
1444: my $postidx = '';
1445: if ($ENV{'form.editdisc'}) {
1446: $postidx = $idx;
1447: }
1448: if (@currnewattach > 0) {
1449: $attachnum += @currnewattach;
1450: }
1451: $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver));
1452: if ($attachnum > 0) {
1453: if (@currnewattach > 0) {
1454: $newattachmsg .= '<b>New attachments</b><br />';
1455: if (@currnewattach > 1) {
1456: $newattachmsg .= '<ol>';
1457: foreach my $item (@currnewattach) {
1458: $item =~ m#.*/([^/]+)$#;
1459: $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n";
1460: }
1461: $newattachmsg .= '</ol>'."\n";
1462: } else {
1463: $currnewattach[0] =~ m#.*/([^/]+)$#;
1464: $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n";
1465: }
1466: }
1467: if ($attachmsg) {
1468: $r->print("<b>Retained attachments</b>:$attachmsg<br />\n");
1469: }
1470: if ($newattachmsg) {
1471: $r->print("$newattachmsg<br />");
1472: }
1473: }
1474: }
1475: $r->print(&generate_preview_button().
1476: &Apache::lonhtmlcommon::htmlareaselectactive('comment').
1477: '</body></html>');
1478: }
1479:
1480: sub print_display_options {
1481: my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_;
1482: # backward compatibility (bulletin boards used to be 'wrapped')
1483: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1484: $feedurl=~s|^/adm/wrapper||;
1485: }
1486:
1487: my $function = &Apache::loncommon::get_users_function();
1488: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
1489: $ENV{'user.domain'});
1490: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
1491: '','');
1492:
1493: my %lt = &Apache::lonlocal::texthash(
1494: 'dido' => 'Discussion display options',
1495: 'pref' => 'Display Preference',
1496: 'curr' => 'Current setting ',
1497: 'actn' => 'Action',
1498: 'deff' => 'Default for all discussions',
1499: 'prca' => 'Preferences can be set for this discussion that determine ....',
1500: 'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and',
1501: 'unwh' => 'Under what circumstances posts are identified as "NEW", and',
1502: 'wipa' => 'Whether individual posts can be marked as read/unread',
1503: 'allposts' => 'All posts',
1504: 'unread' => 'New posts only',
1505: 'unmark' => 'Posts not marked read',
1506: 'ondisp' => 'Once displayed',
1507: 'onmark' => 'Once marked not NEW ',
1508: 'toggon' => 'Shown',
1509: 'toggoff' => 'Not shown',
1510: 'disa' => 'Posts displayed?',
1511: 'npmr' => 'New posts cease to be identified as "NEW"?',
1512: 'dotm' => 'Option to mark each post as read/unread?',
1513: 'chgt' => 'Change to ',
1514: 'mkdf' => 'Set to ',
1515: 'yhni' => 'You have not indicated that you wish to change any of the discussion settings',
1516: 'ywbr' => 'You will be returned to the previous page if you click OK.'
1517: );
1518:
1519: my $dispchangeA = $lt{'unread'};
1520: my $dispchangeB = $lt{'unmark'};
1521: my $markchange = $lt{'ondisp'};
1522: my $toggchange = $lt{'toggon'};
1523: my $currdisp = $lt{'allposts'};
1524: my $currmark = $lt{'onmark'};
1525: my $discdisp = 'allposts';
1526: my $discmark = 'onmark';
1527: my $currtogg = $lt{'toggoff'};
1528: my $disctogg = 'toggoff';
1529:
1530: if ($dispchgA eq 'allposts') {
1531: $dispchangeA = $lt{'allposts'};
1532: $currdisp = $lt{'unread'};
1533: $discdisp = 'unread';
1534: }
1535:
1536: if ($markchg eq 'markonread') {
1537: $markchange = $lt{'onmark'};
1538: $currmark = $lt{'ondisp'};
1539: $discmark = 'ondisp';
1540: }
1541:
1542: if ($dispchgB eq 'onlyunread') {
1543: $dispchangeB = $lt{'unread'};
1544: $currdisp = $lt{'unmark'};
1545: $discdisp = 'unmark';
1546: }
1547: if ($toggchg eq 'toggoff') {
1548: $toggchange = $lt{'toggoff'};
1549: $currtogg = $lt{'toggon'};
1550: $disctogg = 'toggon';
1551: }
1552: $r->print(<<END);
1553: <html>
1554: <head>
1555: <title>$lt{'dido'}</title>
1556: <meta http-equiv="pragma" content="no-cache" />
1557: <script>
1558: function discdispChk(caller) {
1559: var disctogg = '$toggchg'
1560: if (caller == 0) {
1561: if (document.modifydisp.discdisp[0].checked == true) {
1562: if (document.modifydisp.discdisp[1].checked == true) {
1563: document.modifydisp.discdisp[1].checked = false
1564: }
1565: }
1566: }
1567: if (caller == 1) {
1568: if (document.modifydisp.discdisp[1].checked == true) {
1569: if (document.modifydisp.discdisp[0].checked == true) {
1570: document.modifydisp.discdisp[0].checked = false
1571: }
1572: if (disctogg == 'toggon') {
1573: document.modifydisp.disctogg.checked = true
1574: }
1575: if (disctogg == 'toggoff') {
1576: document.modifydisp.disctogg.checked = false
1577: }
1578: }
1579: }
1580: if (caller == 2) {
1581: var dispchgB = '$dispchgB'
1582: if (disctogg == 'toggoff') {
1583: if (document.modifydisp.disctogg.checked == true) {
1584: if (dispchgB == 'onlyunmark') {
1585: document.modifydisp.discdisp[1].checked = false
1586: }
1587: }
1588: }
1589: }
1590: }
1591:
1592: function setDisp() {
1593: var prev = "$previous"
1594: var chktotal = 0
1595: if (document.modifydisp.discdisp[0].checked == true) {
1596: document.modifydisp.$dispchgA.value = "$symb"
1597: chktotal ++
1598: }
1599: if (document.modifydisp.discdisp[1].checked == true) {
1600: document.modifydisp.$dispchgB.value = "$symb"
1601: chktotal ++
1602: }
1603: if (document.modifydisp.discmark.checked == true) {
1604: document.modifydisp.$markchg.value = "$symb"
1605: chktotal ++
1606: }
1607: if (document.modifydisp.disctogg.checked == true) {
1608: document.modifydisp.$toggchg.value = "$symb"
1609: chktotal ++
1610: }
1611: if (chktotal > 0) {
1612: document.modifydisp.submit()
1613: } else {
1614: if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) {
1615: if (prev > 0) {
1616: location.href = "$feedurl?previous=$previous"
1617: } else {
1618: location.href = "$feedurl"
1619: }
1620: }
1621: }
1622: }
1623: </script>
1624: </head>
1625: $bodytag
1626: <form name="modifydisp" method="post" action="/adm/feedback">
1627: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li><li>$lt{'wipa'}</li></ol>
1628: <br />
1629: <table border="0" cellpadding="0" cellspacing="0">
1630: <tr>
1631: <td width="100%" bgcolor="#000000">
1632: <table width="100%" border="0" cellpadding="1" cellspacing="0">
1633: <tr>
1634: <td width="100%" bgcolor="#000000">
1635: <table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF">
1636: <tr bgcolor="$tabcolor">
1637: <td><b>$lt{'pref'}</b></td>
1638: <td><b>$lt{'curr'}</b></td>
1639: <td><b>$lt{'actn'}?</b></td>
1640: </tr>
1641: <tr bgcolor="#dddddd">
1642: <td>$lt{'disa'}</td>
1643: <td>$lt{$discdisp}</td>
1644: <td><input type="checkbox" name="discdisp" onClick="discdispChk('0')" /> $lt{'chgt'} "$dispchangeA"
1645: <br />
1646: <input type="checkbox" name="discdisp" onClick="discdispChk('1')" /> $lt{'chgt'} "$dispchangeB"
1647: </td>
1648: </tr><tr bgcolor="#eeeeee">
1649: <td>$lt{'npmr'}</td>
1650: <td>$lt{$discmark}</td>
1651: <td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td>
1652: </tr><tr bgcolor="#dddddd">
1653: <td>$lt{'dotm'}</td>
1654: <td>$lt{$disctogg}</td>
1655: <td><input type="checkbox" name="disctogg" onClick="discdispChk('2')" />$lt{'chgt'} "$toggchange"</td>
1656: </tr>
1657: </table>
1658: </td>
1659: </tr>
1660: </table>
1661: </td>
1662: </tr>
1663: </table>
1664: <br />
1665: <br />
1666: <input type="hidden" name="previous" value="$previous" />
1667: <input type="hidden" name="$dispchgA" value=""/>
1668: <input type="hidden" name="$dispchgB" value=""/>
1669: <input type="hidden" name="$markchg" value=""/>
1670: <input type="hidden" name="$toggchg" value="" />
1671: <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" />
1672: <br />
1673: <br />
1674: </form>
1675: </body>
1676: </html>
1677: END
1678: return;
1679: }
1680:
1681: sub print_sortfilter_options {
1682: my ($r,$symb,$previous,$feedurl) = @_;
1683: # backward compatibility (bulletin boards used to be 'wrapped')
1684: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1685: $feedurl=~s|^/adm/wrapper||;
1686: }
1687: my @sections = ();
1688: my $section_sel = '';
1689: my $numsections = 0;
1690: my $numvisible = 5;
1691: my ($classlist) = &Apache::loncoursedata::get_classlist(
1692: $ENV{'request.course.id'},
1693: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1694: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1695:
1696: my $sec_index = &Apache::loncoursedata::CL_SECTION();
1697: my $status_index = &Apache::loncoursedata::CL_STATUS();
1698: my %sectioncount = ();
1699: while (my ($student,$data) = each %$classlist) {
1700: my ($section,$status) = ($data->[$sec_index],
1701: $data->[$status_index]);
1702: unless ($section eq '' || $section =~ /^\s*$/) {
1703: if (!defined($sectioncount{$section})) {
1704: $sectioncount{$section} = 1;
1705: $numsections ++;
1706: } else {
1707: $sectioncount{$section} ++;
1708: }
1709: }
1710: }
1711:
1712: if ($ENV{'request.course.sec'} !~ /^\s*$/) {
1713: @sections = ($ENV{'request.course.sec'});
1714: $numvisible = 1;
1715: } else {
1716: @sections = sort {$a cmp $b} keys(%sectioncount);
1717: unshift(@sections,'all'); # Put 'all' at the front of the list
1718: if ($numsections < 4) {
1719: $numvisible = $numsections + 1;
1720: }
1721: }
1722: foreach (@sections) {
1723: $section_sel .= " <option value=\"$_\" />$_\n";
1724: }
1725:
1726: my $function = &Apache::loncommon::get_users_function();
1727: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
1728: $ENV{'user.domain'});
1729: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
1730: '','');
1731: my %lt = &Apache::lonlocal::texthash(
1732: 'diso' => 'Discussion sorting and filtering options',
1733: 'diop' => 'Display Options',
1734: 'curr' => 'Current setting ',
1735: 'actn' => 'Action',
1736: 'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
1737: 'soor' => 'Sort order',
1738: 'disp' => 'Specific user roles',
1739: 'actv' => 'Specific role status',
1740: 'spse' => 'Specific sections',
1741: 'psub' => 'Pick specific users (by name)',
1742: 'shal' => 'Show a list of current posters'
1743: );
1744: $r->print(<<END);
1745: <html>
1746: <head>
1747: <title>$lt{'diso'}</title>
1748: <meta http-equiv="pragma" content="no-cache" />
1749: </head>
1750: $bodytag
1751: <form name="modifyshown" method="post" action="/adm/feedback">
1752: <b>$lt{'diso'}</b><br/> $lt{'prca'}
1753: <br /><br />
1754: <table border="0">
1755: <tr>
1756: <td><b>$lt{'soor'}</b></td>
1757: <td> </td>
1758: <td><b>$lt{'disp'}</b></td>
1759: <td> </td>
1760: <td><b>$lt{'actv'}</b></td>
1761: <td> </td>
1762: <td><b>$lt{'spse'}</b></td>
1763: <td> </td>
1764: <td><b>$lt{'psub'}</b></td>
1765: </tr>
1766: <tr>
1767: <td>
1768: <select name="sortposts">
1769: <option value="ascdate" />Date order - oldest first
1770: <option value="descdate" />Date order - newest first
1771: <option value="thread" />Threaded
1772: <option value="subject" />By subject
1773: <option value="username" />By domain and username
1774: <option value="lastfirst" />By last name, first name
1775: </select>
1776: </td>
1777: <td> </td>
1778: <td>
1779: <select name="rolefilter" multiple="true" size="5">
1780: <option value="all" />All users
1781: <option value="st" />Students
1782: <option value="cc" />Course Coordinators
1783: <option value="in" />Instructors
1784: <option value="ta" />TAs
1785: <option value="pr" />Exam proctors
1786: <option value="cr" />Custom roles
1787: </select>
1788: </td>
1789: <td> </td>
1790: <td>
1791: <select name="statusfilter">
1792: <option value="all" />Roles of any status
1793: <option value="Active" />Only active roles
1794: <option value="Expired" />Only inactive roles
1795: </select>
1796: </td>
1797: <td> </td>
1798: <td>
1799: <select name="sectionpick" multiple="true" size="$numvisible">
1800: $section_sel
1801: </select>
1802: </td>
1803: <td> </td>
1804: <td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</td>
1805: </tr>
1806: </table>
1807: <br />
1808: <br />
1809: <input type="hidden" name="previous" value="$previous" />
1810: <input type="hidden" name="applysort" value="$symb" />
1811: <input type="button" name="sub" value="Store Changes" onClick="javascript:document.modifyshown.submit()" />
1812: <br />
1813: <br />
1814: </form>
1815: </body>
1816: </html>
1817: END
1818: }
1819:
1820: sub print_showposters {
1821: my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
1822: # backward compatibility (bulletin boards used to be 'wrapped')
1823: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
1824: $feedurl=~s|^/adm/wrapper||;
1825: }
1826: # backward compatibility (bulletin boards used to be 'wrapped')
1827: my $ressymb=$symb;
1828: if ($ressymb =~ /bulletin___\d+___/) {
1829: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
1830: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
1831: }
1832: }
1833: my $crs='/'.$ENV{'request.course.id'};
1834: if ($ENV{'request.course.sec'}) {
1835: $crs.='_'.$ENV{'request.course.sec'};
1836: }
1837: $crs=~s/\_/\//g;
1838: my $seeid=&Apache::lonnet::allowed('rin',$crs);
1839: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
1840: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
1841: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1842: my %namesort = ();
1843: my %postcounts = ();
1844: my %lt=&Apache::lonlocal::texthash(
1845: 'diso' => 'Discussion filtering options',
1846: );
1847: my $bodytag=&Apache::loncommon::bodytag('Discussion options',
1848: '','');
1849: if ($contrib{'version'}) {
1850: for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
1851: my $hidden=($contrib{'hidden'}=~/\.$idx\./);
1852: my $deleted=($contrib{'deleted'}=~/\.$idx\./);
1853: unless ((($hidden) && (!$seeid)) || ($deleted)) {
1854: if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
1855: my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
1856: my $lastname = $names{'lastname'};
1857: my $firstname = $names{'firstname'};
1858: if ($lastname eq '') {
1859: $lastname = '_';
1860: }
1861: if ($firstname eq '') {
1862: $firstname = '_';
1863: }
1864: unless (defined($namesort{$lastname})) {
1865: %{$namesort{$lastname}} = ();
1866: }
1867: my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'};
1868: $postcounts{$poster} ++;
1869: if (defined($namesort{$lastname}{$firstname})) {
1870: if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) {
1871: push @{$namesort{$lastname}{$firstname}}, $poster;
1872: }
1873: } else {
1874: @{$namesort{$lastname}{$firstname}} = ("$poster");
1875: }
1876: }
1877: }
1878: }
1879: }
1880: $r->print(<<END);
1881: <html>
1882: <head>
1883: <title>$lt{'diso'}</title>
1884: <meta http-equiv="pragma" content="no-cache" />
1885: </head>
1886: $bodytag
1887: <form name="pickpostersform" method="post">
1888: <table border="0">
1889: <tr>
1890: <td bgcolor="#777777">
1891: <table border="0" cellpadding="3">
1892: <tr bgcolor="#e6ffff">
1893: <td><b>No.</b></td>
1894: <td><b>Select</b></td>
1895: <td><b>Fullname</b><font color="#999999">(Username/domain)</font></td>
1896: <td><b>Posts</td>
1897: </tr>
1898: END
1899: my $count = 0;
1900: foreach my $last (sort keys %namesort) {
1901: foreach my $first (sort keys %{$namesort{$last}}) {
1902: foreach (sort @{$namesort{$last}{$first}}) {
1903: my ($uname,$udom) = split/:/,$_;
1904: if (!$uname || !$udom) {
1905: next;
1906: } else {
1907: $count ++;
1908: $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>');
1909: }
1910: }
1911: }
1912: }
1913: $r->print(<<END);
1914: </table>
1915: </td>
1916: </tr>
1917: </table>
1918: <br />
1919: <input type="hidden" name="sortposts" value="$sortposts" />
1920: <input type="hidden" name="userpick" value="$symb" />
1921: <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" />
1922: </form>
1923: </body>
1924: </html>
1925: END
1926: }
1927:
1928: sub get_post_versions {
1929: my ($versions,$incoming,$htmldecode,$numver) = @_;
1930: if ($incoming =~ /^<version num="0">/) {
1931: my $p = HTML::LCParser->new(\$incoming);
1932: my $done = 0;
1933: while ( (my $token = $p->get_tag("version")) && (!$done)) {
1934: my $num = $token->[1]{num};
1935: my $text = $p->get_text("/version");
1936: if (defined($numver)) {
1937: if ($num == $numver) {
1938: if ($htmldecode) {
1939: $text = &HTML::Entities::decode($text);
1940: }
1941: $$versions{$numver}=$text;
1942: $done = 1;
1943: }
1944: } else {
1945: if ($htmldecode) {
1946: $text = &HTML::Entities::decode($text);
1947: }
1948: $$versions{$num}=$text;
1949: }
1950: }
1951: } else {
1952: if (!defined($numver)) {
1953: $numver = 0;
1954: }
1955: if ($htmldecode) {
1956: $$versions{$numver} = $incoming;
1957: } else {
1958: $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"');
1959: }
1960: }
1961: return;
1962: }
1963:
1964: sub get_post_attachments {
1965: my ($attachments,$attachmenturls) = @_;
1966: my $num;
1967: if ($attachmenturls =~ m/^<attachment id="0">/) {
1968: my $p = HTML::LCParser->new(\$attachmenturls);
1969: while (my $token = $p->get_tag("attachment","filename","post")) {
1970: if ($token->[0] eq "attachment") {
1971: $num = $token->[1]{id};
1972: %{$$attachments{$num}} =();
1973: } elsif ($token->[0] eq "filename") {
1974: $$attachments{$num}{'filename'} = $p->get_text("/filename");
1975: } elsif ($token->[0] eq "post") {
1976: my $id = $token->[1]{id};
1977: $$attachments{$num}{$id} = $p->get_text("/post");
1978: }
1979: }
1980: } else {
1981: %{$$attachments{'0'}} = ();
1982: $$attachments{'0'}{'filename'} = $attachmenturls;
1983: $$attachments{'0'}{'0'} = 'n';
1984: }
1985:
1986: return;
1987: }
1988:
1989: sub fail_redirect {;
1990: my ($r,$feedurl) = @_;
1991: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
1992: $r->print (<<ENDFAILREDIR);
1993: <html>
1994: <head><title>Feedback not sent</title>
1995: <meta http-equiv="pragma" content="no-cache" />
1996: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
1997: </head>
1998: <body bgcolor="#FFFFFF">
1999: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
2000: <b>Sorry, no recipients ...</b>
2001: <br /><a href="$feedurl">Continue</a>
2002: </body>
2003: </html>
2004: ENDFAILREDIR
2005: }
2006:
2007: sub redirect_back {
2008: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_;
2009: my $sorttag = '';
2010: my $roletag = '';
2011: my $statustag = '';
2012: my $sectag = '';
2013: my $userpicktag = '';
2014: my $qrystr = '';
2015: my $prevtag = '';
2016: # backward compatibility (bulletin boards used to be 'wrapped')
2017: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2018: $feedurl=~s|^/adm/wrapper||;
2019: }
2020: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
2021: if ($previous > 0) {
2022: $qrystr = 'previous='.$previous;
2023: if ($feedurl =~ /\?register=1/) {
2024: $feedurl .= '&'.$qrystr;
2025: } else {
2026: $feedurl .= '?'.$qrystr;
2027: }
2028: $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
2029: }
2030: if (defined($sort)) {
2031: my $sortqry = 'sortposts='.$sort;
2032: if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
2033: $feedurl .= '&'.$sortqry;
2034: } else {
2035: $feedurl .= '?'.$sortqry;
2036: }
2037: $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />';
2038: if ( (defined($numpicks)) && ($numpicks > 0) ) {
2039: my $userpickqry = 'totposters='.$numpicks;
2040: $feedurl .= '&'.$userpickqry;
2041: $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
2042: } else {
2043: my $roleqry = 'rolefilter='.$rolefilter;
2044: $feedurl .= '&'.$roleqry;
2045: $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
2046: $feedurl .= '&statusfilter='.$statusfilter;
2047: $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
2048: $feedurl .= '§ionpick='.$secpick;
2049: $sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />';
2050: }
2051: }
2052: $r->print (<<ENDREDIR);
2053: <html>
2054: <head>
2055: <title>Feedback sent</title>
2056: <meta http-equiv="pragma" content="no-cache" />
2057: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
2058: </head>
2059: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
2060: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
2061: $typestyle
2062: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
2063: <font color="red">$status</font>
2064: <form name="reldt" action="$feedurl" target="loncapaclient">
2065: $prevtag
2066: $sorttag
2067: $statustag
2068: $roletag
2069: $sectag
2070: $userpicktag
2071: </form>
2072: <br /><a href="$feedurl">Continue</a>
2073: </body>
2074: </html>
2075: ENDREDIR
2076: }
2077:
2078: sub no_redirect_back {
2079: my ($r,$feedurl) = @_;
2080: my $nofeed=&mt('Sorry, no feedback possible on this resource ...');
2081: my $continue=&mt('Continue');
2082: $r->print (<<ENDNOREDIR);
2083: <html>
2084: <head><title>Feedback not sent</title>
2085: <meta http-equiv="pragma" content="no-cache" />
2086: ENDNOREDIR
2087:
2088: if ($feedurl!~/^\/adm\/feedback/) {
2089: $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
2090: }
2091:
2092: $r->print (<<ENDNOREDIRTWO);
2093: </head>
2094: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
2095: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
2096: <b>$nofeed</b>
2097: <br /><a href="$feedurl">$continue</a>
2098: </body>
2099: </html>
2100: ENDNOREDIRTWO
2101: }
2102:
2103: sub screen_header {
2104: my ($feedurl) = @_;
2105: my $msgoptions='';
2106: my $discussoptions='';
2107: unless (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) {
2108: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
2109: $msgoptions=
2110: '<p><input type="checkbox" name="author" /> '.
2111: &mt('Feedback to resource author').'</p>';
2112: }
2113: if (&feedback_available(1)) {
2114: $msgoptions.=
2115: '<br /><input type="checkbox" name="question" /> '.
2116: &mt('Question about resource content');
2117: }
2118: if (&feedback_available(0,1)) {
2119: $msgoptions.=
2120: '<br /><input type="checkbox" name="course" /> '.
2121: &mt('Question/Comment/Feedback about course content');
2122: }
2123: if (&feedback_available(0,0,1)) {
2124: $msgoptions.=
2125: '<br /><input type="checkbox" name="policy" /> '.
2126: &mt('Question/Comment/Feedback about course policy');
2127: }
2128: }
2129: if ($ENV{'request.course.id'}) {
2130: if (&discussion_open() &&
2131: &Apache::lonnet::allowed('pch',
2132: $ENV{'request.course.id'}.
2133: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
2134: $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
2135: ($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
2136: &mt('Contribution to course discussion of resource');
2137: $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
2138: &mt('Anonymous contribution to course discussion of resource').
2139: ' <i>('.&mt('name only visible to course faculty').')</i>';
2140: }
2141: }
2142: if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
2143: if ($discussoptions) {
2144: $discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
2145: return $msgoptions.$discussoptions;
2146: }
2147:
2148: sub resource_output {
2149: my ($feedurl) = @_;
2150: my $usersaw=&Apache::lonnet::ssi_body($feedurl);
2151: $usersaw=~s/\<body[^\>]*\>//gi;
2152: $usersaw=~s/\<\/body\>//gi;
2153: $usersaw=~s/\<html\>//gi;
2154: $usersaw=~s/\<\/html\>//gi;
2155: $usersaw=~s/\<head\>//gi;
2156: $usersaw=~s/\<\/head\>//gi;
2157: $usersaw=~s/action\s*\=/would_be_action\=/gi;
2158: return $usersaw;
2159: }
2160:
2161: sub clear_out_html {
2162: my ($message,$override)=@_;
2163: unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
2164: # Always allow the <m>-tag
2165: my %html=(M=>1);
2166: # Check if more is allowed
2167: my $cid=$ENV{'request.course.id'};
2168: if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
2169: ($override)) {
2170: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG>
2171: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB>
2172: # <SUP>
2173: %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
2174: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
2175: M=>1, SUB=>1, SUP=>1, SPAN=>1,
2176: H1=>1, H2=>1, H3=>1, H4=>1, H5=>1);
2177: }
2178: # Do the substitution of everything that is not explicitly allowed
2179: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
2180: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge;
2181: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
2182: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge;
2183: return $message;
2184: }
2185:
2186: sub assemble_email {
2187: my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
2188: my $email=<<"ENDEMAIL";
2189: Refers to <a href="$feedurl">$feedurl</a>
2190:
2191: $message
2192: ENDEMAIL
2193: my $citations=<<"ENDCITE";
2194: <h2>Previous attempts of student (if applicable)</h2>
2195: $prevattempts
2196: <br /><hr />
2197: <h2>Original screen output (if applicable)</h2>
2198: $usersaw
2199: <h2>Correct Answer(s) (if applicable)</h2>
2200: $useranswer
2201: ENDCITE
2202: return ($email,$citations);
2203: }
2204:
2205: sub secapply {
2206: my $rec=shift;
2207: my $defaultflag=shift;
2208: $rec=~s/\s+//g;
2209: $rec=~s/\@/\:/g;
2210: my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
2211: if ($sections) {
2212: foreach (split(/\;/,$sections)) {
2213: if (($_ eq $ENV{'request.course.sec'}) ||
2214: ($defaultflag && ($_ eq '*'))) {
2215: return $adr;
2216: }
2217: }
2218: } else {
2219: return $rec;
2220: }
2221: return '';
2222: }
2223:
2224: sub decide_receiver {
2225: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
2226: my $typestyle='';
2227: my %to=();
2228: if ($ENV{'form.author'}||$author) {
2229: $typestyle.='Submitting as Author Feedback<br>';
2230: $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
2231: $to{$2.':'.$1}=1;
2232: }
2233: if ($ENV{'form.question'}||$question) {
2234: $typestyle.='Submitting as Question<br>';
2235: foreach (split(/\,/,
2236: $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
2237: ) {
2238: my $rec=&secapply($_,$defaultflag);
2239: if ($rec) { $to{$rec}=1; }
2240: }
2241: }
2242: if ($ENV{'form.course'}||$course) {
2243: $typestyle.='Submitting as Comment<br />';
2244: foreach (split(/\,/,
2245: $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
2246: ) {
2247: my $rec=&secapply($_,$defaultflag);
2248: if ($rec) { $to{$rec}=1; }
2249: }
2250: }
2251: if ($ENV{'form.policy'}||$policy) {
2252: $typestyle.='Submitting as Policy Feedback<br />';
2253: foreach (split(/\,/,
2254: $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
2255: ) {
2256: my $rec=&secapply($_,$defaultflag);
2257: if ($rec) { $to{$rec}=1; }
2258: }
2259: }
2260: if ((scalar(%to) eq '0') && (!$defaultflag)) {
2261: ($typestyle,%to)=
2262: &decide_receiver($feedurl,$author,$question,$course,$policy,1);
2263: }
2264: return ($typestyle,%to);
2265: }
2266:
2267: sub feedback_available {
2268: my ($question,$course,$policy)=@_;
2269: my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
2270: return scalar(%to);
2271: }
2272:
2273: sub send_msg {
2274: my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
2275: my $status='';
2276: my $sendsomething=0;
2277: foreach (keys %to) {
2278: if ($_) {
2279: my $declutter=&Apache::lonnet::declutter($feedurl);
2280: unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
2281: 'Feedback ['.$declutter.']',$email,$citations,$feedurl,
2282: $attachmenturl)=~/ok/) {
2283: $status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
2284: } else {
2285: $sendsomething++;
2286: }
2287: }
2288: }
2289:
2290: my %record=&Apache::lonnet::restore('_feedback');
2291: my ($temp)=keys %record;
2292: unless ($temp=~/^error\:/) {
2293: my %newrecord=();
2294: $newrecord{'resource'}=$feedurl;
2295: $newrecord{'subnumber'}=$record{'subnumber'}+1;
2296: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
2297: $status.='<br />'.&mt('Not registered').'<br />';
2298: }
2299: }
2300:
2301: return ($status,$sendsomething);
2302: }
2303:
2304: sub adddiscuss {
2305: my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
2306: my $status='';
2307: my $realsymb;
2308: if ($symb=~/^bulletin___/) {
2309: my $filename=(&Apache::lonnet::decode_symb($symb))[2];
2310: $filename=~s|^adm/wrapper/||;
2311: $realsymb=&Apache::lonnet::symbread($filename);
2312: }
2313: if (&discussion_open(undef,$realsymb) &&
2314: &Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
2315: ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
2316:
2317: my %contrib=('message' => $email,
2318: 'sendername' => $ENV{'user.name'},
2319: 'senderdomain' => $ENV{'user.domain'},
2320: 'screenname' => $ENV{'environment.screenname'},
2321: 'plainname' => $ENV{'environment.firstname'}.' '.
2322: $ENV{'environment.middlename'}.' '.
2323: $ENV{'environment.lastname'}.' '.
2324: $ENV{'enrironment.generation'},
2325: 'attachmenturl'=> $attachmenturl,
2326: 'subject' => $subject);
2327: if ($ENV{'form.replydisc'}) {
2328: $contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
2329: }
2330: if ($anon) {
2331: $contrib{'anonymous'}='true';
2332: }
2333: if (($symb) && ($email)) {
2334: if ($ENV{'form.editdisc'}) {
2335: my %newcontrib = ();
2336: $contrib{'ip'}=$ENV{'REMOTE_ADDR'};
2337: $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'};
2338: $contrib{'timestamp'} = time;
2339: $contrib{'history'} = '';
2340: my $numoldver = 0;
2341: my ($oldsymb,$oldidx)=split(/\:\:\:/,$ENV{'form.editdisc'});
2342: $oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
2343: # get timestamp for last post and history
2344: my %oldcontrib=&Apache::lonnet::restore($oldsymb,$ENV{'request.course.id'},
2345: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2346: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2347: if (defined($oldcontrib{$oldidx.':replyto'})) {
2348: $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'};
2349: }
2350: if (defined($oldcontrib{$oldidx.':history'})) {
2351: if ($oldcontrib{$oldidx.':history'} =~ /:/) {
2352: my @oldversions = split/:/,$oldcontrib{$oldidx.':history'};
2353: $numoldver = @oldversions;
2354: } else {
2355: $numoldver = 1;
2356: }
2357: $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':';
2358: }
2359: my $numnewver = $numoldver + 1;
2360: if (defined($oldcontrib{$oldidx.':subject'})) {
2361: if ($oldcontrib{$oldidx.':subject'} =~ /^<version num="0">/) {
2362: $contrib{'subject'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>';
2363: $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'};
2364: } else {
2365: $contrib{'subject'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>';
2366: }
2367: }
2368: if (defined($oldcontrib{$oldidx.':message'})) {
2369: if ($oldcontrib{$oldidx.':message'} =~ /^<version num="0">/) {
2370: $contrib{'message'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>';
2371: $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'};
2372: } else {
2373: $contrib{'message'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>';
2374: }
2375: }
2376: $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'};
2377: foreach (keys %contrib) {
2378: my $key = $oldidx.':'.&Apache::lonnet::escape($oldsymb).':'.$_;
2379: $newcontrib{$key} = $contrib{$_};
2380: }
2381: my $put_reply = &Apache::lonnet::putstore($ENV{'request.course.id'},
2382: \%newcontrib,
2383: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2384: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2385: $status='Editing class discussion'.($anon?' (anonymous)':'');
2386: } else {
2387: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
2388: &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
2389: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2390: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2391: }
2392: my %storenewentry=($symb => time);
2393: $status.='<br />'.&mt('Updating discussion time').': '.
2394: &Apache::lonnet::put('discussiontimes',\%storenewentry,
2395: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2396: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2397: }
2398: my %record=&Apache::lonnet::restore('_discussion');
2399: my ($temp)=keys %record;
2400: unless ($temp=~/^error\:/) {
2401: my %newrecord=();
2402: $newrecord{'resource'}=$symb;
2403: $newrecord{'subnumber'}=$record{'subnumber'}+1;
2404: $status.='<br />'.&mt('Registering').': '.
2405: &Apache::lonnet::cstore(\%newrecord,'_discussion');
2406: }
2407: } else {
2408: $status.='Failed.';
2409: }
2410: return $status.'<br />';
2411: }
2412:
2413: # ----------------------------------------------------------- Preview function
2414:
2415: sub show_preview {
2416: my $r=shift;
2417: my $message=&clear_out_html($ENV{'form.comment'});
2418: $message=~s/\n/\<br \/\>/g;
2419: $message=&Apache::lonspeller::markeduptext($message);
2420: $message=&Apache::lontexconvert::msgtexconverted($message);
2421: my $subject=&clear_out_html($ENV{'form.subject'});
2422: $subject=~s/\n/\<br \/\>/g;
2423: $subject=&Apache::lontexconvert::msgtexconverted($subject);
2424: $r->print('<table border="2"><tr><td>'.
2425: '<b>Subject:</b> '.$subject.'<br /><br />'.
2426: $message.'</td></tr></table>');
2427: }
2428:
2429: sub generate_preview_button {
2430: my $pre=&mt("Show Preview and Check Spelling");
2431: return(<<ENDPREVIEW);
2432: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
2433: <input type="hidden" name="subject">
2434: <input type="hidden" name="comment" />
2435: <input type="button" value="$pre"
2436: onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
2437: </form>
2438: ENDPREVIEW
2439: }
2440:
2441: sub modify_attachments {
2442: my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls)=@_;
2443: my $orig_subject = &Apache::lonnet::unescape($ENV{'form.subject'});
2444: my $subject=&clear_out_html($orig_subject);
2445: $subject=~s/\n/\<br \/\>/g;
2446: $subject=&Apache::lontexconvert::msgtexconverted($subject);
2447: my $timestamp=$ENV{'form.timestamp'};
2448: my $numoldver=$ENV{'form.numoldver'};
2449: my $bodytag=&Apache::loncommon::bodytag('Discussion Post Attachments',
2450: '','');
2451: my $msg = '';
2452: my %attachments = ();
2453: my %currattach = ();
2454: if ($idx) {
2455: &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold);
2456: }
2457: $r->print(<<END);
2458: <html>
2459: <head>
2460: <title>Managing Attachments</title>
2461: <script>
2462: function setAction () {
2463: document.modattachments.action = document.modattachments.origpage.value;
2464: document.modattachments.submit();
2465: }
2466: </script>
2467: </head>
2468: $bodytag
2469: <form name="modattachments" method="post" enctype="multipart/form-data" action="/adm/feedback?attach=$symb">
2470: <table border="2">
2471: <tr>
2472: <td>
2473: <b>Subject:</b> $subject</b><br /><br />
2474: END
2475: if ($idx) {
2476: if ($attachmenturls) {
2477: my @currold = keys %currattach;
2478: if (@currold > 0) {
2479: $r->print("The following attachments were part of the most recent saved version of this posting.<br />Check the checkboxes for any you wish to remove<br />\n");
2480: foreach my $id (@currold) {
2481: my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'});
2482: $attachurl =~ m#/([^/]+)$#;
2483: $r->print('<input type="checkbox" name="deloldattach" value="'.$id.'" /> '.$1.'<br />'."\n");
2484: }
2485: $r->print("<br />");
2486: }
2487: }
2488: }
2489: if (@{$currnewattach} > 0) {
2490: $r->print("The following attachments have been uploaded for inclusion with this posting.<br />Check the checkboxes for any you wish to remove<br />\n");
2491: foreach (@{$currnewattach}) {
2492: $_ =~ m#/([^/]+)$#;
2493: $r->print('<input type="checkbox" name="delnewattach" value="'.$_.'" /> '.$1.'<br />'."\n");
2494: }
2495: $r->print("<br />");
2496: }
2497: $r->print(<<END);
2498: Add a new attachment to this post. <input type="file" name="addnewattach" /><input type="button" name="upload" value="Upload" onClick="this.form.submit()" />
2499: </td>
2500: </tr>
2501: </table>
2502: <input type="hidden" name="subject" value="$ENV{'form.subject'}" />
2503: <input type="hidden" name="comment" value="$ENV{'form.comment'}" />
2504: <input type="hidden" name="timestamp" value="$ENV{'form.timestamp'}" />
2505: <input type="hidden" name="idx" value="$ENV{'form.idx'}" />
2506: <input type="hidden" name="numoldver" value="$ENV{'form.numoldver'}" />
2507: <input type="hidden" name="origpage" value="$ENV{'form.origpage'}" />
2508: <input type="hidden" name="anondiscuss" value="$ENV{'form.anondiscuss'}" />
2509: <input type="hidden" name="discuss" value="$ENV{'form.discuss'}" />
2510: END
2511: foreach (@{$currnewattach}) {
2512: $r->print('<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n");
2513: }
2514: foreach (@{$currdelold}) {
2515: $r->print('<input type="hidden" name="deloldattach" value="'.$_.'" />'."\n");
2516: }
2517: $r->print(<<END);
2518: <input type="button" name="rtntoedit" value="Store Changes" onClick="setAction()"/>
2519: </form>
2520: </body>
2521: </html>
2522: END
2523: return;
2524: }
2525:
2526: sub process_attachments {
2527: my ($currnewattach,$currdelold,$keepold) = @_;
2528: if (exists($ENV{'form.currnewattach'})) {
2529: if (ref($ENV{'form.currnewattach'}) eq 'ARRAY') {
2530: @{$currnewattach} = @{$ENV{'form.currnewattach'}};
2531: } else {
2532: $$currnewattach[0] = $ENV{'form.currnewattach'};
2533: }
2534: }
2535: if (exists($ENV{'form.deloldattach'})) {
2536: if (ref($ENV{'form.deloldattach'}) eq 'ARRAY') {
2537: @{$currdelold} = @{$ENV{'form.deloldattach'}};
2538: } else {
2539: $$currdelold[0] = $ENV{'form.deloldattach'};
2540: }
2541: }
2542: if (exists($ENV{'form.delnewattach'})) {
2543: my @currdelnew = ();
2544: my @currnew = ();
2545: if (ref($ENV{'form.delnewattach'}) eq 'ARRAY') {
2546: @currdelnew = @{$ENV{'form.delnewattach'}};
2547: } else {
2548: $currdelnew[0] = $ENV{'form.delnewattach'};
2549: }
2550: foreach my $newone (@{$currnewattach}) {
2551: my $delflag = 0;
2552: foreach (@currdelnew) {
2553: if ($newone eq $_) {
2554: $delflag = 1;
2555: last;
2556: }
2557: }
2558: unless ($delflag) {
2559: push @currnew, $newone;
2560: }
2561: }
2562: @{$currnewattach} = @currnew;
2563: }
2564: if (exists($ENV{'form.keepold'})) {
2565: if (ref($ENV{'form.keepold'}) eq 'ARRAY') {
2566: @{$keepold} = @{$ENV{'form.keepold'}};
2567: } else {
2568: $$keepold[0] = $ENV{'form.keepold'};
2569: }
2570: }
2571: }
2572:
2573: sub generate_attachments_button {
2574: my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach,$numoldver,$mode) = @_;
2575: my $origpage = $ENV{'REQUEST_URI'};
2576: my $att=$attachnum.' '.&mt("attachments");
2577: my $response = (<<END);
2578: <form name="attachment" action="/adm/feedback?attach=$ressymb" method="post">
2579: Click to add/remove attachments: <input type="button" value="$att"
2580: onClick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=escape(document.mailform.comment.value);this.form.subject.value=escape(document.mailform.subject.value);
2581: END
2582: unless ($mode eq 'board') {
2583: $response .= 'javascript:anonchk();';
2584: }
2585: $response .= (<<ENDATTACH);
2586: this.form.submit();" />
2587: <input type="hidden" name="origpage" value="$origpage" />
2588: <input type="hidden" name="idx" value="$idx" />
2589: <input type="hidden" name="timestamp" value="$now" />
2590: <input type="hidden" name="subject" />
2591: <input type="hidden" name="comment" />
2592: <input type="hidden" name="anondiscuss" value = "0";
2593: <input type="hidden" name="discuss" value = "0";
2594: <input type="hidden" name="numoldver" value="$numoldver" />
2595: ENDATTACH
2596: if (defined($deloldattach)) {
2597: if (@{$deloldattach} > 0) {
2598: foreach (@{$deloldattach}) {
2599: $response .= '<input type="hidden" name="deloldattach" value="'.$_.'" />'."\n";
2600: }
2601: }
2602: }
2603: if (defined($currnewattach)) {
2604: if (@{$currnewattach} > 0) {
2605: foreach (@{$currnewattach}) {
2606: $response .= '<input type="hidden" name="currnewattach" value="'.$_.'" />'."\n";
2607: }
2608: }
2609: }
2610: $response .= '</form>';
2611: return $response;
2612: }
2613:
2614: sub extract_attachments {
2615: my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_;
2616: %{$attachments}=();
2617: &get_post_attachments($attachments,$attachmenturls);
2618: foreach my $id (sort keys %{$attachments}) {
2619: if (exists($$attachments{$id}{$numoldver})) {
2620: if (defined($currdelold)) {
2621: if (@{$currdelold} > 0) {
2622: unless (grep/^$id$/,@{$currdelold}) {
2623: $$currattach{$id} = $$attachments{$id}{$numoldver};
2624: }
2625: } else {
2626: $$currattach{$id} = $$attachments{$id}{$numoldver};
2627: }
2628: } else {
2629: $$currattach{$id} = $$attachments{$id}{$numoldver};
2630: }
2631: }
2632: }
2633: my @attached = (sort { $a <=> $b } keys %{$currattach});
2634: if (@attached == 1) {
2635: my $id = $attached[0];
2636: my $attachurl;
2637: if ($attachmenturls =~ m/^<attachment id="0">/) {
2638: $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
2639: } else {
2640: $attachurl = $$attachments{$id}{'filename'};
2641: }
2642: $attachurl=~m|/([^/]+)$|;
2643: $$message.='<br /><a href="'.$attachurl.'"><tt>'.
2644: $1.'</tt></a><br />';
2645: &Apache::lonnet::allowuploaded('/adm/feedback',
2646: $attachurl);
2647: } elsif (@attached > 1) {
2648: $$message.='<ol>';
2649: foreach (@attached) {
2650: my $id = $_;
2651: my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
2652: my ($fname)
2653: =($attachurl=~m|/([^/]+)$|);
2654: $$message .= '<li><a href="'.$attachurl.
2655: '"><tt>'.
2656: $fname.'</tt></a></li>';
2657: &Apache::lonnet::allowuploaded('/adm/feedback',
2658: $attachurl);
2659: }
2660: $$message .= '</ol>';
2661: }
2662: }
2663:
2664: sub construct_attachmenturl {
2665: my ($currnewattach,$keepold,$symb,$idx)=@_;
2666: my $oldattachmenturl;
2667: my $newattachmenturl;
2668: my $startnum = 0;
2669: my $currver = 0;
2670: if (($ENV{'form.editdisc'}) && ($idx)) {
2671: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
2672: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2673: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2674: $oldattachmenturl = $contrib{$idx.':attachmenturl'};
2675: if ($contrib{$idx.':history'}) {
2676: if ($contrib{$idx.':history'} =~ /:/) {
2677: my @oldversions = split/:/,$contrib{$idx.':history'};
2678: $currver = 1 + scalar(@oldversions);
2679: } else {
2680: $currver = 2;
2681: }
2682: } else {
2683: $currver = 1;
2684: }
2685: if ($oldattachmenturl) {
2686: if ($oldattachmenturl =~ m/^<attachment id="0">/) {
2687: my %attachments = ();
2688: my $prevver = $currver-1;
2689: &get_post_attachments(\%attachments,$oldattachmenturl);
2690: my $numattach = scalar(keys %attachments);
2691: $startnum += $numattach;
2692: foreach my $num (sort {$a <=> $b} keys %attachments) {
2693: $newattachmenturl .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>';
2694: foreach $_ (sort {$a <=> $b} keys %{$attachments{$num}}) {
2695: unless ($_ eq 'filename') {
2696: $newattachmenturl .= '<post id="'.$_.'">'.$attachments{$num}{$_}.'</post>';
2697: }
2698: }
2699: if (grep/^$num$/,@{$keepold}) {
2700: $newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>';
2701: }
2702: $newattachmenturl .= '</attachment>';
2703: }
2704: } else {
2705: $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>';
2706: unless (grep/^0$/,@{$keepold}) {
2707: $newattachmenturl .= '<post id="1">n</post>';
2708: }
2709: $newattachmenturl .= '</attachment>';
2710: $startnum ++;
2711: }
2712: }
2713: }
2714: for (my $i=0; $i<@{$currnewattach}; $i++) {
2715: my $attachnum = $startnum + $i;
2716: $newattachmenturl .= '<attachment id="'.$attachnum.'"><filename>'.&HTML::Entities::encode($$currnewattach[$i]).'</filename><post id="'.$currver.'">n</post></attachment>';
2717: }
2718: return $newattachmenturl;
2719: }
2720:
2721: sub has_discussion {
2722: my $resourcesref = shift;
2723: my $navmap = Apache::lonnavmaps::navmap->new();
2724: my @allres=$navmap->retrieveResources();
2725: foreach my $resource (@allres) {
2726: if ($resource->hasDiscussion()) {
2727: my $ressymb;
2728: if ($resource->symb() =~ m-(___adm/\w+/\w+)/(\d+)/bulletinboard$-) {
2729: $ressymb = 'bulletin___'.$2.$1.'/'.$2.'/bulletinboard';
2730: } else {
2731: $ressymb = $resource->symb();
2732: }
2733: push @{$resourcesref}, $ressymb;
2734: }
2735: }
2736: return;
2737: }
2738:
2739: sub handler {
2740: my $r = shift;
2741: if ($r->header_only) {
2742: &Apache::loncommon::content_type($r,'text/html');
2743: $r->send_http_header;
2744: return OK;
2745: }
2746:
2747: # --------------------------- Get query string for limited number of parameters
2748:
2749: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
2750: ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','threadedon','threadedoff','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export']);
2751: if ($ENV{'form.discsymb'}) {
2752: my $symb = $ENV{'form.discsymb'};
2753: my $readkey = $symb.'_read';
2754: my %readinghash = ();
2755: my $chgcount = 0;
2756: %readinghash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$readkey],$ENV{'user.domain'},$ENV{'user.name'});
2757: foreach my $key (keys %ENV) {
2758: if ($key =~ m/^form\.postunread_(\d+)/) {
2759: if ($readinghash{$readkey} =~ /\.$1\./) {
2760: $readinghash{$readkey} =~ s/\.$1\.//;
2761: $chgcount ++;
2762: }
2763: } elsif ($key =~ m/^form\.postread_(\d+)/) {
2764: unless ($readinghash{$readkey} =~ /\.$1\./) {
2765: $readinghash{$readkey} .= '.'.$1.'.';
2766: $chgcount ++;
2767: }
2768: }
2769: }
2770: if ($chgcount > 0) {
2771: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%readinghash,$ENV{'user.domain'},$ENV{'user.name'});
2772: }
2773: &Apache::loncommon::content_type($r,'text/html');
2774: $r->send_http_header;
2775: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2776: my $previous=$ENV{'form.previous'};
2777: my $feedurl = &Apache::lonnet::clutter($url);
2778: &redirect_back($r,$feedurl,&mt('Marked postings read/unread').'<br />','0','0','',$previous,'','','',);
2779: return OK;
2780: }
2781: if ($ENV{'form.allversions'}) {
2782: &Apache::loncommon::content_type($r,'text/html');
2783: $r->send_http_header;
2784: my $bodytag=&Apache::loncommon::bodytag('Discussion Post Versions',
2785: '','');
2786: $r->print (<<END);
2787: <html>
2788: <head>
2789: <title>Post Versions</title>
2790: <meta http-equiv="pragma" content="no-cache" />
2791: </head>
2792: $bodytag
2793: END
2794: my $crs='/'.$ENV{'request.course.id'};
2795: if ($ENV{'request.course.sec'}) {
2796: $crs.='_'.$ENV{'request.course.sec'};
2797: }
2798: $crs=~s/\_/\//g;
2799: my $seeid=&Apache::lonnet::allowed('rin',$crs);
2800: my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.allversions'});
2801: my $ressymb=$symb;
2802: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
2803: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
2804: }
2805: if ($idx > 0) {
2806: my %messages = ();
2807: my %subjects = ();
2808: my %attachmsgs = ();
2809: my %allattachments = ();
2810: my %imsfiles = ();
2811: my ($screenname,$plainname);
2812: my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
2813: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
2814: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
2815: my $discussion = &get_post_contents(\%contrib,$idx,$seeid,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname);
2816: $r->print($discussion);
2817: }
2818: return OK;
2819: }
2820: if ($ENV{'form.posterlist'}) {
2821: &Apache::loncommon::content_type($r,'text/html');
2822: $r->send_http_header;
2823: my $symb=$ENV{'form.posterlist'};
2824: my $sortposts = $ENV{'form.sortposts'};
2825: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2826: my $previous=$ENV{'form.previous'};
2827: my $feedurl = &Apache::lonnet::clutter($url);
2828: # backward compatibility (bulletin boards used to be 'wrapped')
2829: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2830: $feedurl=~s|^/adm/wrapper||;
2831: }
2832: &print_showposters($r,$symb,$previous,$feedurl,$sortposts);
2833: return OK;
2834: }
2835: if ($ENV{'form.userpick'}) {
2836: &Apache::loncommon::content_type($r,'text/html');
2837: $r->send_http_header;
2838: my $symb=$ENV{'form.userpick'};
2839: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2840: my $previous=$ENV{'form.previous'};
2841: # backward compatibility (bulletin boards used to be 'wrapped')
2842: my $ressymb=$symb;
2843: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
2844: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
2845: }
2846: my $sort=$ENV{'form.sortposts'};
2847: my @posters = ();
2848: if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') {
2849: @posters = $ENV{'form.stuinfo'};
2850: } else {
2851: $posters[0] = $ENV{'form.stuinfo'};
2852: }
2853: my $numpicks = @posters;
2854: if (defined($ENV{'form.userpick'})) {
2855: my %discinfo = ();
2856: $discinfo{$ressymb.'_userpick'} = join('&',@posters);
2857: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
2858: }
2859: my $feedurl = &Apache::lonnet::clutter($url);
2860: # backward compatibility (bulletin boards used to be 'wrapped')
2861: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2862: $feedurl=~s|^/adm/wrapper||;
2863: }
2864: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks);
2865: return OK;
2866: }
2867: if ($ENV{'form.applysort'}) {
2868: &Apache::loncommon::content_type($r,'text/html');
2869: $r->send_http_header;
2870: my $symb=$ENV{'form.applysort'};
2871: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2872: my $previous=$ENV{'form.previous'};
2873: my $sort = $ENV{'form.sortposts'};
2874: my $rolefilter = $ENV{'form.rolefilter'};
2875: my $statusfilter = $ENV{'form.statusfilter'};
2876: my $secpick = $ENV{'form.sectionpick'};
2877: my $feedurl = &Apache::lonnet::clutter($url);
2878: # backward compatibility (bulletin boards used to be 'wrapped')
2879: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2880: $feedurl=~s|^/adm/wrapper||;
2881: }
2882: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick);
2883: return OK;
2884: } elsif ($ENV{'form.sortfilter'}) {
2885: &Apache::loncommon::content_type($r,'text/html');
2886: $r->send_http_header;
2887: my $symb=$ENV{'form.sortfilter'};
2888: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2889: my $previous=$ENV{'form.previous'};
2890: my $feedurl = &Apache::lonnet::clutter($url);
2891: # backward compatibility (bulletin boards used to be 'wrapped')
2892: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2893: $feedurl=~s|^/adm/wrapper||;
2894: }
2895: &print_sortfilter_options($r,$symb,$previous,$feedurl);
2896: return OK;
2897: } elsif ($ENV{'form.navtime'}) {
2898: my %discinfo = ();
2899: my @resources = ();
2900: if (defined($ENV{'form.navmaps'})) {
2901: if ($ENV{'form.navmaps'} =~ /:/) {
2902: @resources = split/:/,$ENV{'form.navmaps'};
2903: } else {
2904: @resources = ("$ENV{'form.navmaps'}");
2905: }
2906: } else {
2907: &has_discussion(\@resources);
2908: }
2909: my $numitems = @resources;
2910: my $feedurl = '/adm/navmaps';
2911: if ($ENV{'form.navurl'}) {
2912: $feedurl .= '?'.$ENV{'form.navurl'};
2913: }
2914: my %lt = &Apache::lonlocal::texthash(
2915: 'mnpa' => 'Marked "New" posts as read in a total of',
2916: 'robb' => 'resources/bulletin boards.',
2917: 'twnp' => 'There are currently no resources or bulletin boards with unread discussion postings.'
2918: );
2919: foreach (@resources) {
2920: # backward compatibility (bulletin boards used to be 'wrapped')
2921: my $ressymb=$_;
2922: if ($ressymb =~ m/bulletin___\d+___/) {
2923: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
2924: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
2925: }
2926: }
2927: my $lastkey = $ressymb.'_lastread';
2928: $discinfo{$lastkey} = $ENV{'form.navtime'};
2929: }
2930: my $textline = "<b>$lt{'mnpa'} $numitems $lt{'robb'}</b>";
2931: if ($numitems > 0) {
2932: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
2933: } else {
2934: $textline = "<b>$lt{'twnp'}</b>";
2935: }
2936: &Apache::loncommon::content_type($r,'text/html');
2937: $r->send_http_header;
2938: $r->print (<<ENDREDIR);
2939: <html>
2940: <head>
2941: <title>New posts marked as read</title>
2942: <meta http-equiv="pragma" content="no-cache" />
2943: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
2944: </head>
2945: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
2946: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
2947: $textline
2948: <form name="reldt" action="$feedurl" target="loncapaclient">
2949: </form>
2950: <br /><a href="$feedurl">Continue</a>
2951: </body>
2952: </html>
2953: ENDREDIR
2954: return OK;
2955: } elsif ($ENV{'form.modifydisp'}) {
2956: &Apache::loncommon::content_type($r,'text/html');
2957: $r->send_http_header;
2958: my $symb=$ENV{'form.modifydisp'};
2959: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2960: my $previous=$ENV{'form.previous'};
2961: my ($dispchgA,$dispchgB,$markchg,$toggchg) = split/_/,$ENV{'form.changes'};
2962: my $feedurl = &Apache::lonnet::clutter($url);
2963: # backward compatibility (bulletin boards used to be 'wrapped')
2964: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
2965: $feedurl=~s|^/adm/wrapper||;
2966: }
2967: &print_display_options($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl);
2968: return OK;
2969: } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) || $ENV{'form.onlyunmark'} || $ENV{'form.toggoff'} || $ENV{'form.toggon'} ) {
2970: &Apache::loncommon::content_type($r,'text/html');
2971: $r->send_http_header;
2972: my $previous=$ENV{'form.previous'};
2973: my ($map,$ind,$url);
2974: if ( ($ENV{'form.toggoff'}) || ($ENV{'form.toggon'}) ) {
2975: # ------------------------------ Modify setting for read/unread toggle for each post
2976: my $symb=$ENV{'form.toggoff'}?$ENV{'form.toggoff'}:$ENV{'form.toggon'};
2977: my $ressymb = $symb;
2978: ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2979: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
2980: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
2981: }
2982: my %discinfo = ();
2983: my $toggkey = $ressymb.'_readtoggle';
2984: if ($ENV{'form.toggon'}) {
2985: $discinfo{$toggkey} = 1;
2986: } elsif ($ENV{'form.toggoff'}) {
2987: $discinfo{$toggkey} = 0;
2988: }
2989: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
2990: }
2991: if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) {
2992: # ---------------------- Modify setting for identification of 'NEW' posts in this discussion
2993: my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'};
2994: my $ressymb = $symb;
2995: ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
2996: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
2997: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
2998: }
2999: my %discinfo = ();
3000: my $lastkey = $ressymb.'_lastread';
3001: my $ondispkey = $ressymb.'_markondisp';
3002: if ($ENV{'form.markondisp'}) {
3003: $discinfo{$lastkey} = time;
3004: $discinfo{$ondispkey} = 1;
3005: } elsif ($ENV{'form.markonread'}) {
3006: if ( $previous > 0 ) {
3007: $discinfo{$lastkey} = $previous;
3008: }
3009: $discinfo{$ondispkey} = 0;
3010: }
3011: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
3012: }
3013: if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) || ($ENV{'form.onlyunmark'}) ) {
3014: # ----------------------------------------------------------------- Modify display setting for this discussion
3015: my $symb;
3016: if ($ENV{'form.allposts'}) {
3017: $symb = $ENV{'form.allposts'};
3018: } elsif ($ENV{'form.onlyunread'}) {
3019: $symb = $ENV{'form.onlyunread'};
3020: } else {
3021: $symb = $ENV{'form.onlyunmark'};
3022: }
3023: my $ressymb = $symb;
3024: ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3025: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
3026: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
3027: }
3028: my %discinfo = ();
3029: if ($ENV{'form.allposts'}) {
3030: $discinfo{$ressymb.'_showonlyunread'} = 0;
3031: $discinfo{$ressymb.'_showonlyunmark'} = 0;
3032: } elsif ($ENV{'form.onlyunread'}) {
3033: $discinfo{$ressymb.'_showonlyunread'} = 1;
3034: } else {
3035: $discinfo{$ressymb.'_showonlyunmark'} = 1;
3036: }
3037: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
3038: }
3039: if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) || ($ENV{'form.onlyunmark'}) ||($ENV{'form.toggoff'}) || ($ENV{'form.toggon'}) ) {
3040: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous);
3041: } else {
3042: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0');
3043: }
3044: return OK;
3045: } elsif ($ENV{'form.markread'}) {
3046: # ----------------------------------------------------------------- Mark new posts not NEW
3047: &Apache::loncommon::content_type($r,'text/html');
3048: $r->send_http_header;
3049: my $symb=$ENV{'form.markread'};
3050: my $ressymb = $symb;
3051: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3052: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
3053: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
3054: }
3055: my %discinfo = ();
3056: my $lastkey = $ressymb.'_lastread';
3057: $discinfo{$lastkey} = time;
3058: &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
3059: &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0');
3060: return OK;
3061: } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
3062: # ----------------------------------------------------------------- Hide/unhide
3063: &Apache::loncommon::content_type($r,'text/html');
3064: $r->send_http_header;
3065:
3066: my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
3067:
3068: my ($symb,$idx)=split(/\:\:\:/,$entry);
3069: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3070:
3071: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
3072: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
3073: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
3074:
3075:
3076: my $currenthidden=$contrib{'hidden'};
3077: my $currentstudenthidden=$contrib{'studenthidden'};
3078:
3079: my $crs='/'.$ENV{'request.course.id'};
3080: if ($ENV{'request.course.sec'}) {
3081: $crs.='_'.$ENV{'request.course.sec'};
3082: }
3083: $crs=~s/\_/\//g;
3084: my $seeid=&Apache::lonnet::allowed('rin',$crs);
3085:
3086: if ($ENV{'form.hide'}) {
3087: $currenthidden.='.'.$idx.'.';
3088: unless ($seeid) {
3089: $currentstudenthidden.='.'.$idx.'.';
3090: }
3091: } else {
3092: $currenthidden=~s/\.$idx\.//g;
3093: }
3094: my %newhash=('hidden' => $currenthidden);
3095: if ( ($ENV{'form.hide'}) && (!$seeid) ) {
3096: $newhash{'studenthidden'} = $currentstudenthidden;
3097: }
3098:
3099: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
3100: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
3101: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
3102:
3103: &redirect_back($r,&Apache::lonnet::clutter($url),
3104: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
3105: } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
3106: &Apache::loncommon::content_type($r,'text/html');
3107: $r->send_http_header;
3108: if ($ENV{'form.threadedon'}) {
3109: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
3110: &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
3111: } else {
3112: &Apache::lonnet::del('environment',['threadeddiscussion']);
3113: &Apache::lonnet::delenv('environment\.threadeddiscussion');
3114: }
3115: my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
3116: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3117: &redirect_back($r,&Apache::lonnet::clutter($url),
3118: &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
3119: } elsif ($ENV{'form.deldisc'}) {
3120: # --------------------------------------------------------------- Hide for good
3121: &Apache::loncommon::content_type($r,'text/html');
3122: $r->send_http_header;
3123:
3124: my $entry=$ENV{'form.deldisc'};
3125:
3126: my ($symb,$idx)=split(/\:\:\:/,$entry);
3127: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3128:
3129: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
3130: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
3131: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
3132:
3133:
3134: my $currentdeleted=$contrib{'deleted'};
3135:
3136: $currentdeleted.='.'.$idx.'.';
3137:
3138: my %newhash=('deleted' => $currentdeleted);
3139:
3140: &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
3141: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
3142: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
3143:
3144: &redirect_back($r,&Apache::lonnet::clutter($url),
3145: &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
3146: } elsif ($ENV{'form.preview'}) {
3147: # -------------------------------------------------------- User wants a preview
3148: $r->content_type('text/html');
3149: $r->send_http_header;
3150: &show_preview($r);
3151: } elsif ($ENV{'form.attach'}) {
3152: # -------------------------------------------------------- Work on attachments
3153: &Apache::loncommon::content_type($r,'text/html');
3154: $r->send_http_header;
3155: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','anondiscuss','discuss']);
3156: my @currnewattach = ();
3157: my @currdelold = ();
3158: my @keepold = ();
3159: &process_attachments(\@currnewattach,\@currdelold,\@keepold);
3160: if (exists($ENV{'form.addnewattach.filename'})) {
3161: unless (length($ENV{'form.addnewattach'})>131072) {
3162: my $subdir = 'feedback/'.$ENV{'form.timestamp'};
3163: my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir);
3164: push @currnewattach, $newattachment;
3165: }
3166: }
3167: my $attachmenturls = '';
3168: my $idx = $ENV{'form.idx'};
3169: my $symb = $ENV{'form.attach'};
3170: if ($idx) {
3171: my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
3172: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
3173: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
3174: $attachmenturls = $contrib{$idx.':attachmenturl'};
3175: }
3176: &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx,$attachmenturls);
3177: } elsif ($ENV{'form.chgreads'}) {
3178: &Apache::loncommon::content_type($r,'text/html');
3179: $r->send_http_header;
3180: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($ENV{'form.chgreads'});
3181: &redirect_back($r,&Apache::lonnet::clutter($url),
3182: &mt('Changed read status').'<br />','0','0');
3183: } elsif ($ENV{'form.export'}) {
3184: &Apache::loncommon::content_type($r,'text/html');
3185: $r->send_http_header;
3186: my $symb=$ENV{'form.export'};
3187: my $mode;
3188: my $status='OPEN';
3189: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
3190: my $previous=$ENV{'form.previous'};
3191: my $feedurl = &Apache::lonnet::clutter($url);
3192: # backward compatibility (bulletin boards used to be 'wrapped')
3193: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
3194: $mode = 'board';
3195: $feedurl=~s|^/adm/wrapper||;
3196: }
3197: if ($feedurl =~ /\.(problem|exam|quiz|assess|survey|form|library)$/) {
3198: $mode='problem';
3199: $status=$Apache::inputtags::status[-1];
3200: }
3201: my $discussion = &list_discussion($mode,$status,$symb);
3202: my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion');
3203: $r->print($bodytag.$discussion);
3204: return OK;
3205: } else {
3206: # ------------------------------------------------------------- Normal feedback
3207: my $feedurl=$ENV{'form.postdata'};
3208: $feedurl=~s/^http\:\/\///;
3209: $feedurl=~s/^$ENV{'SERVER_NAME'}//;
3210: $feedurl=~s/^$ENV{'HTTP_HOST'}//;
3211: $feedurl=~s/\?.+$//;
3212:
3213: my $symb;
3214: if ($ENV{'form.replydisc'}) {
3215: $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
3216: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
3217: $feedurl=&Apache::lonnet::clutter($url);
3218: } elsif ($ENV{'form.editdisc'}) {
3219: $symb=(split(/\:\:\:/,$ENV{'form.editdisc'}))[0];
3220: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
3221: $feedurl=&Apache::lonnet::clutter($url);
3222: } elsif ($ENV{'form.origpage'}) {
3223: $symb="";
3224: } else {
3225: $symb=&Apache::lonnet::symbread($feedurl);
3226: }
3227: unless ($symb) {
3228: $symb=$ENV{'form.symb'};
3229: if ($symb) {
3230: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
3231: $feedurl=&Apache::lonnet::clutter($url);
3232: }
3233: }
3234: my $goahead=1;
3235: if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
3236: unless ($symb) { $goahead=0; }
3237: }
3238: # backward compatibility (bulletin boards used to be 'wrapped')
3239: if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
3240: $feedurl=~s|^/adm/wrapper||;
3241: }
3242: if ($goahead) {
3243: # Go ahead with feedback, no ambiguous reference
3244: &Apache::loncommon::content_type($r,'text/html');
3245: $r->send_http_header;
3246:
3247: if (
3248: (
3249: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
3250: )
3251: ||
3252: ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
3253: ||
3254: ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
3255: ) {
3256: # --------------------------------------------------- Print login screen header
3257: unless ($ENV{'form.sendit'}) {
3258: my $options=&screen_header($feedurl);
3259: if ($options) {
3260: &mail_screen($r,$feedurl,$options);
3261: } else {
3262: &fail_redirect($r,$feedurl);
3263: }
3264: } else {
3265:
3266: # Get previous user input
3267: my $prevattempts=&Apache::loncommon::get_previous_attempt(
3268: $symb,$ENV{'user.name'},$ENV{'user.domain'},
3269: $ENV{'request.course.id'});
3270:
3271: # Get output from resource
3272: my $usersaw=&resource_output($feedurl);
3273:
3274: # Get resource answer (need to allow student to view grades for this to work)
3275: &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
3276: my $useranswer=&Apache::loncommon::get_student_answers(
3277: $symb,$ENV{'user.name'},$ENV{'user.domain'},
3278: $ENV{'request.course.id'});
3279: &Apache::lonnet::delenv('allowed.vgr');
3280: # Get attachments, if any, and not too large
3281: my $attachmenturl='';
3282: if (($ENV{'form.origpage'}) || ($ENV{'form.editdisc'}) || ($ENV{'form.replydisc'})) {
3283: my ($symb,$idx);
3284: if ($ENV{'form.replydisc'}) {
3285: ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
3286: } elsif ($ENV{'form.editdisc'}) {
3287: ($symb,$idx)=split(/\:\:\:/,$ENV{'form.editdisc'});
3288: } elsif ($ENV{'form.origpage'}) {
3289: $symb = $ENV{'form.symb'};
3290: }
3291: my @currnewattach = ();
3292: my @deloldattach = ();
3293: my @keepold = ();
3294: &process_attachments(\@currnewattach,\@deloldattach,\@keepold);
3295: $symb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
3296: $attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx);
3297: } elsif ($ENV{'form.attachment.filename'}) {
3298: unless (length($ENV{'form.attachment'})>131072) {
3299: $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback');
3300: }
3301: }
3302: # Filter HTML out of message (could be nasty)
3303: my $message=&clear_out_html($ENV{'form.comment'});
3304:
3305: # Assemble email
3306: my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
3307: $usersaw,$useranswer);
3308:
3309: # Who gets this?
3310: my ($typestyle,%to) = &decide_receiver($feedurl);
3311:
3312: # Actually send mail
3313: my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
3314: $attachmenturl,%to);
3315:
3316: # Discussion? Store that.
3317:
3318: my $numpost=0;
3319: if ($ENV{'form.discuss'}) {
3320: my $subject = &clear_out_html($ENV{'form.subject'});
3321: $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
3322: $numpost++;
3323: }
3324:
3325: if ($ENV{'form.anondiscuss'}) {
3326: my $subject = &clear_out_html($ENV{'form.subject'});
3327: $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
3328: $numpost++;
3329: }
3330:
3331:
3332: # Receipt screen and redirect back to where came from
3333: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
3334:
3335: }
3336: } else {
3337: # Unable to give feedback
3338: &no_redirect_back($r,$feedurl);
3339: }
3340: } else {
3341: # Ambiguous Problem Resource
3342: if ( &Apache::lonnet::mod_perl_version() == 2 ) {
3343: &Apache::lonnet::cleanenv();
3344: }
3345: $r->internal_redirect('/adm/ambiguous');
3346: }
3347: }
3348: return OK;
3349: }
3350:
3351: 1;
3352: __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