loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.144: download - view: text, annotated - select for diffs
Sun Nov 21 04:24:49 2004 UTC (19 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: version_1_2_99_0, HEAD

Sections in Sort/filter display come from loncommon::get_sections().  Some small display improvements.

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