File:  [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.103: download - view: text, annotated - select for diffs
Fri Jul 23 16:56:29 2004 UTC (19 years, 10 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- need to protect anything that is going to be put into a <textarea>

    1: # The LearningOnline Network
    2: # Feedback
    3: #
    4: # $Id: lonfeedback.pm,v 1.103 2004/07/23 16:56:29 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::lonfeedback;
   31: 
   32: use strict;
   33: use Apache::Constants qw(:common);
   34: use Apache::lonmsg();
   35: use Apache::loncommon();
   36: use Apache::lontexconvert();
   37: use Apache::lonlocal; # must not have ()
   38: use Apache::lonhtmlcommon();
   39: 
   40: sub discussion_open {
   41:     my ($status)=@_;
   42:     if (defined($status) &&
   43: 	!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
   44: 	  || $status eq 'OPEN')) {
   45: 	return 0;
   46:     }
   47:     my $close=&Apache::lonnet::EXT('resource.0.discussend');
   48:     if (defined($close) && $close ne '' && $close < time) {
   49: 	return 0;
   50:     }
   51:     return 1;
   52: }
   53: 
   54: sub discussion_visible {
   55:     my ($status)=@_;
   56:     if (not &discussion_open($status)) {
   57: 	my $hidden=&Apache::lonnet::EXT('resource.0.discusshide');
   58: 	if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden))  {
   59: 	    return 0;
   60: 	}
   61:     }
   62:     return 1;
   63: }
   64: 
   65: sub list_discussion {
   66:     my ($mode,$status,$symb)=@_;
   67: 
   68:     my $outputtarget=$ENV{'form.grade_target'};
   69:     if (not &discussion_visible($status)) { return ''; }
   70:     my @bgcols = ("#cccccc","#eeeeee");
   71:     my $discussiononly=0;
   72:     if ($mode eq 'board') { $discussiononly=1; }
   73:     unless ($ENV{'request.course.id'}) { return ''; }
   74:     my $crs='/'.$ENV{'request.course.id'};
   75:     my $cid=$ENV{'request.course.id'};
   76:     if ($ENV{'request.course.sec'}) {
   77: 	$crs.='_'.$ENV{'request.course.sec'};
   78:     }                 
   79:     $crs=~s/\_/\//g;
   80:     unless ($symb) {
   81: 	$symb=&Apache::lonnet::symbread();
   82:     }
   83:     unless ($symb) { return ''; }
   84:     my %usernamesort = ();
   85:     my %namesort =();
   86:     my %subjectsort = ();
   87: # backward compatibility (bulletin boards used to be 'wrapped')
   88:     my $ressymb=$symb;
   89:     if ($mode eq 'board') {
   90:         unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
   91:             $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
   92:         }
   93:     }
   94: 
   95: # Get discussion display settings for this discussion
   96:     my $lastkey = $ressymb.'_lastread';
   97:     my $showkey = $ressymb.'_showonlyunread';
   98:     my $visitkey = $ressymb.'_visit';
   99:     my $ondispkey = $ressymb.'_markondisp';
  100:     my $userpickkey = $ressymb.'_userpick';
  101:     my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'});
  102:     my %discinfo = ();
  103:     my $showonlyunread = 0;
  104:     my $markondisp = 0;
  105:     my $prevread = 0;
  106:     my $previous = 0;
  107:     my $visit = 0;
  108:     my $newpostsflag = 0;
  109:     my @posters = split/\&/,$dischash{$userpickkey};
  110: 
  111: # Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts.
  112:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']);
  113:     my $sortposts = $ENV{'form.sortposts'};
  114:     my $rolefilter = $ENV{'form.rolefilter'};
  115:     my $statusfilter = $ENV{'form.statusfilter'};
  116:     my $sectionpick = $ENV{'form.sectionpick'};
  117:     my $totposters = $ENV{'form.totposters'};
  118:     $previous = $ENV{'form.previous'};
  119:     if ($previous > 0) {
  120:         $prevread = $previous;
  121:     } elsif (defined($dischash{$lastkey})) {
  122:         unless ($dischash{$lastkey} eq '') {
  123:             $prevread = $dischash{$lastkey};
  124:         }
  125:     }
  126: 
  127: # Get information about students and non-stundents in course for filtering display of posts
  128:     my %roleshash = ();
  129:     my %roleinfo = ();
  130:     if ($rolefilter) {
  131:         %roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  132:         foreach (keys %roleshash) {
  133:             my ($role,$uname,$udom,$sec) = split/:/,$_;
  134:             my ($end,$start) = split/:/,$roleshash{$_};
  135:             my $now = time;
  136:             my $status = 'Active';
  137:             if (($now < $start) || ($end > 0 && $now > $end)) {
  138:                 $status = 'Expired';
  139:             }
  140:             push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
  141:         }
  142:         my ($classlist) = &Apache::loncoursedata::get_classlist(
  143:                               $ENV{'request.course.id'},
  144:                               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  145:                               $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  146:         my $sec_index = &Apache::loncoursedata::CL_SECTION();
  147:         my $status_index = &Apache::loncoursedata::CL_STATUS();
  148:         while (my ($student,$data) = each %$classlist) {
  149:             my ($section,$status) = ($data->[$sec_index],
  150:                                  $data->[$status_index]);
  151:             push @{$roleinfo{$student}}, 'st:'.$section.':'.$status;
  152:         }
  153:     }
  154: 
  155: # Get discussion display default settings for user
  156:     my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'});
  157:     my $discdisplay=$userenv{'discdisplay'};
  158:     if ($discdisplay eq 'unread') {
  159:         $showonlyunread = 1;
  160:     }
  161:     my $discmarkread=$userenv{'discmarkread'};
  162:     if ($discmarkread eq 'ondisp') {
  163:         $markondisp = 1;
  164:     }
  165: 
  166: # Override user's default if user specified display setting for this discussion
  167:     if (defined($dischash{$ondispkey})) {
  168:         $markondisp = $dischash{$ondispkey};
  169:     }
  170:     if ($markondisp) {
  171:         $discinfo{$lastkey} = time;
  172:     }
  173: 
  174:     if (defined($dischash{$showkey})) {
  175:         $showonlyunread = $dischash{$showkey};
  176:     }
  177: 
  178:     if (defined($dischash{$visitkey})) {
  179:         $visit = $dischash{$visitkey};
  180:     }
  181:     $visit ++;
  182: 
  183:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
  184:     my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
  185: 	&& ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
  186:     my @discussionitems=();
  187:     my %shown = ();
  188:     my @posteridentity=();
  189:     my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
  190: 			  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  191: 			  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  192:     my $visible=0;
  193:     my @depth=();
  194:     my @original=();
  195:     my @index=();
  196:     my @replies=();
  197:     my %alldiscussion=();
  198:     my %notshown = ();
  199:     my %newitem = ();
  200:     my $maxdepth=0;
  201: 
  202:     my $target='';
  203:     unless ($ENV{'browser.interface'} eq 'textual' ||
  204: 	    $ENV{'environment.remote'} eq 'off' ) {
  205: 	$target='target="LONcom"';
  206:     }
  207:     
  208:     my $now = time;
  209:     $discinfo{$visitkey} = $visit;
  210: 
  211:     &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
  212: 
  213:     if ($contrib{'version'}) {
  214:         my $oldest = $contrib{'1:timestamp'};
  215:         if ($prevread eq '0') {
  216:             $prevread = $oldest-1;
  217:         }
  218: 	for (my $id=1;$id<=$contrib{'version'};$id++) {
  219: 	    my $idx=$id;
  220:             my $posttime = $contrib{$idx.':timestamp'};
  221:             if ($prevread <= $posttime) {
  222:                 $newpostsflag = 1;
  223:             }
  224: 	    my $hidden=($contrib{'hidden'}=~/\.$idx\./);
  225:             my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./);
  226: 	    my $deleted=($contrib{'deleted'}=~/\.$idx\./);
  227: 	    my $origindex='0.';
  228:             my $numoldver=0;
  229: 	    if ($contrib{$idx.':replyto'}) {
  230:                 if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
  231: # this is a follow-up message
  232: 		    $original[$idx]=$original[$contrib{$idx.':replyto'}];
  233: 		    $depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1;
  234: 		    $origindex=$index[$contrib{$idx.':replyto'}];
  235: 		    if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; }
  236:                 } else {
  237:                     $original[$idx]=0;
  238:                     $depth[$idx]=0;
  239:                 }
  240: 	    } else {
  241: # this is an original message
  242: 		$original[$idx]=0;
  243: 		$depth[$idx]=0;
  244: 	    }
  245: 	    if ($replies[$depth[$idx]]) {
  246: 		$replies[$depth[$idx]]++;
  247: 	    } else {
  248: 		$replies[$depth[$idx]]=1;
  249: 	    }
  250: 	    unless ((($hidden) && (!$seeid)) || ($deleted)) {
  251: 		$visible++;
  252:                 if ($contrib{$idx.':history'}) {
  253:                     if ($contrib{$idx.':history'} =~ /:/) {
  254:                         my @oldversions = split/:/,$contrib{$idx.':history'};
  255:                         $numoldver = @oldversions;
  256:                     } else {
  257:                         $numoldver = 1;
  258:                     } 
  259:                 }
  260: 		my $message=$contrib{$idx.':message'};
  261: 		$message=~s/\n/\<br \/\>/g;
  262: 		$message=&Apache::lontexconvert::msgtexconverted($message,undef,$numoldver);
  263:                 my $subject=$contrib{$idx.':subject'};
  264:                 if (defined($subject)) {
  265:                     $subject=~s/\n/\<br \/\>/g;
  266:                     $subject=&Apache::lontexconvert::msgtexconverted($subject,undef,$numoldver);
  267:                 }
  268: 		if ($contrib{$idx.':attachmenturl'}) {
  269: 		    my ($fname)
  270:                         =($contrib{$idx.':attachmenturl'}=~m|/([^/]+)$|);
  271: 		    &Apache::lonnet::allowuploaded('/adm/feedback',
  272: 					   $contrib{$idx.':attachmenturl'});
  273: 		    $message.='<p>'.&mt('Attachment').
  274: 			': <a href="'.$contrib{$idx.':attachmenturl'}.'"><tt>'.
  275: 			$fname.'</tt></a></p>';
  276: 		}
  277: 		if ($message) {
  278: 		    if ($hidden) {
  279: 			$message='<font color="#888888">'.$message.'</font>';
  280:                         if ($studenthidden) {
  281:                             $message .='<br /><br />Deleted by poster (student).';
  282:                         }
  283: 		    }
  284: 		    my $screenname=&Apache::loncommon::screenname(
  285: 					    $contrib{$idx.':sendername'},
  286: 					    $contrib{$idx.':senderdomain'});
  287: 		    my $plainname=&Apache::loncommon::nickname(
  288: 					    $contrib{$idx.':sendername'},
  289: 					    $contrib{$idx.':senderdomain'});
  290: 		    
  291: 		    my $sender=&mt('Anonymous');
  292: # Set up for sorting by subject
  293:                     if ($contrib{$idx.':subject'} eq '') {
  294:                         if (defined($subjectsort{'__No subject'})) {
  295:                             push @{$subjectsort{'__No subject'}}, $idx;
  296:                         } else {
  297:                             @{$subjectsort{'__No subject'}} = ("$idx");
  298:                         }
  299:                     } else {
  300:                         if (defined($subjectsort{$contrib{$idx.':subject'}})) {
  301:                             push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx;
  302:                         } else {
  303:                             @{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx");
  304:                         }
  305:                     }
  306: 		    if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
  307: 			$sender=&Apache::loncommon::aboutmewrapper(
  308: 					 $plainname,
  309: 					 $contrib{$idx.':sendername'},
  310: 					 $contrib{$idx.':senderdomain'}).' ('.
  311: 					 $contrib{$idx.':sendername'}.' at '.
  312: 					 $contrib{$idx.':senderdomain'}.')';
  313: 			if ($contrib{$idx.':anonymous'}) {
  314: 			    $sender.=' ['.&mt('anonymous').'] '.
  315: 				$screenname;
  316: 			}
  317: # Set up for sorting by domain, then username
  318:                         unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) {
  319:                             %{$usernamesort{$contrib{$idx.':senderdomain'}}} = ();
  320:                         }
  321:                         if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) {
  322:                             push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx;
  323:                         } else {
  324:                             @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx");
  325:                         }
  326: # Set up for sorting by last name, then first name
  327:                         my %names = &Apache::lonnet::get('environment',['firstname','lastname'],
  328:                                   $contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
  329:                         my $lastname = $names{'lastname'};
  330:                         my $firstname = $names{'firstname'};
  331:                         if ($lastname eq '') {
  332:                             $lastname = '_';
  333:                         }
  334:                         if ($firstname eq '') {
  335:                             $firstname = '_';
  336:                         }
  337:                         unless (defined($namesort{$lastname})) {
  338:                             %{$namesort{$lastname}} = ();
  339:                         }
  340:                         if (defined($namesort{$lastname}{$firstname})) {
  341:                             push @{$namesort{$lastname}{$firstname}}, $idx;
  342:                         } else {
  343:                             @{$namesort{$lastname}{$firstname}} = ("$idx");
  344:                         }
  345:                         if ($ENV{"course.$cid.allow_discussion_post_editing"} =~ m/yes/i) {
  346:                             if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) {
  347:                                 $sender.=' <a href="/adm/feedback?editdisc='.
  348:                                     $ressymb.':::'.$idx;
  349:                                 if ($newpostsflag) {
  350:                                     $sender .= '&previous='.$prevread;
  351:                                 }
  352:                                 $sender .= '" '.$target.'>'.&mt('Edit').'</a>';                                      unless ($seeid) {
  353:                                     $sender.=" <a href=\"javascript:studentdelete('$ressymb','$idx','$newpostsflag','$prevread')";
  354:                                     $sender .= '">'.&mt('Delete').'</a>';
  355:                                 }
  356:                             }
  357:                         }
  358: 			if ($seeid) {
  359: 			    if ($hidden) {
  360:                                 unless ($studenthidden) {
  361: 				    $sender.=' <a href="/adm/feedback?unhide='.
  362: 				        $ressymb.':::'.$idx;
  363:                                     if ($newpostsflag) {
  364:                                         $sender .= '&previous='.$prevread;
  365:                                     }
  366:                                     $sender .= '">'.&mt('Make Visible').'</a>';
  367:                                 }
  368: 			    } else {
  369: 				$sender.=' <a href="/adm/feedback?hide='.
  370: 				    $ressymb.':::'.$idx;
  371:                                 if ($newpostsflag) {
  372:                                     $sender .= '&previous='.$prevread;
  373:                                 }
  374:                                 $sender .= '">'.&mt('Hide').'</a>';
  375: 			    }                     
  376: 			    $sender.=' <a href="/adm/feedback?deldisc='.
  377: 				    $ressymb.':::'.$idx;
  378:                             if ($newpostsflag) {
  379:                                 $sender .= '&previous='.$prevread;
  380:                             }
  381:                             $sender .= '">'.&mt('Delete').'</a>';
  382: 			}
  383: 		    } else {
  384: 			if ($screenname) {
  385: 			    $sender='<i>'.$screenname.'</i>';
  386: 			}
  387: # Set up for sorting by domain, then username for anonymous
  388:                         unless (defined($usernamesort{'__anon'})) {
  389:                             %{$usernamesort{'__anon'}} = ();
  390:                         }
  391:                         if (defined($usernamesort{'__anon'}{'__anon'})) {
  392:                             push @{$usernamesort{'__anon'}{'__anon'}}, $idx;
  393:                         } else {
  394:                             @{$usernamesort{'__anon'}{'__anon'}} = ("$idx");
  395:                         }
  396: # Set up for sorting by last name, then first name for anonymous
  397:                         unless (defined($namesort{'__anon'})) {
  398:                             %{$namesort{'__anon'}} = ();
  399:                         }
  400:                         if (defined($namesort{'__anon'}{'__anon'})) {
  401:                             push @{$namesort{'__anon'}{'__anon'}}, $idx;
  402:                         } else {
  403:                             @{$namesort{'__anon'}{'__anon'}} = ("$idx");
  404:                         }
  405: 		    }
  406: 		    if (&discussion_open($status) &&
  407: 			&Apache::lonnet::allowed('pch',
  408: 						 $ENV{'request.course.id'}.
  409: 						 ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
  410: 			$sender.=' <a href="/adm/feedback?replydisc='.
  411: 			    $ressymb.':::'.$idx;
  412:                         if ($newpostsflag) {
  413:                             $sender .= '&previous='.$prevread;
  414:                         }
  415:                         $sender .= '" '.$target.'>'.&mt('Reply').'</a>';
  416: 		    }
  417: 		    my $vgrlink;
  418: 		    if ($viewgrades) {
  419: 			$vgrlink=&Apache::loncommon::submlink('Submissions',
  420:             $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
  421: 		    }
  422: #figure out at what position this needs to print
  423: 		    my $thisindex=$idx;
  424: 		    if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
  425: 			$thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
  426: 		    }
  427: 		    $alldiscussion{$thisindex}=$idx;
  428:                     $shown{$idx} = 0;
  429:                     $index[$idx]=$thisindex;
  430:                     my $spansize = 2;
  431:                     if ($showonlyunread && $prevread > $posttime) {
  432:                         $notshown{$idx} = 1;
  433:                     } else {
  434:                         my $uname = $contrib{$idx.':sendername'};
  435:                         my $udom = $contrib{$idx.':senderdomain'};
  436:                         my $poster = $uname.':'.$udom;
  437:                         my $rolematch = '';
  438:                         my $skiptest = 1;
  439:                         if ($totposters > 0) {
  440:                             if (grep/^$poster$/,@posters) {
  441:                                 $shown{$idx} = 1;
  442:                             }
  443:                         } else {
  444:                             if ($rolefilter) {
  445:                                 if ($rolefilter eq 'all') {
  446:                                     $rolematch = '([^:]+)';
  447:                                 } else {
  448:                                     $rolematch = $rolefilter;
  449:                                     $skiptest = 0;
  450:                                 }
  451:                             }
  452:                             if ($sectionpick) {
  453:                                 if ($sectionpick eq 'all') {
  454:                                     $rolematch .= ':([^:]*)';
  455:                                 } else {
  456:                                     $rolematch .= ':'.$sectionpick;
  457:                                     $skiptest = 0;
  458:                                 }
  459:                             }
  460:                             if ($statusfilter) {
  461:                                 if ($statusfilter eq 'all') {
  462:                                     $rolematch .= ':([^:]+)';
  463:                                 } else {
  464:                                     $rolematch .= ':'.$statusfilter;
  465:                                     $skiptest = 0;
  466:                                 }
  467:                             }
  468:                             if ($skiptest) {
  469:                                 $shown{$idx} = 1;
  470:                             } else {
  471:                                 foreach my $role (@{$roleinfo{$poster}}) {
  472:                                     if ($role =~ m/^$rolematch$/) {
  473:                                         $shown{$idx} = 1;
  474:                                         last;
  475:                                     }
  476:                                 }
  477:                             }
  478:                         }
  479:                     }
  480:                     unless ($notshown{$idx} == 1) {
  481:                         if ($prevread > 0 && $prevread <= $posttime) {
  482:                             $newitem{$idx} = 1;
  483:                             $discussionitems[$idx] .= '
  484:                              <p><table border="0" width="100%">
  485:                               <tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
  486:                         } else {
  487:                             $newitem{$idx} = 0;
  488:                             $discussionitems[$idx] .= '
  489:                              <p><table border="0" width="100%">
  490:                               <tr><td align="left">&nbsp;</td>';
  491:                         }
  492:                         $discussionitems[$idx] .= '<td align ="left">&nbsp;&nbsp;'.
  493:                             '<b>'.$subject.'</b>&nbsp;&nbsp;'.
  494:                             $sender.'</b> '.$vgrlink.' ('.
  495:                             localtime($posttime).')</td></tr>'.
  496:                             '</table><blockquote>'.$message.'</blockquote></p>';
  497:                         if ($contrib{$idx.':history'}) {
  498:                             my @postversions = ();
  499:                             $discussionitems[$idx] .= '<br />'.&mt('This post has been edited by the author.').'<br/>'.&mt('Earlier version(s) were posted on: ');
  500:                             if ($contrib{$idx.':history'} =~ m/:/) {
  501:                                 @postversions = split/:/,$contrib{$idx.':history'};
  502:                             } else {
  503:                                 @postversions = ("$contrib{$idx.':history'}");
  504:                             }
  505:                             for (my $i=0; $i<@postversions; $i++) {
  506:                                 my $version = $i+1;
  507:                                 $discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&Apache::lonlocal::locallocaltime($postversions[$i]).'  ';
  508:                             }
  509:                             $discussionitems[$idx] .= '<br />';
  510:                         }
  511:                     }
  512:                 }
  513:             }
  514: 	}
  515:     }
  516: 
  517:     my $discussion='';
  518: 
  519:     my $function = &Apache::loncommon::get_users_function();
  520:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
  521:                                                     $ENV{'user.domain'});
  522:     my %lt = &Apache::lonlocal::texthash(
  523:         'cuse' => 'Current discussion settings',
  524:         'allposts' => 'All posts',
  525:         'unread' => 'New posts only',
  526:         'ondisp' => 'Once displayed',
  527:         'onmark' => 'Once marked read',
  528:         'disa' => 'Posts to be displayed',
  529:         'npce' => 'Posts cease to be marked "NEW"',
  530:         'chgt' => 'Change',
  531:         'disp' => 'Display',
  532:         'nolo' => 'Not new',
  533:     );
  534: 
  535:     my $currdisp = $lt{'allposts'};
  536:     my $currmark = $lt{'onmark'};
  537:     my $dispchange = $lt{'unread'};
  538:     my $markchange = $lt{'ondisp'};
  539:     my $chglink = '/adm/feedback?modifydisp='.$ressymb;
  540:     my $displink = 'onlyunread';
  541:     my $marklink = 'markondisp';
  542: 
  543:     if ($markondisp) {
  544:         $currmark = $lt{'ondisp'};
  545:         $markchange = $lt{'onmark'};
  546:         $marklink = 'markonread';
  547:     }
  548: 
  549:     if ($showonlyunread) {
  550:         $currdisp = $lt{'unread'};
  551:         $dispchange = $lt{'allposts'};
  552:         $displink = 'allposts';
  553:     }
  554:    
  555:     $chglink .= '&changes='.$displink.'_'.$marklink;
  556: 
  557:     if ($newpostsflag) {
  558:         $chglink .= '&previous='.$prevread;
  559:     }
  560: 
  561:     if ($visible) {
  562: # Print the discusssion
  563: 	if ($outputtarget ne 'tex') {
  564:             my $colspan=$maxdepth+1;
  565:             $discussion.= qq|
  566: <script>
  567:    function studentdelete (symb,idx,newflag,previous) {
  568:        var symbparm = symb+':::'+idx
  569:        var prevparm = ""
  570:        if (newflag == 1) {
  571:            prevparm = "&previous="+previous
  572:        }
  573:        if (confirm("Are you sure you want to delete this post?\\nDeleted posts will no longer be visible to you and other students,\\nbut will continue to be visible to your instructor")) {
  574:            document.location.href = "/adm/feedback?hide="+symbparm+prevparm
  575:        }  
  576:    }
  577: </script>
  578:             |;
  579: 	    $discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
  580: 	    $discussion .='<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'.
  581: 		'<table border="0" width="100%" bgcolor="#DDDDBB"><tr>';
  582: 	    if ($visible>2) {
  583: 		$discussion.='<td align="left">'.
  584: 		    '<a href="/adm/feedback?threadedon='.$ressymb;
  585: 		if ($newpostsflag) {
  586: 		    $discussion .= '&previous='.$prevread;
  587: 		}
  588: 		$discussion .='">'.&mt('Threaded View').'</a>&nbsp;&nbsp;'.
  589: 		    '<a href="/adm/feedback?threadedoff='.$ressymb;
  590: 		if ($newpostsflag) {
  591: 		    $discussion .= '&previous='.$prevread;
  592: 		}
  593: 		$discussion .='">'.&mt('Chronological View').'</a>&nbsp;&nbsp;
  594:                               <a href= "/adm/feedback?sortfilter='.$ressymb;
  595:                 if ($newpostsflag) {
  596:                     $discussion .= '&previous='.$prevread;
  597:                 }
  598:                 $discussion .='">'.&mt('Sorting/Filtering options').'</a>&nbsp;&nbsp';
  599:             } else {
  600:                 $discussion .= '<td align="left">';
  601:             }
  602:             $discussion .='<a href= "/adm/feedback?export='.$ressymb;
  603:             if ($newpostsflag) {
  604:                 $discussion .= '&previous='.$prevread;
  605:             }
  606:             $discussion .= '">'.&mt('Export').'?</a>&nbsp;&nbsp;</td>';
  607: 	    if ($newpostsflag) {
  608: 		if (!$markondisp) {
  609: 		    $discussion .='<td align="right"><a href="/adm/feedback?markread='.$ressymb.'">'.&mt('Mark new posts as read').'</a>&nbsp;&nbsp;';
  610: 		} else {
  611: 		    $discussion .= '<td>&nbsp;</td>';
  612: 		}
  613: 	    } else {
  614: 		$discussion .= '<td>&nbsp;</td>';
  615: 	    }
  616: 	    $discussion .= '</tr></table></td></tr>';
  617: 	} else {
  618: 	    $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
  619:                          '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'.
  620:                          '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'.
  621:                          '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
  622:                          '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}';
  623: 	}
  624:         my $numhidden = keys %notshown;
  625:         if ($numhidden > 0) {
  626:             my $colspan = $maxdepth+1;
  627:             $discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
  628:                          '<a href="/adm/feedback?allposts='.$ressymb;
  629:             if ($newpostsflag) {
  630:                 $discussion .= '&previous='.$prevread;
  631:             }
  632:             $discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
  633:                          $numhidden.' '.&mt('previously viewed posts').
  634:                          '<br/></td></tr>';
  635:         }
  636: 
  637: # Choose sort mechanism
  638:         my @showposts = ();
  639:         if ($sortposts eq 'descdate') {
  640:             @showposts = (sort { $b <=> $a } keys %alldiscussion);
  641:         } elsif ($sortposts eq 'thread') {
  642:             @showposts = (sort { $a <=> $b } keys %alldiscussion);
  643:         } elsif ($sortposts eq 'subject') {
  644:             foreach (sort keys %subjectsort) {
  645:                 push @showposts, @{$subjectsort{$_}};
  646:             }
  647:         } elsif ($sortposts eq 'username') {
  648:             foreach my $domain (sort keys %usernamesort) {
  649:                 foreach (sort keys %{$usernamesort{$domain}}) {
  650:                     push @showposts, @{$usernamesort{$domain}{$_}};
  651:                 }
  652:             }
  653:         } elsif ($sortposts eq 'lastfirst') {
  654:             foreach my $last (sort keys %namesort) {
  655:                  foreach (sort keys %{$namesort{$last}}) {
  656:                      push @showposts, @{$namesort{$last}{$_}};
  657:                  }
  658:             }
  659:         } else {
  660:             $sortposts = 'ascdate';
  661:             @showposts =  (sort { $a <=> $b } keys %alldiscussion);
  662:         }
  663:         foreach (@showposts) {
  664:             unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'})) {
  665:                 $alldiscussion{$_} = $_;
  666:             }
  667:             unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) {
  668:                 if ($outputtarget ne 'tex') {
  669: 		    $discussion.="\n<tr>";
  670: 		} else {
  671: 		    $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}';
  672: 		}
  673: 	        my $thisdepth=$depth[$alldiscussion{$_}];
  674:                 if ($outputtarget ne 'tex') {
  675: 		    for (1..$thisdepth) {
  676: 			$discussion.='<td>&nbsp;&nbsp;&nbsp;</td>';
  677: 		    }
  678: 		}
  679: 	        my $colspan=$maxdepth-$thisdepth+1;
  680:                 if ($outputtarget ne 'tex') {
  681: 		    $discussion.='<td  bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].'" colspan="'.$colspan.'">'.
  682:                              $discussionitems[$alldiscussion{$_}].
  683: 	                     '</td></tr>';
  684: 		} else {
  685: 		    #cleanup block
  686: 		    $discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
  687: 		    $discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
  688:                     my $threadinsert='';
  689:                     if ($thisdepth > 0) {
  690: 			$threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>';
  691: 		    }
  692: 		    $discussionitems[$alldiscussion{$_}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/;
  693: 		    $discussionitems[$alldiscussion{$_}]=~s/<a([^>]+)>(Edit|Hide|Delete|Reply|Submissions)<\/a>//g;
  694:                     $discussionitems[$alldiscussion{$_}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g;
  695: 		    
  696:                     #FIXME xmlparse can't be safely called from inside xmlparse
  697:                     #   due to the global variables that are use, the safe
  698:                     #   space etc. I expect this has unforseen issues that
  699:                     #   need resolving.
  700: 		    
  701:                     $discussion.=&Apache::lonxml::xmlparse('','tex',$discussionitems[$alldiscussion{$_}]);
  702: 		}
  703: 	    }
  704:         }
  705: 	if ($outputtarget ne 'tex') {
  706:             my $colspan=$maxdepth+1;
  707:             $discussion .= <<END; 
  708:             <tr bgcolor="#FFFFFF">
  709:              <td colspan="$colspan" valign="top">
  710:               <table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2">
  711:                <tr>
  712:                 <td align="left">
  713:                  <table border="0" cellpadding="0" cellspacing="4">
  714:                   <tr>
  715:                    <td>
  716:                     <font size="-1"><b>$lt{'cuse'}</b>:</td>
  717:                    <td>&nbsp;</td>
  718: END
  719:             if ($newpostsflag) {
  720:                 $discussion .= 
  721:                    '<td><font size="-1">1.&nbsp;'.$lt{'disp'}.'&nbsp;-&nbsp;<i>'.$currdisp.'</i>&nbsp;&nbsp;2.&nbsp;'.$lt{'nolo'}.'&nbsp;-&nbsp;<i>'.$currmark.'</i></font></td>';
  722:             } else {
  723:                 $discussion .=
  724:                    '<td><font size="-1">'.$lt{'disp'}.'&nbsp;-&nbsp;<i>'.$currdisp.'</i></font></td>';
  725:             }
  726:             $discussion .= <<END;
  727:                    <td>&nbsp;</td>
  728:                    <td>
  729:                     <font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b></td>
  730:                   </tr>
  731:                  </table>
  732:                 </td>
  733:                </tr>
  734:               </table>
  735:              </td>
  736:             </tr>
  737:            </table>
  738:            <br /><br />
  739: END
  740: 	}
  741:     }
  742:     if ($discussiononly) {
  743: 	$discussion.=(<<ENDDISCUSS);
  744: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
  745: <input type="submit" name="discuss" value="Post Discussion" />
  746: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
  747: <input type="hidden" name="symb" value="$ressymb" />
  748: <input type="hidden" name="sendit" value="true" />
  749: <br />
  750: <font size="1">Note: in anonymous discussion, your name is visible only to
  751: course faculty</font><br />
  752: <b>Title:</b>&nbsp;<input type="text" name="subject" value="" size="30" /><br /><br />
  753: <textarea name="comment" cols="80" rows="14" wrap="hard"></textarea>
  754: <p>
  755: Attachment (128 KB max size): <input type="file" name="attachment" />
  756: </p>
  757: </form>
  758: ENDDISCUSS
  759:         if ($outputtarget ne 'tex') {
  760: 	    $discussion.=&generate_preview_button();
  761: 	}
  762:     } else {
  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: 	    if ($outputtarget ne 'tex') {
  768: 		$discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='.
  769: 		    $symb.':::" '.$target.'>'.
  770: 		    '<img src="/adm/lonMisc/chat.gif" border="0" />'.
  771: 		    &mt('Post Discussion').'</a></td></tr></table>';
  772: 	    }
  773: 	}
  774:     }
  775:    return $discussion;
  776: }
  777: 
  778: sub mail_screen {
  779:   my ($r,$feedurl,$options) = @_;
  780:   my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
  781:                                           '','onLoad="window.focus();setposttype();"');
  782:   my $title=&Apache::lonnet::gettitle($feedurl);
  783:   if (!$title) { $title = $feedurl; }
  784:   my $quote='';
  785:   my $subject = '';
  786:   my $oldmessage = '';
  787:   my $prevtag = '';
  788:   my $parentmsg = '';
  789:   my $anonscript = (<<END);
  790:   function setposttype() {
  791:       return
  792:   }
  793: END
  794:   if (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) {
  795:       my ($symb,$idx);
  796:       if ($ENV{'form.replydisc'}) {
  797:           ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
  798:       } else {
  799:           ($symb,$idx)=split(/\:\:\:/,$ENV{'form.editdisc'});
  800:       }
  801:       my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
  802: 					   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  803: 					   $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  804:       unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) {
  805:           if ($ENV{'form.replydisc'}) {
  806:               my $numoldver = 0;
  807:               if ($contrib{$idx.':history'}) {
  808:                   if ($contrib{$idx.':history'} =~ /:/) {
  809:                       my @oldversions = split/:/,$contrib{$idx.':history'};
  810:                       $numoldver = @oldversions;
  811:                   } else {
  812:                       $numoldver = 1;
  813:                   }
  814:               }
  815: 	      my $message=$contrib{$idx.':message'};
  816: 	      $message=~s/\n/\<br \/\>/g;
  817: 	      $quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message,undef,$numoldver).'</blockquote>';
  818:               if ($idx > 0) {
  819:                   if ($contrib{'subject'} =~ /::::\d+::::(.+)$/si) {
  820:                       $subject = $1;
  821:                   } else {
  822:                       $subject = $contrib{$idx.':subject'};
  823:                   }
  824:                   $subject = 'Re: '.$subject;
  825:               }
  826:           } else {
  827:               if ($contrib{$idx.':message'} =~ /::::\d+::::(.+)$/si) {
  828:                   $oldmessage = $1;
  829:               } else {
  830:                   $oldmessage = $contrib{$idx.':message'};
  831:               }
  832: 	      $oldmessage=&HTML::Entities::encode($oldmessage,'<>&"');
  833:               if ($contrib{$idx.':subject'} =~ /::::\d+::::(.+)$/si) {
  834:                   $subject = $1;
  835:               } else {
  836:                   $subject = $contrib{$idx.':subject'};
  837:               }
  838:               if (defined($contrib{$idx.':replyto'})) {
  839:                   $parentmsg = $contrib{$idx.':replyto'};
  840:               }
  841:               my $anonflag = 0;
  842:               if ($contrib{$idx.':anonymous'}) {
  843:                   $anonflag = 1;
  844:               }
  845:               $anonscript = (<<END);
  846:   function setposttype () {
  847:       var currtype = $anonflag
  848:       if (currtype == 1) {
  849:           document.mailform.elements.discuss.checked = false
  850:           document.mailform.elements.anondiscuss.checked = true
  851:       }
  852:       if (currtype == 0) {
  853:           document.mailform.elements.anondiscuss.checked = false
  854:           document.mailform.elements.discuss.checked = true
  855:       }
  856:       return
  857:   }
  858: END
  859:           }
  860:       }
  861:       if ($ENV{'form.previous'}) {
  862:           $prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
  863:       }
  864:   }
  865:   my $latexHelp=&Apache::loncommon::helpLatexCheatsheet();
  866:   my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders();
  867:   my $onsubmit='';
  868:   if ((&Apache::lonhtmlcommon::htmlareabrowser()) &&
  869:       (!&Apache::lonhtmlcommon::htmlareablocked())) {
  870:       $onsubmit='document.mailform.onsubmit();';
  871:   }
  872:   my $send=&mt('Send');
  873:   $r->print(<<END);
  874: <html>
  875: <head>
  876: <title>The LearningOnline Network with CAPA</title>
  877: <meta http-equiv="pragma" content="no-cache"></meta>
  878: $htmlheader
  879: <script type="text/javascript">
  880: //<!--
  881:     function gosubmit() {
  882:         var rec=0;
  883:         if (typeof(document.mailform.elements.author)!="undefined") {
  884:           if (document.mailform.elements.author.checked) {
  885:              rec=1;
  886:           } 
  887:         }
  888:         if (typeof(document.mailform.elements.question)!="undefined") {
  889:           if (document.mailform.elements.question.checked) {
  890:              rec=1;
  891:           } 
  892:         }
  893:         if (typeof(document.mailform.elements.course)!="undefined") {
  894:           if (document.mailform.elements.course.checked) {
  895:              rec=1;
  896:           } 
  897:         }
  898:         if (typeof(document.mailform.elements.policy)!="undefined") {
  899:           if (document.mailform.elements.policy.checked) {
  900:              rec=1;
  901:           } 
  902:         }
  903:         if (typeof(document.mailform.elements.discuss)!="undefined") {
  904:           if (document.mailform.elements.discuss.checked) {
  905:              rec=1;
  906:           } 
  907:         }
  908:         if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
  909:           if (document.mailform.elements.anondiscuss.checked) {
  910:              rec=1;
  911:           } 
  912:         }
  913: 
  914:         if (rec) {
  915:             $onsubmit
  916: 	    document.mailform.submit();
  917:         } else {
  918:             alert('Please check a feedback type.');
  919: 	}
  920:     }
  921:     $anonscript
  922: //-->
  923: </script>
  924: </head>
  925: $bodytag
  926: <h2><tt>$title</tt></h2>
  927: <form action="/adm/feedback" method="post" name="mailform"
  928: enctype="multipart/form-data">
  929: $prevtag
  930: <input type="hidden" name="postdata" value="$feedurl" />
  931: END
  932:   if ($ENV{'form.replydisc'}) {
  933:       $r->print(<<END);
  934: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
  935: END
  936:   } elsif ($ENV{'form.editdisc'}) {
  937:      $r->print(<<END);
  938: <input type="hidden" name="editdisc" value ="$ENV{'form.editdisc'}" />
  939: <input type="hidden" name="parentmsg" value ="$parentmsg" />
  940: END
  941:   }
  942:   $r->print(<<ENDDOCUMENT);
  943: Please check at least one of the following feedback types:
  944: $options<hr />
  945: $quote
  946: <p>My question/comment/feedback:</p>
  947: <p>
  948: $latexHelp
  949: Title: <input type="text" name="subject" size="30" value="$subject" /></p>
  950: <p>
  951: <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">$oldmessage
  952: </textarea></p>
  953: <p>
  954: Attachment (128 KB max size): <input type="file" name="attachment" />
  955: </p>
  956: <p>
  957: <input type="hidden" name="sendit" value="1" />
  958: <input type="button" value="$send" onClick='gosubmit();' />
  959: </p>
  960: </form>
  961: ENDDOCUMENT
  962: $r->print(&generate_preview_button().
  963: &Apache::lonhtmlcommon::htmlareaselectactive('comment').
  964: '</body></html>');
  965: }
  966: 
  967: sub print_display_options {
  968:     my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_;
  969:  # backward compatibility (bulletin boards used to be 'wrapped')
  970:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
  971:         $feedurl=~s|^/adm/wrapper||;
  972:     }
  973: 
  974:     my $function = &Apache::loncommon::get_users_function();
  975:     my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
  976:                                                     $ENV{'user.domain'});
  977:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
  978:                                           '','');
  979: 
  980:     my %lt = &Apache::lonlocal::texthash(
  981:         'dido' => 'Discussion display options',
  982:         'pref' => 'Display Preference',
  983:         'curr' => 'Current setting ',
  984:         'actn' => 'Action',
  985:         'deff' => 'Default for all discussions',
  986:         'prca' => 'Preferences can be set for this discussion that determine ....',
  987:         'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and',
  988:         'unwh' => 'Under what circumstances posts are identfied as "New."',
  989:         'allposts' => 'All posts',
  990:         'unread' => 'New posts only',
  991:         'ondisp' => 'Once displayed',
  992:         'onmark' => 'Once marked as read',
  993:         'disa' => 'Posts displayed?',
  994:         'npmr' => 'New posts cease to be identified as "New"?',
  995:         'chgt' => 'Change to ',
  996:         'mkdf' => 'Set to ',
  997:         'yhni' => 'You have not indicated that you wish to change either of the discussion settings',
  998:         'ywbr' => 'You will be returned to the previous page if you click OK.'
  999:     );
 1000: 
 1001:     my $dispchange = $lt{'unread'};
 1002:     my $markchange = $lt{'ondisp'};
 1003:     my $currdisp = $lt{'allposts'};
 1004:     my $currmark = $lt{'onmark'};
 1005:     my $discdisp = 'allposts';
 1006:     my $discmark = 'onmark';
 1007:                                                                                       
 1008:     if ($dispchg eq 'allposts') {
 1009:         $dispchange = $lt{'allposts'};
 1010:         $currdisp = $lt{'unread'};
 1011:         $discdisp = 'unread';
 1012:     }
 1013:                                                                                       
 1014:     if ($markchg eq 'markonread') {
 1015:         $markchange = $lt{'onmark'};
 1016:         $currmark = $lt{'ondisp'};
 1017:         $discmark = 'ondisp';
 1018:     }
 1019:     $r->print(<<END);
 1020: <html>
 1021: <head>
 1022: <title>$lt{'dido'}</title>
 1023: <meta http-equiv="pragma" content="no-cache" />
 1024: <script>
 1025: function setDisp() {
 1026:     var prev = "$previous"
 1027:     var chktotal = 0
 1028:     if (document.modifydisp.discdisp.checked == true) {
 1029:         document.modifydisp.$dispchg.value = "$symb"
 1030:         chktotal ++
 1031:     }
 1032:     if (document.modifydisp.discmark.checked == true) {
 1033:         document.modifydisp.$markchg.value = "$symb"
 1034:         chktotal ++
 1035:     }
 1036:     if (chktotal > 0) { 
 1037:         document.modifydisp.submit()
 1038:     } else {
 1039:         if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}"))      {
 1040:             if (prev > 0) {
 1041:                 location.href = "$feedurl?previous=$previous"
 1042:             } else {
 1043:                 location.href = "$feedurl"
 1044:             }
 1045:         }
 1046:     }
 1047: }
 1048: </script>
 1049: </head>
 1050: $bodytag
 1051: <form name="modifydisp" method="post" action="/adm/feedback">
 1052: $lt{'sdpf'}<br/> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
 1053: <br />
 1054: <table border="0" cellpadding="0" cellspacing="0">
 1055:  <tr>
 1056:   <td width="100%" bgcolor="#000000">
 1057:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
 1058:     <tr>
 1059:      <td width="100%" bgcolor="#000000">
 1060:       <table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF">
 1061:        <tr bgcolor="$tabcolor">
 1062:         <td><b>$lt{'pref'}</b></td>
 1063:         <td><b>$lt{'curr'}</b></td>
 1064:         <td><b>$lt{'actn'}?</b></td>
 1065:        </tr>
 1066:        <tr bgcolor="#dddddd">
 1067:        <td>$lt{'disa'}</td>
 1068:        <td>$lt{$discdisp}</td>
 1069:        <td><input type="checkbox" name="discdisp" />&nbsp;$lt{'chgt'} "$dispchange"</td>
 1070:       </tr><tr bgcolor="#eeeeee">
 1071:        <td>$lt{'npmr'}</td>
 1072:        <td>$lt{$discmark}</td>
 1073:        <td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td>
 1074:       </tr>
 1075:      </table>
 1076:     </td>
 1077:    </tr>
 1078:   </table>
 1079:  </td>
 1080: </tr>
 1081: </table>
 1082: <br />
 1083: <br />
 1084: <input type="hidden" name="previous" value="$previous" />
 1085: <input type="hidden" name="$dispchg" value=""/>
 1086: <input type="hidden" name="$markchg" value=""/>
 1087: <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" />
 1088: <br />
 1089: <br />
 1090: </form>
 1091: </body>
 1092: </html>
 1093: END
 1094:     return;
 1095: }
 1096: 
 1097: sub print_sortfilter_options {
 1098:     my ($r,$symb,$previous,$feedurl) = @_;
 1099:  # backward compatibility (bulletin boards used to be 'wrapped')
 1100:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1101:         $feedurl=~s|^/adm/wrapper||;
 1102:     }
 1103:     my @sections = ();
 1104:     my $section_sel = '';
 1105:     my $numsections = 0;
 1106:     my $numvisible = 5;
 1107:     my ($classlist) = &Apache::loncoursedata::get_classlist(
 1108:                               $ENV{'request.course.id'},
 1109:                               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1110:                               $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1111:                                                                                    
 1112:     my $sec_index = &Apache::loncoursedata::CL_SECTION();
 1113:     my $status_index = &Apache::loncoursedata::CL_STATUS();
 1114:     my %sectioncount = ();
 1115:     while (my ($student,$data) = each %$classlist) {
 1116:         my ($section,$status) = ($data->[$sec_index],
 1117:                                  $data->[$status_index]);
 1118:         unless ($section eq '' || $section =~ /^\s*$/) {
 1119:             if (!defined($sectioncount{$section})) {
 1120:                 $sectioncount{$section} = 1;
 1121:                 $numsections ++;
 1122:             } else {
 1123:                 $sectioncount{$section} ++;
 1124:             }
 1125:         }
 1126:     }
 1127:                                                                                    
 1128:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
 1129:         @sections = ($ENV{'request.course.sec'});
 1130:         $numvisible = 1;
 1131:     } else {
 1132:         @sections = sort {$a cmp $b} keys(%sectioncount);
 1133:         unshift(@sections,'all'); # Put 'all' at the front of the list
 1134:         if ($numsections < 4) {
 1135:             $numvisible = $numsections + 1;
 1136:         }
 1137:     }
 1138:     foreach (@sections) {
 1139:         $section_sel .= "  <option value=\"$_\" />$_\n";
 1140:     }
 1141:                                                                                    
 1142:     my $function = &Apache::loncommon::get_users_function();
 1143:     my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
 1144:                                                     $ENV{'user.domain'});
 1145:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
 1146:                                           '','');
 1147:     my %lt = &Apache::lonlocal::texthash(
 1148:         'diso' => 'Discussion sorting and filtering options',
 1149:         'diop' => 'Display Options',
 1150:         'curr' => 'Current setting ',
 1151:         'actn' => 'Action',
 1152:         'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
 1153:         'soor' => 'Sort order',
 1154:         'disp' => 'Specific user roles',
 1155:         'actv' => 'Specific role status',
 1156:         'spse' => 'Specific sections',
 1157:         'psub' => 'Pick specific users (by name)',
 1158:         'shal' => 'Show a list of current posters'
 1159:     );
 1160:     $r->print(<<END);
 1161: <html>
 1162: <head>
 1163: <title>$lt{'diso'}</title>
 1164: <meta http-equiv="pragma" content="no-cache" />
 1165: </head>
 1166: $bodytag
 1167: <form name="modifyshown" method="post" action="/adm/feedback">
 1168: <b>$lt{'diso'}</b><br/> $lt{'prca'}
 1169: <br /><br />
 1170: <table border="0">
 1171:  <tr>
 1172:   <td><b>$lt{'soor'}</b></td>
 1173:   <td>&nbsp;</td>
 1174:   <td><b>$lt{'disp'}</b></td>
 1175:   <td>&nbsp;</td>
 1176:   <td><b>$lt{'actv'}</b></td>
 1177:   <td>&nbsp;</td>
 1178:   <td><b>$lt{'spse'}</b></td>
 1179:   <td>&nbsp;</td>
 1180:   <td><b>$lt{'psub'}</b></td>
 1181:  </tr>
 1182:  <tr>
 1183:   <td>
 1184:    <select name="sortposts">
 1185:     <option value="ascdate" />Date order - oldest first
 1186:     <option value="descdate" />Date order - newest first
 1187:     <option value="thread" />Threaded
 1188:     <option value="subject" />By subject
 1189:     <option value="username" />By domain and username
 1190:     <option value="lastfirst" />By last name, first name
 1191:    </select>
 1192:   </td>
 1193:   <td>&nbsp;</td>
 1194:   <td>
 1195:    <select name="rolefilter" multiple="true" size="5">
 1196:     <option value="all" />All users
 1197:     <option value="st" />Students
 1198:     <option value="cc" />Course Coordinators
 1199:     <option value="in" />Instructors
 1200:     <option value="ta" />TAs
 1201:     <option value="pr" />Exam proctors
 1202:     <option value="cr" />Custom roles
 1203:    </select>
 1204:   </td>
 1205:   <td>&nbsp;</td>
 1206:   <td>
 1207:    <select name="statusfilter">
 1208:     <option value="all" />Roles of any status
 1209:     <option value="Active" />Only active roles
 1210:     <option value="Expired" />Only inactive roles
 1211:    </select>
 1212:   </td>
 1213:   <td>&nbsp;</td>
 1214:   <td>
 1215:    <select name="sectionpick" multiple="true" size="$numvisible">
 1216:     $section_sel
 1217:    </select>
 1218:   </td>
 1219:   <td>&nbsp;</td>
 1220:   <td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</td>
 1221:  </tr>
 1222: </table>
 1223: <br />
 1224: <br />
 1225: <input type="hidden" name="previous" value="$previous" />
 1226: <input type="hidden" name="applysort" value="$symb" />
 1227: <input type="button" name="sub" value="Store Changes" onClick="javascript:document.modifyshown.submit()" />
 1228: <br />
 1229: <br />
 1230: </form>
 1231: </body>
 1232: </html>
 1233: END
 1234: }
 1235: 
 1236: sub print_showposters {
 1237:     my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
 1238:  # backward compatibility (bulletin boards used to be 'wrapped')
 1239:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1240:         $feedurl=~s|^/adm/wrapper||;
 1241:     }
 1242: # backward compatibility (bulletin boards used to be 'wrapped')
 1243:     my $ressymb=$symb;
 1244:     if ($ressymb =~ /bulletin___\d+___/) {
 1245:         unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1246:             $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1247:         }
 1248:     }
 1249:     my $crs='/'.$ENV{'request.course.id'};
 1250:     if ($ENV{'request.course.sec'}) {
 1251:         $crs.='_'.$ENV{'request.course.sec'};
 1252:     }
 1253:     $crs=~s/\_/\//g;
 1254:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
 1255:     my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
 1256:                           $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1257:                           $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1258:     my %namesort = ();
 1259:     my %postcounts = ();
 1260:     my %lt=&Apache::lonlocal::texthash(
 1261:                      'diso' => 'Discussion filtering options',
 1262:     );
 1263:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
 1264:                                           '','');
 1265:     if ($contrib{'version'}) {
 1266:         for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
 1267:             my $hidden=($contrib{'hidden'}=~/\.$idx\./);
 1268:             my $deleted=($contrib{'deleted'}=~/\.$idx\./);
 1269:             unless ((($hidden) && (!$seeid)) || ($deleted)) {
 1270:                 if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
 1271:                     my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
 1272:                     my $lastname = $names{'lastname'};
 1273:                     my $firstname = $names{'firstname'};
 1274:                     if ($lastname eq '') {
 1275:                         $lastname = '_';
 1276:                     }
 1277:                     if ($firstname eq '') {
 1278:                         $firstname = '_';
 1279:                     }
 1280:                     unless (defined($namesort{$lastname})) {
 1281:                         %{$namesort{$lastname}} = ();
 1282:                     }
 1283:                     my $poster =  $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'};
 1284:                     $postcounts{$poster} ++;
 1285:                     if (defined($namesort{$lastname}{$firstname})) {
 1286:                         if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) {
 1287:                             push @{$namesort{$lastname}{$firstname}}, $poster;
 1288:                         }
 1289:                     } else {
 1290:                         @{$namesort{$lastname}{$firstname}} = ("$poster");
 1291:                     }
 1292:                 }
 1293:             }
 1294:         }
 1295:     }
 1296:     $r->print(<<END);
 1297: <html>
 1298: <head>
 1299: <title>$lt{'diso'}</title>
 1300: <meta http-equiv="pragma" content="no-cache" />
 1301: </head>
 1302: $bodytag
 1303:  <form name="pickpostersform" method="post">
 1304:   <table border="0">
 1305:    <tr>
 1306:     <td bgcolor="#777777">
 1307:      <table border="0" cellpadding="3">
 1308:       <tr bgcolor="#e6ffff">
 1309:        <td><b>No.</b></td>
 1310:        <td><b>Select</b></td>
 1311:        <td><b>Fullname</b><font color="#999999">(Username/domain)</font></td>
 1312:        <td><b>Posts</td>
 1313:       </tr>
 1314: END
 1315:     my $count = 0;
 1316:     foreach my $last (sort keys %namesort) {
 1317:         foreach my $first (sort keys %{$namesort{$last}}) {
 1318:             foreach (sort @{$namesort{$last}{$first}}) {
 1319:                 my ($uname,$udom) = split/:/,$_;
 1320:                 if (!$uname || !$udom) { 
 1321:                     next;
 1322:                 } else {
 1323:                     $count ++;
 1324:                     $r->print('<tr bgcolor="#ffffe6"><td align="right">'.$count.'</td><td align="center"><input name="stuinfo" type="checkbox" value="'.$_.'" /></td><td>'.$last.', '.$first.' ('.$uname.','.$udom.')</td><td>'.$postcounts{$_}.'</td></tr>');
 1325:                 }
 1326:             }
 1327:         }
 1328:     }
 1329:     $r->print(<<END);
 1330:      </table>
 1331:     </td>
 1332:    </tr>
 1333:   </table>
 1334: <br />
 1335: <input type="hidden" name="sortposts" value="$sortposts" />
 1336: <input type="hidden" name="userpick" value="$symb" />
 1337: <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" />
 1338: </form>
 1339: </body>
 1340: </html>
 1341: END
 1342: }
 1343: 
 1344: sub fail_redirect {
 1345:   my ($r,$feedurl) = @_;
 1346:   if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
 1347:   $r->print (<<ENDFAILREDIR);
 1348: <html>
 1349: <head><title>Feedback not sent</title>
 1350: <meta http-equiv="pragma" content="no-cache" />
 1351: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1352: </head>
 1353: <body bgcolor="#FFFFFF">
 1354: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1355: <b>Sorry, no recipients  ...</b>
 1356: </body>
 1357: </html>
 1358: ENDFAILREDIR
 1359: }
 1360: 
 1361: sub redirect_back {
 1362:   my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_;
 1363:   my $sorttag = '';
 1364:   my $roletag = '';
 1365:   my $statustag = '';
 1366:   my $sectag = '';
 1367:   my $userpicktag = '';
 1368:   my $qrystr = '';
 1369:   my $prevtag = '';
 1370:  # backward compatibility (bulletin boards used to be 'wrapped')
 1371:   if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1372:       $feedurl=~s|^/adm/wrapper||;
 1373:   }
 1374:   if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
 1375:   if ($previous > 0) {
 1376:       $qrystr = 'previous='.$previous;
 1377:       if ($feedurl =~ /\?register=1/) {
 1378:           $feedurl .= '&'.$qrystr;
 1379:       } else {
 1380:           $feedurl .= '?'.$qrystr;
 1381:       }
 1382:       $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
 1383:   }
 1384:   if (defined($sort)) {
 1385:       my $sortqry = 'sortposts='.$sort;
 1386:       if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
 1387:           $feedurl .= '&'.$sortqry;
 1388:       } else {
 1389:           $feedurl .= '?'.$sortqry;
 1390:       }
 1391:       $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />';
 1392:       if ( (defined($numpicks)) && ($numpicks > 0) ) {
 1393:           my $userpickqry = 'totposters='.$numpicks;
 1394:           $feedurl .= '&'.$userpickqry;
 1395:           $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
 1396:       } else {
 1397:           my $roleqry = 'rolefilter='.$rolefilter;
 1398:           $feedurl .= '&'.$roleqry;
 1399:           $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
 1400:           $feedurl .= '&statusfilter='.$statusfilter;
 1401:           $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
 1402:           $feedurl .= '&sectionpick='.$secpick;
 1403:           $sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />';
 1404:       }
 1405:   }
 1406:   $r->print (<<ENDREDIR);
 1407: <html>
 1408: <head>
 1409: <title>Feedback sent</title>
 1410: <meta http-equiv="pragma" content="no-cache" />
 1411: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1412: </head>
 1413: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
 1414: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1415: $typestyle
 1416: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
 1417: <font color="red">$status</font>
 1418: <form name="reldt" action="$feedurl" target="loncapaclient">
 1419: $prevtag
 1420: $sorttag
 1421: $statustag
 1422: $roletag
 1423: $sectag
 1424: $userpicktag
 1425: </form>
 1426: </body>
 1427: </html>
 1428: ENDREDIR
 1429: }
 1430: 
 1431: sub no_redirect_back {
 1432:   my ($r,$feedurl) = @_;
 1433:   $r->print (<<ENDNOREDIR);
 1434: <html>
 1435: <head><title>Feedback not sent</title>
 1436: <meta http-equiv="pragma" content="no-cache" />
 1437: ENDNOREDIR
 1438: 
 1439:   if ($feedurl!~/^\/adm\/feedback/) { 
 1440:     $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
 1441:   }
 1442:   
 1443:   $r->print (<<ENDNOREDIRTWO);
 1444: </head>
 1445: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
 1446: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1447: <b>Sorry, no feedback possible on this resource  ...</b>
 1448: </body>
 1449: </html>
 1450: ENDNOREDIRTWO
 1451: }
 1452: 
 1453: sub screen_header {
 1454:     my ($feedurl) = @_;
 1455:     my $msgoptions='';
 1456:     my $discussoptions='';
 1457:     unless (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) {
 1458: 	if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
 1459: 	    $msgoptions= 
 1460: 		'<p><input type="checkbox" name="author" /> '.
 1461: 		&mt('Feedback to resource author').'</p>';
 1462: 	}
 1463: 	if (&feedback_available(1)) {
 1464: 	    $msgoptions.=
 1465: 		'<br /><input type="checkbox" name="question" /> '.
 1466: 		&mt('Question about resource content');
 1467: 	}
 1468: 	if (&feedback_available(0,1)) {
 1469: 	    $msgoptions.=
 1470: 		'<br /><input type="checkbox" name="course" /> '.
 1471: 		&mt('Question/Comment/Feedback about course content');
 1472: 	}
 1473: 	if (&feedback_available(0,0,1)) {
 1474: 	    $msgoptions.=
 1475: 		'<br /><input type="checkbox" name="policy" /> '.
 1476: 		&mt('Question/Comment/Feedback about course policy');
 1477: 	}
 1478:     }
 1479:     if ($ENV{'request.course.id'}) {
 1480: 	if (&discussion_open() &&
 1481: 	    &Apache::lonnet::allowed('pch',
 1482: 				     $ENV{'request.course.id'}.
 1483: 				     ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
 1484: 	    $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
 1485: 		($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
 1486: 		&mt('Contribution to course discussion of resource');
 1487: 	    $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
 1488: 		&mt('Anonymous contribution to course discussion of resource').
 1489: 		' <i>('.&mt('name only visible to course faculty').')</i>';
 1490:       }
 1491:     }
 1492:     if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
 1493:     if ($discussoptions) { 
 1494: 	$discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
 1495:     return $msgoptions.$discussoptions;
 1496: }
 1497: 
 1498: sub resource_output {
 1499:   my ($feedurl) = @_;
 1500:   my $usersaw=&Apache::lonnet::ssi_body($feedurl);
 1501:   $usersaw=~s/\<body[^\>]*\>//gi;
 1502:   $usersaw=~s/\<\/body\>//gi;
 1503:   $usersaw=~s/\<html\>//gi;
 1504:   $usersaw=~s/\<\/html\>//gi;
 1505:   $usersaw=~s/\<head\>//gi;
 1506:   $usersaw=~s/\<\/head\>//gi;
 1507:   $usersaw=~s/action\s*\=/would_be_action\=/gi;
 1508:   return $usersaw;
 1509: }
 1510: 
 1511: sub clear_out_html {
 1512:   my ($message,$override)=@_;
 1513:   unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
 1514:   my $cid=$ENV{'request.course.id'};
 1515:   if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
 1516:       ($override)) {
 1517:       # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 
 1518:       # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB>
 1519:       # <SUP>
 1520:       my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
 1521: 		BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
 1522:                 M=>1, SUB=>1, SUP=>1, SPAN=>1, 
 1523: 		H1=>1, H2=>1, H3=>1, H4=>1, H5=>1);
 1524: 
 1525:       $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
 1526: 	  {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\&lt;$1"}/ge;
 1527:       $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
 1528: 	  {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\&gt;"}/ge;
 1529:   } else {
 1530:       $message=~s/\</\&lt\;/g;
 1531:       $message=~s/\>/\&gt\;/g;
 1532:   }
 1533:   return $message;
 1534: }
 1535: 
 1536: sub assemble_email {
 1537:   my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
 1538:   my $email=<<"ENDEMAIL";
 1539: Refers to <a href="$feedurl">$feedurl</a>
 1540: 
 1541: $message
 1542: ENDEMAIL
 1543:     my $citations=<<"ENDCITE";
 1544: <h2>Previous attempts of student (if applicable)</h2>
 1545: $prevattempts
 1546: <br /><hr />
 1547: <h2>Original screen output (if applicable)</h2>
 1548: $usersaw
 1549: <h2>Correct Answer(s) (if applicable)</h2>
 1550: $useranswer
 1551: ENDCITE
 1552:   return ($email,$citations);
 1553: }
 1554: 
 1555: sub secapply {
 1556:     my $rec=shift;
 1557:     my $defaultflag=shift;
 1558:     $rec=~s/\s+//g;
 1559:     $rec=~s/\@/\:/g;
 1560:     my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
 1561:     if ($sections) {
 1562: 	foreach (split(/\;/,$sections)) {
 1563:             if (($_ eq $ENV{'request.course.sec'}) ||
 1564:                 ($defaultflag && ($_ eq '*'))) {
 1565:                 return $adr; 
 1566:             }
 1567:         }
 1568:     } else {
 1569:        return $rec;
 1570:     }
 1571:     return '';
 1572: }
 1573: 
 1574: sub decide_receiver {
 1575:   my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
 1576:   my $typestyle='';
 1577:   my %to=();
 1578:   if ($ENV{'form.author'}||$author) {
 1579:     $typestyle.='Submitting as Author Feedback<br>';
 1580:     $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
 1581:     $to{$2.':'.$1}=1;
 1582:   }
 1583:   if ($ENV{'form.question'}||$question) {
 1584:     $typestyle.='Submitting as Question<br>';
 1585:     foreach (split(/\,/,
 1586: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
 1587: 	     ) {
 1588: 	my $rec=&secapply($_,$defaultflag);
 1589:         if ($rec) { $to{$rec}=1; }
 1590:     } 
 1591:   }
 1592:   if ($ENV{'form.course'}||$course) {
 1593:     $typestyle.='Submitting as Comment<br />';
 1594:     foreach (split(/\,/,
 1595: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
 1596: 	     ) {
 1597: 	my $rec=&secapply($_,$defaultflag);
 1598:         if ($rec) { $to{$rec}=1; }
 1599:     } 
 1600:   }
 1601:   if ($ENV{'form.policy'}||$policy) {
 1602:     $typestyle.='Submitting as Policy Feedback<br />';
 1603:     foreach (split(/\,/,
 1604: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
 1605: 	     ) {
 1606: 	my $rec=&secapply($_,$defaultflag);
 1607:         if ($rec) { $to{$rec}=1; }
 1608:     } 
 1609:   }
 1610:   if ((scalar(%to) eq '0') && (!$defaultflag)) {
 1611:      ($typestyle,%to)=
 1612: 	 &decide_receiver($feedurl,$author,$question,$course,$policy,1);
 1613:   }
 1614:   return ($typestyle,%to);
 1615: }
 1616: 
 1617: sub feedback_available {
 1618:     my ($question,$course,$policy)=@_;
 1619:     my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
 1620:     return scalar(%to);
 1621: }
 1622: 
 1623: sub send_msg {
 1624:   my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
 1625:   my $status='';
 1626:   my $sendsomething=0;
 1627:   foreach (keys %to) {
 1628:     if ($_) {
 1629:       my $declutter=&Apache::lonnet::declutter($feedurl);
 1630:       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
 1631:                'Feedback ['.$declutter.']',$email,$citations,$feedurl,
 1632:                 $attachmenturl)=~/ok/) {
 1633: 	$status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
 1634:       } else {
 1635: 	$sendsomething++;
 1636:       }
 1637:     }
 1638:   }
 1639: 
 1640:     my %record=&Apache::lonnet::restore('_feedback');
 1641:     my ($temp)=keys %record;
 1642:     unless ($temp=~/^error\:/) {
 1643:        my %newrecord=();
 1644:        $newrecord{'resource'}=$feedurl;
 1645:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
 1646:        unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
 1647: 	   $status.='<br />'.&mt('Not registered').'<br />';
 1648:        }
 1649:     }
 1650:        
 1651:   return ($status,$sendsomething);
 1652: }
 1653: 
 1654: sub adddiscuss {
 1655:     my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
 1656:     my $status='';
 1657:     if (&discussion_open() &&
 1658: 	&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
 1659:         ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
 1660: 
 1661:     my %contrib=('message'      => $email,
 1662:                  'sendername'   => $ENV{'user.name'},
 1663:                  'senderdomain' => $ENV{'user.domain'},
 1664:                  'screenname'   => $ENV{'environment.screenname'},
 1665:                  'plainname'    => $ENV{'environment.firstname'}.' '.
 1666: 		                   $ENV{'environment.middlename'}.' '.
 1667:                                    $ENV{'environment.lastname'}.' '.
 1668:                                    $ENV{'enrironment.generation'},
 1669:                  'attachmenturl'=> $attachmenturl,
 1670:                  'subject'      => $subject);
 1671:     if ($ENV{'form.replydisc'}) {
 1672: 	$contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
 1673:     }
 1674:     if ($anon) {
 1675: 	$contrib{'anonymous'}='true';
 1676:     }
 1677:     if (($symb) && ($email)) {
 1678:         if ($ENV{'form.editdisc'}) {
 1679:             my %newcontrib = ();
 1680:             $contrib{'ip'}=$ENV{'REMOTE_ADDR'};
 1681:             $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'};
 1682:             $contrib{'timestamp'} = time;
 1683:             $contrib{'history'} = '';
 1684:             my $numoldver = 0;
 1685:             my ($oldsymb,$oldidx)=split(/\:\:\:/,$ENV{'form.editdisc'});
 1686: # get timestamp for last post and history
 1687:             my %oldcontrib=&Apache::lonnet::restore($oldsymb,$ENV{'request.course.id'},
 1688:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1689:                      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1690:             if (defined($oldcontrib{$oldidx.':replyto'})) {
 1691:                 $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'};
 1692:             }
 1693:             if (defined($oldcontrib{$oldidx.':history'})) {
 1694:                 if ($oldcontrib{$oldidx.':history'} =~ /:/) {
 1695:                     my @oldversions = split/:/,$oldcontrib{$oldidx.':history'};
 1696:                     $numoldver = @oldversions;
 1697:                 } else {
 1698:                     $numoldver = 1;
 1699:                 }
 1700:                 $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':';
 1701:             }
 1702:             if (defined($oldcontrib{$oldidx.':subject'})) {
 1703:                 $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.'::::'.$numoldver.'::::'.$contrib{'subject'};            
 1704:             } 
 1705:             if (defined($oldcontrib{$oldidx.':message'})) {
 1706:                 $contrib{'message'} = $oldcontrib{$oldidx.':message'}.'::::'.$numoldver.'::::'.$contrib{'message'};
 1707:             }
 1708:             $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'};
 1709:             foreach (keys %contrib) {
 1710:                 my $key = $oldidx.':'.&Apache::lonnet::escape($oldsymb).':'.$_;                                                                               
 1711:                 $newcontrib{$key} = $contrib{$_};
 1712:             }
 1713:             my $put_reply = &Apache::lonnet::putstore($ENV{'request.course.id'},
 1714:                   \%newcontrib,
 1715:                   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1716:                   $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1717:             $status='Editing class discussion'.($anon?' (anonymous)':'');
 1718:         } else {
 1719:            $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
 1720:            &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
 1721:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1722: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1723:         }
 1724:         my %storenewentry=($symb => time);
 1725:         $status.='<br />'.&mt('Updating discussion time').': '.
 1726:         &Apache::lonnet::put('discussiontimes',\%storenewentry,
 1727:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1728: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1729:     }
 1730:     my %record=&Apache::lonnet::restore('_discussion');
 1731:     my ($temp)=keys %record;
 1732:     unless ($temp=~/^error\:/) {
 1733:        my %newrecord=();
 1734:        $newrecord{'resource'}=$symb;
 1735:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
 1736:        $status.='<br />'.&mt('Registering').': '.
 1737:                &Apache::lonnet::cstore(\%newrecord,'_discussion');
 1738:     }
 1739:     } else {
 1740: 	$status.='Failed.';
 1741:     }
 1742:     return $status.'<br />';   
 1743: }
 1744: 
 1745: # ----------------------------------------------------------- Preview function
 1746: 
 1747: sub show_preview {
 1748:     my $r=shift;
 1749:     my $message=&clear_out_html($ENV{'form.comment'});
 1750:     $message=~s/\n/\<br \/\>/g;
 1751:     $message=&Apache::lontexconvert::msgtexconverted($message);
 1752:     my $subject=&clear_out_html($ENV{'form.subject'});
 1753:     $subject=~s/\n/\<br \/\>/g;
 1754:     $subject=&Apache::lontexconvert::msgtexconverted($subject);
 1755:     $r->print('<table border="2"><tr><td>'.
 1756:        '<b>Subject:</b> '.$subject.'<br /><br />'.
 1757:        $message.'</td></tr></table>');
 1758: }
 1759: 
 1760: sub generate_preview_button {
 1761:     my $pre=&mt("Show Preview");
 1762:     return(<<ENDPREVIEW);
 1763: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
 1764: <input type="hidden" name="subject">
 1765: <input type="hidden" name="comment" />
 1766: <input type="button" value="$pre"
 1767: onClick="document.mailform.onsubmit();this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
 1768: </form>
 1769: ENDPREVIEW
 1770: }
 1771: 
 1772: sub handler {
 1773:   my $r = shift;
 1774:   if ($r->header_only) {
 1775:      &Apache::loncommon::content_type($r,'text/html');
 1776:      $r->send_http_header;
 1777:      return OK;
 1778:   }
 1779: 
 1780: # --------------------------- Get query string for limited number of parameters
 1781: 
 1782:   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 1783:          ['hide','unhide','deldisc','postdata','preview','replydisc','editdisc','threadedon','threadedoff','onlyunread','allposts','previous','markread','markonread','markondisp','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick']);
 1784:   if ($ENV{'form.posterlist'}) {
 1785:       &Apache::loncommon::content_type($r,'text/html');
 1786:       $r->send_http_header;
 1787:       my $symb=$ENV{'form.posterlist'};
 1788:       my $sortposts = $ENV{'form.sortposts'};
 1789:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1790:       my $previous=$ENV{'form.previous'};
 1791:       my $feedurl = &Apache::lonnet::clutter($url);
 1792:  # backward compatibility (bulletin boards used to be 'wrapped')
 1793:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1794:           $feedurl=~s|^/adm/wrapper||;
 1795:       }
 1796:       &print_showposters($r,$symb,$previous,$feedurl,$sortposts);
 1797:       return OK;
 1798:   }
 1799:   if ($ENV{'form.userpick'}) {
 1800:       &Apache::loncommon::content_type($r,'text/html');
 1801:       $r->send_http_header;
 1802:       my $symb=$ENV{'form.userpick'};
 1803:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1804:       my $previous=$ENV{'form.previous'};
 1805: # backward compatibility (bulletin boards used to be 'wrapped')
 1806:       my $ressymb=$symb;
 1807:       unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1808:           $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1809:       }
 1810:       my $sort=$ENV{'form.sortposts'};
 1811:       my @posters = ();
 1812:       if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') {
 1813:           @posters = $ENV{'form.stuinfo'};
 1814:       } else {
 1815:           $posters[0] = $ENV{'form.stuinfo'};
 1816:       }
 1817:       my $numpicks = @posters;
 1818:       if (defined($ENV{'form.userpick'})) {
 1819:           my %discinfo = ();
 1820:           $discinfo{$ressymb.'_userpick'} = join('&',@posters);
 1821:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1822:       }
 1823:       my $feedurl = &Apache::lonnet::clutter($url);
 1824:  # backward compatibility (bulletin boards used to be 'wrapped')
 1825:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1826:           $feedurl=~s|^/adm/wrapper||;
 1827:       }
 1828:       &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks);
 1829:       return OK;
 1830:   }
 1831:   if ($ENV{'form.applysort'}) {
 1832:       &Apache::loncommon::content_type($r,'text/html');
 1833:       $r->send_http_header;
 1834:       my $symb=$ENV{'form.applysort'};
 1835:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1836:       my $previous=$ENV{'form.previous'};
 1837:       my $sort = $ENV{'form.sortposts'};
 1838:       my $rolefilter = $ENV{'form.rolefilter'};
 1839:       my $statusfilter = $ENV{'form.statusfilter'};
 1840:       my $secpick = $ENV{'form.sectionpick'};
 1841:       my $feedurl = &Apache::lonnet::clutter($url);
 1842:  # backward compatibility (bulletin boards used to be 'wrapped')
 1843:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1844:           $feedurl=~s|^/adm/wrapper||;
 1845:       }
 1846:       &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick);
 1847:       return OK;
 1848:   } elsif ($ENV{'form.sortfilter'}) {
 1849:       &Apache::loncommon::content_type($r,'text/html');
 1850:       $r->send_http_header;
 1851:       my $symb=$ENV{'form.sortfilter'};
 1852:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1853:       my $previous=$ENV{'form.previous'};
 1854:       my $feedurl = &Apache::lonnet::clutter($url);
 1855:  # backward compatibility (bulletin boards used to be 'wrapped')
 1856:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1857:           $feedurl=~s|^/adm/wrapper||;
 1858:       }
 1859:       &print_sortfilter_options($r,$symb,$previous,$feedurl);
 1860:       return OK;
 1861:   } elsif ($ENV{'form.navmaps'}) {
 1862:       my %discinfo = ();
 1863:       my @resources = ();
 1864:       if ($ENV{'form.navmaps'} =~ /:/) {
 1865:           @resources = split/:/,$ENV{'form.navmaps'};
 1866:       } else {
 1867:           @resources = ("$ENV{'form.navmaps'}");
 1868:       }
 1869:       my $numitems = @resources;
 1870:       my $feedurl = '/adm/navmaps';
 1871:       if ($ENV{'form.navurl'}) {
 1872:           $feedurl .= '?'.$ENV{'form.navurl'};
 1873:       }
 1874:       my %lt = &Apache::lonlocal::texthash(
 1875:           'mnpa' => 'Marked "New" posts as read in a total of',
 1876:           'robb' => 'resources/bulletin boards.'
 1877:       );       
 1878:       foreach (@resources) {
 1879: # backward compatibility (bulletin boards used to be 'wrapped')
 1880:           my $ressymb=$_;
 1881:           if ($ressymb =~ m/bulletin___\d+___/) {
 1882:               unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1883:                   $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
 1884:               }
 1885:           }
 1886:           my $lastkey = $ressymb.'_lastread';
 1887:           $discinfo{$lastkey} = time;
 1888:       }
 1889:       &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1890:       &Apache::loncommon::content_type($r,'text/html');
 1891:       $r->send_http_header;
 1892:       $r->print (<<ENDREDIR);
 1893: <html>
 1894: <head>
 1895: <title>New posts marked as read</title>
 1896: <meta http-equiv="pragma" content="no-cache" />
 1897: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1898: </head>
 1899: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
 1900: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1901: <b>$lt{'mnpa'} $numitems $lt{'robb'}</b>
 1902: <form name="reldt" action="$feedurl" target="loncapaclient">
 1903: </form>
 1904: </body>
 1905: </html>
 1906: ENDREDIR
 1907:       return OK;
 1908:   } elsif ($ENV{'form.modifydisp'}) {
 1909:       &Apache::loncommon::content_type($r,'text/html');
 1910:       $r->send_http_header;
 1911:       my $symb=$ENV{'form.modifydisp'};
 1912:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1913:       my $previous=$ENV{'form.previous'};
 1914:       my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'};
 1915:       my $feedurl = &Apache::lonnet::clutter($url);
 1916:  # backward compatibility (bulletin boards used to be 'wrapped')  
 1917:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1918:           $feedurl=~s|^/adm/wrapper||;
 1919:       }
 1920:       &print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl);
 1921:       return OK;
 1922:   } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
 1923:       &Apache::loncommon::content_type($r,'text/html');
 1924:       $r->send_http_header;
 1925:       my $previous=$ENV{'form.previous'};
 1926:       my ($map,$ind,$url);
 1927:       if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) {
 1928: # ---------------------- Modify setting for identification of 'NEW' posts in this discussion
 1929:           my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'};
 1930:           my $ressymb = $symb;
 1931:           ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1932:           unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1933:               $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1934:           }
 1935:           my %discinfo = ();
 1936:           my $lastkey = $ressymb.'_lastread';
 1937:           my $ondispkey = $ressymb.'_markondisp';
 1938:           if ($ENV{'form.markondisp'}) {
 1939:               $discinfo{$lastkey} = time;
 1940:               $discinfo{$ondispkey} = 1;
 1941:           } elsif ($ENV{'form.markonread'}) {
 1942:               if ( $previous > 0 ) {
 1943:                   $discinfo{$lastkey} = $previous;
 1944:               }
 1945:               $discinfo{$ondispkey} = 0;
 1946:           }
 1947:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1948:       }
 1949:       if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
 1950: # ----------------------------------------------------------------- Modify display setting for this discussion 
 1951:           my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
 1952:           my $ressymb = $symb;
 1953:           ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1954:           unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1955:               $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1956:           }
 1957:           my %discinfo = ();
 1958:           if ($ENV{'form.allposts'}) {
 1959:               $discinfo{$ressymb.'_showonlyunread'} = 0;
 1960:           } elsif ($ENV{'form.onlyunread'}) {
 1961:               $discinfo{$ressymb.'_showonlyunread'} = 1;
 1962:           }
 1963:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1964:       }
 1965:       if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
 1966:           &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous);
 1967:       } else {
 1968:           &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0');
 1969:       }
 1970:       return OK;
 1971:   } elsif ($ENV{'form.markread'}) {
 1972: # ----------------------------------------------------------------- Mark new posts as read
 1973:       &Apache::loncommon::content_type($r,'text/html');
 1974:       $r->send_http_header;
 1975:       my $symb=$ENV{'form.markread'};
 1976:       my $ressymb = $symb;
 1977:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1978:       unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1979:           $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1980:       }
 1981:       my %discinfo = ();
 1982:       my $lastkey = $ressymb.'_lastread';
 1983:       $discinfo{$lastkey} = time;
 1984:       &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1985:       &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0');
 1986:       return OK;
 1987:   } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
 1988: # ----------------------------------------------------------------- Hide/unhide
 1989:     &Apache::loncommon::content_type($r,'text/html');
 1990:     $r->send_http_header;
 1991: 
 1992:     my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
 1993: 
 1994:     my ($symb,$idx)=split(/\:\:\:/,$entry);
 1995:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1996: 
 1997:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
 1998:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1999: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2000: 
 2001:         
 2002:     my $currenthidden=$contrib{'hidden'};
 2003:     my $currentstudenthidden=$contrib{'studenthidden'};
 2004: 
 2005:     my $crs='/'.$ENV{'request.course.id'};
 2006:     if ($ENV{'request.course.sec'}) {
 2007:         $crs.='_'.$ENV{'request.course.sec'};
 2008:     }
 2009:     $crs=~s/\_/\//g;
 2010:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
 2011:     
 2012:     if ($ENV{'form.hide'}) {
 2013: 	$currenthidden.='.'.$idx.'.';
 2014:         unless ($seeid) {
 2015:             $currentstudenthidden.='.'.$idx.'.';
 2016:         }
 2017:     } else {
 2018:         $currenthidden=~s/\.$idx\.//g;
 2019:     }
 2020:     my %newhash=('hidden' => $currenthidden);
 2021:     if ( ($ENV{'form.hide'}) && (!$seeid) ) {
 2022:         $newhash{'studenthidden'} = $currentstudenthidden;
 2023:     }
 2024: 
 2025:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
 2026:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2027: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2028: 
 2029:     &redirect_back($r,&Apache::lonnet::clutter($url),
 2030:        &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
 2031:   } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
 2032:       &Apache::loncommon::content_type($r,'text/html');
 2033:       $r->send_http_header;
 2034:       if ($ENV{'form.threadedon'}) {
 2035: 	  &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
 2036: 	  &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
 2037:       } else {
 2038:  	  &Apache::lonnet::del('environment',['threadeddiscussion']);
 2039: 	  &Apache::lonnet::delenv('environment\.threadeddiscussion');
 2040:       }
 2041:       my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
 2042:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 2043:       &redirect_back($r,&Apache::lonnet::clutter($url),
 2044: 		     &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
 2045:   } elsif ($ENV{'form.deldisc'}) {
 2046: # --------------------------------------------------------------- Hide for good
 2047:     &Apache::loncommon::content_type($r,'text/html');
 2048:     $r->send_http_header;
 2049: 
 2050:     my $entry=$ENV{'form.deldisc'};
 2051: 
 2052:     my ($symb,$idx)=split(/\:\:\:/,$entry);
 2053:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 2054: 
 2055:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
 2056:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2057: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2058: 
 2059:         
 2060:     my $currentdeleted=$contrib{'deleted'};
 2061:     
 2062:     $currentdeleted.='.'.$idx.'.';
 2063: 
 2064:     my %newhash=('deleted' => $currentdeleted);
 2065: 
 2066:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
 2067:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2068: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2069: 
 2070:     &redirect_back($r,&Apache::lonnet::clutter($url),
 2071:        &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
 2072:   } elsif ($ENV{'form.preview'}) {
 2073: # -------------------------------------------------------- User wants a preview
 2074:       $r->content_type('text/html');
 2075:       $r->send_http_header;
 2076:       &show_preview($r);
 2077:   } else {
 2078: # ------------------------------------------------------------- Normal feedback
 2079:   my $feedurl=$ENV{'form.postdata'};
 2080:   $feedurl=~s/^http\:\/\///;
 2081:   $feedurl=~s/^$ENV{'SERVER_NAME'}//;
 2082:   $feedurl=~s/^$ENV{'HTTP_HOST'}//;
 2083:   $feedurl=~s/\?.+$//;
 2084: 
 2085:   my $symb;
 2086:   if ($ENV{'form.replydisc'}) {
 2087:       $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
 2088:       my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2089:       $feedurl=&Apache::lonnet::clutter($url);
 2090:   } elsif ($ENV{'form.editdisc'}) {
 2091:       $symb=(split(/\:\:\:/,$ENV{'form.editdisc'}))[0];
 2092:       my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2093:       $feedurl=&Apache::lonnet::clutter($url);
 2094:   } else {
 2095:       $symb=&Apache::lonnet::symbread($feedurl);
 2096:   }
 2097:   unless ($symb) {
 2098:       $symb=$ENV{'form.symb'};
 2099:       if ($symb) {
 2100: 	  my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2101:           $feedurl=&Apache::lonnet::clutter($url);
 2102:       }
 2103:   }
 2104:   my $goahead=1;
 2105:   if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
 2106:       unless ($symb) { $goahead=0; }
 2107:   }
 2108:   # backward compatibility (bulletin boards used to be 'wrapped')
 2109:   if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 2110:       $feedurl=~s|^/adm/wrapper||;
 2111:   }
 2112:   if ($goahead) {
 2113: # Go ahead with feedback, no ambiguous reference
 2114:     &Apache::loncommon::content_type($r,'text/html');
 2115:     $r->send_http_header;
 2116:   
 2117:     if (
 2118:       (
 2119:        ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
 2120:       ) 
 2121:       || 
 2122:       ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
 2123:       ||
 2124:       ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
 2125:      ) {
 2126: # --------------------------------------------------- Print login screen header
 2127:     unless ($ENV{'form.sendit'}) {
 2128:       my $options=&screen_header($feedurl);
 2129:       if ($options) {
 2130: 	&mail_screen($r,$feedurl,$options);
 2131:       } else {
 2132: 	&fail_redirect($r,$feedurl);
 2133:       }
 2134:     } else {
 2135:       
 2136: # Get previous user input
 2137:       my $prevattempts=&Apache::loncommon::get_previous_attempt(
 2138:             $symb,$ENV{'user.name'},$ENV{'user.domain'},
 2139:             $ENV{'request.course.id'});
 2140: 
 2141: # Get output from resource
 2142:       my $usersaw=&resource_output($feedurl);
 2143: 
 2144: # Get resource answer (need to allow student to view grades for this to work)
 2145:       &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
 2146:       my $useranswer=&Apache::loncommon::get_student_answers(
 2147:                        $symb,$ENV{'user.name'},$ENV{'user.domain'},
 2148: 		       $ENV{'request.course.id'});
 2149:       &Apache::lonnet::delenv('allowed.vgr');
 2150: # Get attachments, if any, and not too large
 2151:       my $attachmenturl='';
 2152:       if ($ENV{'form.attachment.filename'}) {
 2153: 	  unless (length($ENV{'form.attachment'})>131072) {
 2154: 	      $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback');
 2155: 	  }
 2156:       }
 2157: # Filter HTML out of message (could be nasty)
 2158:       my $message=&clear_out_html($ENV{'form.comment'});
 2159: 
 2160: # Assemble email
 2161:       my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
 2162:           $usersaw,$useranswer);
 2163:  
 2164: # Who gets this?
 2165:       my ($typestyle,%to) = &decide_receiver($feedurl);
 2166: 
 2167: # Actually send mail
 2168:       my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
 2169:           $attachmenturl,%to);
 2170: 
 2171: # Discussion? Store that.
 2172: 
 2173:       my $numpost=0;
 2174:       if ($ENV{'form.discuss'}) {
 2175:           my $subject = &clear_out_html($ENV{'form.subject'});
 2176: 	  $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
 2177: 	  $numpost++;
 2178:       }
 2179: 
 2180:       if ($ENV{'form.anondiscuss'}) {
 2181:           my $subject = &clear_out_html($ENV{'form.subject'});
 2182: 	  $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
 2183: 	  $numpost++;
 2184:       }
 2185: 
 2186: 
 2187: # Receipt screen and redirect back to where came from
 2188:       &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
 2189: 
 2190:     }
 2191:    } else {
 2192: # Unable to give feedback
 2193:     &no_redirect_back($r,$feedurl);
 2194:    }
 2195:   } else {
 2196: # Ambiguous Problem Resource
 2197:       if ( &Apache::lonnet::mod_perl_version() == 2 ) {
 2198: 	  &Apache::lonnet::cleanenv();
 2199:       }
 2200:       $r->internal_redirect('/adm/ambiguous');
 2201:   }
 2202: }
 2203:   return OK;
 2204: } 
 2205: 
 2206: 1;
 2207: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>