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