loncom/interface/lonfeedback.pm - view

File: [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.361: download - view: text, annotated - select for diffs
Wed Dec 19 05:18:31 2012 UTC (11 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Fix quotes (typo in rev. 1.360).

1: # The LearningOnline Network 2: # Feedback 3: # 4: # $Id: lonfeedback.pm,v 1.361 2012/12/19 05:18:31 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::lonnet; 39: use Apache::lonhtmlcommon(); 40: use Apache::lonnavmaps; 41: use Apache::lonenc(); 42: use Apache::lonrss(); 43: use HTML::LCParser(); 44: #use HTML::Tidy::libXML; 45: use Apache::lonspeller(); 46: use Apache::longroup; 47: use Cwd; 48: use LONCAPA; 49: 50: sub discussion_open { 51: my ($status,$symb)=@_; 52: # Advanced roles can always discuss 53: if ($env{'request.role.adv'}) { return 1; } 54: # Get discussion closing date 55: my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb); 56: # If it is defined and in the future, the instructor wants this discussion to be open 57: if (defined($close) && $close ne '' && $close > time) { 58: return 1; 59: } 60: # It was not explicitly open, check if the problem is available. 61: # If the problem is not available, close the discussion 62: if (defined($status) && 63: !($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER' 64: || $status eq 'OPEN')) { 65: return 0; 66: } 67: # The problem is available, but check if the instructor explictly closed discussion 68: if (defined($close) && $close ne '' && $close < time) { 69: return 0; 70: } 71: return 1; 72: } 73: 74: sub discussion_visible { 75: my ($status)=@_; 76: if (not &discussion_open($status)) { 77: my $hidden=&Apache::lonnet::EXT('resource.0.discusshide'); 78: if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) { 79: if (!$env{'request.role.adv'}) { return 0; } 80: } 81: } 82: return 1; 83: } 84: 85: sub discussion_vote_available { 86: my ($status,$symb)=@_; 87: my $canvote=&Apache::lonnet::EXT('resource.0.discussvote',$symb); 88: if ((lc($canvote) eq 'yes') || 89: ((lc($canvote) eq 'notended') && (&discussion_open($status,$symb)))) { 90: return 1; 91: } 92: } 93: 94: sub get_realsymb { 95: my ($symb) = @_; 96: my $realsymb = $symb; 97: if ($symb=~/^bulletin___/) { 98: my $filename=(&Apache::lonnet::decode_symb($symb))[2]; 99: $filename=~s{^adm/wrapper/}{}; 100: $realsymb=&Apache::lonnet::symbread($filename); 101: } 102: return $realsymb; 103: } 104: 105: sub list_discussion { 106: my ($mode,$status,$ressymb,$imsextras,$group)=@_; 107: unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); } 108: unless ($ressymb) { return ''; } 109: $ressymb=&wrap_symb($ressymb); 110: my $outputtarget=$env{'form.grade_target'}; 111: if (defined($env{'form.export'})) { 112: if($env{'form.export'}) { 113: $outputtarget = 'export'; 114: } 115: } 116: if (defined($imsextras)) { 117: if ($$imsextras{'caller'} eq 'imsexport') { 118: $outputtarget = 'export'; 119: } 120: } 121: if (not &discussion_visible($status)) { 122: if ($mode ne 'board') { 123: &Apache::lonenc::check_encrypt(\$ressymb); 124: return '<br /><div class="LC_feedback_link">'.&send_message_link($ressymb)."</div>"; 125: } 126: } 127: if ($group ne '' && $mode eq 'board') { 128: if (&check_group_priv($group,'vgb') ne 'ok') { 129: return ''; 130: } 131: } 132: 133: my ($blocked,$blocktext) = 134: &Apache::loncommon::blocking_status('boards'); 135: if ($blocked) { 136: $blocktext = '<br /><div class="LC_feedback_link"><span class="LC_feedback_link">'.$blocktext."</span>"; 137: &Apache::lonenc::check_encrypt(\$ressymb); 138: if ($mode ne 'board') { 139: $blocktext.=&send_message_link($ressymb).'</div>'; 140: }else{ 141: $blocktext.="</div>"; 142: } 143: return $blocktext; 144: } 145: 146: my @bgcols = ("LC_disc_old_item","LC_disc_new_item"); 147: my $discussiononly=0; 148: if ($mode eq 'board') { $discussiononly=1; } 149: unless ($env{'request.course.id'}) { return ''; } 150: my $crs='/'.$env{'request.course.id'}; 151: my $cid=$env{'request.course.id'}; 152: if ($env{'request.course.sec'}) { 153: $crs.='_'.$env{'request.course.sec'}; 154: } 155: $crs=~s/\_/\//g; 156: my $encsymb=&Apache::lonenc::check_encrypt($ressymb); 157: my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs) 158: && ($ressymb=~/$LONCAPA::assess_re/)); 159: 160: my %usernamesort = (); 161: my %namesort =(); 162: my %subjectsort = (); 163: 164: # Get discussion display settings for this discussion 165: my $lastkey = $ressymb.'_lastread'; 166: my $showkey = $ressymb.'_showonlyunread'; 167: my $markkey = $ressymb.'_showonlyunmark', 168: my $visitkey = $ressymb.'_visit'; 169: my $ondispkey = $ressymb.'_markondisp'; 170: my $userpickkey = $ressymb.'_userpick'; 171: my $toggkey = $ressymb.'_readtoggle'; 172: my $readkey = $ressymb.'_read'; 173: $ressymb=$encsymb; 174: my %dischash = &Apache::lonnet::get('nohist_'.$cid.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$env{'user.domain'},$env{'user.name'}); 175: my %discinfo = (); 176: my $showonlyunread = 0; 177: my $showunmark = 0; 178: my $markondisp = 0; 179: my $prevread = 0; 180: my $previous = 0; 181: my $visit = 0; 182: my $newpostsflag = 0; 183: my @posters = split(/\&/,$dischash{$userpickkey}); 184: 185: # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts. 186: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','grouppick','totposters']); 187: my $sortposts = $env{'form.sortposts'}; 188: my $statusfilter = $env{'form.statusfilter'}; 189: my @sectionpick = split(/,/,$env{'form.sectionpick'}); 190: my @grouppick = split(/,/,$env{'form.grouppick'}); 191: my @rolefilter = split(/,/,$env{'form.rolefilter'}); 192: 193: my $totposters = $env{'form.totposters'}; 194: $previous = $env{'form.previous'}; 195: if ($previous > 0) { 196: $prevread = $previous; 197: } elsif (defined($dischash{$lastkey})) { 198: unless ($dischash{$lastkey} eq '') { 199: $prevread = $dischash{$lastkey}; 200: } 201: } 202: 203: my $cdom = $env{'course.'.$cid.'.domain'}; 204: my $cnum = $env{'course.'.$cid.'.num'}; 205: my $crstype = &Apache::loncommon::course_type(); 206: 207: # Get information about students and non-students in course for filtering display of posts 208: my %roleshash = (); 209: my %roleinfo = (); 210: my ($classgroups,$studentgroups); 211: if ($env{'form.rolefilter'}) { 212: %roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); 213: foreach my $rolekey (keys(%roleshash)) { 214: my ($role,$uname,$udom,$sec) = split(/:/,$rolekey); 215: if ($role =~ /^cr/) { 216: $role = 'cr'; 217: } 218: my ($end,$start) = split(/:/,$roleshash{$rolekey}); 219: my $now = time; 220: my $status = 'Active'; 221: if (($now < $start) || ($end > 0 && $now > $end)) { 222: $status = 'Expired'; 223: } 224: if ($uname && $udom) { 225: push(@{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status); 226: } 227: } 228: my ($classlist,$keylist) = 229: &Apache::loncoursedata::get_classlist($cdom,$cnum); 230: my $sec_index = &Apache::loncoursedata::CL_SECTION(); 231: my $status_index = &Apache::loncoursedata::CL_STATUS(); 232: while (my ($student,$data) = each %$classlist) { 233: my ($section,$status) = ($data->[$sec_index], 234: $data->[$status_index]); 235: push(@{$roleinfo{$student}}, 'st:'.$section.':'.$status); 236: } 237: ($classgroups,$studentgroups) = 238: &Apache::loncoursedata::get_group_memberships($classlist,$keylist, 239: $cdom,$cnum); 240: } 241: 242: # Get discussion display default settings for user 243: if ($env{'environment.discdisplay'} eq 'unread') { 244: $showonlyunread = 1; 245: } 246: if ($env{'environment.discmarkread'} eq 'ondisp') { 247: $markondisp = 1; 248: } 249: 250: # Override user's default if user specified display setting for this discussion 251: if (defined($dischash{$ondispkey})) { 252: unless ($dischash{$ondispkey} eq '') { 253: $markondisp = $dischash{$ondispkey}; 254: } 255: } 256: if ($markondisp) { 257: $discinfo{$lastkey} = time; 258: } 259: 260: if (defined($dischash{$showkey})) { 261: unless ($dischash{$showkey} eq '') { 262: $showonlyunread = $dischash{$showkey}; 263: } 264: } 265: 266: if (defined($dischash{$markkey})) { 267: unless ($dischash{$markkey} eq '') { 268: $showunmark = $dischash{$markkey}; 269: } 270: } 271: 272: if (defined($dischash{$visitkey})) { 273: unless ($dischash{$visitkey} eq '') { 274: $visit = $dischash{$visitkey}; 275: } 276: } 277: $visit ++; 278: 279: my $seeid; 280: if (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { 281: $seeid = 1; 282: } 283: my $seehidden = &can_see_hidden($mode,$ressymb,undef,$group,$cdom,$cnum,$crs); 284: 285: # Is voting on discussions available 286: my $realsymb = &get_realsymb($ressymb); 287: my $canvote = &discussion_vote_available($status,$realsymb); 288: 289: my @discussionitems=(); 290: my %shown = (); 291: my @posteridentity=(); 292: 293: my $current=0; 294: my $visible=0; 295: my @depth=(); 296: my @replies = (); 297: my %alldiscussion=(); 298: my %imsitems=(); 299: my %imsfiles=(); 300: my %notshown = (); 301: my %newitem = (); 302: my $maxdepth=0; 303: my %anonhash=(); 304: my $anoncnt=0; 305: 306: my $now = time; 307: $discinfo{$visitkey} = $visit; 308: 309: &Apache::lonnet::put('nohist_'.$cid.'_discuss',\%discinfo,$env{'user.domain'},$env{'user.name'}); 310: &build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$seehidden,$canvote,$prevread,$sortposts,$encsymb,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group); 311: 312: my $discussion=''; 313: my $manifestfile; 314: my $manifestok=0; 315: my $tempexport; 316: my $imsresources; 317: my $copyresult; 318: 319: my $function = &Apache::loncommon::get_users_function(); 320: my %lt = &Apache::lonlocal::texthash( 321: 'cuse' => 'My settings for this discussion', 322: 'allposts' => 'All posts', 323: 'unread' => 'New posts only', 324: 'unmark' => 'Unread only', 325: 'ondisp' => 'Once displayed', 326: 'onmark' => 'Once marked not NEW', 327: 'toggoff' => 'Off', 328: 'toggon' => 'On', 329: 'disa' => 'Posts to be displayed', 330: 'npce' => 'Posts cease to be marked "NEW"', 331: 'epcb' => 'Each post can be toggled read/unread', 332: 'chgt' => 'Change', 333: 'disp' => 'Display', 334: 'nolo' => 'Not new', 335: 'togg' => 'Toggle read/unread', 336: 'aner' => 'An error occurred opening the manifest file.', 337: 'difo' => 'Discussion for', 338: 'aerr' => 'An error occurred opening the export file for posting', 339: 'aysu' => 'Are you sure you want to delete this post?', 340: 'dpwn' => 'Deleted posts will no longer be visible to you and other students', 341: 'bwco' => 'but will continue to be visible to your instructor', 342: 'depo' => 'Deleted posts will no longer be visible to you or anyone else.', 343: 'discussions' => 'DISCUSSIONS' 344: ); 345: 346: my $currdisp = $lt{'allposts'}; 347: my $currmark = $lt{'onmark'}; 348: my $currtogg = $lt{'toggoff'}; 349: my $dispchange = $lt{'unread'}; 350: my $markchange = $lt{'ondisp'}; 351: my $toggchange = $lt{'toggon'}; 352: my $chglink = '/adm/feedback?modifydisp='.$ressymb; 353: my $displinkA = 'onlyunread'; 354: my $displinkB = 'onlyunmark'; 355: my $marklink = 'markondisp'; 356: my $togglink = 'toggon'; 357: 358: if ($markondisp) { 359: $currmark = $lt{'ondisp'}; 360: $markchange = $lt{'onmark'}; 361: $marklink = 'markonread'; 362: } 363: 364: if ($showonlyunread) { 365: $currdisp = $lt{'unread'}; 366: $dispchange = $lt{'allposts'}; 367: $displinkA = 'allposts'; 368: } 369: 370: if ($showunmark) { 371: $currdisp = $lt{'unmark'}; 372: $dispchange = $lt{'unmark'}; 373: $displinkA='allposts'; 374: $displinkB='onlyunread'; 375: $showonlyunread = 0; 376: } 377: 378: if ($dischash{$toggkey}) { 379: $currtogg = $lt{'toggon'}; 380: $toggchange = $lt{'toggoff'}; 381: $togglink = 'toggoff'; 382: } 383: 384: $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink; 385: 386: if ($newpostsflag) { 387: $chglink .= '&previous='.$prevread; 388: } 389: $chglink.=&group_args($group); 390: 391: if ($visible) { 392: # Print the discusssion 393: if ($outputtarget eq 'tex') { 394: $discussion.='<tex>{\tiny \vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'. 395: '\textbf{'.$lt{'discussions'}.'}\makebox[2 cm][b]{\hrulefill}\vskip 0 mm'. 396: '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'. 397: '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}}</tex>'; 398: } elsif ($outputtarget eq 'export') { 399: # Create temporary directory if this is an export 400: my $now = time; 401: if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { 402: $tempexport = $$imsextras{'tempexport'}; 403: if (!-e $tempexport) { 404: mkdir($tempexport,0700); 405: } 406: $tempexport .= '/'.$$imsextras{'count'}; 407: if (!-e $tempexport) { 408: mkdir($tempexport,0700); 409: } 410: } else { 411: $tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports'; 412: if (!-e $tempexport) { 413: mkdir($tempexport,0700); 414: } 415: $tempexport .= '/'.$now; 416: if (!-e $tempexport) { 417: mkdir($tempexport,0700); 418: } 419: $tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'}; 420: } 421: if (!-e $tempexport) { 422: mkdir($tempexport,0700); 423: } 424: # open manifest file 425: my $manifest = '/imsmanifest.xml'; 426: my $manifestfilename = $tempexport.$manifest; 427: if ($manifestfile = Apache::File->new('>'.$manifestfilename)) { 428: $manifestok=1; 429: print $manifestfile qq|<?xml version="1.0" encoding="UTF-8"?> 430: <manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2" 431: xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 432: identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1 433: imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd"> 434: <organizations default="$ressymb"> 435: <organization identifier="$ressymb"> 436: <title>$lt{'difo'} $ressymb</title>\n|; 437: } else { 438: $discussion .= $lt{'aner'}.'<br />'; 439: } 440: } else { 441: my $colspan=$maxdepth+1; 442: $discussion.= &Apache::lonhtmlcommon::scripttag(qq| 443: function verifydelete (caller,symb,idx,newflag,previous,groupparm) { 444: var symbparm = symb+':::'+idx 445: var prevparm = "" 446: if (newflag == 1) { 447: prevparm = "&previous="+previous 448: } 449: if (caller == 'studentdelete') { 450: if (confirm("$lt{'aysu'}\\n$lt{'dpwn'},\\n$lt{'bwco'}")) { 451: document.location.href = "/adm/feedback?hide="+symbparm+prevparm+groupparm 452: } 453: } else { 454: if (caller == 'seeiddelete') { 455: if (confirm("$lt{'aysu'}\\n$lt{'depo'}")) { 456: document.location.href = "/adm/feedback?deldisc="+symbparm+prevparm+groupparm 457: } 458: } 459: } 460: } 461: |); 462: $discussion.='<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$ressymb.'" >'. 463: "\n".'<table width="100%" class="LC_discussion">'; 464: $discussion .= &action_links_bar($colspan,$ressymb,$visible, 465: $newpostsflag,$group, 466: $prevread,$markondisp,$seehidden); 467: my $escsymb=&escape($ressymb); 468: my $numhidden = keys(%notshown); 469: if ($numhidden > 0) { 470: my $colspan = $maxdepth+1; 471: $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'. 472: '<a href="/adm/feedback?allposts=1&symb='.$escsymb; 473: if ($newpostsflag) { 474: $discussion .= '&previous='.$prevread; 475: } 476: $discussion .= &group_args($group); 477: $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '. 478: $numhidden.' '; 479: if ($showunmark) { 480: $discussion .= &mt('posts previously marked read'); 481: } else { 482: $discussion .= &mt('previously viewed posts'); 483: } 484: $discussion .= '<br/></td></tr>'; 485: } 486: } 487: 488: # Choose sort mechanism 489: my @showposts = (); 490: if ($sortposts eq 'descdate') { 491: @showposts = (sort { $b <=> $a } keys(%alldiscussion)); 492: } elsif ($sortposts eq 'thread') { 493: @showposts = (sort { $a <=> $b } keys(%alldiscussion)); 494: } elsif ($sortposts eq 'subject') { 495: foreach my $key (sort(keys(%subjectsort))) { 496: push(@showposts, @{$subjectsort{$key}}); 497: } 498: } elsif ($sortposts eq 'username') { 499: foreach my $domain (sort(keys(%usernamesort))) { 500: foreach my $key (sort(keys(%{$usernamesort{$domain}}))) { 501: push(@showposts, @{$usernamesort{$domain}{$key}}); 502: } 503: } 504: } elsif ($sortposts eq 'lastfirst') { 505: foreach my $last (sort(keys(%namesort))) { 506: foreach my $key (sort(keys(%{$namesort{$last}}))) { 507: push(@showposts, @{$namesort{$last}{$key}}); 508: } 509: } 510: } else { 511: @showposts = (sort { $a <=> $b } keys(%alldiscussion)); 512: } 513: my $currdepth = 0; 514: my $firstidx = $alldiscussion{$showposts[0]}; 515: foreach my $post (@showposts) { 516: unless (($sortposts eq 'thread') || 517: (($sortposts eq '') && (!$env{'environment.unthreadeddiscussion'})) || 518: ($outputtarget eq 'export')) { 519: $alldiscussion{$post} = $post; 520: } 521: unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) { 522: if ($outputtarget ne 'tex' && $outputtarget ne 'export') { 523: $discussion.="\n<tr>"; 524: } 525: my $thisdepth=$depth[$alldiscussion{$post}]; 526: if ($outputtarget ne 'tex' && $outputtarget ne 'export') { 527: for (1..$thisdepth) { 528: $discussion.='<td>    </td>'; 529: } 530: } 531: my $colspan=$maxdepth-$thisdepth+1; 532: if ($outputtarget eq 'tex') { 533: #cleanup block 534: $discussionitems[$alldiscussion{$post}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/; 535: $discussionitems[$alldiscussion{$post}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/; 536: my $threadinsert=''; 537: if ($thisdepth > 0) { 538: $threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>'; 539: } 540: $discussionitems[$alldiscussion{$post}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/; 541: $discussionitems[$alldiscussion{$post}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g; 542: 543: $discussionitems[$alldiscussion{$post}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$discussionitems[$alldiscussion{$post}]; 544: $discussion.=$discussionitems[$alldiscussion{$post}]; 545: } elsif ($outputtarget eq 'export') { 546: my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html'; 547: if ($manifestok) { 548: if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) { 549: print $manifestfile ' </item>'."\n"; 550: } 551: $currdepth = $depth[$alldiscussion{$post}]; 552: print $manifestfile "\n". 553: '<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$post}.'" isvisible="'. 554: $imsitems{$alldiscussion{$post}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$post}.'">'. 555: '<title>'.$imsitems{$alldiscussion{$post}}{'title'}.'</title></item>'; 556: $imsresources .= "\n". 557: '<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$post}.'" type="webcontent" href="'.$postfilename.'">'."\n". 558: '<file href="'.$postfilename.'">'."\n". 559: $imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}.'</file>'."\n". 560: '</resource>'; 561: } 562: my $postingfile; 563: my $postingfilename = $tempexport.'/'.$postfilename; 564: if ($postingfile = Apache::File->new('>'.$postingfilename)) { 565: print $postingfile '<html><head><title>Discussion Post</title></head><body>'. 566: $imsitems{$alldiscussion{$post}}{'title'}.' '. 567: $imsitems{$alldiscussion{$post}}{'sender'}. 568: $imsitems{$alldiscussion{$post}}{'timestamp'}.'<br /><br />'. 569: $imsitems{$alldiscussion{$post}}{'message'}.'<br />'. 570: $imsitems{$alldiscussion{$post}}{'attach'}.'</body></html>'."\n"; 571: close($postingfile); 572: } else { 573: $discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'<br />'; 574: } 575: $copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport); 576: } else { 577: $discussion.='<td class="'.$bgcols[$newitem{$alldiscussion{$post}}]. 578: '" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$post}]. 579: '</td></tr>'; 580: } 581: } 582: } 583: unless ($outputtarget eq 'tex' || $outputtarget eq 'export') { 584: my $colspan=$maxdepth+1; 585: $discussion .= <<END; 586: <tr> 587: <td colspan="$colspan"> 588: <table width="100%"> 589: <tr> 590: <td class="LC_disc_action_left"> 591: <font size="-1"><b>$lt{'cuse'}</b>:  592: END 593: if ($newpostsflag) { 594: $discussion .= 595: '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i>  2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i>'; 596: if ($dischash{$toggkey}) { 597: $discussion .= '  3. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; 598: } 599: } else { 600: if ($dischash{$toggkey}) { 601: $discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>'; 602: } else { 603: $discussion .= 604: $lt{'disp'}.' - <i>'.$currdisp.'</i>'; 605: } 606: } 607: $discussion .= <<END; 608:   <b><a href="$chglink">$lt{'chgt'}</a></b></font> 609: </td> 610: END 611: if ($sortposts) { 612: my %sort_types = (); 613: my %role_types = (); 614: my %status_types = (); 615: &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype); 616: 617: $discussion .= '<td class="LC_disc_action_right"><font size="-1"><b>'.&mt('Sorted by').'</b>: '.$sort_types{$sortposts}.'<br />'; 618: if (defined($env{'form.totposters'})) { 619: $discussion .= &mt('Posts by').':'; 620: if ($totposters > 0) { 621: foreach my $poster (@posters) { 622: $discussion .= ' '.$poster.','; 623: } 624: $discussion =~ s/,$//; 625: } else { 626: $discussion .= &mt('None selected'); 627: } 628: } else { 629: my $filterchoice =''; 630: if (@sectionpick > 0) { 631: $filterchoice = '<i>'.&mt('sections').'</i>- '.$env{'form.sectionpick'}; 632: $filterchoice .= '    '; 633: } 634: if (@grouppick > 0) { 635: $filterchoice = '<i>'.&mt('groups').'</i>- '.$env{'form.grouppick'}; 636: $filterchoice .= '    '; 637: } 638: if (@rolefilter > 0) { 639: $filterchoice .= '<i>'.&mt('roles').'</i>-'; 640: foreach my $role (@rolefilter) { 641: $filterchoice .= ' '.$role_types{$role}.','; 642: } 643: $filterchoice =~ s/,$//; 644: $filterchoice .= '<br />'.(' ' x8); 645: } 646: if ($statusfilter) { 647: $filterchoice .= '<i>'.&mt('status').'</i>- '.$status_types{$statusfilter}; 648: } 649: if ($filterchoice) { 650: $discussion .= '<b>'.&mt('Filters').'</b>: '.$filterchoice; 651: } 652: } 653: $discussion .= '</font></td>'; 654: 655: } 656: if ($dischash{$toggkey}) { 657: my $storebutton = &mt('Save read/unread changes'); 658: $discussion.='<td align="right">'. 659: '<input type="hidden" name="discsymb" value="'.$ressymb.'" />'."\n". 660: '<input type="button" name="readoptions" value="'.$storebutton.'"'. 661: ' onclick="this.form.submit();" />'."\n". 662: '</td>'; 663: } 664: $discussion .= (<<END); 665: </tr> 666: </table> 667: </td> 668: </tr> 669: END 670: $discussion .= &action_links_bar($colspan,$ressymb,$visible, 671: $newpostsflag,$group, 672: $prevread,$markondisp,$seehidden); 673: $discussion .= "</table></form>\n"; 674: } 675: if ($outputtarget eq 'export') { 676: if ($manifestok) { 677: while ($currdepth > 0) { 678: print $manifestfile " </item>\n"; 679: $currdepth --; 680: } 681: print $manifestfile qq| 682: </organization> 683: </organizations> 684: <resources> 685: $imsresources 686: </resources> 687: </manifest> 688: |; 689: close($manifestfile); 690: if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) { 691: $discussion = $copyresult; 692: } else { 693: 694: #Create zip file in prtspool 695: 696: my $imszipfile = '/prtspool/'. 697: $env{'user.name'}.'_'.$env{'user.domain'}.'_'. 698: time.'_'.rand(1000000000).'.zip'; 699: my $cwd = &getcwd(); 700: my $imszip = '/home/httpd/'.$imszipfile; 701: chdir $tempexport; 702: open(OUTPUT, "zip -r $imszip * 2> /dev/null |"); 703: close(OUTPUT); 704: chdir $cwd; 705: $discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive','<a href="'.$imszipfile.'">').'</a><br />'; 706: if ($copyresult) { 707: $discussion .= &mt('The following errors occurred during export').' - <br />'.$copyresult; 708: } 709: } 710: } else { 711: $discussion .= '<br />'.&mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.').'<br />'; 712: } 713: return $discussion; 714: } 715: } 716: if ($discussiononly) { 717: my $now = time; 718: my $attachnum = 0; 719: my $currnewattach = []; 720: my $currdelold = []; 721: my $comment = ''; 722: my $subject = ''; 723: if ($env{'form.origpage'}) { 724: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']); 725: $subject = &unescape($env{'form.subject'}); 726: $comment = &unescape($env{'form.comment'}); 727: my @keepold = (); 728: &process_attachments($currnewattach,$currdelold,\@keepold); 729: if (@{$currnewattach} > 0) { 730: $attachnum += @{$currnewattach}; 731: } 732: } 733: if ((&discussion_open($status)) && ($outputtarget ne 'tex')) { 734: if (($group ne '') && ($mode eq 'board')) { 735: if ((&check_group_priv($group,'pgd') eq 'ok') && 736: ($ressymb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})) { 737: $discussion .= 738: &postingform_display($mode,$ressymb,$now,$subject, 739: $comment,$outputtarget,$attachnum, 740: $currnewattach,$currdelold, 741: $group,$crstype); 742: } 743: } else { 744: if (&Apache::lonnet::allowed('pch',$env{'request.course.id'}. 745: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { 746: 747: $discussion.= 748: &postingform_display($mode,$ressymb,$now,$subject, 749: $comment,$outputtarget,$attachnum, 750: $currnewattach,$currdelold,'',$crstype); 751: } else { 752: $discussion.= '<span class="LC_feedback_link">'. 753: &mt('This discussion is closed.').'</span>'; 754: } 755: } 756: } 757: if (!(&discussion_open($status)) && ($outputtarget ne 'tex')) { 758: $discussion.= '<span class="LC_feedback_link">'. 759: &mt('This discussion is closed.').'</span>'; 760: } 761: } elsif ($outputtarget ne 'tex') { 762: $discussion.='<div class="LC_feedback_link">'; 763: if (&discussion_open($status) && 764: &Apache::lonnet::allowed('pch', 765: $env{'request.course.id'}. 766: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { 767: $discussion.= &send_feedback_link($ressymb); 768: if ($env{'request.role.adv'}) { 769: my $close = &Apache::lonnet::EXT('resource.0.discussend',$ressymb); 770: my $canvote = &Apache::lonnet::EXT('resource.0.discussvote',$ressymb); 771: if (defined($close) && $close ne '' && $close < time) { 772: if ($canvote eq 'notended') { 773: $discussion .= ' '.&mt('(Posting and voting closed for [_1] roles)', 774: &Apache::lonnet::plaintext('st',$crstype)); 775: } else { 776: $discussion .= ' '.&mt('(Closed for [_1] roles)', 777: &Apache::lonnet::plaintext('st',$crstype)); 778: } 779: } 780: } 781: } else { 782: $discussion.= '<span class="LC_feedback_link">'.&mt('This discussion is closed.').'</span>'; 783: } 784: $discussion.= &send_message_link($ressymb).'</div>'; 785: } 786: return $discussion; 787: } 788: 789: sub can_see_hidden { 790: my ($mode,$ressymb,$feedurl,$group,$cdom,$cnum,$crs) = @_; 791: my $seehidden; 792: if ($env{'request.course.id'}) { 793: unless ($cdom ne '' && $cnum ne '') { 794: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 795: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 796: } 797: if ($crs eq '') { 798: $crs = '/'.$env{'request.course.id'}; 799: if ($env{'request.course.sec'}) { 800: $crs.='_'.$env{'request.course.sec'}; 801: } 802: $crs=~s{_}{/}g; 803: } 804: if ($mode eq '') { 805: $mode='board'; 806: if ($feedurl =~ /$LONCAPA::assess_re/) { 807: $mode='problem'; 808: } 809: } 810: if (($group ne '') && ($mode eq 'board') && 811: ($ressymb =~ m{^bulletin___\d+\Q___adm/wrapper/adm/$cdom/$cnum/\E\d+/bulletinboard$})) { 812: if (&check_group_priv($group,'dgp') eq 'ok') { 813: $seehidden = 1; 814: } 815: } else { 816: $seehidden=&Apache::lonnet::allowed('rin',$crs); 817: } 818: } 819: return $seehidden; 820: } 821: 822: sub discussion_link { 823: my ($ressymb,$linktext,$cmd,$item,$flag,$prev,$adds,$title)=@_; 824: my $link='/adm/feedback?inhibitmenu=yes&modal=yes&'.$cmd.'='.&escape($ressymb).':::'.$item; 825: if ($flag) { $link .= '&previous='.$prev; } 826: if ($adds) { $link .= $adds; } 827: my $width=600; 828: my $height=600; 829: if (($cmd eq 'hide') || ($cmd eq 'unhide') || ($cmd eq 'like') || ($cmd eq 'unlike')) { 830: $width=300; 831: $height=200; 832: } 833: return &Apache::loncommon::modal_link($link,$linktext,$width,$height,undef,undef,$title); 834: } 835: 836: 837: sub send_feedback_link { 838: my ($ressymb) = @_; 839: return '<span class="LC_feedback_link">'. 840: &discussion_link($ressymb, 841: '<img alt="" class="LC_noBorder" src="'. 842: &Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif'). 843: '" border="0" /><span class="LC_menubuttons_inline_text">'.&mt('Post Discussion').'</span>', 844: 'replydisc'). 845: '</span>'; 846: } 847: 848: sub send_message_link { 849: my ($ressymb) = @_; 850: my $output = '<span class="LC_message_link">'. 851: &discussion_link($ressymb, 852: '<img alt="" class="LC_noBorder" src="'. 853: &Apache::loncommon::lonhttpdurl('/res/adm/pages/feedback.png'). 854: '" border="0" /><span class="LC_menubuttons_inline_text">'.&mt('Send Feedback').'</span>', 855: 'sendmessageonly'). 856: '</span>'; 857: return $output; 858: } 859: 860: sub action_links_bar { 861: my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp, 862: $seehidden) = @_; 863: my $discussion = '<tr><td colspan="'.$colspan.'">'. 864: '<table width="100%"><tr>'. 865: '<td class="LC_disc_action_left">'; 866: my $escsymb=&escape($ressymb); 867: if ($visible) { 868: $discussion .= '<a href="/adm/feedback?cmd=threadedon&symb='.$escsymb; 869: if ($newpostsflag) { 870: $discussion .= '&previous='.$prevread; 871: } 872: $discussion .= &group_args($group); 873: $discussion .='">'.&mt('Threaded View').'</a>  '. 874: '<a href="/adm/feedback?cmd=threadedoff&symb='.$escsymb; 875: if ($newpostsflag) { 876: $discussion .= '&previous='.$prevread; 877: } 878: $discussion .= &group_args($group); 879: $discussion .='">'.&mt('Chronological View').'</a>  '; 880: 881: my $otherviewurl='/adm/feedback?cmd=sortfilter&symb='.$escsymb.'&inhibitmenu=yes&modal=yes'; 882: if ($newpostsflag) { 883: $otherviewurl .= '&previous='.$prevread; 884: } 885: $otherviewurl .= &group_args($group); 886: $discussion .= &Apache::loncommon::modal_link($otherviewurl,&mt('Other Views ...'),800,340); 887: $discussion .= '<br />'; 888: } 889: $discussion .='<a href="/adm/feedback?export='.$escsymb; 890: if ($newpostsflag) { 891: $discussion .= '&previous='.$prevread; 892: } 893: $discussion .= &group_args($group); 894: $discussion .= '">'.&mt('Export').'</a>'; 895: if ($seehidden) { 896: $discussion .= '  '; 897: $discussion .='<a href="/adm/feedback?undeleteall='.$escsymb; 898: if ($newpostsflag) { 899: $discussion .= '&previous='.$prevread; 900: } 901: $discussion .= &group_args($group); 902: $discussion .= '">'.&mt('Undelete all deleted entries').'</a>'; 903: } 904: $discussion.='</td>'; 905: if ($newpostsflag) { 906: if (!$markondisp) { 907: $discussion .='<td class="LC_disc_action_right"><a href="/adm/preferences?action=changediscussions'; 908: $discussion .= &group_args($group); 909: $discussion .= '">'. 910: &mt('My general preferences on what is marked as NEW'). 911: '</a><br /><a href="/adm/feedback?markread=1&symb='.$escsymb; 912: $discussion .= &group_args($group); 913: $discussion .= '">'.&mt('Mark NEW posts no longer new').'</a></td>'; 914: } else { 915: $discussion .= '<td> </td>'; 916: } 917: } else { 918: $discussion .= '<td> </td>'; 919: } 920: $discussion .= '</tr></table></td></tr>'; 921: return $discussion; 922: } 923: 924: sub postingform_display { 925: my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum, 926: $currnewattach,$currdelold,$group,$crstype) = @_; 927: my $newattachmsg; 928: my %lt = &Apache::lonlocal::texthash( 929: 'note' => 'Note: in anonymous discussion, your name is visible only to course faculty', 930: 'title' => 'Title', 931: 'podi' => 'Post Discussion', 932: 'poan' => 'Post Anonymous Discussion', 933: 'newa' => 'New attachments', 934: ); 935: if ($crstype eq 'Community') { 936: $lt{'note'} = &mt('Note: in anonymous discussion, your name is visible only to community facilitators'); 937: } 938: my ($postingform,$textareaclass); 939: if (&Apache::lonhtmlcommon::htmlareabrowser()) { 940: $postingform = &Apache::lonhtmlcommon::htmlareaselectactive(); 941: $textareaclass = 'class="LC_richDefaultOff"'; 942: if ($env{'request.course.id'}) { 943: unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) { 944: undef($textareaclass); 945: } 946: } 947: } 948: $postingform .= (<<ENDDISCUSS); 949: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> <input type="submit" name="discuss" value="$lt{'podi'}" /> 950: <input type="submit" name="anondiscuss" value="$lt{'poan'}" /> <input type="hidden" name="symb" value="$ressymb" /> 951: <input type="hidden" name="sendit" value="true" /> 952: <input type="hidden" name="timestamp" value="$now" /> 953: <a name="newpost"></a> 954: <font size="1">$lt{'note'}</font><br /> 955: <b>$lt{'title'}:</b> <input type="text" name="subject" value="$subject" size="30" /><br /> 956: <textarea name="comment" cols="80" rows="14" id="comment" $textareaclass>$comment</textarea> 957: ENDDISCUSS 958: if ($env{'form.origpage'}) { 959: $postingform .= '<input type="hidden" name="origpage" value="'. 960: $env{'form.origpage'}.'" />'."\n"; 961: foreach my $att (@{$currnewattach}) { 962: $postingform .= '<input type="hidden" name="currnewattach" '. 963: 'value="'.$att.'" />'."\n"; 964: } 965: } 966: if (exists($env{'form.ref'})) { 967: $postingform .= '<input type="hidden" name="ref" value="'. 968: $env{'form.ref'}.'" />'; 969: } 970: if ($group ne '') { 971: $postingform .='<input type="hidden" name="group" value="'.$group.'" />'; 972: } 973: my $blockblog = &Apache::loncommon::blocking_status('blogs'); 974: if (!$blockblog) { 975: $postingform .= &add_blog_checkbox($crstype); 976: } 977: $postingform .= "</form>\n"; 978: $postingform .= &generate_attachments_button('',$attachnum,$ressymb, 979: $now,$currnewattach, 980: $currdelold,'',$mode, 981: $blockblog); 982: if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { 983: $newattachmsg = '<br /><b>'.$lt{'newa'}.'</b><br />'; 984: if (@{$currnewattach} > 1) { 985: $newattachmsg .= '<ol>'; 986: foreach my $item (@{$currnewattach}) { 987: $item =~ m#.*/([^/]+)$#; 988: $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; 989: } 990: $newattachmsg .= '</ol>'."\n"; 991: } else { 992: $$currnewattach[0] =~ m#.*/([^/]+)$#; 993: $newattachmsg .= '<a href="'.$$currnewattach[0].'">'.$1.'</a><br />'."\n"; 994: } 995: } 996: $postingform .= $newattachmsg; 997: $postingform .= &generate_preview_button(); 998: return $postingform; 999: } 1000: 1001: sub build_posting_display { 1002: my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$seehidden,$canvote,$prevread,$sortposts,$ressymb,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_; 1003: my @original=(); 1004: my @index=(); 1005: my $skip_group_check = 0; 1006: my $symb=&Apache::lonenc::check_decrypt($ressymb); 1007: my $escsymb=&escape($ressymb); 1008: # These are the discussion contributions 1009: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 1010: $env{'course.'.$env{'request.course.id'}.'.domain'}, 1011: $env{'course.'.$env{'request.course.id'}.'.num'}); 1012: my (%likes,%userlikes,%userunlikes,@theselikes,$oneplus,$twoplus,$oneminus,$twominus); 1013: my $thisuser=$env{'user.name'}.':'.$env{'user.domain'}; 1014: if ($seeid || $canvote) { 1015: # And these are the likes/unlikes 1016: %likes=&Apache::lonnet::dump('disclikes', 1017: $env{'course.'.$env{'request.course.id'}.'.domain'}, 1018: $env{'course.'.$env{'request.course.id'}.'.num'}, 1019: '^'.$symb.':'); 1020: # Array with likes to figure out averages, etc. 1021: @theselikes=(); 1022: # Hashes containing likes and unlikes for this user. 1023: %userlikes=(); 1024: %userunlikes=(); 1025: } 1026: # Is the user allowed to see the real name behind anonymous postings? 1027: my $see_anonymous = 1028: &Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')); 1029: 1030: if ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) { 1031: $skip_group_check = 1; 1032: } 1033: # Deletions and hiddens are just lists. Split them up into a hash for quicker lookup 1034: my (%deletions,%hiddens); 1035: if ($contrib{'deleted'}) { 1036: my $deleted = $contrib{'deleted'}; 1037: $deleted =~ s/^\.//; 1038: $deleted =~ s/\.$//; 1039: %deletions = map { $_ => 1 } (split(/\.\./,$deleted)); 1040: } 1041: if ($contrib{'hidden'}) { 1042: my $hidden = $contrib{'hidden'}; 1043: $hidden =~ s/^\.//; 1044: $hidden =~ s/\.$//; 1045: %hiddens = map { $_ => 1 } (split(/\.\./,$hidden)); 1046: } 1047: # Versions if store/restore are used to actually store the messages. 1048: if ($contrib{'version'}) { 1049: my $oldest = $contrib{'1:timestamp'}; 1050: if ($prevread eq '0') { 1051: $prevread = $oldest-1; 1052: } 1053: my ($skiptest,$rolematch,$roleregexp,$secregexp,$statusregexp); 1054: if ($sortposts) { 1055: ($skiptest,$roleregexp,$secregexp,$statusregexp) = 1056: &filter_regexp($rolefilter,$sectionpick,$statusfilter); 1057: $rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp; 1058: } 1059: my %votestyle; 1060: if ($seeid || $canvote) { 1061: # We need to go through this twice, first to get the likes/dislikes, then to actually build the display 1062: for (my $id=1;$id<=$contrib{'version'};$id++) { 1063: my $idx=$id; 1064: next if ($contrib{$idx.':deleted'}); 1065: next if ($contrib{$idx.':hidden'}); 1066: unless ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx}) || (!$contrib{$idx.':message'})) { 1067: push(@theselikes,$likes{$symb.':'.$idx.':likes'}); 1068: if ($likes{$symb.':'.$idx.':likes'} ne '') { 1069: if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') { 1070: if (exists($likes{$symb.':'.$idx.':likers'}{$thisuser})) { 1071: $userlikes{$idx} = 1; 1072: } 1073: } 1074: if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') { 1075: if (exists($likes{$symb.':'.$idx.':unlikers'}{$thisuser})) { 1076: $userunlikes{$idx} = 1; 1077: } 1078: } 1079: } 1080: } 1081: } 1082: # Figure out average likes and standard deviation if there are enough 1083: # discussions to warrant that 1084: my $ave=0; 1085: my $stddev=10000; 1086: if ($#theselikes>1) { 1087: my $sum=0; 1088: my $num=$#theselikes+1; 1089: foreach my $thislike (@theselikes) { 1090: $sum+=$thislike; 1091: } 1092: $ave=$sum/$num; 1093: my $sumsq=0; 1094: foreach my $thislike (@theselikes) { 1095: $sumsq+=($thislike-$ave)*($thislike-$ave); 1096: } 1097: $stddev=sqrt($sumsq/$num); 1098: } 1099: # Now we know the average likes $ave and the standard deviation $stddev 1100: # Get the boundaries for markup 1101: $oneplus=$ave+$stddev; 1102: $twoplus=$ave+2.*$stddev; 1103: $oneminus=$ave-$stddev; 1104: $twominus=$ave-2.*$stddev; 1105: if ($#theselikes>1) { 1106: foreach my $class ('twoplus','oneplus','zero','oneminus','twominus') { 1107: my $fontstyle = $env{'course.'.$env{'request.course.id'}.'.discussion_post_fonts_'.$class}; 1108: if ($fontstyle ne '') { 1109: my ($size,$weight,$style,$other) = split(/,/,$fontstyle); 1110: if ($size ne '') { 1111: $votestyle{$class} .= 'font-size: '.$size.';'; 1112: } 1113: if ($weight ne '') { 1114: $votestyle{$class} .= 'font-weight: '.$weight.';'; 1115: } 1116: if ($style ne '') { 1117: $votestyle{$class} .= 'font-style: '.$style.';'; 1118: } 1119: if ($other ne '') { 1120: $votestyle{$class} .= $other; 1121: } 1122: if ($votestyle{$class} ne '') { 1123: $votestyle{$class} = 'style="'.$votestyle{$class}.'"'; 1124: } 1125: } 1126: } 1127: } 1128: } 1129: # 1130: # This is now the real loop. Go through all entries, pick up what we need 1131: # 1132: for (my $id=1;$id<=$contrib{'version'};$id++) { 1133: my $idx=$id; 1134: next if ($contrib{$idx.':deleted'}); 1135: next if ($contrib{$idx.':hidden'}); 1136: # If we get here, we are actually going to display the message - we don't know where and we don't know if we display 1137: # previous edits, but it counts as one entry 1138: my $posttime = $contrib{$idx.':timestamp'}; 1139: if ($prevread <= $posttime) { 1140: $$newpostsflag = 1; 1141: } 1142: my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./); 1143: my $origindex='0.'; 1144: my $numoldver=0; 1145: if ($contrib{$idx.':replyto'}) { 1146: if ( ((!$env{'environment.unthreadeddiscussion'}) && ($sortposts eq '')) || 1147: ($sortposts eq 'thread') || ($outputtarget eq 'export')) { 1148: # this is a follow-up message 1149: $original[$idx]=$original[$contrib{$idx.':replyto'}]; 1150: $$depth[$idx]=$$depth[$contrib{$idx.':replyto'}]+1; 1151: $origindex=$index[$contrib{$idx.':replyto'}]; 1152: if ($$depth[$idx]>$$maxdepth) { $$maxdepth=$$depth[$idx]; } 1153: } else { 1154: $original[$idx]=0; 1155: $$depth[$idx]=0; 1156: } 1157: } else { 1158: # this is an original message 1159: $original[$idx]=0; 1160: $$depth[$idx]=0; 1161: } 1162: if ($$replies[$$depth[$idx]]) { 1163: $$replies[$$depth[$idx]]++; 1164: } else { 1165: $$replies[$$depth[$idx]]=1; 1166: } 1167: unless ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx})) { 1168: $$visible++; 1169: if ($contrib{$idx.':history'}) { 1170: if ($contrib{$idx.':history'} =~ /:/) { 1171: my @oldversions = split(/:/,$contrib{$idx.':history'}); 1172: $numoldver = @oldversions; 1173: } else { 1174: $numoldver = 1; 1175: } 1176: } 1177: $$current = $numoldver; 1178: my %messages = (); 1179: my %subjects = (); 1180: my %attachtxt = (); 1181: my %allattachments = (); 1182: my ($screenname,$plainname,$showaboutme); 1183: my $sender = &mt('Anonymous'); 1184: # Anonymous users getting number within a discussion 1185: # Since idx is in static order, this should give the same sequence every time. 1186: my $key=$contrib{$idx.':sendername'}.'@'.$contrib{$idx.':senderdomain'}; 1187: unless ($$anonhash{$key}) { 1188: $anoncnt++; 1189: $$anonhash{$key}=&mt('Anonymous').' '.$anoncnt; 1190: } 1191: my ($message,$subject,$vgrlink,$ctlink); 1192: &get_post_contents(\%contrib,$idx,$seeid,$seehidden,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,\$showaboutme,$numoldver); 1193: 1194: 1195: # Set up for sorting by subject 1196: unless ($outputtarget eq 'export') { 1197: $message=$messages{$numoldver}; 1198: $message.=$attachtxt{$numoldver}; 1199: $subject=$subjects{$numoldver}; 1200: if ($message) { 1201: if ($hiddens{$idx}) { 1202: $message='<font color="#888888">'.$message.'</font>'; 1203: if ($studenthidden) { 1204: $message .='<br /><br />Deleted by poster (student).'; 1205: } 1206: } 1207: 1208: if ($subject eq '') { 1209: if (defined($$subjectsort{'__No subject'})) { 1210: push(@{$$subjectsort{'__No subject'}}, $idx); 1211: } else { 1212: @{$$subjectsort{'__No subject'}} = ("$idx"); 1213: } 1214: } else { 1215: if (defined($$subjectsort{$subject})) { 1216: push(@{$$subjectsort{$subject}}, $idx); 1217: } else { 1218: @{$$subjectsort{$subject}} = ("$idx"); 1219: } 1220: } 1221: if (!$contrib{$idx.':anonymous'} || $see_anonymous) { 1222: if ($showaboutme) { 1223: $sender = &Apache::loncommon::aboutmewrapper( 1224: $plainname, 1225: $contrib{$idx.':sendername'}, 1226: $contrib{$idx.':senderdomain'}); 1227: } else { 1228: $sender = $plainname; 1229: } 1230: if ($see_anonymous) { 1231: $sender .= ' ('.$contrib{$idx.':sendername'}.':'. 1232: $contrib{$idx.':senderdomain'}.')'; 1233: } 1234: $sender = '<b>'.$sender.'</b>'; 1235: if ($contrib{$idx.':anonymous'}) { 1236: $sender.=' <font color="red"><b>['.$$anonhash{$key}.']</b></font> '. 1237: $screenname; 1238: } 1239: if ($see_anonymous) { 1240: $sender.=&Apache::loncommon::student_image_tag($contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); 1241: } 1242: # Set up for sorting by domain, then username 1243: unless (defined($$usernamesort{$contrib{$idx.':senderdomain'}})) { 1244: %{$$usernamesort{$contrib{$idx.':senderdomain'}}} = (); 1245: } 1246: if (defined($$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) { 1247: push(@{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx); 1248: } else { 1249: @{$$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx"); 1250: } 1251: # Set up for sorting by last name, then first name 1252: my %names = &Apache::lonnet::get('environment', 1253: ['firstname','lastname'],$contrib{$idx.':senderdomain'}, 1254: ,$contrib{$idx.':sendername'}); 1255: my $lastname = $names{'lastname'}; 1256: my $firstname = $names{'firstname'}; 1257: if ($lastname eq '') { 1258: $lastname = '_'; 1259: } 1260: if ($firstname eq '') { 1261: $firstname = '_'; 1262: } 1263: unless (defined($$namesort{$lastname})) { 1264: %{$$namesort{$lastname}} = (); 1265: } 1266: if (defined($$namesort{$lastname}{$firstname})) { 1267: push(@{$$namesort{$lastname}{$firstname}}, $idx); 1268: } else { 1269: @{$$namesort{$lastname}{$firstname}} = ("$idx"); 1270: } 1271: if ($outputtarget ne 'tex') { 1272: # Add karma stars 1273: my $karma=&userkarma($contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'}); 1274: for (my $i=1;$i<=$karma;$i++) { 1275: $sender.='<img border="0" src="/res/adm/pages/star.gif" alt="'.&mt('Contributor Kudos').'" />'; 1276: } 1277: # Can people edit this? 1278: if (&editing_allowed($escsymb.':::'.$idx,$group)) { 1279: if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) { 1280: $sender.=' '. 1281: &discussion_link($symb,&mt('Edit'),'editdisc',$idx,$$newpostsflag,$prevread,&group_args($group)); 1282: unless ($seehidden) { 1283: my $grpargs = &group_args($group); 1284: $sender.=" <a href=\"javascript:verifydelete('studentdelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')"; 1285: $sender .= '">'.&mt('Delete').'</a>'; 1286: } 1287: } 1288: } 1289: if ($seehidden) { 1290: if ($hiddens{$idx}) { 1291: unless ($studenthidden) { 1292: $sender.=' '. 1293: &discussion_link($symb,&mt('Make Visible'),'unhide',$idx,$$newpostsflag,$prevread,&group_args($group)); 1294: } 1295: } else { 1296: $sender.=' '. 1297: &discussion_link($symb,&mt('Hide'),'hide',$idx,$$newpostsflag,$prevread,&group_args($group)); 1298: } 1299: my $grpargs = &group_args($group); 1300: $sender.= 1301: " <a href=\"javascript:verifydelete('seeiddelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')\">"; 1302: $sender .= &mt('Delete').'</a>'; 1303: } 1304: } 1305: } else { 1306: if ($screenname) { 1307: $sender='<i>'.$screenname.'</i>'; 1308: } else { 1309: $sender='<i>'.$$anonhash{$key}.'</i>'; 1310: } 1311: $sender = '<b>'.$sender.'</b>'; 1312: # Set up for sorting by domain, then username for anonymous 1313: unless (defined($$usernamesort{'__anon'})) { 1314: %{$$usernamesort{'__anon'}} = (); 1315: } 1316: if (defined($$usernamesort{'__anon'}{'__anon'})) { 1317: push(@{$$usernamesort{'__anon'}{'__anon'}}, $idx); 1318: } else { 1319: @{$$usernamesort{'__anon'}{'__anon'}} = ("$idx"); 1320: } 1321: # Set up for sorting by last name, then first name for anonymous 1322: unless (defined($$namesort{'__anon'})) { 1323: %{$$namesort{'__anon'}} = (); 1324: } 1325: if (defined($$namesort{'__anon'}{'__anon'})) { 1326: push(@{$$namesort{'__anon'}{'__anon'}}, $idx); 1327: } else { 1328: @{$$namesort{'__anon'}{'__anon'}} = ("$idx"); 1329: } 1330: } 1331: if ($outputtarget ne 'tex') { 1332: if (&discussion_open($status)) { 1333: if (($group ne '') && 1334: (&check_group_priv($group,'pgd') eq 'ok')) { 1335: $sender.=' '. 1336: &discussion_link($symb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread,&group_args($group)); 1337: } elsif (&Apache::lonnet::allowed('pch', 1338: $env{'request.course.id'}. 1339: ($env{'request.course.sec'}?'/'. 1340: $env{'request.course.sec'}:''))) { 1341: $sender.=' '. 1342: &discussion_link($symb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread); 1343: } 1344: } 1345: if ($viewgrades) { 1346: $vgrlink=&Apache::loncommon::submlink(&mt('Submissions'), 1347: $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb); 1348: } 1349: if ($$dischash{$readkey}=~/\.$idx\./) { 1350: $ctlink = '<label><b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" /></label>'; 1351: } else { 1352: $ctlink = '<label><b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" /></label>'; 1353: } 1354: } 1355: } 1356: #figure out at what position this needs to print 1357: } 1358: if ($outputtarget eq 'export' || $message) { 1359: my $thisindex=$idx; 1360: if ( ((!$env{'environment.unthreadeddiscussion'}) && ($sortposts eq '')) || 1361: ($sortposts eq 'thread') || ($outputtarget eq 'export')) { 1362: $thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2); 1363: } 1364: $$alldiscussion{$thisindex}=$idx; 1365: $$shown{$idx} = 0; 1366: $index[$idx]=$thisindex; 1367: } 1368: if ($outputtarget eq 'export') { 1369: %{$$imsitems{$idx}} = (); 1370: $$imsitems{$idx}{'isvisible'}='true'; 1371: if ($hiddens{$idx}) { 1372: $$imsitems{$idx}{'isvisible'}='false'; 1373: } 1374: $$imsitems{$idx}{'title'}=$subjects{$numoldver}; 1375: $$imsitems{$idx}{'message'}=$messages{$numoldver}; 1376: $$imsitems{$idx}{'attach'}=$attachtxt{$numoldver}; 1377: $$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'}; 1378: $$imsitems{$idx}{'sender'}=$plainname.' ('. 1379: $contrib{$idx.':sendername'}.':'. 1380: $contrib{$idx.':senderdomain'}.')'; 1381: $$imsitems{$idx}{'isanonymous'}='false'; 1382: if ($contrib{$idx.':anonymous'}) { 1383: $$imsitems{$idx}{'isanonymous'}='true'; 1384: } 1385: $$imsitems{$idx}{'currversion'}=$numoldver; 1386: %{$$imsitems{$idx}{'allattachments'}}=%allattachments; 1387: unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') { 1388: $$shown{$idx} = 1; 1389: } 1390: } else { 1391: if ($message) { 1392: my $spansize = 2; 1393: my ($uname,$udom); 1394: if ($showonlyunread && $prevread > $posttime) { 1395: $$notshown{$idx} = 1; 1396: } elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) { 1397: $$notshown{$idx} = 1; 1398: } else { 1399: # apply filters 1400: $uname = $contrib{$idx.':sendername'}; 1401: $udom = $contrib{$idx.':senderdomain'}; 1402: my $poster = $uname.':'.$udom; 1403: if ($env{'form.totposters'} ne '') { 1404: if ($totposters == 0) { 1405: $$shown{$idx} = 0; 1406: } elsif ($totposters > 0) { 1407: if (grep/^$poster$/,@{$posters}) { 1408: $$shown{$idx} = 1; 1409: } 1410: } 1411: } elsif ($sortposts) { 1412: if ($skiptest) { 1413: $$shown{$idx} = 1; 1414: } else { 1415: foreach my $role (@{$$roleinfo{$poster}}) { 1416: if ($role =~ /^cc:/) { 1417: my $cc_regexp = $roleregexp.':[^:]*:'.$statusregexp; 1418: if ($role =~ /$cc_regexp/) { 1419: $$shown{$idx} = 1; 1420: last; 1421: } 1422: } elsif ($role =~ /^$rolematch$/) { 1423: $$shown{$idx} = 1; 1424: last; 1425: } 1426: } 1427: } 1428: if ($$shown{$idx} && !$skip_group_check) { 1429: my $showflag = 0; 1430: if (ref($$classgroups{$poster}{active}) eq 'HASH') { 1431: foreach my $grp (@{$grouppick}) { 1432: if (grep/^\Q$grp\E$/, 1433: keys(%{$$classgroups{$poster}{active}})) { 1434: $showflag = 1; 1435: last; 1436: } 1437: } 1438: } 1439: if ($showflag) { 1440: $$shown{$idx} = 1; 1441: } else { 1442: $$shown{$idx} = 0; 1443: } 1444: } 1445: } else { 1446: $$shown{$idx} = 1; 1447: } 1448: } 1449: unless ($$notshown{$idx} == 1) { 1450: if ($prevread > 0 && $prevread <= $posttime) { 1451: $$newitem{$idx} = 1; 1452: $$discussionitems[$idx] .= '<font color="#FF0000"><b>'.&mt('NEW').'  </b></font>'; 1453: } else { 1454: $$newitem{$idx} = 0; 1455: } 1456: $$discussionitems[$idx] .= '<b>'.$subject.'</b>  '. 1457: $sender.' '.$vgrlink.' ('. 1458: &Apache::lonlocal::locallocaltime($posttime).')'; 1459: if ($$dischash{$toggkey}) { 1460: $$discussionitems[$idx].='  '.$ctlink; 1461: } 1462: my $thislikes=$likes{$symb.':'.$idx.':likes'}; 1463: my $likestyle; 1464: if ($seeid || $canvote) { 1465: # Figure out size based on likes 1466: my $class = 'zero'; 1467: my $thislikes=$likes{$symb.':'.$idx.':likes'}; 1468: if ($thislikes>$twoplus) { 1469: $class = 'twoplus'; 1470: } elsif ($thislikes>$oneplus) { 1471: $class = 'oneplus'; 1472: } 1473: if ($thislikes<$twominus) { 1474: $class = 'twominus'; 1475: } elsif ($thislikes<$oneminus) { 1476: $class = 'oneminus'; 1477: } 1478: $likestyle = $votestyle{$class}; 1479: } 1480: # Actually glue in the message itself 1481: $$discussionitems[$idx].= '<br /><blockquote>'. 1482: "<div $likestyle>". 1483: $message. 1484: '</div></blockquote>'; 1485: if ($canvote) { 1486: my $ownpost; 1487: if (($uname eq $env{'user.name'}) && 1488: ($udom eq $env{'user.domain'})) { 1489: $ownpost = 1; 1490: } 1491: # Put in the like and unlike buttons 1492: if ($ownpost || (($hiddens{$idx}) && ($seehidden))) { 1493: my $novote; 1494: if ($ownpost) { 1495: $novote = &mt('No voting for your own posts.'); 1496: } else { 1497: $novote = &mt('No voting for hidden posts.'); 1498: } 1499: $$discussionitems[$idx].= 1500: '<a href="javascript:alert('."'$novote'".');" style="text-decoration: none;">'. 1501: '<img border="0" src="/res/adm/pages/thumbsup_novote.png" alt="'.$novote.'" /> '. 1502: '<img border="0" src="/res/adm/pages/thumbsdown_novote.png" alt="'.$novote.'" /></a>'; 1503: 1504: } else { 1505: if ($userlikes{$idx}) { 1506: $$discussionitems[$idx].='<img border="0" src="/res/adm/pages/thumbsup_gray.png" alt="'.&mt('You like this posting').'" />'; 1507: } else { 1508: $$discussionitems[$idx].=' '.&discussion_link($symb,'<img border="0" src="/res/adm/pages/thumbsup.png" alt="'.&mt('Like').'" />','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting")); 1509: } 1510: if ($userunlikes{$idx}) { 1511: $$discussionitems[$idx].='<img border="0" src="/res/adm/pages/thumbsdown_gray.png" alt="'.&mt('You unlike this posting').'" />'; 1512: } else { 1513: $$discussionitems[$idx].=' '.&discussion_link($symb,'<img border="0" src="/res/adm/pages/thumbsdown.png" alt="'.&mt('Unlike').'" />','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting")); 1514: } 1515: } 1516: } 1517: if ($seeid || $canvote) { 1518: my $thislikes=$likes{$symb.':'.$idx.':likes'}; 1519: if ($thislikes>0) { 1520: $$discussionitems[$idx].=' ('.&mt("[_1] likes",$thislikes).')'; 1521: } elsif ($thislikes<0) { 1522: $$discussionitems[$idx].=' ('.&mt("[_1] unlikes",abs($thislikes)).')'; 1523: } 1524: } 1525: # If there is any history to this post, inform the reader 1526: if ($contrib{$idx.':history'}) { 1527: my @postversions = (); 1528: $$discussionitems[$idx] .= '  '.&mt('This post has been edited by the author.'); 1529: if ($seehidden) { 1530: $$discussionitems[$idx] .= '  '. 1531: &discussion_link($symb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group)); 1532: } 1533: $$discussionitems[$idx].='<br/>'.&mt('Earlier version(s) were posted on: '); 1534: if ($contrib{$idx.':history'} =~ m/:/) { 1535: @postversions = split(/:/,$contrib{$idx.':history'}); 1536: } else { 1537: @postversions = ("$contrib{$idx.':history'}"); 1538: } 1539: for (my $i=0; $i<@postversions; $i++) { 1540: my $version = $i+1; 1541: $$discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' '; 1542: } 1543: } 1544: # end of unless ($$notshown ...) 1545: } 1546: # end of if ($message) ... 1547: } 1548: # end of the else-branch of target being export 1549: } 1550: # end of unless hidden or deleted 1551: } 1552: # end of the loop over all discussion entries 1553: } 1554: # end of "if there actually are any discussions 1555: } 1556: # end of subroutine "build_posting_display" 1557: } 1558: 1559: sub filter_regexp { 1560: my ($rolefilter,$sectionpick,$statusfilter) = @_; 1561: my ($roleregexp,$secregexp,$statusregexp); 1562: my $skiptest = 1; 1563: if (@{$rolefilter} > 0) { 1564: my @okrolefilter = (); 1565: foreach my $role (@{$rolefilter}) { 1566: unless ($role eq '') { 1567: push(@okrolefilter, $role); 1568: } 1569: } 1570: if (@okrolefilter > 0) { 1571: if (grep/^all$/,@okrolefilter) { 1572: $roleregexp='[^:]+'; 1573: } else { 1574: if (@okrolefilter == 1) { 1575: $roleregexp=$okrolefilter[0]; 1576: } else { 1577: $roleregexp='('.join('|',@okrolefilter).')'; 1578: } 1579: $skiptest = 0; 1580: } 1581: } 1582: } 1583: if (@{$sectionpick} > 0) { 1584: my @oksectionpick = (); 1585: foreach my $sec (@{$sectionpick}) { 1586: unless ($sec eq '') { 1587: push(@oksectionpick, $sec); 1588: } 1589: } 1590: if ((@oksectionpick > 0) && (!grep/^all$/,@oksectionpick)) { 1591: if (@oksectionpick == 1) { 1592: $secregexp = $oksectionpick[0]; 1593: } else { 1594: $secregexp .= '('.join('|',@oksectionpick).')'; 1595: } 1596: $skiptest = 0; 1597: } else { 1598: $secregexp .= '[^:]*'; 1599: } 1600: } 1601: 1602: if (defined($statusfilter) && $statusfilter ne '') { 1603: if ($statusfilter eq 'all') { 1604: $statusregexp = '[^:]+'; 1605: } else { 1606: $statusregexp = $statusfilter; 1607: $skiptest = 0; 1608: } 1609: } 1610: return ($skiptest,$roleregexp,$secregexp,$statusregexp); 1611: } 1612: 1613: 1614: sub get_post_contents { 1615: my ($contrib,$idx,$seeid,$seehidden,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$showaboutme,$numver) = @_; 1616: my $discussion = ''; 1617: my $start=$numver; 1618: my $end=$numver + 1; 1619: %{$$imsfiles{$idx}}=(); 1620: if ($type eq 'allversions') { 1621: unless($seehidden) { 1622: $discussion=&mt('You do not have privileges to view all versions of posts.').' '.&mt('Please select a different role.'); 1623: return $discussion; 1624: } 1625: } 1626: # $$screenname=&Apache::loncommon::screenname( 1627: # $$contrib{$idx.':sendername'}, 1628: # $$contrib{$idx.':senderdomain'}); 1629: $$plainname=&Apache::loncommon::nickname( 1630: $$contrib{$idx.':sendername'}, 1631: $$contrib{$idx.':senderdomain'}); 1632: $$screenname=$$contrib{$idx.':screenname'}; 1633: $$showaboutme = &Apache::lonnet::usertools_access($$contrib{$idx.':sendername'}, 1634: $$contrib{$idx.':senderdomain'}, 1635: 'aboutme'); 1636: my $sender = $$plainname; 1637: if ($$showaboutme) { 1638: $sender = &Apache::loncommon::aboutmewrapper( 1639: $$plainname, 1640: $$contrib{$idx.':sendername'}, 1641: $$contrib{$idx.':senderdomain'}); 1642: } 1643: if ($seeid) { 1644: $sender .= ' ('.$$contrib{$idx.':sendername'}.':'. 1645: $$contrib{$idx.':senderdomain'}.')'; 1646: } 1647: my $attachmenturls = $$contrib{$idx.':attachmenturl'}; 1648: my @postversions = (); 1649: if ($type eq 'allversions' || $type eq 'export') { 1650: $start = 0; 1651: if ($$contrib{$idx.':history'}) { 1652: @postversions = split(/:/,$$contrib{$idx.':history'}); 1653: } 1654: &get_post_versions($messages,$$contrib{$idx.':message'},1); 1655: &get_post_versions($subjects,$$contrib{$idx.':subject'},1); 1656: push(@postversions,$$contrib{$idx.':timestamp'}); 1657: $end = @postversions; 1658: } else { 1659: &get_post_versions($messages,$$contrib{$idx.':message'},1,$numver); 1660: &get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver); 1661: } 1662: 1663: if ($$contrib{$idx.':anonymous'}) { 1664: $sender.=' ['.&mt('anonymous').'] '.$$screenname; 1665: } 1666: if ($type eq 'allversions') { 1667: $discussion=('<b>'.$sender.'</b><br /><ul>'); 1668: } 1669: for (my $i=$start; $i<$end; $i++) { 1670: my ($timesent,$attachmsg); 1671: my %currattach = (); 1672: $timesent = &Apache::lonlocal::locallocaltime($postversions[$i]); 1673: unless (&contains_block_html($messages->{$i})) { 1674: &newline_to_br(\$messages->{$i}); 1675: } 1676: $$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i}); 1677: $$subjects{$i}=~s/\n/\<br \/\>/g; 1678: $$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i}); 1679: if ($attachmenturls) { 1680: &extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach); 1681: } 1682: if ($type eq 'export') { 1683: $$imsfiles{$idx}{$i} = ''; 1684: if ($attachmsg) { 1685: $$attachtxt{$i} = '<br />'.&mt('Attachments').':<br />'; 1686: foreach my $key (sort(keys(%currattach))) { 1687: if ($$allattachments{$key}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { 1688: my $fname = $1.$3.'/'.$4; 1689: $$imsfiles{$idx}{$i} .= '<file href="'.$fname.'" />'."\n"; 1690: $$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />'; 1691: } 1692: } 1693: } 1694: } else { 1695: if ($attachmsg) { 1696: $$attachtxt{$i} = '<br />'.&mt('Attachments').':'.$attachmsg.'<br />'; 1697: } else { 1698: $$attachtxt{$i} = ''; 1699: } 1700: } 1701: if ($type eq 'allversions') { 1702: $discussion.= <<"END"; 1703: <li><b>$$subjects{$i}</b>, $timesent<br /> 1704: $$messages{$i}<br /> 1705: $$attachtxt{$i}</li> 1706: END 1707: } 1708: } 1709: if ($type eq 'allversions') { 1710: $discussion.='</ul>'; 1711: return $discussion; 1712: } else { 1713: return; 1714: } 1715: } 1716: 1717: sub replicate_attachments { 1718: my ($attachrefs,$tempexport) = @_; 1719: my $response; 1720: foreach my $id (keys(%{$attachrefs})) { 1721: if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) { 1722: my $path = $tempexport; 1723: my $tail = $1.'/'.$2.$4; 1724: my @extras = split(/\//,$tail); 1725: my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5; 1726: if (!-e $destination) { 1727: my $i= 0; 1728: while ($i<@extras) { 1729: $path .= '/'.$extras[$i]; 1730: if (!-e $path) { 1731: mkdir($path,0700); 1732: } 1733: $i ++; 1734: } 1735: my ($content,$rtncode); 1736: my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode); 1737: if ($uploadreply eq 'ok') { 1738: my $attachcopy; 1739: if ($attachcopy = Apache::File->new('>'.$destination)) { 1740: print $attachcopy $content; 1741: close($attachcopy); 1742: } else { 1743: $response .= &mt('Error copying file attachment - [_1] to IMS package',$5).': '.$!.'<br />'."\n"; 1744: } 1745: } else { 1746: &Apache::lonnet::logthis("Replication of attachment failed when building IMS export of discussion posts - domain: $1, course: $2, file: $$attachrefs{$id}{'filename'} -error: $rtncode"); 1747: $response .= &mt('Error copying file attachment - [_1] to IMS package: ',$5).$rtncode.'<br />'."\n"; 1748: } 1749: } 1750: } 1751: } 1752: return $response; 1753: } 1754: 1755: sub mail_screen { 1756: my ($r,$feedurl,$options,$caller_symb,$attachmaxtext) = @_; 1757: if (exists($env{'form.origpage'})) { 1758: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss','blog','group','ref']); 1759: } 1760: 1761: my %lt = &Apache::lonlocal::texthash( 1762: 'myqu' => 'Question/comment/feedback:', 1763: 'title' => 'Title', 1764: 'reta' => 'Retained attachments', 1765: 'atta' => 'Attachment', 1766: ); 1767: if($env{'form.editdisc'} || $env{'form.replydisc'}){ 1768: %lt = &Apache::lonlocal::texthash( 1769: 'myqu' => 'Post Discussion', 1770: ); 1771: } 1772: my $restitle = &get_resource_title($caller_symb,$feedurl); 1773: my $quote=''; 1774: my $subject = ''; 1775: my $comment = ''; 1776: my $prevtag = ''; 1777: my $parentmsg = ''; 1778: my ($symb,$idx,$attachmenturls); 1779: my $numoldver = 0; 1780: my $attachmsg = ''; 1781: my $newattachmsg = ''; 1782: my @currnewattach = (); 1783: my @currdelold = (); 1784: my @keepold = (); 1785: my %attachments = (); 1786: my %currattach = (); 1787: my $attachnum = 0; 1788: my $anonchk = (<<END); 1789: function anonchk() { 1790: for (var i=0; i < document.mailform.discuss.length; i++) { 1791: if (document.mailform.discuss[i].checked) { 1792: document.attachment.discuss.value = 1793: document.mailform.discuss[i].value; 1794: } 1795: } 1796: if (document.mailform.blog.checked) { 1797: document.attachment.blog.value = 1; 1798: } 1799: return 1800: } 1801: END 1802: my $anonscript; 1803: if (exists($env{'form.origpage'})) { 1804: $anonscript = (<<END); 1805: function setposttype() { 1806: var disc = "$env{'form.discuss'}"; 1807: for (var i=0; i < document.mailform.discuss.length; i++) { 1808: if (disc == document.mailform.discuss[i].value) { 1809: document.mailform.discuss[i].checked = 1; 1810: } 1811: } 1812: var blog = "$env{'form.blog'}"; 1813: if (blog == 1) { 1814: document.mailform.blog.checked=1; 1815: } 1816: return 1817: } 1818: END 1819: } else { 1820: $anonscript = (<<END); 1821: function setposttype() { 1822: return 1823: } 1824: END 1825: } 1826: if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { 1827: if ($env{'form.replydisc'}) { 1828: ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); 1829: } else { 1830: ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); 1831: } 1832: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 1833: $env{'course.'.$env{'request.course.id'}.'.domain'}, 1834: $env{'course.'.$env{'request.course.id'}.'.num'}); 1835: unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) { 1836: my $numoldver = 0; 1837: if ($contrib{$idx.':history'}) { 1838: if ($contrib{$idx.':history'} =~ /:/) { 1839: my @oldversions = split(/:/,$contrib{$idx.':history'}); 1840: $numoldver = @oldversions; 1841: } else { 1842: $numoldver = 1; 1843: } 1844: } 1845: if ($idx > 0) { 1846: my (%msgversions,%subversions,$htmldecode); 1847: $htmldecode = 0; 1848: if ($env{'form.replydisc'}) { 1849: $htmldecode = 1; 1850: } 1851: &get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver); 1852: &get_post_versions(\%subversions,$contrib{$idx.':subject'},$htmldecode, 1853: $numoldver); 1854: $subject = $subversions{$numoldver}; 1855: if ($env{'form.replydisc'}) { 1856: $quote = $msgversions{$numoldver}; 1857: $subject = &HTML::Entities::encode(&mt('Re: ').$subject,'<>&"'); 1858: } else { 1859: $comment = $msgversions{$numoldver}; 1860: } 1861: } 1862: if ($env{'form.editdisc'}) { 1863: $attachmenturls = $contrib{$idx.':attachmenturl'}; 1864: if (defined($contrib{$idx.':replyto'})) { 1865: $parentmsg = $contrib{$idx.':replyto'}; 1866: } 1867: unless (exists($env{'form.origpage'})) { 1868: my $anonflag = 'nonanon'; 1869: if ($contrib{$idx.':anonymous'}) { 1870: $anonflag = 'anon'; 1871: } 1872: $anonscript = (<<END); 1873: function setposttype () { 1874: var currtype = "$anonflag"; 1875: for (var i=0; i<document.mailform.discuss.length; i++) { 1876: if (document.mailform.elements.discuss[i].value == currtype ) { 1877: document.mailform.elements.discuss[i].checked=1; 1878: } 1879: } 1880: return 1881: } 1882: END 1883: } 1884: } 1885: } 1886: if ($env{'form.previous'}) { 1887: $prevtag = '<input type="hidden" name="previous" value="'.$env{'form.previous'}.'" />'; 1888: } 1889: } 1890: 1891: if ($env{'form.origpage'}) { 1892: $subject = &unescape($env{'form.subject'}); 1893: $comment = &unescape($env{'form.comment'}); 1894: &process_attachments(\@currnewattach,\@currdelold,\@keepold); 1895: } 1896: my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(undef,undef,1,($env{'form.modal'}?'popup':0)); 1897: my $send=&mt('Send'); 1898: my $alert = &mt('Please select a feedback type.'); 1899: my $js= <<END; 1900: <script type="text/javascript"> 1901: // 1935: </script> 1936: END 1937: 1938: my ($textareaheader,$textareaclass); 1939: if (&Apache::lonhtmlcommon::htmlareabrowser()) { 1940: $textareaheader = &Apache::lonhtmlcommon::htmlareaselectactive(); 1941: $textareaclass = 'class="LC_richDefaultOff"'; 1942: if ($env{'request.course.id'}) { 1943: unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) { 1944: undef($textareaclass); 1945: } 1946: } 1947: } 1948: 1949: # Breadcrumbs 1950: my $brcrum = [{'href' => '', 1951: 'text' => 'Resource Feedback and Discussion'}]; 1952: 1953: my %onload = ('onload' => 'window.focus();setposttype();'); 1954: my %parms=('add_entries' => \%onload); 1955: if ($env{'form.modal'} ne 'yes') { 'bread_crumbs' => $brcrum } 1956: my $start_page= 1957: &Apache::loncommon::start_page('Resource Feedback and Discussion',$js,\%parms); 1958: 1959: if ($quote ne '') { 1960: $quote = &HTML::Entities::decode($quote); 1961: unless (&contains_block_html($quote)) { 1962: &newline_to_br(\$quote); 1963: } 1964: $quote=&Apache::lonhtmlcommon::start_pick_box(). 1965: &Apache::lonhtmlcommon::row_title(&mt('Quote')). 1966: &Apache::lontexconvert::msgtexconverted($quote). 1967: &Apache::lonhtmlcommon::row_closure(1). 1968: &Apache::lonhtmlcommon::end_pick_box(); 1969: } 1970: my $header=''; 1971: unless ($env{'form.modal'}) { 1972: $header="<h2><tt>$restitle</tt></h2>"; 1973: } 1974: $r->print(<<END); 1975: $start_page 1976: <h1>$lt{'myqu'}</h1> 1977: $header 1978: <form action="/adm/feedback" method="post" name="mailform" 1979: enctype="multipart/form-data"> 1980: $prevtag 1981: <input type="hidden" name="postdata" value="$feedurl" /> 1982: <input type="hidden" name="modal" value="$env{'form.modal'}" /> 1983: END 1984: if ($env{'form.replydisc'}) { 1985: $r->print(<<END); 1986: <input type="hidden" name="replydisc" value="$env{'form.replydisc'}" /> 1987: END 1988: } elsif ($env{'form.editdisc'}) { 1989: $r->print(<<END); 1990: <input type="hidden" name="editdisc" value="$env{'form.editdisc'}" /> 1991: <input type="hidden" name="parentmsg" value="$parentmsg" /> 1992: END 1993: } 1994: $r->print(<<END); 1995: $options 1996: <br /> 1997: END 1998: $r->print(&Apache::lonhtmlcommon::start_pick_box()); 1999: $r->print(<<END); 2000: $quote 2001: <p> 2002: $textareaheader 2003: </p> 2004: <p> 2005: $latexHelp 2006: </p> 2007: <p> 2008: END 2009: 2010: 2011: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject'))); 2012: $r->print('<input type="text" name="subject" size="30" value="'. 2013: $subject.'" /></p>'); 2014: $r->print(&Apache::lonhtmlcommon::row_closure()); 2015: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Message'))); 2016: $r->print('<textarea name="comment" id="comment" cols="55" rows="10" '. 2017: $textareaclass.'>'.$comment. 2018: '</textarea>'); 2019: $r->print(&Apache::lonhtmlcommon::row_closure(1)); 2020: $r->print(&Apache::lonhtmlcommon::end_pick_box()); 2021: 2022: if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) { 2023: if ($env{'form.origpage'}) { 2024: foreach my $attach (@currnewattach) { 2025: $r->print('<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n"); 2026: } 2027: foreach my $oldatt (@currdelold) { 2028: $r->print('<input type="hidden" name="deloldattach" value="'.$oldatt.'" />'."\n"); 2029: } 2030: } 2031: if ($env{'form.editdisc'}) { 2032: if ($attachmenturls) { 2033: &extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold); 2034: $attachnum = scalar(keys(%currattach)); 2035: foreach my $key (keys(%currattach)) { 2036: $r->print('<input type="hidden" name="keepold" value="'.$key.'" />'."\n"); 2037: } 2038: } 2039: } 2040: } else { 2041: $r->print(<<END); 2042: <p> 2043: $lt{'atta'} $attachmaxtext: <input type="file" name="attachment" /> 2044: </p> 2045: END 2046: } 2047: if (exists($env{'form.group'})) { 2048: $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); 2049: } 2050: if (exists($env{'form.ref'})) { 2051: $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); 2052: } 2053: $r->print(<<END); 2054: <input type="hidden" name="sendit" value="1" /> 2055: <input type="button" value="$send" onclick='gosubmit();' /> 2056: </form> 2057: END 2058: if ($env{'form.editdisc'} || $env{'form.replydisc'}) { 2059: my $now = time; 2060: my $ressymb = $symb; 2061: &Apache::lonenc::check_encrypt(\$ressymb); 2062: my $postidx = ''; 2063: if ($env{'form.editdisc'}) { 2064: $postidx = $idx; 2065: } 2066: if (@currnewattach > 0) { 2067: $attachnum += @currnewattach; 2068: } 2069: my $blockblog = &Apache::loncommon::blocking_status('blogs'); 2070: if ($attachnum > 0) { 2071: if (@currnewattach > 0) { 2072: $newattachmsg .= '<br /><b>'.&mt('New attachments').'</b><br />'; 2073: if (@currnewattach > 1) { 2074: $newattachmsg .= '<ol>'; 2075: foreach my $item (@currnewattach) { 2076: $item =~ m#.*/([^/]+)$#; 2077: $newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n"; 2078: } 2079: $newattachmsg .= '</ol>'."\n"; 2080: } else { 2081: $currnewattach[0] =~ m#.*/([^/]+)$#; 2082: $newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n"; 2083: } 2084: } 2085: if ($attachmsg) { 2086: $r->print("<br /><b>$lt{'reta'}</b>:$attachmsg<br />\n"); 2087: } 2088: if ($newattachmsg) { 2089: $r->print("$newattachmsg"); 2090: } 2091: } 2092: $r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog)); 2093: } 2094: $r->print(&generate_preview_button(). 2095: &Apache::loncommon::end_page()); 2096: 2097: } 2098: 2099: sub print_display_options { 2100: my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_; 2101: &Apache::loncommon::content_type($r,'text/html'); 2102: $r->send_http_header; 2103: 2104: my $function = &Apache::loncommon::get_users_function(); 2105: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', 2106: $env{'user.domain'}); 2107: 2108: my %lt = &Apache::lonlocal::texthash( 2109: 'pref' => 'Display Preference', 2110: 'curr' => 'Current setting ', 2111: 'actn' => 'Action', 2112: 'deff' => 'Default for all discussions', 2113: 'prca' => 'Preferences can be set for this discussion that determine ....', 2114: 'whpo' => 'Which posts are displayed when you display this discussion board or resource, and', 2115: 'unwh' => 'Under what circumstances posts are identified as "NEW", and', 2116: 'wipa' => 'Whether individual posts can be marked as read/unread', 2117: 'allposts' => 'All posts', 2118: 'unread' => 'New posts only', 2119: 'unmark' => 'Posts not marked read', 2120: 'ondisp' => 'Once displayed', 2121: 'onmark' => 'Once marked not NEW', 2122: 'toggon' => 'Shown', 2123: 'toggoff' => 'Not shown', 2124: 'disa' => 'Posts displayed?', 2125: 'npmr' => 'New posts cease to be identified as "NEW"?', 2126: 'dotm' => 'Option to mark each post as read/unread?', 2127: 'chgt' => 'Change to ', 2128: 'mkdf' => 'Set to ', 2129: 'yhni' => 'You have not indicated that you wish to change any of the discussion settings', 2130: 'ywbr' => 'You will be returned to the previous page if you click OK.' 2131: ); 2132: 2133: my $dispchangeA = $lt{'unread'}; 2134: my $dispchangeB = $lt{'unmark'}; 2135: my $markchange = $lt{'ondisp'}; 2136: my $toggchange = $lt{'toggon'}; 2137: my $currdisp = $lt{'allposts'}; 2138: my $currmark = $lt{'onmark'}; 2139: my $discdisp = 'allposts'; 2140: my $discmark = 'onmark'; 2141: my $currtogg = $lt{'toggoff'}; 2142: my $disctogg = 'toggoff'; 2143: 2144: if ($dispchgA eq 'allposts') { 2145: $dispchangeA = $lt{'allposts'}; 2146: $currdisp = $lt{'unread'}; 2147: $discdisp = 'unread'; 2148: } 2149: 2150: if ($markchg eq 'markonread') { 2151: $markchange = $lt{'onmark'}; 2152: $currmark = $lt{'ondisp'}; 2153: $discmark = 'ondisp'; 2154: } 2155: 2156: if ($dispchgB eq 'onlyunread') { 2157: $dispchangeB = $lt{'unread'}; 2158: $currdisp = $lt{'unmark'}; 2159: $discdisp = 'unmark'; 2160: } 2161: if ($toggchg eq 'toggoff') { 2162: $toggchange = $lt{'toggoff'}; 2163: $currtogg = $lt{'toggon'}; 2164: $disctogg = 'toggon'; 2165: } 2166: 2167: my $js = <<END; 2168: <script type="text/javascript"> 2169: function discdispChk(caller) { 2170: var disctogg = '$toggchg' 2171: if (caller == 0) { 2172: if (document.modifydisp.discdisp[0].checked == true) { 2173: if (document.modifydisp.discdisp[1].checked == true) { 2174: document.modifydisp.discdisp[1].checked = false 2175: } 2176: } 2177: } 2178: if (caller == 1) { 2179: if (document.modifydisp.discdisp[1].checked == true) { 2180: if (document.modifydisp.discdisp[0].checked == true) { 2181: document.modifydisp.discdisp[0].checked = false 2182: } 2183: if (disctogg == 'toggon') { 2184: document.modifydisp.disctogg.checked = true 2185: } 2186: if (disctogg == 'toggoff') { 2187: document.modifydisp.disctogg.checked = false 2188: } 2189: } 2190: } 2191: if (caller == 2) { 2192: var dispchgB = '$dispchgB' 2193: if (disctogg == 'toggoff') { 2194: if (document.modifydisp.disctogg.checked == true) { 2195: if (dispchgB == 'onlyunmark') { 2196: document.modifydisp.discdisp[1].checked = false 2197: } 2198: } 2199: } 2200: } 2201: } 2202: 2203: function setDisp() { 2204: var prev = "$previous" 2205: var chktotal = 0 2206: if (document.modifydisp.discdisp[0].checked == true) { 2207: document.modifydisp.$dispchgA.value = "$symb" 2208: chktotal ++ 2209: } 2210: if (document.modifydisp.discdisp[1].checked == true) { 2211: document.modifydisp.$dispchgB.value = "$symb" 2212: chktotal ++ 2213: } 2214: if (document.modifydisp.discmark.checked == true) { 2215: document.modifydisp.$markchg.value = "$symb" 2216: chktotal ++ 2217: } 2218: if (document.modifydisp.disctogg.checked == true) { 2219: document.modifydisp.$toggchg.value = "$symb" 2220: chktotal ++ 2221: } 2222: if (chktotal > 0) { 2223: document.modifydisp.submit() 2224: } else { 2225: if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) { 2226: if (prev > 0) { 2227: location.href = "$feedurl?previous=$previous" 2228: } else { 2229: location.href = "$feedurl" 2230: } 2231: } 2232: } 2233: } 2234: </script> 2235: END 2236: 2237: 2238: my $start_page = 2239: &Apache::loncommon::start_page('Discussion display options',$js); 2240: my $end_page = 2241: &Apache::loncommon::end_page(); 2242: $r->print(<<END); 2243: $start_page 2244: <form name="modifydisp" method="post" action="/adm/feedback"> 2245: $lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li><li>$lt{'wipa'}</li></ol> 2246: <br /> 2247: END 2248: $r->print(&Apache::loncommon::start_data_table()); 2249: $r->print(<<END); 2250: <tr> 2251: <th>$lt{'pref'}</td> 2252: <th>$lt{'curr'}</td> 2253: <th>$lt{'actn'}?</td> 2254: </tr> 2255: END 2256: $r->print(&Apache::loncommon::start_data_table_row()); 2257: $r->print(<<END); 2258: <td>$lt{'disa'}</td> 2259: <td>$lt{$discdisp}</td> 2260: <td><label><input type="checkbox" name="discdisp" onclick="discdispChk('0')" /> $lt{'chgt'} "$dispchangeA"</label> 2261: <br /> 2262: <label><input type="checkbox" name="discdisp" onclick="discdispChk('1')" /> $lt{'chgt'} "$dispchangeB"</label> 2263: </td> 2264: END 2265: $r->print(&Apache::loncommon::end_data_table_row()); 2266: $r->print(&Apache::loncommon::start_data_table_row()); 2267: $r->print(<<END); 2268: <td>$lt{'npmr'}</td> 2269: <td>$lt{$discmark}</td> 2270: <td><label><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</label></td> 2271: END 2272: $r->print(&Apache::loncommon::end_data_table_row()); 2273: $r->print(&Apache::loncommon::start_data_table_row()); 2274: $r->print(<<END); 2275: <td>$lt{'dotm'}</td> 2276: <td>$lt{$disctogg}</td> 2277: <td><label><input type="checkbox" name="disctogg" onclick="discdispChk('2')" />$lt{'chgt'} "$toggchange"</label></td> 2278: END 2279: my $save = &mt('Save'); 2280: $r->print(&Apache::loncommon::end_data_table_row()); 2281: $r->print(&Apache::loncommon::end_data_table()); 2282: $r->print(<<END); 2283: <br /> 2284: <br /> 2285: <input type="hidden" name="symb" value="$symb" /> 2286: <input type="hidden" name="previous" value="$previous" /> 2287: <input type="hidden" name="$dispchgA" value="" /> 2288: <input type="hidden" name="$dispchgB" value="" /> 2289: <input type="hidden" name="$markchg" value="" /> 2290: <input type="hidden" name="$toggchg" value="" /> 2291: <input type="button" name="sub" value="$save" onclick="javascript:setDisp()" /> 2292: END 2293: if (exists($env{'form.group'})) { 2294: $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); 2295: } 2296: if (exists($env{'form.ref'})) { 2297: $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); 2298: } 2299: $r->print(" 2300: <br /> 2301: <br /> 2302: </form> 2303: $end_page 2304: "); 2305: return; 2306: } 2307: 2308: sub print_sortfilter_options { 2309: my ($r,$symb,$previous,$feedurl) = @_; 2310: 2311: &Apache::loncommon::content_type($r,'text/html'); 2312: $r->send_http_header; 2313: 2314: &Apache::lonenc::check_encrypt(\$symb); 2315: my @sections; 2316: my $section_sel = ''; 2317: my $numvisible = 5; 2318: my @groups; 2319: my $group_sel = ''; 2320: my $numgroupvis = 5; 2321: my %sectioncount = &Apache::loncommon::get_sections(); 2322: my @courseroles = qw(st ad ep ta in); 2323: my $crstype = &Apache::loncommon::course_type(); 2324: my $ccrole = 'cc'; 2325: if ($crstype eq 'Community') { 2326: $ccrole = 'co'; 2327: } 2328: push(@courseroles,$ccrole); 2329: 2330: if ($env{'request.course.sec'} !~ /^\s*$/) { #Restrict section choice to current section 2331: @sections = ('all',$env{'request.course.sec'}); 2332: $numvisible = 2; 2333: } else { 2334: @sections = sort {$a cmp $b} keys(%sectioncount); 2335: if (scalar(@sections) < 4) { 2336: $numvisible = scalar(@sections) + 1; 2337: } 2338: unshift(@sections,'all'); # Put 'all' at the front of the list 2339: 2340: } 2341: foreach my $sec (@sections) { 2342: $section_sel .= " <option value=\"$sec\">$sec</option>\n"; 2343: } 2344: 2345: if (&check_group_priv() eq 'ok') { 2346: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2347: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2348: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum); 2349: @groups = sort {$a cmp $b} keys(%curr_groups); 2350: if (scalar(@groups) < 4) { 2351: $numgroupvis = scalar(@groups) + 1; 2352: } 2353: unshift(@groups,'all'); # Put 'all' at the front of the list 2354: } else { 2355: my @coursegroups = split(/:/,$env{'request.course.groups'}); 2356: if (@coursegroups > 0) { 2357: @coursegroups = sort {$a cmp $b} @coursegroups; 2358: @groups = ('all',@coursegroups); 2359: if (scalar(@groups) < 4) { 2360: $numgroupvis = scalar(@groups) + 1; 2361: } 2362: } else { 2363: @groups = ('all'); 2364: $numgroupvis = 1; 2365: } 2366: } 2367: foreach my $group (@groups) { 2368: $group_sel .= " <option value=\"$group\">$group</option>\n"; 2369: } 2370: 2371: my $function = &Apache::loncommon::get_users_function(); 2372: my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg', 2373: $env{'user.domain'}); 2374: my %lt = &Apache::lonlocal::texthash( 2375: 'diop' => 'Display Options', 2376: 'curr' => 'Current setting ', 2377: 'actn' => 'Action', 2378: 'prca' => 'Set options that control the sort order of posts, and/or which posts are displayed.', 2379: 'soor' => 'Sort order', 2380: 'spur' => 'Specific user roles', 2381: 'sprs' => 'Specific role status', 2382: 'spse' => 'Specific sections', 2383: 'spgr' => 'Specific groups', 2384: 'psub' => 'Pick specific users (by name)', 2385: 'shal' => 'Show a list of current posters', 2386: 'stor' => 'Save changes', 2387: ); 2388: 2389: my %sort_types = (); 2390: my %role_types = (); 2391: my %status_types = (); 2392: &sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype); 2393: 2394: my $js = <<END; 2395: <script type="text/javascript"> 2396: function verifyFilter() { 2397: var rolenum = 0 2398: for (var i=0; i<document.modifyshown.rolefilter.length; i++) { 2399: if (document.modifyshown.rolefilter.options[i].selected == true) { 2400: rolenum ++ 2401: } 2402: } 2403: if (rolenum == 0) { 2404: document.modifyshown.rolefilter.options[0].selected = true 2405: } 2406: 2407: var secnum = 0 2408: for (var i=0; i<document.modifyshown.sectionpick.length; i++) { 2409: if (document.modifyshown.sectionpick.options[i].selected == true) { 2410: secnum ++ 2411: } 2412: } 2413: if (secnum == 0) { 2414: document.modifyshown.sectionpick.options[0].selected = true 2415: } 2416: 2417: var grpnum = 0 2418: for (var i=0; i<document.modifyshown.grouppick.length; i++) { 2419: if (document.modifyshown.grouppick.options[i].selected == true) { 2420: grpnum ++ 2421: } 2422: } 2423: if (grpnum == 0) { 2424: document.modifyshown.grouppick.options[0].selected = true 2425: } 2426: 2427: document.modifyshown.submit(); 2428: } 2429: </script> 2430: END 2431: 2432: my $start_page= 2433: &Apache::loncommon::start_page('Discussion options',$js); 2434: my $end_page= 2435: &Apache::loncommon::end_page(); 2436: 2437: $r->print(<<END); 2438: $start_page 2439: <form name="modifyshown" method="post" action="/adm/feedback"> 2440: <b>$lt{'diso'}</b><br/> $lt{'prca'} 2441: <br /> 2442: <table border="0"> 2443: <tr> 2444: <th>$lt{'soor'}</th> 2445: <th> </th> 2446: <th>$lt{'sprs'}</th> 2447: <th> </th> 2448: <th>$lt{'spur'}</th> 2449: <th> </th> 2450: <th>$lt{'spse'}</th> 2451: <th> </th> 2452: <th>$lt{'spgr'}</th> 2453: <th> </th> 2454: <th>$lt{'psub'}</th> 2455: </tr> 2456: <tr> 2457: <td align="center" valign="top"> 2458: <select name="sortposts"> 2459: <option value="ascdate" selected="selected">$sort_types{'ascdate'}</option> 2460: <option value="descdate">$sort_types{'descdate'}</option> 2461: <option value="thread">$sort_types{'thread'}</option> 2462: <option value="subject">$sort_types{'subject'}</option> 2463: <option value="username">$sort_types{'username'}</option> 2464: <option value="lastfirst">$sort_types{'lastfirst'}</option> 2465: </select> 2466: </td> 2467: <td> </td> 2468: <td align="center" valign="top"> 2469: <select name="statusfilter"> 2470: <option value="all" selected="selected">$status_types{'all'}</option> 2471: <option value="Active">$status_types{'Active'}</option> 2472: <option value="Expired">$status_types{'Expired'}</option> 2473: <option value="Future">$status_types{'Future'}</option> 2474: </select> 2475: </td> 2476: <td> </td> 2477: <td align="center" valign="top"> 2478: <select name="rolefilter" multiple="multiple" size="5"> 2479: <option value="all">$role_types{'all'}</option> 2480: <option value="st">$role_types{'st'}</option> 2481: <option value="$ccrole">$role_types{$ccrole}</option> 2482: <option value="in">$role_types{'in'}</option> 2483: <option value="ta">$role_types{'ta'}</option> 2484: <option value="ep">$role_types{'ep'}</option> 2485: <option value="ad">$role_types{'ad'}</option> 2486: <option value="cr">$role_types{'cr'}</option> 2487: </select> 2488: </td> 2489: <td> </td> 2490: <td align="center" valign="top"> 2491: <select name="sectionpick" multiple="multiple" size="$numvisible"> 2492: $section_sel 2493: </select> 2494: </td> 2495: <td> </td> 2496: <td align="center" valign="top"> 2497: <select name="grouppick" multiple="multiple" size="$numvisible"> 2498: $group_sel 2499: </select> 2500: </td> 2501: <td> </td> 2502: <td valign="top"><label><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</label></td> 2503: </tr> 2504: </table> 2505: <br /> 2506: <input type="hidden" name="inhibitmenu" value="$env{'form.inhibitmenu'}" /> 2507: <input type="hidden" name="modal" value="$env{'form.modal'}" /> 2508: <input type="hidden" name="previous" value="$previous" /> 2509: <input type="hidden" name="applysort" value="$symb" /> 2510: <input type="button" name="sub" value="$lt{'stor'}" onclick="verifyFilter()" /> 2511: END 2512: if (exists($env{'form.group'})) { 2513: $r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />'); 2514: } 2515: if (exists($env{'form.ref'})) { 2516: $r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'); 2517: } 2518: $r->print(" 2519: <br /> 2520: <br /> 2521: </form> 2522: $end_page 2523: "); 2524: } 2525: 2526: sub print_showposters { 2527: my ($r,$symb,$previous,$feedurl,$sortposts) = @_; 2528: 2529: &Apache::loncommon::content_type($r,'text/html'); 2530: $r->send_http_header; 2531: 2532: &Apache::lonenc::check_encrypt(\$symb); 2533: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2534: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2535: my $group = $env{'form.group'}; 2536: my $ressymb = &wrap_symb($symb); 2537: my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); 2538: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 2539: $cdom,$cnum); 2540: my %namesort = (); 2541: my %postcounts = (); 2542: 2543: my %lt = &Apache::lonlocal::texthash( 2544: sele => 'Select', 2545: full => 'Fullname', 2546: usdo => 'Username:domain', 2547: post => 'Posts', 2548: ); 2549: if ($contrib{'version'}) { 2550: for (my $idx=1;$idx<=$contrib{'version'};$idx++) { 2551: my $hidden=($contrib{'hidden'}=~/\.$idx\./); 2552: my $deleted=($contrib{'deleted'}=~/\.$idx\./); 2553: unless ((($hidden) && (!$seehidden)) || ($deleted)) { 2554: if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { 2555: my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'}); 2556: my $lastname = $names{'lastname'}; 2557: my $firstname = $names{'firstname'}; 2558: if ($lastname eq '') { 2559: $lastname = '_'; 2560: } 2561: if ($firstname eq '') { 2562: $firstname = '_'; 2563: } 2564: unless (defined($namesort{$lastname})) { 2565: %{$namesort{$lastname}} = (); 2566: } 2567: my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'}; 2568: $postcounts{$poster} ++; 2569: if (defined($namesort{$lastname}{$firstname})) { 2570: if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) { 2571: push(@{$namesort{$lastname}{$firstname}}, $poster); 2572: } 2573: } else { 2574: @{$namesort{$lastname}{$firstname}} = ("$poster"); 2575: } 2576: } 2577: } 2578: } 2579: } 2580: 2581: my $start_page = &Apache::loncommon::start_page('Discussion options'); 2582: my $table_start =&Apache::loncommon::start_data_table(); 2583: $r->print(<<END); 2584: $start_page 2585: <form name="pickpostersform" method="post"> 2586: <br /> 2587: $table_start 2588: <tr> 2589: <th>#</th> 2590: <th>$lt{'sele'}</th> 2591: <th>$lt{'full'} <font color="#999999">($lt{'usdo'})</font></th> 2592: <th>$lt{'post'}</th> 2593: </tr> 2594: END 2595: my $count = 0; 2596: foreach my $last (sort(keys(%namesort))) { 2597: foreach my $first (sort(keys(%{$namesort{$last}}))) { 2598: foreach my $user (sort(@{$namesort{$last}{$first}})) { 2599: my ($uname,$udom) = split(/:/,$user); 2600: if (!$uname || !$udom) { 2601: next; 2602: } else { 2603: $count ++; 2604: $r->print(&Apache::loncommon::start_data_table_row(). 2605: '<td align="right">'.$count.'</td> 2606: <td align="center"><label><input name="stuinfo" type="checkbox" value="'.$user.'" /></td> 2607: <td>'.$last.', '.$first.' ('.$uname.':'.$udom.')</label></td> 2608: <td>'.$postcounts{$user}.'</td>'. 2609: &Apache::loncommon::end_data_table_row()); 2610: } 2611: } 2612: } 2613: } 2614: $r->print(&Apache::loncommon::end_data_table()); 2615: my $end_page = &Apache::loncommon::end_page(); 2616: $r->print(<<END); 2617: <br /> 2618: <input type="hidden" name="sortposts" value="$sortposts" /> 2619: <input type="hidden" name="modal" value="$env{'form.modal'}" /> 2620: <input type="hidden" name="userpick" value="$symb" /> 2621: <input type="button" name="store" value="Display posts" onclick="javascript:document.pickpostersform.submit()" /> 2622: </form> 2623: $end_page 2624: END 2625: } 2626: 2627: sub get_post_versions { 2628: my ($versions,$incoming,$htmldecode,$numver) = @_; 2629: if ($incoming =~ /^<version num="0">/) { 2630: my $p = HTML::LCParser->new(\$incoming); 2631: my $done = 0; 2632: 2633: while ( (my $token = $p->get_tag("version")) && (!$done)) { 2634: my $num = $token->[1]{num}; 2635: my $text = $p->get_text("/version"); 2636: if (defined($numver)) { 2637: if ($num == $numver) { 2638: if ($htmldecode) { 2639: $text = &HTML::Entities::decode($text); 2640: } 2641: $$versions{$numver}=$text; 2642: $done = 1; 2643: } 2644: } else { 2645: if ($htmldecode) { 2646: $text = &HTML::Entities::decode($text); 2647: } 2648: $$versions{$num}=$text; 2649: } 2650: } 2651: } else { 2652: if (!defined($numver)) { 2653: $numver = 0; 2654: } 2655: if ($htmldecode) { 2656: $$versions{$numver} = $incoming; 2657: } else { 2658: $$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"'); 2659: } 2660: } 2661: return; 2662: } 2663: 2664: sub get_post_attachments { 2665: my ($attachments,$attachmenturls) = @_; 2666: my $num; 2667: if ($attachmenturls =~ m/^<attachment id="0">/) { 2668: my $p = HTML::LCParser->new(\$attachmenturls); 2669: while (my $token = $p->get_tag("attachment","filename","post")) { 2670: if ($token->[0] eq "attachment") { 2671: $num = $token->[1]{id}; 2672: %{$$attachments{$num}} =(); 2673: } elsif ($token->[0] eq "filename") { 2674: $$attachments{$num}{'filename'} = $p->get_text("/filename"); 2675: } elsif ($token->[0] eq "post") { 2676: my $id = $token->[1]{id}; 2677: $$attachments{$num}{$id} = $p->get_text("/post"); 2678: } 2679: } 2680: } else { 2681: %{$$attachments{'0'}} = (); 2682: $$attachments{'0'}{'filename'} = $attachmenturls; 2683: $$attachments{'0'}{'0'} = 'n'; 2684: } 2685: 2686: return; 2687: } 2688: 2689: sub fail_redirect { 2690: my ($r,$feedurl) = @_; 2691: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 2692: my %lt = &Apache::lonlocal::texthash( 2693: 'sorr' => 'Sorry, no recipients ...', 2694: ); 2695: my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); 2696: $r->print(&Apache::loncommon::start_page('Feedback not sent',undef, 2697: {'redirect' => [2,$feedurl], 2698: 'only_body' => 1,})); 2699: $r->print(<<ENDFAILREDIR); 2700: <img align="right" src="$logo" /> 2701: <p class="LC_warning">$lt{'sorr'}</p> 2702: ENDFAILREDIR 2703: $r->print(&Apache::loncommon::end_page()); 2704: } 2705: 2706: sub redirect_back { 2707: my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group,$toolarge) = @_; 2708: my $sorttag = ''; 2709: my $roletag = ''; 2710: my $statustag = ''; 2711: my $sectag = ''; 2712: my $grptag = ''; 2713: my $userpicktag = ''; 2714: my $qrystr = ''; 2715: my $prevtag = ''; 2716: 2717: &Apache::loncommon::content_type($r,'text/html'); 2718: $r->send_http_header; 2719: &dewrapper(\$feedurl); 2720: if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' }; 2721: if ($previous > 0) { 2722: $qrystr = 'previous='.$previous; 2723: if ($feedurl =~ /\?register=1/) { 2724: $feedurl .= '&'.$qrystr; 2725: } else { 2726: $feedurl .= '?'.$qrystr; 2727: } 2728: $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />'; 2729: } 2730: if (defined($sort)) { 2731: my $sortqry = 'sortposts='.$sort; 2732: if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) { 2733: $feedurl .= '&'.$sortqry; 2734: } else { 2735: $feedurl .= '?'.$sortqry; 2736: } 2737: $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />'; 2738: if (defined($numpicks)) { 2739: my $userpickqry = 'totposters='.$numpicks; 2740: $feedurl .= '&'.$userpickqry; 2741: $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />'; 2742: } else { 2743: if (ref($sectionpick) eq 'ARRAY') { 2744: $feedurl .= '&sectionpick='; 2745: $sectag .= '<input type="hidden" name="sectionpick" value="'; 2746: foreach my $sec (@{$sectionpick}) { 2747: $feedurl .= $sec.','; 2748: $sectag .= $sec.','; 2749: } 2750: $feedurl =~ s/,$//; 2751: $sectag =~ s/,$//; 2752: $sectag .= '" />'; 2753: } else { 2754: $feedurl .= '&sectionpick='.$sectionpick; 2755: $sectag = '<input type="hidden" name="sectionpick" value="'.$sectionpick.'" />'; 2756: } 2757: if (ref($grouppick) eq 'ARRAY') { 2758: $feedurl .= '&grouppick='; 2759: $sectag .= '<input type="hidden" name="grouppick" value="'; 2760: foreach my $grp (@{$grouppick}) { 2761: $feedurl .= $grp.','; 2762: $grptag .= $grp.','; 2763: } 2764: $feedurl =~ s/,$//; 2765: $grptag =~ s/,$//; 2766: $grptag .= '" />'; 2767: } else { 2768: $feedurl .= '&grouppick='.$grouppick; 2769: $grptag = '<input type="hidden" name="grouppick" value="'.$grouppick.'" />'; 2770: } 2771: if (ref($rolefilter) eq 'ARRAY') { 2772: $feedurl .= '&rolefilter='; 2773: $roletag .= '<input type="hidden" name="rolefilter" value="'; 2774: foreach my $role (@{$rolefilter}) { 2775: $feedurl .= $role.','; 2776: $roletag .= $role.','; 2777: } 2778: $feedurl =~ s/,$//; 2779: $roletag =~ s/,$//; 2780: $roletag .= '" />'; 2781: } else { 2782: $feedurl .= '&rolefilter='.$rolefilter; 2783: $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />'; 2784: } 2785: $feedurl .= '&statusfilter='.$statusfilter; 2786: $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />'; 2787: } 2788: } 2789: my $grouptag; 2790: if ($group ne '') { 2791: $grouptag = '<input type="hidden" name="group" value="'.$group.'" />'; 2792: my $refarg; 2793: if (exists($env{'form.ref'})) { 2794: $refarg = '&ref='.$env{'form.ref'}; 2795: $grouptag .= '<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />'; 2796: } 2797: if ($feedurl =~ /\?/) { 2798: $feedurl .= '&group='.$group.$refarg; 2799: } else { 2800: $feedurl .= '?group='.$group.$refarg; 2801: } 2802: } 2803: &Apache::lonenc::check_encrypt(\$feedurl); 2804: my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); 2805: my %parms=('only_body' => 1); 2806: if ($env{'form.modal'}) { 2807: $parms{'add_entries'}={'onLoad' => 'document.forms.reldt.submit()'}; 2808: } else { 2809: $parms{'redirect'}=[0,$feedurl]; 2810: } 2811: my $start_page= 2812: &Apache::loncommon::start_page('Feedback sent',undef,\%parms); 2813: my $end_page = &Apache::loncommon::end_page(); 2814: $r->print(<<ENDREDIR); 2815: $start_page 2816: <img align="right" src="$logo" /> 2817: $typestyle 2818: <b>Sent $sendsomething message(s), and $sendposts post(s).</b> 2819: $blog 2820: $toolarge 2821: <font color="red">$status</font> 2822: <form name="reldt" action="$feedurl" target="loncapaclient"> 2823: $prevtag 2824: $sorttag 2825: $statustag 2826: $roletag 2827: $sectag 2828: $grptag 2829: $userpicktag 2830: $grouptag 2831: </form> 2832: $end_page 2833: ENDREDIR 2834: } 2835: 2836: sub no_redirect_back { 2837: my ($r,$feedurl) = @_; 2838: my $nofeed=&mt('Sorry, no feedback possible on this resource ...'); 2839: 2840: my %onload; 2841: 2842: my %body_options = ('only_body' => 1, 2843: 'bgcolor' => '#FFFFFF', 2844: 'add_entries' => \%onload,); 2845: 2846: if ($feedurl !~ m{^/adm/feedback}) { 2847: $body_options{'redirect'} = [2,$feedurl]; 2848: } 2849: my $start_page= 2850: &Apache::loncommon::start_page('Feedback not sent',undef, 2851: \%body_options); 2852: 2853: my $end_page = &Apache::loncommon::end_page(); 2854: 2855: &Apache::lonenc::check_encrypt(\$feedurl); 2856: my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); 2857: $r->print (<<ENDNOREDIRTWO); 2858: $start_page 2859: <img align="right" src="$logo" /> 2860: <b>$nofeed</b> 2861: <br /> 2862: $end_page 2863: ENDNOREDIRTWO 2864: } 2865: 2866: sub screen_header { 2867: my ($feedurl,$symb,$group) = @_; 2868: my $crscontent = &mt('Question/Comment/Feedback about course content'); 2869: my $crspolicy = &mt('Question/Comment/Feedback about course policy'); 2870: my $contribdisc = &mt('Contribution to course discussion of resource'); 2871: my $anoncontrib = &mt('Anonymous contribution to course discussion of resource'); 2872: my $namevis = &mt('name only visible to course faculty'); 2873: my $crstype; 2874: if ($env{'request.course.id'}) { 2875: $crstype = &Apache::loncommon::course_type(); 2876: if ($crstype eq 'Community') { 2877: $crscontent = &mt('Question/Comment/Feedback about community content'); 2878: $crspolicy = &mt('Question/Comment/Feedback about community policy'); 2879: $contribdisc = &mt('Contribution to community discussion of resource'); 2880: $anoncontrib = &mt('Anonymous contribution to community discussion of resource'); 2881: $namevis = &mt('name only visible to community facilitators'); 2882: } 2883: } 2884: my $msgoptions=''; 2885: my $discussoptions=''; 2886: unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { 2887: if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) { 2888: $msgoptions= 2889: '<label><input type="radio" name="discuss" value="author" /> '. 2890: &mt('Feedback to resource author').'</label><br />'; 2891: } 2892: my %optionhash=(); 2893: foreach my $type ('question','comment','policy') { 2894: $optionhash{$type}=$env{'course.'.$env{'request.course.id'}.'.'.$type.'.email.text'}; 2895: } 2896: if (&feedback_available(1)) { 2897: $msgoptions.= 2898: '<label><input type="radio" name="discuss" value="question" /> '. 2899: ($optionhash{'question'}?$optionhash{'question'}:&mt('Question about resource content')).'</label><br />'; 2900: } 2901: if (&feedback_available(0,1)) { 2902: $msgoptions.= 2903: '<label><input type="radio" name="discuss" value="course" /> '. 2904: ($optionhash{'comment'}?$optionhash{'comment'}:$crscontent). 2905: '</label><br />'; 2906: } 2907: if (&feedback_available(0,0,1)) { 2908: $msgoptions.= 2909: '<label><input type="radio" name="discuss" value="policy" /> '. 2910: ($optionhash{'policy'}?$optionhash{'policy'}:$crspolicy). 2911: '</label><br />'; 2912: } 2913: } 2914: if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) { 2915: my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards'); 2916: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 2917: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 2918: my $realsymb = &get_realsymb($symb); 2919: if (!$blocked && &discussion_open(undef,$realsymb) && 2920: (&Apache::lonnet::allowed('pch', 2921: $env{'request.course.id'}. 2922: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || 2923: (($group ne '') && ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$}) && (&check_group_priv($group,'pgd') eq 'ok')))) { 2924: $discussoptions='<label><input type="radio" name="discuss" value="nonanon" checked="checked" /> '. 2925: $contribdisc. 2926: '</label><br /><label><input type="radio" name="discuss" value="anon" /> '. 2927: $anoncontrib. 2928: ' <i>('.$namevis.')</i></label> '. 2929: '<a href="/adm/preferences?action=changescreenname">'.&mt('Change Screenname').'</a>'; 2930: my $blockblog = &Apache::loncommon::blocking_status('blogs'); 2931: if (!$blockblog) { 2932: $discussoptions.= &add_blog_checkbox($crstype); 2933: } 2934: } 2935: } 2936: if ($msgoptions) { 2937: $msgoptions='<tr><th><img src="'.&Apache::loncommon::lonhttpdurl('/res/adm/pages/feedback.png').'" />' 2938: .'<br />'.&mt('Send Feedback').'<br />'.&Apache::lonhtmlcommon::coursepreflink(&mt('Feedback Settings'),'feedback').'</th>'. 2939: '<td>'.$msgoptions.'</td></tr>'; 2940: } 2941: if ($discussoptions) { 2942: $discussoptions='<tr><th><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" alt="" />' 2943: .'<br />'.&mt('Discussion Contributions').'<br />'.&Apache::lonhtmlcommon::coursepreflink(&mt('Discussion Settings'),'discussion').'</th>'. 2944: '<td>'.$discussoptions.'</td></tr>'; 2945: } 2946: return &Apache::loncommon::start_data_table().$msgoptions.$discussoptions.&Apache::loncommon::end_data_table(); 2947: } 2948: 2949: sub resource_output { 2950: my ($feedurl) = @_; 2951: my $usersaw=&Apache::lonnet::ssi_body($feedurl); 2952: $usersaw=~s/\<body[^\>]*\>//gi; 2953: $usersaw=~s/\<\/body\>//gi; 2954: $usersaw=~s/\<html\>//gi; 2955: $usersaw=~s/\<\/html\>//gi; 2956: $usersaw=~s/\<head\>//gi; 2957: $usersaw=~s/\<\/head\>//gi; 2958: $usersaw=~s/action\s*\=/would_be_action\=/gi; 2959: return $usersaw; 2960: } 2961: 2962: sub clear_out_html { 2963: my ($message,$override)=@_; 2964: # Always allow the <m>-tag 2965: my %html=(M=>1); 2966: # Check if more is allowed 2967: my $cid=$env{'request.course.id'}; 2968: if (($env{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) || 2969: ($override)) { 2970: # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 2971: # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB> 2972: # <SUP> <TABLE> <TR> <TD> <TH> <TBODY> 2973: %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1, 2974: BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, PRE=>1, DIV=>1, IMG=>1, 2975: M=>1, CHEM=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1, 2976: H1=>1, H2=>1, H3=>1, H4=>1, H5=>1, H6=>1, 2977: TABLE=>1, TR=>1, TD=>1, TH=>1, TBODY=>1); 2978: } 2979: # Do the substitution of everything that is not explicitly allowed 2980: $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/ 2981: {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge; 2982: $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/ 2983: {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge; 2984: return $message; 2985: } 2986: 2987: sub assemble_email { 2988: my ($message,$prevattempts,$usersaw,$useranswer)=@_; 2989: my %lt = &Apache::lonlocal::texthash( 2990: 'prev' => 'Previous attempts of student (if applicable)', 2991: 'orig' => 'Original screen output (if applicable)', 2992: 'corr' => 'Correct Answer(s) (if applicable)', 2993: ); 2994: if (&Apache::loncommon::course_type() eq 'Community') { 2995: $lt{'prev'} = &mt('Previous attempts of member (if applicable)'); 2996: } 2997: my $email=<<"ENDEMAIL"; 2998: $message 2999: ENDEMAIL 3000: my $citations=<<"ENDCITE"; 3001: <h2>$lt{'prev'}</h2> 3002: $prevattempts 3003: <br /><hr /> 3004: <h2>$lt{'orig'}</h2> 3005: $usersaw 3006: <h2>$lt{'corr'}</h2> 3007: $useranswer 3008: ENDCITE 3009: return ($email,$citations); 3010: } 3011: 3012: 3013: sub feedback_available { 3014: my ($question,$course,$policy)=@_; 3015: my ($typestyle,%to)=&Apache::lonmsg::decide_receiver('',0,$question, 3016: $course,$policy); 3017: return scalar(%to); 3018: } 3019: 3020: sub send_msg { 3021: my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,%to)=@_; 3022: my $status=''; 3023: my $sendsomething=0; 3024: my $restitle = &get_resource_title($symb,$feedurl); 3025: if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; } 3026: unless ($title=~/\w/) { $title=&mt('Feedback'); } 3027: foreach my $key (keys(%to)) { 3028: if ($key) { 3029: my ($user,$domain) = split(/\:/,$key,2); 3030: if (!defined($user)) { 3031: $status.='<br />'.&mt('Error sending message to [_1], no user specified.',$key); 3032: } elsif (!defined($domain)) { 3033: $status.='<br />'.&mt('Error sending message to [_1], no domain specified.',$key); 3034: } else { 3035: unless (&Apache::lonmsg::user_normal_msg($user,$domain, 3036: $title.' ['.$restitle.']',$email,$citations,$feedurl, 3037: $attachmenturl,undef,undef,$symb,$restitle)=~/ok/) { 3038: $status.='<br />'.&mt('Error sending message to').' '.$key.'<br />'; 3039: } else { 3040: $sendsomething++; 3041: } 3042: } 3043: } 3044: } 3045: 3046: # Records of number of feedback messages are kept under the "symb" called "_feedback" 3047: # There are two entries within the framework of a course: 3048: # - the URLs for which feedback was provided 3049: # - the total number of contributions 3050: if ($sendsomething) { 3051: my %record=&getfeedbackrecords(); 3052: my ($temp)=keys(%record); 3053: unless ($temp=~/^error\:/) { 3054: my %newrecord=(); 3055: $newrecord{'resource'}=$feedurl; 3056: $newrecord{'subnumber'}=$record{'subnumber'}+1; 3057: unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') { 3058: $status.='<br />'.&mt('Not registered').'<br />'; 3059: } 3060: } 3061: } 3062: return ($status,$sendsomething); 3063: } 3064: 3065: # Routine to get the complete feedback records 3066: 3067: sub getfeedbackrecords { 3068: my ($uname,$udom,$course)=@_; 3069: unless ($uname) { $uname=$env{'user.name'}; } 3070: unless ($udom) { $udom=$env{'user.domain'}; } 3071: unless ($course) { $course=$env{'request.course.id'}; } 3072: my %record=&Apache::lonnet::restore('_feedback',$course,$udom,$uname); 3073: return %record; 3074: } 3075: 3076: # Routine to get feedback statistics 3077: 3078: sub getfeedbackstats { 3079: my %record=&getfeedbackrecords(@_); 3080: return ($record{'subnumber'},$record{'points'},$record{'totallikes'}); 3081: } 3082: 3083: # Store feedback credit 3084: 3085: sub storefeedbackpoints { 3086: my ($points,$uname,$udom,$course)=@_; 3087: unless ($points) { $points=0; } 3088: unless ($uname) { $uname=$env{'user.name'}; } 3089: unless ($udom) { $udom=$env{'user.domain'}; } 3090: unless ($course) { $course=$env{'request.course.id'}; } 3091: my %record=('grader_user' => $env{'user.name'}, 3092: 'grader_domain' => $env{'user.domain'}, 3093: 'points' => $points); 3094: return &Apache::lonnet::cstore(\%record,'_feedback',$course,$udom,$uname); 3095: } 3096: 3097: # Store feedback "likes" 3098: 3099: sub storefeedbacklikes { 3100: my ($likes,$uname,$udom,$course)=@_; 3101: unless ($likes) { $likes=0; } 3102: if ($likes>0) { $likes=1; } 3103: if ($likes<0) { $likes=-1; } 3104: unless ($uname) { $uname=$env{'user.name'}; } 3105: unless ($udom) { $udom=$env{'user.domain'}; } 3106: unless ($course) { $course=$env{'request.course.id'}; } 3107: my %record=&getfeedbackrecords($uname,$udom,$course); 3108: my $totallikes=$record{'totallikes'}; 3109: $totallikes+=$likes; 3110: my %newrecord=('likes_user' => $env{'user.name'}, 3111: 'likes_domain' => $env{'user.domain'}, 3112: 'likes' => $likes, 3113: 'totallikes' => $totallikes); 3114: return &Apache::lonnet::cstore(\%newrecord,'_feedback',$course,$udom,$uname); 3115: } 3116: 3117: 3118: sub adddiscuss { 3119: my ($symb,$email,$anon,$attachmenturl,$subject,$group)=@_; 3120: my $status=''; 3121: my $realsymb = &get_realsymb($symb); 3122: my ($cnum,$cdom); 3123: if ($env{'request.course.id'}) { 3124: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3125: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3126: } 3127: if (&discussion_open(undef,$realsymb) && 3128: (&Apache::lonnet::allowed('pch',$env{'request.course.id'}. 3129: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) || 3130: (($group ne '') && (&check_group_priv($group,'pgd') eq 'ok') && 3131: ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})))) { 3132: 3133: my %contrib=('message' => $email, 3134: 'sendername' => $env{'user.name'}, 3135: 'senderdomain' => $env{'user.domain'}, 3136: 'screenname' => $env{'environment.screenname'}, 3137: 'plainname' => $env{'environment.firstname'}.' '. 3138: $env{'environment.middlename'}.' '. 3139: $env{'environment.lastname'}.' '. 3140: $env{'enrironment.generation'}, 3141: 'attachmenturl'=> $attachmenturl, 3142: 'subject' => $subject); 3143: if ($env{'form.replydisc'}) { 3144: $contrib{'replyto'}=(split(/\:\:\:/,$env{'form.replydisc'}))[1]; 3145: } 3146: if ($anon) { 3147: $contrib{'anonymous'}='true'; 3148: } 3149: if (($symb) && ($email)) { 3150: my $now = time; 3151: if ($env{'form.editdisc'}) { 3152: $contrib{'ip'}=$ENV{'REMOTE_ADDR'}; 3153: $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'}; 3154: $contrib{'timestamp'} = $now; 3155: $contrib{'history'} = ''; 3156: my $numoldver = 0; 3157: my ($oldsymb,$oldidx)=split(/\:\:\:/,$env{'form.editdisc'}); 3158: &Apache::lonenc::check_decrypt(\$oldsymb); 3159: $oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|; 3160: # get timestamp for last post and history 3161: my %oldcontrib=&Apache::lonnet::restore($oldsymb,$env{'request.course.id'}, 3162: $env{'course.'.$env{'request.course.id'}.'.domain'}, 3163: $env{'course.'.$env{'request.course.id'}.'.num'}); 3164: if (defined($oldcontrib{$oldidx.':replyto'})) { 3165: $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'}; 3166: } 3167: if (defined($oldcontrib{$oldidx.':history'})) { 3168: if ($oldcontrib{$oldidx.':history'} =~ /:/) { 3169: my @oldversions = split(/:/,$oldcontrib{$oldidx.':history'}); 3170: $numoldver = @oldversions; 3171: } else { 3172: $numoldver = 1; 3173: } 3174: $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':'; 3175: } 3176: my $numnewver = $numoldver + 1; 3177: if (defined($oldcontrib{$oldidx.':subject'})) { 3178: if ($oldcontrib{$oldidx.':subject'} =~ /^<version num="0">/) { 3179: $contrib{'subject'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; 3180: $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'}; 3181: } else { 3182: $contrib{'subject'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>'; 3183: } 3184: } 3185: if (defined($oldcontrib{$oldidx.':message'})) { 3186: if ($oldcontrib{$oldidx.':message'} =~ /^<version num="0">/) { 3187: $contrib{'message'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; 3188: $contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'}; 3189: } else { 3190: $contrib{'message'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>'; 3191: } 3192: } 3193: $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'}; 3194: my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'}, 3195: $oldsymb,$oldidx,\%contrib, 3196: $env{'course.'.$env{'request.course.id'}.'.domain'}, 3197: $env{'course.'.$env{'request.course.id'}.'.num'}); 3198: $status='Editing class discussion'.($anon?' (anonymous)':''); 3199: } else { 3200: $status='Adding to class discussion'.($anon?' (anonymous)':'').': '. 3201: &Apache::lonnet::store(\%contrib,$symb,$env{'request.course.id'}, 3202: $env{'course.'.$env{'request.course.id'}.'.domain'}, 3203: $env{'course.'.$env{'request.course.id'}.'.num'}); 3204: } 3205: my %storenewentry=($symb => $now); 3206: $status.='<br />'.&mt('Updating discussion time').': '. 3207: &Apache::lonnet::put('discussiontimes',\%storenewentry, 3208: $env{'course.'.$env{'request.course.id'}.'.domain'}, 3209: $env{'course.'.$env{'request.course.id'}.'.num'}); 3210: } 3211: my %record=&getdiscussionrecords(); 3212: my ($temp)=keys(%record); 3213: unless ($temp=~/^error\:/) { 3214: my %newrecord=(); 3215: $newrecord{'resource'}=$symb; 3216: $newrecord{'subnumber'}=$record{'subnumber'}+1; 3217: $status.='<br />'.&mt('Registering').': '. 3218: &Apache::lonnet::cstore(\%newrecord,'_discussion'); 3219: &updatekarma(); 3220: } 3221: } else { 3222: $status.='Failed.'; 3223: } 3224: return $status.'<br />'; 3225: } 3226: 3227: 3228: # Routine to get the complete discussion records 3229: 3230: sub getdiscussionrecords { 3231: my ($uname,$udom,$course)=@_; 3232: unless ($uname) { $uname=$env{'user.name'}; } 3233: unless ($udom) { $udom=$env{'user.domain'}; } 3234: unless ($course) { $course=$env{'request.course.id'}; } 3235: my %record=&Apache::lonnet::restore('_discussion',$course,$udom,$uname); 3236: return %record; 3237: } 3238: 3239: # Routine to get discussion statistics 3240: 3241: sub getdiscussionstats { 3242: my %record=&getdiscussionrecords(@_); 3243: my $totalvotes = $record{'totallikes'} + $record{'totalunlikes'}; 3244: return ($record{'subnumber'},$record{'points'},$record{'totallikes'},$totalvotes); 3245: } 3246: 3247: # Calculate discussion karma 3248: 3249: sub calcdiscussionkarma { 3250: my ($subs,$pts,$likes,$votes)=&getdiscussionstats(@_); 3251: my $karma=0; 3252: if ($votes>0) { 3253: $karma=int(.1+5.*(1.-exp(-$subs/10.))*$likes/$votes); 3254: if ($karma<0) { $karma=0; } 3255: if ($karma>5) { $karma=5; } 3256: } 3257: return $karma; 3258: } 3259: 3260: # Update karma 3261: 3262: sub updatekarma { 3263: my ($uname,$udom,$course)=@_; 3264: unless ($uname) { $uname=$env{'user.name'}; } 3265: unless ($udom) { $udom=$env{'user.domain'}; } 3266: unless ($course) { $course=$env{'request.course.id'}; } 3267: my $karma=&calcdiscussionkarma($uname,$udom,$course); 3268: &Apache::lonnet::cstore({ 'karma' => $karma },'_discussion',$course,$udom,$uname); 3269: &Apache::lonnet::do_cache_new('karma',$uname.':'.$udom.':'.$course,$karma,3600); 3270: return $karma; 3271: } 3272: 3273: # Retrieve karma 3274: 3275: sub userkarma { 3276: my ($uname,$udom,$course)=@_; 3277: unless ($uname) { $uname=$env{'user.name'}; } 3278: unless ($udom) { $udom=$env{'user.domain'}; } 3279: unless ($course) { $course=$env{'request.course.id'}; } 3280: my $hashkey=$uname.':'.$udom.':'.$course; 3281: my ($karma,$cached)=&Apache::lonnet::is_cached_new('karma',$hashkey); 3282: if ($cached) { 3283: return $karma; 3284: } 3285: my %userdisc=&getdiscussionrecords($uname,$udom,$course); 3286: $karma=$userdisc{'karma'}; 3287: &Apache::lonnet::do_cache_new('karma',$hashkey,$karma,3600); 3288: return $karma; 3289: } 3290: 3291: # Store discussion credit 3292: 3293: sub storediscussionpoints { 3294: my ($points,$uname,$udom,$course)=@_; 3295: unless ($points) { $points=0; } 3296: unless ($uname) { $uname=$env{'user.name'}; } 3297: unless ($udom) { $udom=$env{'user.domain'}; } 3298: unless ($course) { $course=$env{'request.course.id'}; } 3299: my %record=('grader_user' => $env{'user.name'}, 3300: 'grader_domain' => $env{'user.domain'}, 3301: 'points' => $points); 3302: return &Apache::lonnet::cstore(\%record,'_discussion',$course,$udom,$uname); 3303: } 3304: 3305: # Store discussion "likes" 3306: 3307: sub storediscussionlikes { 3308: my ($chglikes,$chgunlikes,$uname,$udom,$course,$context)=@_; 3309: unless ($uname) { $uname=$env{'user.name'}; } 3310: unless ($udom) { $udom=$env{'user.domain'}; } 3311: unless ($course) { $course=$env{'request.course.id'}; } 3312: my %record=&getdiscussionrecords($uname,$udom,$course); 3313: my $totallikes=$record{'totallikes'}; 3314: my $totalunlikes=$record{'totalunlikes'}; 3315: $totallikes += $chglikes; 3316: $totalunlikes += $chgunlikes; 3317: my %newrecord=('likes_user' => $env{'user.name'}, 3318: 'likes_domain' => $env{'user.domain'}, 3319: 'totallikes' => $totallikes, 3320: 'totalunlikes' => $totalunlikes, 3321: 'context' => $context); 3322: my $status=&Apache::lonnet::cstore(\%newrecord,'_discussion',$course,$udom,$uname); 3323: if ($status eq 'ok') { 3324: &updatekarma($uname,$udom,$course); 3325: } 3326: return $status; 3327: } 3328: 3329: sub get_discussion_info { 3330: my ($idx,%contrib) = @_; 3331: my $changelast = 0; 3332: my $count = 0; 3333: my $hiddenflag = 0; 3334: my $deletedflag = 0; 3335: my ($hidden,$deleted,%info,$newlastdisc); 3336: my $version = $contrib{'version'}; 3337: if ($version) { 3338: for (my $id=$version; $id>0; $id--) { 3339: my $vkeys=$contrib{$id.':keys'}; 3340: my @keys=split(/:/,$vkeys); 3341: if (grep(/^hidden$/,@keys)) { 3342: if (!$hiddenflag) { 3343: $hidden = $contrib{$id.':hidden'}; 3344: $hiddenflag = 1; 3345: } 3346: } elsif (grep(/^deleted$/,@keys)) { 3347: if (!$deletedflag) { 3348: $deleted = $contrib{$id.':deleted'}; 3349: $deletedflag = 1; 3350: } 3351: } else { 3352: if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)) { 3353: $count++; 3354: $info{$count}{'id'} = $id; 3355: $info{$count}{'timestamp'}=$contrib{$id.':timestamp'}; 3356: } 3357: } 3358: } 3359: if ($info{'1'}{'id'} == $idx) { 3360: $changelast = 1; 3361: if ($count > 1) { 3362: $newlastdisc = $info{'2'}{'timestamp'}; 3363: } else { 3364: $newlastdisc = 0; 3365: } 3366: } 3367: } 3368: return ($changelast,$newlastdisc); 3369: } 3370: 3371: # ----------------------------------------------------------- Preview function 3372: 3373: sub show_preview { 3374: my ($r) = @_; 3375: &Apache::loncommon::content_type($r,'text/html'); 3376: $r->send_http_header; 3377: my $start_page= 3378: &Apache::loncommon::start_page('Preview',undef, 3379: {'only_body' => 1,}); 3380: 3381: my $message=&clear_out_html($env{'form.comment'}); 3382: &newline_to_br(\$message); 3383: $message=&Apache::lonspeller::markeduptext($message); 3384: $message=&Apache::lontexconvert::msgtexconverted($message); 3385: my $subject=&clear_out_html($env{'form.subject'}); 3386: $subject=~s/\n/\<br \/\>/g; 3387: $subject=&Apache::lontexconvert::msgtexconverted($subject); 3388: 3389: my $end_page = &Apache::loncommon::end_page(); 3390: 3391: $r->print($start_page 3392: .'<h1>'.&mt('Preview').'</h1>' 3393: .&Apache::lonhtmlcommon::start_pick_box() 3394: .&Apache::lonhtmlcommon::row_title(&mt('Subject')) 3395: .$subject 3396: .&Apache::lonhtmlcommon::row_closure() 3397: .&Apache::lonhtmlcommon::row_title(&mt('Message')) 3398: .$message 3399: .&Apache::lonhtmlcommon::row_closure(1) 3400: .&Apache::lonhtmlcommon::end_pick_box() 3401: .$end_page 3402: ); 3403: } 3404: 3405: sub contains_block_html { 3406: my ($message)=@_; 3407: return ($message =~ m{ 3408: <(br|h1|h2|h3|h4|h5|h6|p|ol|ul|table|pre|address|blockquote|center|div) 3409: \s* 3410: (\w+\=['"]\w+['"])* 3411: \s* 3412: ( 3413: \s*/>| 3414: >.*</\1\s*> 3415: )}xs 3416: ); 3417: } 3418: 3419: sub tidy_html { 3420: my ($message)=@_; 3421: # my $tidy = HTML::Tidy::libXML->new(); 3422: # my $xhtml = $tidy->clean($message, 'utf-8', 1); 3423: # $xhtml =~ m/<body>(.*)<\/body>/is; 3424: # my $clean = $1; 3425: # # remove any empty block-level tags 3426: # $clean =~ s/<(table|p|div|tbody|blockquote|m|pre|algebra|center|ol|ul|span|h1|h2|h3|h4|h5|h6)\s*\/>//i; 3427: # $message=$clean; 3428: return $message; 3429: } 3430: 3431: sub newline_to_br { 3432: my ($message)=@_; 3433: my $newmessage; 3434: my $parser=HTML::LCParser->new($message); 3435: while (my $token=$parser->get_token()) { 3436: if ($token->[0] eq 'T') { 3437: my $text=$token->[1]; 3438: $text=~s/\n/\<br \/\>/g; 3439: $newmessage.=$text; 3440: } elsif ($token->[0] eq 'D' || $token->[0] eq 'C') { 3441: $newmessage.=$token->[1]; 3442: } elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') { 3443: $newmessage.=$token->[2]; 3444: } elsif ($token->[0] eq 'S') { 3445: $newmessage.=$token->[4]; 3446: } 3447: 3448: } 3449: $$message=$newmessage; 3450: } 3451: 3452: sub generate_preview_button { 3453: my ($formname,$fieldname)=@_; 3454: unless ($formname) { $formname='mailform'; } 3455: unless ($fieldname) { $fieldname='comment'; } 3456: my $pre=&mt("Show Preview and Check Spelling"); 3457: return(<<ENDPREVIEW); 3458: <br /> 3459: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview"> 3460: <input type="hidden" name="subject" /> 3461: <input type="hidden" name="comment" /> 3462: <input type="button" value="$pre" 3463: onclick="if (typeof(document.$formname.onsubmit)=='function') {document.$formname.onsubmit();};this.form.comment.value=document.$formname.$fieldname.value;this.form.subject.value=document.$formname.subject.value;this.form.submit();" /> 3464: </form> 3465: ENDPREVIEW 3466: } 3467: 3468: sub modify_attachments { 3469: my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls, 3470: $attachmaxtext,$toolarge)=@_; 3471: 3472: my %lt = &Apache::lonlocal::texthash( 3473: 'subj' => 'Subject', 3474: 'chth' => 'Check the checkboxes for any you wish to remove.', 3475: 'thef' => 'The following attachments have been uploaded for inclusion with this posting.', 3476: 'adda' => 'Add a new attachment to this post', 3477: 'stch' => 'Save Changes', 3478: 'clic' => 'Add/remove attachments', 3479: ); 3480: my $js = <<END; 3481: <script type="text/javascript"> 3482: function setAction () { 3483: document.modattachments.action = document.modattachments.origpage.value; 3484: document.modattachments.submit(); 3485: } 3486: </script> 3487: END 3488: 3489: # Breadcrumbs 3490: my $brcrum = [{'href' => '', 3491: 'text' => 'Discussion Post Attachments'}]; 3492: my %parms=('only_body' => 1); 3493: if ($env{'form.modal'} ne 'yes') { 'bread_crumbs' => $brcrum } 3494: 3495: my $start_page = 3496: &Apache::loncommon::start_page('Discussion Post Attachments',$js,\%parms); 3497: 3498: my $orig_subject = &unescape($env{'form.subject'}); 3499: my $subject=&clear_out_html($orig_subject); 3500: $subject=~s/\n/\<br \/\>/g; 3501: $subject=&Apache::lontexconvert::msgtexconverted($subject); 3502: my $timestamp=$env{'form.timestamp'}; 3503: my $numoldver=$env{'form.numoldver'}; 3504: 3505: my $msg = ''; 3506: my %attachments = (); 3507: my %currattach = (); 3508: if ($idx) { 3509: &extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold); 3510: } 3511: &Apache::lonenc::check_encrypt(\$symb); 3512: 3513: my $end_page = 3514: &Apache::loncommon::end_page(); 3515: 3516: $r->print(<<END); 3517: $start_page 3518: $toolarge 3519: <form name="modattachments" method="post" enctype="multipart/form-data" action="/adm/feedback?attach=$symb"> 3520: 3521: <h1>$lt{'clic'}</h1> 3522: END 3523: $r->print(&Apache::lonhtmlcommon::start_pick_box()); 3524: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject'))); 3525: $r->print('<b>'.$subject.'</b>'); 3526: $r->print(&Apache::lonhtmlcommon::row_closure()); 3527: $r->print(&Apache::lonhtmlcommon::row_title($lt{'adda'})); 3528: $r->print('<input type="file" name="addnewattach" /><input type="button" name="upload" value="Upload" onclick="this.form.submit()" /> '.$attachmaxtext); 3529: if(($idx)||(ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)){ 3530: $r->print(&Apache::lonhtmlcommon::row_closure()); 3531: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Attachments'))); 3532: if ($idx) { 3533: if ($attachmenturls) { 3534: my @currold = keys(%currattach); 3535: if (@currold > 0) { 3536: $r->print($lt{'thfo'}.'<br />'.$lt{'chth'}.'<br />'."\n"); 3537: foreach my $id (@currold) { 3538: my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'}); 3539: $attachurl =~ m#/([^/]+)$#; 3540: $r->print('<label><input type="checkbox" name="deloldattach" value="'.$id.'" /> '.$1.'</label><br />'."\n"); 3541: } 3542: $r->print("<br />"); 3543: } 3544: } 3545: } 3546: if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) { 3547: $r->print($lt{'chth'}.'<br />'."\n"); 3548: foreach my $attach (@{$currnewattach}) { 3549: $attach =~ m#/([^/]+)$#; 3550: $r->print('<label><input type="checkbox" name="delnewattach" value="'.$attach.'" /> '.$1.'</label><br />'."\n"); 3551: } 3552: } 3553: } 3554: $r->print(&Apache::lonhtmlcommon::row_closure(1)); 3555: $r->print(&Apache::lonhtmlcommon::end_pick_box()); 3556: $r->print(<<END); 3557: <input type="hidden" name="subject" value="$env{'form.subject'}" /> 3558: <input type="hidden" name="comment" value="$env{'form.comment'}" /> 3559: <input type="hidden" name="timestamp" value="$env{'form.timestamp'}" /> 3560: <input type="hidden" name="idx" value="$env{'form.idx'}" /> 3561: <input type="hidden" name="numoldver" value="$env{'form.numoldver'}" /> 3562: <input type="hidden" name="origpage" value="$env{'form.origpage'}" /> 3563: <input type="hidden" name="blog" value="$env{'form.blog'}" /> 3564: <input type="hidden" name="discuss" value="$env{'form.discuss'}" /> 3565: END 3566: foreach my $item (@{$currnewattach}) { 3567: $r->print('<input type="hidden" name="currnewattach" value="'.$item.'" />'."\n"); 3568: } 3569: foreach my $item (@{$currdelold}) { 3570: $r->print('<input type="hidden" name="deloldattach" value="'.$item.'" />'."\n"); 3571: } 3572: $r->print(<<END); 3573: <input type="button" name="rtntoedit" value="$lt{'stch'}" onclick="setAction()" /> 3574: </form> 3575: $end_page 3576: END 3577: return; 3578: } 3579: 3580: sub process_attachments { 3581: my ($currnewattach,$currdelold,$keepold) = @_; 3582: 3583: @{$currnewattach}= 3584: &Apache::loncommon::get_env_multiple('form.currnewattach'); 3585: @{$currdelold}= 3586: &Apache::loncommon::get_env_multiple('form.deloldattach'); 3587: if (exists($env{'form.delnewattach'})) { 3588: my @currdelnew = 3589: &Apache::loncommon::get_env_multiple('form.delnewattach'); 3590: my @currnew = (); 3591: foreach my $newone (@{$currnewattach}) { 3592: my $delflag = 0; 3593: foreach my $item (@currdelnew) { 3594: if ($newone eq $item) { 3595: $delflag = 1; 3596: last; 3597: } 3598: } 3599: unless ($delflag) { 3600: push(@currnew, $newone); 3601: } 3602: } 3603: @{$currnewattach} = @currnew; 3604: } 3605: @{$keepold} = &Apache::loncommon::get_env_multiple('form.keepold'); 3606: } 3607: 3608: sub generate_attachments_button { 3609: my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach, 3610: $numoldver,$mode,$blockblog) = @_; 3611: my $origpage = $ENV{'REQUEST_URI'}; 3612: my $att=$attachnum.' '.&mt("attachments"); 3613: my %lt = &Apache::lonlocal::texthash( 3614: 'clic' => 'Add/remove attachments', 3615: ); 3616: my $response = (<<END); 3617: <br /> 3618: <form name="attachment" action="/adm/feedback?attach=$ressymb" method="post"> 3619: <input type="button" value="$lt{'clic'}" 3620: onclick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=escape(document.mailform.comment.value);this.form.subject.value=escape(document.mailform.subject.value); 3621: END 3622: if (!$blockblog) { 3623: $response .= 'setblogvalue();'; 3624: } 3625: unless ($mode eq 'board') { 3626: $response .= 'javascript:anonchk();'; 3627: } 3628: $response .= (<<ENDATTACH); 3629: this.form.submit();" /> 3630: <input type="hidden" name="origpage" value="$origpage" /> 3631: <input type="hidden" name="idx" value="$idx" /> 3632: <input type="hidden" name="timestamp" value="$now" /> 3633: <input type="hidden" name="subject" /> 3634: <input type="hidden" name="comment" /> 3635: <input type="hidden" name="blog" value="0" /> 3636: <input type="hidden" name="discuss" value="0" /> 3637: <input type="hidden" name="numoldver" value="$numoldver" /> 3638: ENDATTACH 3639: if (defined($deloldattach)) { 3640: if (@{$deloldattach} > 0) { 3641: foreach my $delatt (@{$deloldattach}) { 3642: $response .= '<input type="hidden" name="deloldattach" value="'.$delatt.'" />'."\n"; 3643: } 3644: } 3645: } 3646: if (defined($currnewattach)) { 3647: if (@{$currnewattach} > 0) { 3648: foreach my $attach (@{$currnewattach}) { 3649: $response .= '<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n"; 3650: } 3651: } 3652: } 3653: $response .= '</form>'; 3654: return $response; 3655: } 3656: 3657: sub extract_attachments { 3658: my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_; 3659: %{$attachments}=(); 3660: &get_post_attachments($attachments,$attachmenturls); 3661: foreach my $id (sort(keys(%{$attachments}))) { 3662: if (exists($$attachments{$id}{$numoldver})) { 3663: if (defined($currdelold)) { 3664: if (@{$currdelold} > 0) { 3665: unless (grep/^$id$/,@{$currdelold}) { 3666: $$currattach{$id} = $$attachments{$id}{$numoldver}; 3667: } 3668: } else { 3669: $$currattach{$id} = $$attachments{$id}{$numoldver}; 3670: } 3671: } else { 3672: $$currattach{$id} = $$attachments{$id}{$numoldver}; 3673: } 3674: } 3675: } 3676: my @attached = (sort { $a <=> $b } keys(%{$currattach})); 3677: if (@attached == 1) { 3678: my $id = $attached[0]; 3679: my $attachurl; 3680: if ($attachmenturls =~ m/^<attachment id="0">/) { 3681: $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); 3682: } else { 3683: $attachurl = $$attachments{$id}{'filename'}; 3684: } 3685: $attachurl=~m|/([^/]+)$|; 3686: $$message.='<br /><a href="'.$attachurl.'"><tt>'. 3687: $1.'</tt></a><br />'; 3688: &Apache::lonnet::allowuploaded('/adm/feedback', 3689: $attachurl); 3690: } elsif (@attached > 1) { 3691: $$message.='<ol>'; 3692: foreach my $attach (@attached) { 3693: my $id = $attach; 3694: my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'}); 3695: my ($fname) 3696: =($attachurl=~m|/([^/]+)$|); 3697: $$message .= '<li><a href="'.$attachurl. 3698: '"><tt>'. 3699: $fname.'</tt></a></li>'; 3700: &Apache::lonnet::allowuploaded('/adm/feedback', 3701: $attachurl); 3702: } 3703: $$message .= '</ol>'; 3704: } 3705: } 3706: 3707: sub construct_attachmenturl { 3708: my ($currnewattach,$keepold,$symb,$idx)=@_; 3709: my $oldattachmenturl; 3710: my $newattachmenturl; 3711: my $startnum = 0; 3712: my $currver = 0; 3713: if (($env{'form.editdisc'}) && ($idx)) { 3714: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 3715: $env{'course.'.$env{'request.course.id'}.'.domain'}, 3716: $env{'course.'.$env{'request.course.id'}.'.num'}); 3717: $oldattachmenturl = $contrib{$idx.':attachmenturl'}; 3718: if ($contrib{$idx.':history'}) { 3719: if ($contrib{$idx.':history'} =~ /:/) { 3720: my @oldversions = split(/:/,$contrib{$idx.':history'}); 3721: $currver = 1 + scalar(@oldversions); 3722: } else { 3723: $currver = 2; 3724: } 3725: } else { 3726: $currver = 1; 3727: } 3728: if ($oldattachmenturl) { 3729: if ($oldattachmenturl =~ m/^<attachment id="0">/) { 3730: my %attachments = (); 3731: my $prevver = $currver-1; 3732: &get_post_attachments(\%attachments,$oldattachmenturl); 3733: my $numattach = scalar(keys(%attachments)); 3734: $startnum += $numattach; 3735: foreach my $num (sort {$a <=> $b} keys(%attachments)) { 3736: $newattachmenturl .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>'; 3737: foreach my $item (sort {$a <=> $b} keys(%{$attachments{$num}})) { 3738: unless ($item eq 'filename') { 3739: $newattachmenturl .= '<post id="'.$item.'">'.$attachments{$num}{$item}.'</post>'; 3740: } 3741: } 3742: if (grep/^$num$/,@{$keepold}) { 3743: $newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>'; 3744: } 3745: $newattachmenturl .= '</attachment>'; 3746: } 3747: } else { 3748: $newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>'; 3749: unless (grep/^0$/,@{$keepold}) { 3750: $newattachmenturl .= '<post id="1">n</post>'; 3751: } 3752: $newattachmenturl .= '</attachment>'; 3753: $startnum ++; 3754: } 3755: } 3756: } 3757: for (my $i=0; $i<@{$currnewattach}; $i++) { 3758: my $attachnum = $startnum + $i; 3759: $newattachmenturl .= '<attachment id="'.$attachnum.'"><filename>'.&HTML::Entities::encode($$currnewattach[$i]).'</filename><post id="'.$currver.'">n</post></attachment>'; 3760: } 3761: return $newattachmenturl; 3762: } 3763: 3764: sub add_blog_checkbox { 3765: my ($crstype) = @_; 3766: my $checkstatus; 3767: if ($env{'form.blog'}) { 3768: $checkstatus = 'checked="checked"'; 3769: } 3770: my $output = ' 3771: <script type="text/javascript"> 3772: function setblogvalue() { 3773: if (document.mailform.blog.checked) { 3774: document.attachment.blog.value = 1; 3775: } else { 3776: document.attachment.blog.value = 0; 3777: } 3778: } 3779: </script><br /> 3780: <label><input type="checkbox" name="blog" '.$checkstatus.' /> '; 3781: if ($crstype eq 'Community') { 3782: $output .= &mt('Add to my public community blog'); 3783: } else { 3784: $output .= &mt('Add to my public course blog'); 3785: } 3786: $output .= '</label><br />'."\n"; 3787: return $output; 3788: } 3789: 3790: sub has_discussion { 3791: my $resourcesref = shift; 3792: my $navmap = Apache::lonnavmaps::navmap->new(); 3793: if (defined($navmap)) { 3794: my @allres=$navmap->retrieveResources(); 3795: foreach my $resource (@allres) { 3796: if ($resource->hasDiscussion()) { 3797: my $ressymb = $resource->wrap_symb(); 3798: if (ref($resourcesref) eq 'ARRAY') { 3799: push(@{$resourcesref}, $ressymb); 3800: } 3801: } 3802: } 3803: } else { 3804: &Apache::lonnet::logthis('Has discussion check failed - could not create navmap object.'); 3805: } 3806: return; 3807: } 3808: 3809: sub sort_filter_names { 3810: my ($sort_types,$role_types,$status_types,$crstype) = @_; 3811: if (ref($sort_types) eq 'HASH') { 3812: %{$sort_types} = ( 3813: ascdate => 'Date order - oldest first', 3814: descdate => 'Date order - newest first', 3815: thread => 'Threaded', 3816: subject => 'By subject', 3817: username => 'By domain and username', 3818: lastfirst => 'By last name, first name' 3819: ); 3820: } 3821: my @courseroles = qw(st in ta ep ad); 3822: if ($crstype eq 'Community') { 3823: push(@courseroles,'co'); 3824: } else { 3825: push(@courseroles,'cc'); 3826: } 3827: if (ref($role_types) eq 'HASH') { 3828: foreach my $role (@courseroles) { 3829: $role_types->{$role} = &Apache::lonnet::plaintext($role,$crstype); 3830: } 3831: $role_types->{'all'} = 'All roles'; 3832: $role_types->{'cr'} = 'Custom role'; 3833: } 3834: if (ref($status_types) eq 'HASH') { 3835: %{$status_types} = ( 3836: all => 'Roles of any status', 3837: Active => 'Only active roles', 3838: Expired => 'Only past roles', 3839: Future => 'Only future roles', 3840: ); 3841: } 3842: } 3843: 3844: sub handler { 3845: my $r = shift; 3846: if ($r->header_only) { 3847: &Apache::loncommon::content_type($r,'text/html'); 3848: $r->send_http_header; 3849: return OK; 3850: } 3851: 3852: # --------------------------- Get query string for limited number of parameters 3853: 3854: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, 3855: ['like','unlike','modal','hide','unhide','deldisc','undeleteall','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']); 3856: my $group = $env{'form.group'}; 3857: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 3858: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 3859: 3860: my %attachmax = ( 3861: text => &mt('(128 KB max size)'), 3862: num => 131072, 3863: ); 3864: if ($env{'form.editdisc'}) { 3865: if (!(&editing_allowed($env{'form.editdisc'},$group))) { 3866: my $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; 3867: my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb); 3868: my $feedurl=&Apache::lonnet::clutter($url); 3869: &redirect_back($r,$feedurl,&mt('Editing not permitted').'<br />', '0','0','','',$env{'form.previous'},undef,undef,undef, 3870: undef,undef,undef,$group); 3871: return OK; 3872: } 3873: } 3874: if ($env{'form.discsymb'}) { 3875: my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.discsymb'}); 3876: my $readkey = $symb.'_read'; 3877: my $chgcount = 0; 3878: my %readinghash = &Apache::lonnet::get('nohist_'.$env{'request.course.id'}.'_discuss',[$readkey],$env{'user.domain'},$env{'user.name'}); 3879: foreach my $key (keys(%env)) { 3880: if ($key =~ m/^form\.postunread_(\d+)/) { 3881: if ($readinghash{$readkey} =~ /\.$1\./) { 3882: $readinghash{$readkey} =~ s/\.$1\.//; 3883: $chgcount ++; 3884: } 3885: } elsif ($key =~ m/^form\.postread_(\d+)/) { 3886: unless ($readinghash{$readkey} =~ /\.$1\./) { 3887: $readinghash{$readkey} .= '.'.$1.'.'; 3888: $chgcount ++; 3889: } 3890: } 3891: } 3892: if ($chgcount > 0) { 3893: &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', 3894: \%readinghash,$env{'user.domain'},$env{'user.name'}); 3895: } 3896: &redirect_back($r,$feedurl,&mt('Marked postings read/unread').'<br />', 3897: '0','0','','',$env{'form.previous'},'','','', 3898: undef,undef,undef,$group); 3899: return OK; 3900: } 3901: if ($env{'form.allversions'}) { 3902: &Apache::loncommon::content_type($r,'text/html'); 3903: &Apache::loncommon::no_cache($r); 3904: $r->send_http_header; 3905: 3906: # Breadcrumbs 3907: my $brcrum = [{'href' => '', 3908: 'text' => 'Discussion Post Versions'}]; 3909: 3910: my %parms=(); 3911: if ($env{'form.modal'} ne 'yes') { 'bread_crumbs' => $brcrum } 3912: 3913: $r->print(&Apache::loncommon::start_page('Discussion Post Versions',undef,\%parms)); 3914: 3915: my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'}); 3916: ($symb, my $feedurl)=&get_feedurl_and_clean_symb($symb); 3917: my $ressymb = &wrap_symb($symb); 3918: my $seeid; 3919: if (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) { 3920: $seeid = 1; 3921: } 3922: my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); 3923: if ($idx > 0) { 3924: my %messages = (); 3925: my %subjects = (); 3926: my %attachmsgs = (); 3927: my %allattachments = (); 3928: my %imsfiles = (); 3929: my ($screenname,$plainname,$showaboutme); 3930: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 3931: $cdom,$cnum); 3932: $r->print(&get_post_contents(\%contrib,$idx,$seeid,$seehidden,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname,\$showaboutme)); 3933: } 3934: $r->print(&Apache::loncommon::end_page()); 3935: return OK; 3936: } 3937: if ($env{'form.posterlist'}) { 3938: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); 3939: &print_showposters($r,$symb,$env{'form.previous'},$feedurl, 3940: $env{'form.sortposts'}); 3941: return OK; 3942: } 3943: if ($env{'form.userpick'}) { 3944: my @posters = &Apache::loncommon::get_env_multiple('form.stuinfo'); 3945: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.userpick'}); 3946: my $numpicks = @posters; 3947: my %discinfo; 3948: $discinfo{$symb.'_userpick'} = join('&',@posters); 3949: &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', 3950: \%discinfo,$env{'user.domain'},$env{'user.name'}); 3951: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','', 3952: '',$env{'form.previous'},$env{'form.sortposts'},'','','', 3953: '',$numpicks,$group); 3954: return OK; 3955: } 3956: if ($env{'form.applysort'}) { 3957: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'}); 3958: &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','', 3959: '',$env{'form.previous'},$env{'form.sortposts'}, 3960: $env{'form.rolefilter'},$env{'form.statusfilter'}, 3961: $env{'form.sectionpick'},$env{'form.grouppick'}, 3962: undef,$group); 3963: return OK; 3964: } elsif ($env{'form.cmd'} eq 'sortfilter') { 3965: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); 3966: &print_sortfilter_options($r,$symb,$env{'form.previous'},$feedurl); 3967: return OK; 3968: } elsif ($env{'form.navtime'}) { 3969: my %discinfo = (); 3970: my @resources = (); 3971: if (defined($env{'form.navmaps'})) { 3972: if ($env{'form.navmaps'} =~ /:/) { 3973: @resources = split(/:/,$env{'form.navmaps'}); 3974: } else { 3975: @resources = ("$env{'form.navmaps'}"); 3976: } 3977: } else { 3978: &has_discussion(\@resources); 3979: } 3980: my $numitems = @resources; 3981: my $feedurl = '/adm/navmaps'; 3982: if ($env{'form.navurl'}) { $feedurl .= '?'.$env{'form.navurl'}; } 3983: my %lt = &Apache::lonlocal::texthash( 3984: 'twnp' => 'There are currently no resources or discussion boards with unread discussion postings.' 3985: ); 3986: foreach my $res (@resources) { 3987: my $ressymb=$res; 3988: &Apache::lonenc::check_decrypt(\$ressymb); 3989: my $lastkey = $ressymb.'_lastread'; 3990: $discinfo{$lastkey} = $env{'form.navtime'}; 3991: } 3992: my $textline = '<b>'. 3993: &mt('Marked "New" posts as read in a total of [_1] resources/bulletin boards.', 3994: $numitems). 3995: '</b>'; 3996: if ($numitems > 0) { 3997: &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', 3998: \%discinfo,$env{'user.domain'},$env{'user.name'}); 3999: } else { 4000: $textline = "<b>$lt{'twnp'}</b>"; 4001: } 4002: &Apache::loncommon::content_type($r,'text/html'); 4003: $r->send_http_header; 4004: my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif'); 4005: my %onload; 4006: 4007: my $start_page= 4008: &Apache::loncommon::start_page('New posts marked as read',undef, 4009: {'redirect' => [2,$feedurl], 4010: 'only_body' => 1, 4011: 'add_entries' => \%onload}); 4012: my $end_page = &Apache::loncommon::end_page(); 4013: $r->print (<<ENDREDIR); 4014: $start_page 4015: <img align="right" src="$logo" /> 4016: $textline 4017: <form name="reldt" action="$feedurl" target="loncapaclient"> 4018: </form> 4019: <br /> 4020: $end_page 4021: ENDREDIR 4022: return OK; 4023: } elsif ($env{'form.modifydisp'}) { 4024: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'}); 4025: my ($dispchgA,$dispchgB,$markchg,$toggchg) = 4026: split(/_/,$env{'form.changes'}); 4027: &print_display_options($r,$symb,$env{'form.previous'},$dispchgA, 4028: $dispchgB,$markchg,$toggchg,$feedurl); 4029: return OK; 4030: } elsif ($env{'form.markondisp'} || $env{'form.markonread'} || 4031: $env{'form.allposts'} || $env{'form.onlyunread'} || 4032: $env{'form.onlyunmark'} || $env{'form.toggoff'} || 4033: $env{'form.toggon'} || $env{'form.markread'}) { 4034: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); 4035: my %discinfo; 4036: # ------------------------ Modify setting for read/unread toggle for each post 4037: if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; } 4038: if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; } 4039: # --------- Modify setting for identification of 'NEW' posts in this discussion 4040: if ($env{'form.markondisp'}) { 4041: $discinfo{$symb.'_lastread'} = time; 4042: $discinfo{$symb.'_markondisp'} = 1; 4043: } 4044: if ($env{'form.markonread'}) { 4045: if ( $env{'form.previous'} > 0 ) { 4046: $discinfo{$symb.'_lastread'} = $env{'form.previous'}; 4047: } 4048: $discinfo{$symb.'_markondisp'} = 0; 4049: } 4050: # --------------------------------- Modify display setting for this discussion 4051: if ($env{'form.allposts'}) { 4052: $discinfo{$symb.'_showonlyunread'} = 0; 4053: $discinfo{$symb.'_showonlyunmark'} = 0; 4054: } 4055: if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; } 4056: if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; } 4057: # ----------------------------------------------------- Mark new posts not NEW 4058: if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; } 4059: &Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss', 4060: \%discinfo,$env{'user.domain'},$env{'user.name'}); 4061: my $previous=$env{'form.previous'}; 4062: if ($env{'form.markondisp'}) { $previous=undef; } 4063: &redirect_back($r,$feedurl,&mt('Changed display status').'<br />', 4064: '0','0','','',$previous,'','','','','','',$group); 4065: return OK; 4066: } elsif (($env{'form.hide'}) || ($env{'form.unhide'})) { 4067: # ----------------------------------------------------------------- Hide/unhide 4068: my $entry=$env{'form.hide'}?$env{'form.hide'}:$env{'form.unhide'}; 4069: my ($symb,$idx)=split(/\:\:\:/,$entry); 4070: ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); 4071: my $ressymb = &wrap_symb($symb); 4072: 4073: my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum); 4074: unless (($seehidden) || (&editing_allowed($env{'form.hide'},$group))) { 4075: &redirect_back($r,$feedurl,&mt('Hiding not permitted').'<br />', 4076: '0','0','','',$env{'form.previous'},'','','','', 4077: undef,undef,$group,); 4078: return OK; 4079: } 4080: 4081: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 4082: $cdom,$cnum); 4083: 4084: my $currenthidden=$contrib{'hidden'}; 4085: my $currentstudenthidden=$contrib{'studenthidden'}; 4086: 4087: if ($env{'form.hide'}) { 4088: $currenthidden.='.'.$idx.'.'; 4089: unless ($seehidden) { 4090: $currentstudenthidden.='.'.$idx.'.'; 4091: } 4092: } else { 4093: $currenthidden=~s/\.$idx\.//g; 4094: } 4095: my %newhash=('hidden' => $currenthidden); 4096: if ( ($env{'form.hide'}) && (!$seehidden) ) { 4097: $newhash{'studenthidden'} = $currentstudenthidden; 4098: } 4099: if ($env{'form.hide'}) { 4100: my $changelast = 0; 4101: my $newlast; 4102: ($changelast,$newlast) = &get_discussion_info($idx,%contrib); 4103: if ($changelast) { 4104: &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, 4105: $cdom,$cnum); 4106: } 4107: } 4108: my $result; 4109: if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, 4110: $cdom,$cnum) eq 'ok') { 4111: my $prefix=$symb.':'.$idx.':'; 4112: my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, 4113: '^'.$prefix); 4114: my ($totallikes,$totalunlikes); 4115: if (ref($likes{$prefix.'likers'}) eq 'HASH') { 4116: $totallikes = scalar(keys(%{$likes{$prefix.'likers'}})); 4117: } 4118: if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { 4119: $totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}})); 4120: } 4121: if ($totallikes || $totalunlikes) { 4122: my ($chglikes,$chgunlikes,$context); 4123: if ($env{'form.hide'}) { 4124: $chglikes = -1 * $totallikes; 4125: $chgunlikes = -1 * $totalunlikes; 4126: $context = 'hide'; 4127: } else { 4128: $chglikes = $totallikes; 4129: $chgunlikes = $totalunlikes; 4130: $context = 'unhide'; 4131: } 4132: &storediscussionlikes($chglikes,$chgunlikes, 4133: $contrib{$idx.':sendername'}, 4134: $contrib{$idx.':senderdomain'}, 4135: $env{'request.course.id'}, 4136: $context); 4137: 4138: } 4139: $result = &mt('Changed discussion status'); 4140: } else { 4141: $result = &mt('Discussion status unchanged'); 4142: } 4143: &redirect_back($r,$feedurl,$result.'<br />','0','0','','', 4144: $env{'form.previous'},undef,undef,undef, 4145: undef,undef,undef,$group); 4146: return OK; 4147: } elsif (($env{'form.like'}) || ($env{'form.unlike'})) { 4148: # ----------------------------------------------------------------- Like/unlike 4149: my $entry=$env{'form.like'}?$env{'form.like'}:$env{'form.unlike'}; 4150: my ($symb,$idx)=split(/\:\:\:/,$entry); 4151: ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); 4152: my $result; 4153: if ($idx > 0) { 4154: my $realsymb = &get_realsymb($symb); 4155: my $status='OPEN'; 4156: if ($Apache::lonhomework::parsing_a_problem || 4157: $Apache::lonhomework::parsing_a_task) { 4158: $status=$Apache::inputtags::status[-1]; 4159: } 4160: if (&discussion_vote_available($status,$realsymb)) { 4161: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 4162: $cdom,$cnum); 4163: my $ownpost; 4164: if (($contrib{$idx.':sendername'} eq $env{'user.name'}) && 4165: ($contrib{$idx.':senderdomain'} eq $env{'user.domain'})) { 4166: $ownpost = 1; 4167: } 4168: if ($ownpost || $contrib{$idx.':hidden'} || $contrib{$idx.':deleted'}) { 4169: $result = &mt('Vote not registered.').' '; 4170: } 4171: if ($ownpost) { 4172: $result .= &mt('No voting for your own posts.'); 4173: } elsif ($contrib{$idx.':hidden'}) { 4174: $result .= &mt('No voting for hidden posts.'); 4175: } elsif ($contrib{$idx.':deleted'}) { 4176: $result .= &mt('No voting for deleted posts.'); 4177: } else { 4178: # 4179: # Likes and unlikes are in db-file "disclikes" of the course 4180: # The prefix is the $symb to identify the resource discussion, 4181: # and the $idx to identify the entry 4182: # 4183: my $prefix=$symb.':'.$idx.':'; 4184: my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, 4185: '^'.$prefix); 4186: 4187: # Get current like or unlike status for the $idx for this user. 4188: my $thisuser=$env{'user.name'}.':'.$env{'user.domain'}; 4189: my ($userlikes,$userunlikes); 4190: if (ref($likes{$prefix.'likers'}) eq 'HASH') { 4191: if (exists($likes{$prefix.'likers'}{$thisuser})) { 4192: $userlikes = 1; 4193: } 4194: } 4195: if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { 4196: if (exists($likes{$prefix.'unlikers'}{$thisuser})) { 4197: $userunlikes = 1; 4198: } 4199: } 4200: # Get the current "likes" count 4201: my $likescount=$likes{$prefix.'likes'}; 4202: # Find out if they already voted 4203: # Users cannot like a post twice, or unlike it twice. 4204: # They can change their mind, though. 4205: my $alreadyflag=0; 4206: my $votetype; 4207: if ($env{'form.like'}) { 4208: if ($userlikes) { 4209: $alreadyflag=1; 4210: } elsif ($userunlikes) { 4211: delete($likes{$prefix.'unlikers'}{$thisuser}); 4212: $votetype = 'switch'; 4213: $likescount++; 4214: } else { 4215: if (ref($likes{$prefix.'likers'}) eq 'HASH') { 4216: $likes{$prefix.'likers'}{$thisuser} = 1; 4217: } else { 4218: $likes{$prefix.'likers'} = {$thisuser => 1}; 4219: } 4220: $likescount++; 4221: } 4222: } else { 4223: if ($userunlikes) { 4224: $alreadyflag=1; 4225: } elsif ($userlikes) { 4226: delete($likes{$prefix.'likers'}{$thisuser}); 4227: $votetype = 'switch'; 4228: $likescount--; 4229: } else { 4230: if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { 4231: $likes{$prefix.'unlikers'}{$thisuser} = 1; 4232: } else { 4233: $likes{$prefix.'unlikers'} = {$thisuser => 1}; 4234: } 4235: $likescount--; 4236: } 4237: } 4238: # $alreadyflag would be 1 if they tried to double-like or double-unlike 4239: if ($alreadyflag) { 4240: if ($env{'form.like'}) { 4241: $result= &mt("'Like' already registered"); 4242: } else { 4243: $result= &mt("'Unlike' already registered"); 4244: } 4245: } else { 4246: my %newhash=($prefix.'likes' => $likescount, 4247: $prefix.'likers' => $likes{$prefix.'likers'}, 4248: $prefix.'unlikers' => $likes{$prefix.'unlikers'}); 4249: # Store data in db-file "disclikes" 4250: if (&Apache::lonnet::put('disclikes',\%newhash,$cdom,$cnum) eq 'ok') { 4251: # Also store with the person who posted the liked/unliked entry 4252: my ($chglike,$chgunlike); 4253: if ($env{'form.like'}) { 4254: if ($votetype eq 'switch') { 4255: $chglike = 0; 4256: $chgunlike = -1; 4257: } else { 4258: $chglike = 1; 4259: $chgunlike = 0; 4260: } 4261: &storediscussionlikes($chglike,$chgunlike, 4262: $contrib{$idx.':sendername'}, 4263: $contrib{$idx.':senderdomain'}, 4264: $env{'request.course.id'},'like'); 4265: $result=&mt("Registered 'Like'"); 4266: } else { 4267: if ($votetype eq 'switch') { 4268: $chglike = -1; 4269: $chgunlike = 0; 4270: } else { 4271: $chglike = 0; 4272: $chgunlike = 1; 4273: } 4274: &storediscussionlikes($chglike,$chgunlike, 4275: $contrib{$idx.':sendername'}, 4276: $contrib{$idx.':senderdomain'}, 4277: $env{'request.course.id'},'unlike'); 4278: $result=&mt("Registered 'Unlike'"); 4279: } 4280: } else { 4281: # Oops, something went wrong 4282: $result=&mt("Failed to register vote"); 4283: } 4284: } 4285: } 4286: } else { 4287: $result=&mt('Voting unavailable for this discussion'); 4288: } 4289: } else { 4290: $result=&mt('Invalid post number'); 4291: } 4292: &redirect_back($r,$feedurl,$result.'<br />', 4293: '0','0','','',$env{'form.previous'},undef,undef,undef, 4294: undef,undef,undef,$group); 4295: return OK; 4296: } elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) { 4297: my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'}); 4298: if ($env{'form.cmd'} eq 'threadedoff') { 4299: &Apache::lonnet::put('environment',{'unthreadeddiscussion' => 'on'}); 4300: &Apache::lonnet::appenv({'environment.unthreadeddiscussion' => 'on'}); 4301: &Apache::lonnet::del('environment',['threadeddiscussion']); 4302: &Apache::lonnet::delenv('environment.threadeddiscussion'); 4303: } else { 4304: &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'}); 4305: &Apache::lonnet::appenv({'environment.threadeddiscussion' => 'on'}); 4306: &Apache::lonnet::del('environment',['unthreadeddiscussion']); 4307: &Apache::lonnet::delenv('environment.unthreadeddiscussion'); 4308: } 4309: &redirect_back($r,$feedurl,&mt('Changed discussion view mode').'<br />', 4310: '0','0','','',$env{'form.previous'},undef,undef,undef, 4311: undef,undef,undef,$group); 4312: return OK; 4313: } elsif ($env{'form.deldisc'}) { 4314: # --------------------------------------------------------------- Hide for good 4315: my ($symb,$idx)=split(/\:\:\:/,$env{'form.deldisc'}); 4316: ($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb); 4317: my $ressymb=&wrap_symb($symb); 4318: 4319: unless (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) { 4320: &redirect_back($r,$feedurl,&mt('Deletion not permitted').'<br />', 4321: '0','0','','',$env{'form.previous'},'','','','', 4322: undef,undef,$group); 4323: return OK; 4324: } 4325: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 4326: $cdom,$cnum); 4327: my ($changelast,$newlast) = &get_discussion_info($idx,%contrib); 4328: if ($changelast) { 4329: &Apache::lonnet::put('discussiontimes',{$symb => $newlast}, 4330: $cdom,$cnum); 4331: } 4332: my %newhash=('deleted' => $contrib{'deleted'}.".$idx."); 4333: 4334: my $result; 4335: if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'}, 4336: $cdom,$cnum) eq 'ok') { 4337: $result = &mt('Changed discussion status'); 4338: my $prefix=$symb.':'.$idx.':'; 4339: my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum, 4340: '^'.$prefix); 4341: my ($totallikes,$totalunlikes); 4342: if (ref($likes{$prefix.'likers'}) eq 'HASH') { 4343: $totallikes = scalar(keys(%{$likes{$prefix.'likers'}})); 4344: } 4345: if (ref($likes{$prefix.'unlikers'}) eq 'HASH') { 4346: $totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}})); 4347: } 4348: if ($totallikes || $totalunlikes) { 4349: my $chglikes = -1 * $totallikes; 4350: my $chgunlikes = -1 * $totalunlikes; 4351: &storediscussionlikes($chglikes,$chgunlikes, 4352: $contrib{$idx.':sendername'}, 4353: $contrib{$idx.':senderdomain'}, 4354: $env{'request.course.id'}, 4355: 'delete'); 4356: } 4357: } else { 4358: $result = &mt('Discussion status unchanged'); 4359: } 4360: &redirect_back($r,$feedurl,$result.'<br />','0','0','','', 4361: $env{'form.previous'},undef,undef,undef, 4362: undef,undef,undef,$group); 4363: return OK; 4364: } elsif ($env{'form.preview'}) { 4365: # -------------------------------------------------------- User wants a preview 4366: &show_preview($r); 4367: return OK; 4368: } elsif ($env{'form.attach'}) { 4369: # -------------------------------------------------------- Work on attachments 4370: &Apache::loncommon::content_type($r,'text/html'); 4371: $r->send_http_header; 4372: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','discuss','blog']); 4373: my (@currnewattach,@currdelold,@keepold,$toolarge); 4374: &process_attachments(\@currnewattach,\@currdelold,\@keepold); 4375: if (exists($env{'form.addnewattach.filename'})) { 4376: if (length($env{'form.addnewattach'})<=$attachmax{'num'}) { 4377: my $subdir = 'feedback/'.$env{'form.timestamp'}; 4378: my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir); 4379: push(@currnewattach, $newattachment); 4380: } else { 4381: $toolarge = '<p><span class="LC_warning">'.&mt('Attachment not included - exceeded permitted length').'</span><br /></p>'; 4382: } 4383: } 4384: my $attachmenturls; 4385: my ($symb) = &get_feedurl_and_clean_symb($env{'form.attach'}); 4386: my $idx = $env{'form.idx'}; 4387: if ($idx) { 4388: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 4389: $cdom,$cnum); 4390: $attachmenturls = $contrib{$idx.':attachmenturl'}; 4391: } 4392: &modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx, 4393: $attachmenturls,$attachmax{'text'},$toolarge); 4394: return OK; 4395: } elsif ($env{'form.export'}) { 4396: &Apache::loncommon::content_type($r,'text/html'); 4397: $r->send_http_header; 4398: my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.export'}); 4399: my $mode='board'; 4400: my $status='OPEN'; 4401: my $previous=$env{'form.previous'}; 4402: if ($feedurl =~ /$LONCAPA::assess_re/) { 4403: $mode='problem'; 4404: $status=$Apache::inputtags::status[-1]; 4405: } 4406: 4407: my $discussion = &list_discussion($mode,$status,$symb); 4408: my $start_page = 4409: &Apache::loncommon::start_page('Resource Feedback and Discussion'); 4410: my $end_page = 4411: &Apache::loncommon::end_page(); 4412: $r->print($start_page.$discussion.$end_page); 4413: return OK; 4414: 4415: } elsif ($env{'form.undeleteall'}) { 4416: &Apache::loncommon::content_type($r,'text/html'); 4417: $r->send_http_header; 4418: my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.undeleteall'}); 4419: my $ressymb=&wrap_symb($symb); 4420: $r->print(&Apache::loncommon::start_page('Undelete all deleted discussion entries')); 4421: if (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) { 4422: my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'}, 4423: $cdom,$cnum); 4424: $contrib{'deleted'} =~ s/^\.//; 4425: $contrib{'deleted'} =~ s/\.$//; 4426: if ($contrib{'deleted'} ne '') { 4427: if (&Apache::lonnet::store({'deleted' => ''},$symb,$env{'request.course.id'}, 4428: $cdom,$cnum) eq 'ok') { 4429: my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,'^'.$symb.':'); 4430: my @ids = split(/\.\./,$contrib{'deleted'}); 4431: my (%chglikes,%chgunlikes); 4432: foreach my $idx (@ids) { 4433: my $uname = $contrib{$idx.':sendername'}; 4434: my $udom = $contrib{$idx.':senderdomain'}; 4435: my ($totallikes,$totalunlikes); 4436: if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') { 4437: $totallikes = scalar(keys(%{$likes{$symb.':'.$idx.':likers'}})); 4438: } 4439: if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') { 4440: $totalunlikes = scalar(keys(%{$likes{$symb.':'.$idx.':unlikers'}})); 4441: } 4442: if ($totallikes || $totalunlikes) { 4443: $chglikes{$uname.':'.$udom} += $totallikes; 4444: $chgunlikes{$uname.':'.$udom} += $totalunlikes; 4445: } 4446: } 4447: foreach my $user (keys(%chglikes)) { 4448: my ($uname,$udom) = split(/:/,$user); 4449: &storediscussionlikes($chglikes{$user},$chgunlikes{$user}, 4450: $uname,$udom,$env{'request.course.id'}, 4451: 'undelete'); 4452: } 4453: $r->print(&Apache::lonhtmlcommon::confirm_success(&mt("Undeleted all entries"))); 4454: } else { 4455: $r->print(&Apache::lonhtmlcommon::confirm_success(&mt("Failed to undelete entries"),1)); 4456: } 4457: } else { 4458: $r->print(&Apache::lonhtmlcommon::confirm_success(&mt("No entries to undelete"),1)); 4459: } 4460: $r->print("<br /><a href='$feedurl'>".&mt("Return and reload")."</a>"); 4461: } 4462: $r->print(&Apache::loncommon::end_page()); 4463: return OK; 4464: } else { 4465: # ------------------------------------------------------------- Normal feedback 4466: my $feedurl=$env{'form.postdata'}; 4467: $feedurl=~s/^https?\:\/\///; 4468: $feedurl=~s/^$ENV{'SERVER_NAME'}//; 4469: $feedurl=~s/^$ENV{'HTTP_HOST'}//; 4470: $feedurl=~s/\?.+$//; 4471: 4472: my $symb; 4473: if ($env{'form.replydisc'}) { 4474: $symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0]; 4475: } elsif ($env{'form.editdisc'}) { 4476: $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0]; 4477: } elsif ($env{'form.origpage'}) { 4478: $symb=""; 4479: } elsif ($env{'form.sendmessageonly'}) { 4480: $symb=(split(/\:\:\:/,$env{'form.sendmessageonly'}))[0]; 4481: } else { 4482: $symb=&Apache::lonnet::symbread($feedurl); 4483: } 4484: unless ($symb) { 4485: $symb=$env{'form.symb'}; 4486: } 4487: if (defined($symb)) { 4488: ($symb,$feedurl)=&get_feedurl_and_clean_symb($symb); 4489: } else { 4490: # backward compatibility (bulletin boards used to be 'wrapped') 4491: &Apache::lonenc::check_decrypt(\$feedurl); 4492: &dewrapper(\$feedurl); 4493: } 4494: my $goahead=1; 4495: if ($feedurl=~/$LONCAPA::assess_re/) { 4496: unless ($symb) { $goahead=0; } 4497: } 4498: if (!$goahead) { 4499: # Ambiguous Problem Resource 4500: $r->internal_redirect('/adm/ambiguous'); 4501: return OK; 4502: } 4503: # Go ahead with feedback, no ambiguous reference 4504: unless ( 4505: ( 4506: ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:) 4507: ) 4508: || 4509: ($env{'request.course.id'} && ($feedurl!~m:^/adm:)) 4510: || 4511: ($env{'request.course.id'} && ($symb=~/^bulletin\_\_\_/)) 4512: ) { 4513: &Apache::loncommon::content_type($r,'text/html'); 4514: $r->send_http_header; 4515: # Unable to give feedback 4516: &Apache::lonenc::check_encrypt(\$feedurl); 4517: &no_redirect_back($r,$feedurl); 4518: return OK; 4519: } 4520: # --------------------------------------------------- Print login screen header 4521: unless ($env{'form.sendit'}) { 4522: &Apache::lonenc::check_encrypt(\$feedurl); 4523: &Apache::loncommon::content_type($r,'text/html'); 4524: $r->send_http_header; 4525: if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) { 4526: my ($blocked,$blocktext) = 4527: &Apache::loncommon::blocking_status('boards'); 4528: if ($blocked) { 4529: $r->print(&blocked_reply_or_edit($blocktext)); 4530: return OK; 4531: } 4532: } 4533: my $options=&screen_header($feedurl,$symb,$group); 4534: if ($options) { 4535: &mail_screen($r,$feedurl,$options,$symb,$attachmax{'text'}); 4536: } else { 4537: &fail_redirect($r,$feedurl); 4538: } 4539: return OK; 4540: } 4541: 4542: # Get previous user input 4543: my $prevattempts=&Apache::loncommon::get_previous_attempt( 4544: $symb,$env{'user.name'},$env{'user.domain'}, 4545: $env{'request.course.id'}); 4546: 4547: # Get output from resource 4548: &Apache::lonenc::check_encrypt(\$feedurl); 4549: my $usersaw=&resource_output($feedurl); 4550: 4551: # Get resource answer (need to allow student to view grades for this to work) 4552: &Apache::lonnet::appenv({'allowed.vgr'=>'F'}); 4553: my $usersymb = &Apache::lonenc::check_encrypt($symb); 4554: my $useranswer= 4555: &Apache::loncommon::get_student_answers( 4556: $usersymb,$env{'user.name'},$env{'user.domain'}, 4557: $env{'request.course.id'}); 4558: &Apache::lonnet::delenv('allowed.vgr'); 4559: # Get attachments, if any, and not too large 4560: my $attachmenturl=''; 4561: my $toolarge=''; 4562: if (($env{'form.origpage'}) || ($env{'form.editdisc'}) || 4563: ($env{'form.replydisc'})) { 4564: my ($symb,$idx); 4565: if ($env{'form.replydisc'}) { 4566: ($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'}); 4567: } elsif ($env{'form.editdisc'}) { 4568: ($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'}); 4569: } elsif ($env{'form.origpage'}) { 4570: $symb = $env{'form.symb'}; 4571: } 4572: &Apache::lonenc::check_decrypt(\$symb); 4573: my @currnewattach = (); 4574: my @deloldattach = (); 4575: my @keepold = (); 4576: &process_attachments(\@currnewattach,\@deloldattach,\@keepold); 4577: $symb=~s|(bulletin___\d+___)adm/wrapper/|$1|; 4578: $attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx); 4579: } elsif ($env{'form.attachment.filename'}) { 4580: if (length($env{'form.attachment'})<=$attachmax{'num'}) { 4581: my $now = time; 4582: my $subdir = 'feedback/'.$now; 4583: $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,$subdir); 4584: } else { 4585: $toolarge = '<p><span class="LC_warning">'.&mt('Attachment not included - exceeded permitted length').'</span><br /></p>'; 4586: } 4587: } 4588: # Filter HTML out of message (could be nasty) 4589: my $override; 4590: if ($env{'form.discuss'} =~ /^(?:author|question|course|policy)$/) { 4591: $override = 1; 4592: } 4593: my $message=&clear_out_html($env{'form.comment'},$override); 4594: 4595: # Assemble email 4596: my ($email,$citations)=&assemble_email($message,$prevattempts, 4597: $usersaw,$useranswer); 4598: 4599: # Who gets this? 4600: my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl); 4601: 4602: # Actually send mail 4603: my ($status,$numsent)=&send_msg(&clear_out_html($env{'form.subject'}), 4604: $feedurl,$email,$citations, 4605: $attachmenturl,$usersymb,%to); 4606: 4607: # Discussion? Store that. 4608: my $numpost=0; 4609: if ( ($env{'form.discuss'} ne '' 4610: && $env{'form.discuss'} !~ /^(?:author|question|course|policy)/) 4611: || $env{'form.anondiscuss'} ne '') { 4612: my $subject = &clear_out_html($env{'form.subject'}); 4613: my $anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} ); 4614: $typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl, 4615: $subject,$group); 4616: $numpost++; 4617: } 4618: 4619: # Add to blog? 4620: 4621: my $blog=''; 4622: if ($env{'form.blog'}) { 4623: my $subject = &clear_out_html($env{'form.subject'}); 4624: $status.=&Apache::lonrss::addentry($env{'user.name'}, 4625: $env{'user.domain'}, 4626: 'CourseBlog_'.$env{'request.course.id'}, 4627: $subject,$message,$feedurl,'public'); 4628: if (&Apache::loncommon::course_type() eq 'Community') { 4629: $blog='<br />'.&mt('Added to my community blog').'<br />'; 4630: } else { 4631: $blog='<br />'.&mt('Added to my course blog').'<br />'; 4632: } 4633: } 4634: 4635: # Receipt screen and redirect back to where came from 4636: &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},undef,undef,undef,undef,undef,undef,$group,$toolarge); 4637: } 4638: return OK; 4639: } 4640: 4641: sub blocked_reply_or_edit { 4642: my ($blocktext) = @_; 4643: return 4644: &Apache::loncommon::start_page('Resource Feedback and Discussion'). 4645: $blocktext.'<br /><br /><a href="javascript:history.go(-1)">'. 4646: &mt('Back to previous page'). 4647: &Apache::loncommon::end_page(); 4648: } 4649: 4650: sub wrap_symb { 4651: my ($ressymb)=@_; 4652: if ($ressymb =~ /bulletin___\d+___/) { 4653: unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) { 4654: $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|; 4655: } 4656: } 4657: return $ressymb; 4658: } 4659: 4660: sub dewrapper { 4661: my ($feedurl)=@_; 4662: if ($$feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) { 4663: $$feedurl=~s|^/adm/wrapper||; 4664: } 4665: } 4666: 4667: sub get_feedurl { 4668: my ($symb)=@_; 4669: my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb); 4670: my $feedurl = &Apache::lonnet::clutter($url); 4671: &dewrapper(\$feedurl); 4672: return $feedurl; 4673: } 4674: 4675: sub get_feedurl_and_clean_symb { 4676: my ($symb)=@_; 4677: &Apache::lonenc::check_decrypt(\$symb); 4678: # backward compatibility (bulletin boards used to be 'wrapped') 4679: unless ($symb =~ m|bulletin___\d+___adm/wrapper|) { 4680: $symb=~s|(bulletin___\d+___)|$1adm/wrapper|; 4681: } 4682: my $feedurl = &get_feedurl($symb); 4683: return ($symb,$feedurl); 4684: } 4685: 4686: sub editing_allowed { 4687: my ($postid,$group) = @_; 4688: $postid = &unescape($postid); 4689: my $can_edit = 0; 4690: if ($group ne '') { 4691: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 4692: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 4693: if ($postid =~ m|^bulletin___\d+___adm/wrapper(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) { 4694: if (&check_group_priv($group,'egp') eq 'ok') { 4695: $can_edit = 1; 4696: } 4697: return $can_edit; 4698: } 4699: } 4700: my $cid = $env{'request.course.id'}; 4701: my $role = (split(/\./,$env{'request.role'}))[0]; 4702: my $section = $env{'request.course.sec'}; 4703: my $allow_editing_config = 4704: $env{'course.'.$cid.'.allow_discussion_post_editing'}; 4705: if ($allow_editing_config =~ m/^\s*yes\s*$/i) { 4706: $can_edit = 1; 4707: } else { 4708: foreach my $editor (split(/,/,$allow_editing_config)) { 4709: my ($editor_role,$editor_sec) = split(/:/,$editor); 4710: if ($editor_role eq $role 4711: && defined($editor_sec) 4712: && defined($section) 4713: && $editor_sec eq $section) { 4714: $can_edit = 1; 4715: last; 4716: } 4717: if ($editor_role eq $role 4718: && !defined($editor_sec)) { 4719: $can_edit = 1; 4720: } 4721: } 4722: } 4723: return $can_edit; 4724: } 4725: 4726: sub check_group_priv { 4727: my ($group,$grp_priv) = @_; 4728: foreach my $priv ('mdg','vcg') { 4729: my $checkcourse = $env{'request.course.id'}. 4730: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''); 4731: if (&Apache::lonnet::allowed($priv,$checkcourse)) { 4732: return 'ok'; 4733: } 4734: } 4735: if ($grp_priv && $group ne '') { 4736: if (&Apache::lonnet::allowed($grp_priv,$env{'request.course.id'}.'/'.$group)) { 4737: return 'ok'; 4738: } 4739: } 4740: return ''; 4741: } 4742: 4743: sub group_args { 4744: my ($group) = @_; 4745: if ($group eq '') { return ''; } 4746: my $extra_args = '&group='.$group; 4747: if (exists($env{'form.ref'})) { 4748: $extra_args .= '&ref='.$env{'form.ref'}; 4749: } 4750: return $extra_args; 4751: } 4752: 4753: sub get_resource_title { 4754: my ($symb,$feedurl) = @_; 4755: my ($restitle,$plainurl); 4756: if (defined($symb)) { 4757: my $plain_symb = &Apache::lonenc::check_decrypt($symb); 4758: $restitle = &Apache::lonnet::gettitle($plain_symb); 4759: } 4760: if (defined($feedurl)) { 4761: $plainurl = &Apache::lonenc::check_decrypt($feedurl); 4762: } 4763: if (!defined($restitle)) { 4764: if (defined($feedurl)) { 4765: $restitle = &Apache::lonnet::gettitle($plainurl); 4766: } 4767: } 4768: if ($plainurl ne $feedurl) { 4769: my ($plain_filename) = ($plainurl =~ m-/([^/]+)$-); 4770: if ($plain_filename eq $restitle) { 4771: $restitle = &mt('Untitled resource'); 4772: } 4773: } 4774: if ($restitle eq '') { 4775: $restitle = &mt('Untitled resource'); 4776: } 4777: return $restitle; 4778: } 4779: 4780: 1; 4781: __END__ 4782: 4783: 4784: =pod 4785: 4786: =head1 NAME 4787: 4788: Apache::lonfeedback.pm 4789: 4790: =head1 SYNOPSIS 4791: 4792: Handles feedback from students to instructors and system administrators. 4793: 4794: Provides a screenshot of the current resource, as well as previous attempts if the resource was a homework. 4795: 4796: Used by lonmsg.pm. 4797: 4798: This is part of the LearningOnline Network with CAPA project 4799: described at http://www.lon-capa.org. 4800: 4801: =head1 OVERVIEW 4802: 4803: None 4804: 4805: =head1 SUBROUTINES 4806: 4807: =over 4808: 4809: =item discussion_open() 4810: 4811: =item discussion_visible() 4812: 4813: =item discussion_vote_available() 4814: 4815: =item get_realsymb() 4816: 4817: =item list_discussion() 4818: 4819: =item can_see_hidden() 4820: 4821: =item discussion_link() 4822: 4823: =item send_feedback_link() 4824: 4825: =item send_message_link() 4826: 4827: =item action_links_bar() 4828: 4829: =item postingform_display() 4830: 4831: =item build_posting_display 4832: 4833: =item filter_regexp() 4834: 4835: =item get_post_contents() 4836: 4837: =item replicate_attachments() 4838: 4839: =item mail_screen() 4840: 4841: =item print_display_options() 4842: 4843: =item print_sortfilter_options() 4844: 4845: =item print_showposters() 4846: 4847: =item get_post_versions() 4848: 4849: =item get_post_attachments() 4850: 4851: =item fail_redirect() 4852: 4853: =item redirect_back() 4854: 4855: =item no_redirect_back() 4856: 4857: =item screen_header() 4858: 4859: =item resource_output() 4860: 4861: =item clear_out_html() 4862: 4863: =item assemble_email() 4864: 4865: =item feedback_available() 4866: 4867: =item send_msg() 4868: 4869: =item adddiscuss() 4870: 4871: =item get_discussion_info() 4872: 4873: =item show_preview() 4874: 4875: =item newline_to_br() 4876: 4877: =item tidy_html() 4878: 4879: =item generate_preview_button() 4880: 4881: =item modify_attachments() 4882: 4883: =item process_attachments() 4884: 4885: =item generate_attachments_button() 4886: 4887: =item extract_attachments() 4888: 4889: =item construct_attachmenturl() 4890: 4891: =item add_blog_checkbox() 4892: 4893: =item has_discussion() 4894: 4895: =item sort_filter_names() 4896: 4897: =item handler() 4898: 4899: =item blocked_reply_or_edit() 4900: 4901: =item wrap_symb() 4902: 4903: =item dewrapper() 4904: 4905: =item get_feedurl() 4906: 4907: =item get_feedurl_and_clean_symb() 4908: 4909: =item editing_allowed() 4910: 4911: =item check_group_priv() 4912: 4913: =item group_args() 4914: 4915: =item get_resource_title() 4916: 4917: =back 4918: 4919: =cut