loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.198: download - view: text, annotated - select for diffs
Tue May 9 20:00:44 2006 UTC (18 years ago) by albertel
Branches: MAIN
CVS tags: HEAD

- blog posting setting is remebered when going to a from attachments screen
- page headers added back to attachment screen
- anon versus nonanon is a radiobutton now

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