loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.143: download - view: text, annotated - select for diffs
Sat Nov 20 20:40:51 2004 UTC (19 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

Fix bug #3607.  Extend filtering to support multiple selections of roles and/or sections.

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