loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.125: download - view: text, annotated - select for diffs
Mon Sep 13 12:49:42 2004 UTC (19 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Eliminate debugging messages. Indentation changes. Save messages from replication of attachments for IMS.

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