loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.111: download - view: text, annotated - select for diffs
Sun Aug 1 16:05:14 2004 UTC (19 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

User can now toggle read/unread for individual discussion posts.

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