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