loncom/interface/lonfeedback.pm - view

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

Correcting indentation

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