loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.113: download - view: text, annotated - select for diffs
Wed Aug 4 18:04:57 2004 UTC (19 years, 9 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

XML now used to store information about multiple attachments.  Still to do: option to set display of attachments inline in post.

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