File:  [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.102: download - view: text, annotated - select for diffs
Thu Jul 22 23:18:01 2004 UTC (19 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Allow posters to edit/delete their own discussion postings.  Controlled by
course parameter set via PARM. Previous versions of postings are preserved.
Deleted postings are hidden. Course Coordinators etc. will be able to see
all versions of postings (interface still needed). Editing currently works for
resource discussions, but not bulletin boards (work in progress).

    1: # The LearningOnline Network
    2: # Feedback
    3: #
    4: # $Id: lonfeedback.pm,v 1.102 2004/07/22 23:18:01 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::lonfeedback;
   31: 
   32: use strict;
   33: use Apache::Constants qw(:common);
   34: use Apache::lonmsg();
   35: use Apache::loncommon();
   36: use Apache::lontexconvert();
   37: use Apache::lonlocal; # must not have ()
   38: use Apache::lonhtmlcommon();
   39: 
   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:               if ($contrib{$idx.':subject'} =~ /::::\d+::::(.+)$/si) {
  833:                   $subject = $1;
  834:               } else {
  835:                   $subject = $contrib{$idx.':subject'};
  836:               }
  837:               if (defined($contrib{$idx.':replyto'})) {
  838:                   $parentmsg = $contrib{$idx.':replyto'};
  839:               }
  840:               my $anonflag = 0;
  841:               if ($contrib{$idx.':anonymous'}) {
  842:                   $anonflag = 1;
  843:               }
  844:               $anonscript = (<<END);
  845:   function setposttype () {
  846:       var currtype = $anonflag
  847:       if (currtype == 1) {
  848:           document.mailform.elements.discuss.checked = false
  849:           document.mailform.elements.anondiscuss.checked = true
  850:       }
  851:       if (currtype == 0) {
  852:           document.mailform.elements.anondiscuss.checked = false
  853:           document.mailform.elements.discuss.checked = true
  854:       }
  855:       return
  856:   }
  857: END
  858:           }
  859:       }
  860:       if ($ENV{'form.previous'}) {
  861:           $prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
  862:       }
  863:   }
  864:   my $latexHelp=&Apache::loncommon::helpLatexCheatsheet();
  865:   my $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders();
  866:   my $onsubmit='';
  867:   if ((&Apache::lonhtmlcommon::htmlareabrowser()) &&
  868:       (!&Apache::lonhtmlcommon::htmlareablocked())) {
  869:       $onsubmit='document.mailform.onsubmit();';
  870:   }
  871:   my $send=&mt('Send');
  872:   $r->print(<<END);
  873: <html>
  874: <head>
  875: <title>The LearningOnline Network with CAPA</title>
  876: <meta http-equiv="pragma" content="no-cache"></meta>
  877: $htmlheader
  878: <script type="text/javascript">
  879: //<!--
  880:     function gosubmit() {
  881:         var rec=0;
  882:         if (typeof(document.mailform.elements.author)!="undefined") {
  883:           if (document.mailform.elements.author.checked) {
  884:              rec=1;
  885:           } 
  886:         }
  887:         if (typeof(document.mailform.elements.question)!="undefined") {
  888:           if (document.mailform.elements.question.checked) {
  889:              rec=1;
  890:           } 
  891:         }
  892:         if (typeof(document.mailform.elements.course)!="undefined") {
  893:           if (document.mailform.elements.course.checked) {
  894:              rec=1;
  895:           } 
  896:         }
  897:         if (typeof(document.mailform.elements.policy)!="undefined") {
  898:           if (document.mailform.elements.policy.checked) {
  899:              rec=1;
  900:           } 
  901:         }
  902:         if (typeof(document.mailform.elements.discuss)!="undefined") {
  903:           if (document.mailform.elements.discuss.checked) {
  904:              rec=1;
  905:           } 
  906:         }
  907:         if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
  908:           if (document.mailform.elements.anondiscuss.checked) {
  909:              rec=1;
  910:           } 
  911:         }
  912: 
  913:         if (rec) {
  914:             $onsubmit
  915: 	    document.mailform.submit();
  916:         } else {
  917:             alert('Please check a feedback type.');
  918: 	}
  919:     }
  920:     $anonscript
  921: //-->
  922: </script>
  923: </head>
  924: $bodytag
  925: <h2><tt>$title</tt></h2>
  926: <form action="/adm/feedback" method="post" name="mailform"
  927: enctype="multipart/form-data">
  928: $prevtag
  929: <input type="hidden" name="postdata" value="$feedurl" />
  930: END
  931:   if ($ENV{'form.replydisc'}) {
  932:       $r->print(<<END);
  933: <input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
  934: END
  935:   } elsif ($ENV{'form.editdisc'}) {
  936:      $r->print(<<END);
  937: <input type="hidden" name="editdisc" value ="$ENV{'form.editdisc'}" />
  938: <input type="hidden" name="parentmsg" value ="$parentmsg" />
  939: END
  940:   }
  941:   $r->print(<<ENDDOCUMENT);
  942: Please check at least one of the following feedback types:
  943: $options<hr />
  944: $quote
  945: <p>My question/comment/feedback:</p>
  946: <p>
  947: $latexHelp
  948: Title: <input type="text" name="subject" size="30" value="$subject" /></p>
  949: <p>
  950: <textarea name="comment" id="comment" cols="60" rows="10" wrap="hard">$oldmessage
  951: </textarea></p>
  952: <p>
  953: Attachment (128 KB max size): <input type="file" name="attachment" />
  954: </p>
  955: <p>
  956: <input type="hidden" name="sendit" value="1" />
  957: <input type="button" value="$send" onClick='gosubmit();' />
  958: </p>
  959: </form>
  960: ENDDOCUMENT
  961: $r->print(&generate_preview_button().
  962: &Apache::lonhtmlcommon::htmlareaselectactive('comment').
  963: '</body></html>');
  964: }
  965: 
  966: sub print_display_options {
  967:     my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_;
  968:  # backward compatibility (bulletin boards used to be 'wrapped')
  969:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
  970:         $feedurl=~s|^/adm/wrapper||;
  971:     }
  972: 
  973:     my $function = &Apache::loncommon::get_users_function();
  974:     my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
  975:                                                     $ENV{'user.domain'});
  976:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
  977:                                           '','');
  978: 
  979:     my %lt = &Apache::lonlocal::texthash(
  980:         'dido' => 'Discussion display options',
  981:         'pref' => 'Display Preference',
  982:         'curr' => 'Current setting ',
  983:         'actn' => 'Action',
  984:         'deff' => 'Default for all discussions',
  985:         'prca' => 'Preferences can be set for this discussion that determine ....',
  986:         'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and',
  987:         'unwh' => 'Under what circumstances posts are identfied as "New."',
  988:         'allposts' => 'All posts',
  989:         'unread' => 'New posts only',
  990:         'ondisp' => 'Once displayed',
  991:         'onmark' => 'Once marked as read',
  992:         'disa' => 'Posts displayed?',
  993:         'npmr' => 'New posts cease to be identified as "New"?',
  994:         'chgt' => 'Change to ',
  995:         'mkdf' => 'Set to ',
  996:         'yhni' => 'You have not indicated that you wish to change either of the discussion settings',
  997:         'ywbr' => 'You will be returned to the previous page if you click OK.'
  998:     );
  999: 
 1000:     my $dispchange = $lt{'unread'};
 1001:     my $markchange = $lt{'ondisp'};
 1002:     my $currdisp = $lt{'allposts'};
 1003:     my $currmark = $lt{'onmark'};
 1004:     my $discdisp = 'allposts';
 1005:     my $discmark = 'onmark';
 1006:                                                                                       
 1007:     if ($dispchg eq 'allposts') {
 1008:         $dispchange = $lt{'allposts'};
 1009:         $currdisp = $lt{'unread'};
 1010:         $discdisp = 'unread';
 1011:     }
 1012:                                                                                       
 1013:     if ($markchg eq 'markonread') {
 1014:         $markchange = $lt{'onmark'};
 1015:         $currmark = $lt{'ondisp'};
 1016:         $discmark = 'ondisp';
 1017:     }
 1018:     $r->print(<<END);
 1019: <html>
 1020: <head>
 1021: <title>$lt{'dido'}</title>
 1022: <meta http-equiv="pragma" content="no-cache" />
 1023: <script>
 1024: function setDisp() {
 1025:     var prev = "$previous"
 1026:     var chktotal = 0
 1027:     if (document.modifydisp.discdisp.checked == true) {
 1028:         document.modifydisp.$dispchg.value = "$symb"
 1029:         chktotal ++
 1030:     }
 1031:     if (document.modifydisp.discmark.checked == true) {
 1032:         document.modifydisp.$markchg.value = "$symb"
 1033:         chktotal ++
 1034:     }
 1035:     if (chktotal > 0) { 
 1036:         document.modifydisp.submit()
 1037:     } else {
 1038:         if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}"))      {
 1039:             if (prev > 0) {
 1040:                 location.href = "$feedurl?previous=$previous"
 1041:             } else {
 1042:                 location.href = "$feedurl"
 1043:             }
 1044:         }
 1045:     }
 1046: }
 1047: </script>
 1048: </head>
 1049: $bodytag
 1050: <form name="modifydisp" method="post" action="/adm/feedback">
 1051: $lt{'sdpf'}<br/> $lt{'prca'}  <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
 1052: <br />
 1053: <table border="0" cellpadding="0" cellspacing="0">
 1054:  <tr>
 1055:   <td width="100%" bgcolor="#000000">
 1056:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
 1057:     <tr>
 1058:      <td width="100%" bgcolor="#000000">
 1059:       <table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF">
 1060:        <tr bgcolor="$tabcolor">
 1061:         <td><b>$lt{'pref'}</b></td>
 1062:         <td><b>$lt{'curr'}</b></td>
 1063:         <td><b>$lt{'actn'}?</b></td>
 1064:        </tr>
 1065:        <tr bgcolor="#dddddd">
 1066:        <td>$lt{'disa'}</td>
 1067:        <td>$lt{$discdisp}</td>
 1068:        <td><input type="checkbox" name="discdisp" />&nbsp;$lt{'chgt'} "$dispchange"</td>
 1069:       </tr><tr bgcolor="#eeeeee">
 1070:        <td>$lt{'npmr'}</td>
 1071:        <td>$lt{$discmark}</td>
 1072:        <td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td>
 1073:       </tr>
 1074:      </table>
 1075:     </td>
 1076:    </tr>
 1077:   </table>
 1078:  </td>
 1079: </tr>
 1080: </table>
 1081: <br />
 1082: <br />
 1083: <input type="hidden" name="previous" value="$previous" />
 1084: <input type="hidden" name="$dispchg" value=""/>
 1085: <input type="hidden" name="$markchg" value=""/>
 1086: <input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" />
 1087: <br />
 1088: <br />
 1089: </form>
 1090: </body>
 1091: </html>
 1092: END
 1093:     return;
 1094: }
 1095: 
 1096: sub print_sortfilter_options {
 1097:     my ($r,$symb,$previous,$feedurl) = @_;
 1098:  # backward compatibility (bulletin boards used to be 'wrapped')
 1099:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1100:         $feedurl=~s|^/adm/wrapper||;
 1101:     }
 1102:     my @sections = ();
 1103:     my $section_sel = '';
 1104:     my $numsections = 0;
 1105:     my $numvisible = 5;
 1106:     my ($classlist) = &Apache::loncoursedata::get_classlist(
 1107:                               $ENV{'request.course.id'},
 1108:                               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1109:                               $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1110:                                                                                    
 1111:     my $sec_index = &Apache::loncoursedata::CL_SECTION();
 1112:     my $status_index = &Apache::loncoursedata::CL_STATUS();
 1113:     my %sectioncount = ();
 1114:     while (my ($student,$data) = each %$classlist) {
 1115:         my ($section,$status) = ($data->[$sec_index],
 1116:                                  $data->[$status_index]);
 1117:         unless ($section eq '' || $section =~ /^\s*$/) {
 1118:             if (!defined($sectioncount{$section})) {
 1119:                 $sectioncount{$section} = 1;
 1120:                 $numsections ++;
 1121:             } else {
 1122:                 $sectioncount{$section} ++;
 1123:             }
 1124:         }
 1125:     }
 1126:                                                                                    
 1127:     if ($ENV{'request.course.sec'} !~ /^\s*$/) {
 1128:         @sections = ($ENV{'request.course.sec'});
 1129:         $numvisible = 1;
 1130:     } else {
 1131:         @sections = sort {$a cmp $b} keys(%sectioncount);
 1132:         unshift(@sections,'all'); # Put 'all' at the front of the list
 1133:         if ($numsections < 4) {
 1134:             $numvisible = $numsections + 1;
 1135:         }
 1136:     }
 1137:     foreach (@sections) {
 1138:         $section_sel .= "  <option value=\"$_\" />$_\n";
 1139:     }
 1140:                                                                                    
 1141:     my $function = &Apache::loncommon::get_users_function();
 1142:     my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
 1143:                                                     $ENV{'user.domain'});
 1144:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
 1145:                                           '','');
 1146:     my %lt = &Apache::lonlocal::texthash(
 1147:         'diso' => 'Discussion sorting and filtering options',
 1148:         'diop' => 'Display Options',
 1149:         'curr' => 'Current setting ',
 1150:         'actn' => 'Action',
 1151:         'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
 1152:         'soor' => 'Sort order',
 1153:         'disp' => 'Specific user roles',
 1154:         'actv' => 'Specific role status',
 1155:         'spse' => 'Specific sections',
 1156:         'psub' => 'Pick specific users (by name)',
 1157:         'shal' => 'Show a list of current posters'
 1158:     );
 1159:     $r->print(<<END);
 1160: <html>
 1161: <head>
 1162: <title>$lt{'diso'}</title>
 1163: <meta http-equiv="pragma" content="no-cache" />
 1164: </head>
 1165: $bodytag
 1166: <form name="modifyshown" method="post" action="/adm/feedback">
 1167: <b>$lt{'diso'}</b><br/> $lt{'prca'}
 1168: <br /><br />
 1169: <table border="0">
 1170:  <tr>
 1171:   <td><b>$lt{'soor'}</b></td>
 1172:   <td>&nbsp;</td>
 1173:   <td><b>$lt{'disp'}</b></td>
 1174:   <td>&nbsp;</td>
 1175:   <td><b>$lt{'actv'}</b></td>
 1176:   <td>&nbsp;</td>
 1177:   <td><b>$lt{'spse'}</b></td>
 1178:   <td>&nbsp;</td>
 1179:   <td><b>$lt{'psub'}</b></td>
 1180:  </tr>
 1181:  <tr>
 1182:   <td>
 1183:    <select name="sortposts">
 1184:     <option value="ascdate" />Date order - oldest first
 1185:     <option value="descdate" />Date order - newest first
 1186:     <option value="thread" />Threaded
 1187:     <option value="subject" />By subject
 1188:     <option value="username" />By domain and username
 1189:     <option value="lastfirst" />By last name, first name
 1190:    </select>
 1191:   </td>
 1192:   <td>&nbsp;</td>
 1193:   <td>
 1194:    <select name="rolefilter" multiple="true" size="5">
 1195:     <option value="all" />All users
 1196:     <option value="st" />Students
 1197:     <option value="cc" />Course Coordinators
 1198:     <option value="in" />Instructors
 1199:     <option value="ta" />TAs
 1200:     <option value="pr" />Exam proctors
 1201:     <option value="cr" />Custom roles
 1202:    </select>
 1203:   </td>
 1204:   <td>&nbsp;</td>
 1205:   <td>
 1206:    <select name="statusfilter">
 1207:     <option value="all" />Roles of any status
 1208:     <option value="Active" />Only active roles
 1209:     <option value="Expired" />Only inactive roles
 1210:    </select>
 1211:   </td>
 1212:   <td>&nbsp;</td>
 1213:   <td>
 1214:    <select name="sectionpick" multiple="true" size="$numvisible">
 1215:     $section_sel
 1216:    </select>
 1217:   </td>
 1218:   <td>&nbsp;</td>
 1219:   <td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</td>
 1220:  </tr>
 1221: </table>
 1222: <br />
 1223: <br />
 1224: <input type="hidden" name="previous" value="$previous" />
 1225: <input type="hidden" name="applysort" value="$symb" />
 1226: <input type="button" name="sub" value="Store Changes" onClick="javascript:document.modifyshown.submit()" />
 1227: <br />
 1228: <br />
 1229: </form>
 1230: </body>
 1231: </html>
 1232: END
 1233: }
 1234: 
 1235: sub print_showposters {
 1236:     my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
 1237:  # backward compatibility (bulletin boards used to be 'wrapped')
 1238:     if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1239:         $feedurl=~s|^/adm/wrapper||;
 1240:     }
 1241: # backward compatibility (bulletin boards used to be 'wrapped')
 1242:     my $ressymb=$symb;
 1243:     if ($ressymb =~ /bulletin___\d+___/) {
 1244:         unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1245:             $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1246:         }
 1247:     }
 1248:     my $crs='/'.$ENV{'request.course.id'};
 1249:     if ($ENV{'request.course.sec'}) {
 1250:         $crs.='_'.$ENV{'request.course.sec'};
 1251:     }
 1252:     $crs=~s/\_/\//g;
 1253:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
 1254:     my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
 1255:                           $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1256:                           $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1257:     my %namesort = ();
 1258:     my %postcounts = ();
 1259:     my %lt=&Apache::lonlocal::texthash(
 1260:                      'diso' => 'Discussion filtering options',
 1261:     );
 1262:     my $bodytag=&Apache::loncommon::bodytag('Discussion options',
 1263:                                           '','');
 1264:     if ($contrib{'version'}) {
 1265:         for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
 1266:             my $hidden=($contrib{'hidden'}=~/\.$idx\./);
 1267:             my $deleted=($contrib{'deleted'}=~/\.$idx\./);
 1268:             unless ((($hidden) && (!$seeid)) || ($deleted)) {
 1269:                 if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
 1270:                     my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
 1271:                     my $lastname = $names{'lastname'};
 1272:                     my $firstname = $names{'firstname'};
 1273:                     if ($lastname eq '') {
 1274:                         $lastname = '_';
 1275:                     }
 1276:                     if ($firstname eq '') {
 1277:                         $firstname = '_';
 1278:                     }
 1279:                     unless (defined($namesort{$lastname})) {
 1280:                         %{$namesort{$lastname}} = ();
 1281:                     }
 1282:                     my $poster =  $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'};
 1283:                     $postcounts{$poster} ++;
 1284:                     if (defined($namesort{$lastname}{$firstname})) {
 1285:                         if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) {
 1286:                             push @{$namesort{$lastname}{$firstname}}, $poster;
 1287:                         }
 1288:                     } else {
 1289:                         @{$namesort{$lastname}{$firstname}} = ("$poster");
 1290:                     }
 1291:                 }
 1292:             }
 1293:         }
 1294:     }
 1295:     $r->print(<<END);
 1296: <html>
 1297: <head>
 1298: <title>$lt{'diso'}</title>
 1299: <meta http-equiv="pragma" content="no-cache" />
 1300: </head>
 1301: $bodytag
 1302:  <form name="pickpostersform" method="post">
 1303:   <table border="0">
 1304:    <tr>
 1305:     <td bgcolor="#777777">
 1306:      <table border="0" cellpadding="3">
 1307:       <tr bgcolor="#e6ffff">
 1308:        <td><b>No.</b></td>
 1309:        <td><b>Select</b></td>
 1310:        <td><b>Fullname</b><font color="#999999">(Username/domain)</font></td>
 1311:        <td><b>Posts</td>
 1312:       </tr>
 1313: END
 1314:     my $count = 0;
 1315:     foreach my $last (sort keys %namesort) {
 1316:         foreach my $first (sort keys %{$namesort{$last}}) {
 1317:             foreach (sort @{$namesort{$last}{$first}}) {
 1318:                 my ($uname,$udom) = split/:/,$_;
 1319:                 if (!$uname || !$udom) { 
 1320:                     next;
 1321:                 } else {
 1322:                     $count ++;
 1323:                     $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>');
 1324:                 }
 1325:             }
 1326:         }
 1327:     }
 1328:     $r->print(<<END);
 1329:      </table>
 1330:     </td>
 1331:    </tr>
 1332:   </table>
 1333: <br />
 1334: <input type="hidden" name="sortposts" value="$sortposts" />
 1335: <input type="hidden" name="userpick" value="$symb" />
 1336: <input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" />
 1337: </form>
 1338: </body>
 1339: </html>
 1340: END
 1341: }
 1342: 
 1343: sub fail_redirect {
 1344:   my ($r,$feedurl) = @_;
 1345:   if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
 1346:   $r->print (<<ENDFAILREDIR);
 1347: <html>
 1348: <head><title>Feedback not sent</title>
 1349: <meta http-equiv="pragma" content="no-cache" />
 1350: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1351: </head>
 1352: <body bgcolor="#FFFFFF">
 1353: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1354: <b>Sorry, no recipients  ...</b>
 1355: </body>
 1356: </html>
 1357: ENDFAILREDIR
 1358: }
 1359: 
 1360: sub redirect_back {
 1361:   my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_;
 1362:   my $sorttag = '';
 1363:   my $roletag = '';
 1364:   my $statustag = '';
 1365:   my $sectag = '';
 1366:   my $userpicktag = '';
 1367:   my $qrystr = '';
 1368:   my $prevtag = '';
 1369:  # backward compatibility (bulletin boards used to be 'wrapped')
 1370:   if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1371:       $feedurl=~s|^/adm/wrapper||;
 1372:   }
 1373:   if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
 1374:   if ($previous > 0) {
 1375:       $qrystr = 'previous='.$previous;
 1376:       if ($feedurl =~ /\?register=1/) {
 1377:           $feedurl .= '&'.$qrystr;
 1378:       } else {
 1379:           $feedurl .= '?'.$qrystr;
 1380:       }
 1381:       $prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
 1382:   }
 1383:   if (defined($sort)) {
 1384:       my $sortqry = 'sortposts='.$sort;
 1385:       if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
 1386:           $feedurl .= '&'.$sortqry;
 1387:       } else {
 1388:           $feedurl .= '?'.$sortqry;
 1389:       }
 1390:       $sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />';
 1391:       if ( (defined($numpicks)) && ($numpicks > 0) ) {
 1392:           my $userpickqry = 'totposters='.$numpicks;
 1393:           $feedurl .= '&'.$userpickqry;
 1394:           $userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
 1395:       } else {
 1396:           my $roleqry = 'rolefilter='.$rolefilter;
 1397:           $feedurl .= '&'.$roleqry;
 1398:           $roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
 1399:           $feedurl .= '&statusfilter='.$statusfilter;
 1400:           $statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
 1401:           $feedurl .= '&sectionpick='.$secpick;
 1402:           $sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />';
 1403:       }
 1404:   }
 1405:   $r->print (<<ENDREDIR);
 1406: <html>
 1407: <head>
 1408: <title>Feedback sent</title>
 1409: <meta http-equiv="pragma" content="no-cache" />
 1410: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1411: </head>
 1412: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
 1413: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1414: $typestyle
 1415: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
 1416: <font color="red">$status</font>
 1417: <form name="reldt" action="$feedurl" target="loncapaclient">
 1418: $prevtag
 1419: $sorttag
 1420: $statustag
 1421: $roletag
 1422: $sectag
 1423: $userpicktag
 1424: </form>
 1425: </body>
 1426: </html>
 1427: ENDREDIR
 1428: }
 1429: 
 1430: sub no_redirect_back {
 1431:   my ($r,$feedurl) = @_;
 1432:   $r->print (<<ENDNOREDIR);
 1433: <html>
 1434: <head><title>Feedback not sent</title>
 1435: <meta http-equiv="pragma" content="no-cache" />
 1436: ENDNOREDIR
 1437: 
 1438:   if ($feedurl!~/^\/adm\/feedback/) { 
 1439:     $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
 1440:   }
 1441:   
 1442:   $r->print (<<ENDNOREDIRTWO);
 1443: </head>
 1444: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
 1445: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1446: <b>Sorry, no feedback possible on this resource  ...</b>
 1447: </body>
 1448: </html>
 1449: ENDNOREDIRTWO
 1450: }
 1451: 
 1452: sub screen_header {
 1453:     my ($feedurl) = @_;
 1454:     my $msgoptions='';
 1455:     my $discussoptions='';
 1456:     unless (($ENV{'form.replydisc'}) || ($ENV{'form.editdisc'})) {
 1457: 	if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
 1458: 	    $msgoptions= 
 1459: 		'<p><input type="checkbox" name="author" /> '.
 1460: 		&mt('Feedback to resource author').'</p>';
 1461: 	}
 1462: 	if (&feedback_available(1)) {
 1463: 	    $msgoptions.=
 1464: 		'<br /><input type="checkbox" name="question" /> '.
 1465: 		&mt('Question about resource content');
 1466: 	}
 1467: 	if (&feedback_available(0,1)) {
 1468: 	    $msgoptions.=
 1469: 		'<br /><input type="checkbox" name="course" /> '.
 1470: 		&mt('Question/Comment/Feedback about course content');
 1471: 	}
 1472: 	if (&feedback_available(0,0,1)) {
 1473: 	    $msgoptions.=
 1474: 		'<br /><input type="checkbox" name="policy" /> '.
 1475: 		&mt('Question/Comment/Feedback about course policy');
 1476: 	}
 1477:     }
 1478:     if ($ENV{'request.course.id'}) {
 1479: 	if (&discussion_open() &&
 1480: 	    &Apache::lonnet::allowed('pch',
 1481: 				     $ENV{'request.course.id'}.
 1482: 				     ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
 1483: 	    $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
 1484: 		($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
 1485: 		&mt('Contribution to course discussion of resource');
 1486: 	    $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
 1487: 		&mt('Anonymous contribution to course discussion of resource').
 1488: 		' <i>('.&mt('name only visible to course faculty').')</i>';
 1489:       }
 1490:     }
 1491:     if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
 1492:     if ($discussoptions) { 
 1493: 	$discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
 1494:     return $msgoptions.$discussoptions;
 1495: }
 1496: 
 1497: sub resource_output {
 1498:   my ($feedurl) = @_;
 1499:   my $usersaw=&Apache::lonnet::ssi_body($feedurl);
 1500:   $usersaw=~s/\<body[^\>]*\>//gi;
 1501:   $usersaw=~s/\<\/body\>//gi;
 1502:   $usersaw=~s/\<html\>//gi;
 1503:   $usersaw=~s/\<\/html\>//gi;
 1504:   $usersaw=~s/\<head\>//gi;
 1505:   $usersaw=~s/\<\/head\>//gi;
 1506:   $usersaw=~s/action\s*\=/would_be_action\=/gi;
 1507:   return $usersaw;
 1508: }
 1509: 
 1510: sub clear_out_html {
 1511:   my ($message,$override)=@_;
 1512:   unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
 1513:   my $cid=$ENV{'request.course.id'};
 1514:   if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
 1515:       ($override)) {
 1516:       # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 
 1517:       # <BLOCKQUOTE> <DIV .*> <DIV> <IMG> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB>
 1518:       # <SUP>
 1519:       my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
 1520: 		BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
 1521:                 M=>1, SUB=>1, SUP=>1, SPAN=>1, 
 1522: 		H1=>1, H2=>1, H3=>1, H4=>1, H5=>1);
 1523: 
 1524:       $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
 1525: 	  {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\&lt;$1"}/ge;
 1526:       $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
 1527: 	  {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\&gt;"}/ge;
 1528:   } else {
 1529:       $message=~s/\</\&lt\;/g;
 1530:       $message=~s/\>/\&gt\;/g;
 1531:   }
 1532:   return $message;
 1533: }
 1534: 
 1535: sub assemble_email {
 1536:   my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
 1537:   my $email=<<"ENDEMAIL";
 1538: Refers to <a href="$feedurl">$feedurl</a>
 1539: 
 1540: $message
 1541: ENDEMAIL
 1542:     my $citations=<<"ENDCITE";
 1543: <h2>Previous attempts of student (if applicable)</h2>
 1544: $prevattempts
 1545: <br /><hr />
 1546: <h2>Original screen output (if applicable)</h2>
 1547: $usersaw
 1548: <h2>Correct Answer(s) (if applicable)</h2>
 1549: $useranswer
 1550: ENDCITE
 1551:   return ($email,$citations);
 1552: }
 1553: 
 1554: sub secapply {
 1555:     my $rec=shift;
 1556:     my $defaultflag=shift;
 1557:     $rec=~s/\s+//g;
 1558:     $rec=~s/\@/\:/g;
 1559:     my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
 1560:     if ($sections) {
 1561: 	foreach (split(/\;/,$sections)) {
 1562:             if (($_ eq $ENV{'request.course.sec'}) ||
 1563:                 ($defaultflag && ($_ eq '*'))) {
 1564:                 return $adr; 
 1565:             }
 1566:         }
 1567:     } else {
 1568:        return $rec;
 1569:     }
 1570:     return '';
 1571: }
 1572: 
 1573: sub decide_receiver {
 1574:   my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
 1575:   my $typestyle='';
 1576:   my %to=();
 1577:   if ($ENV{'form.author'}||$author) {
 1578:     $typestyle.='Submitting as Author Feedback<br>';
 1579:     $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
 1580:     $to{$2.':'.$1}=1;
 1581:   }
 1582:   if ($ENV{'form.question'}||$question) {
 1583:     $typestyle.='Submitting as Question<br>';
 1584:     foreach (split(/\,/,
 1585: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
 1586: 	     ) {
 1587: 	my $rec=&secapply($_,$defaultflag);
 1588:         if ($rec) { $to{$rec}=1; }
 1589:     } 
 1590:   }
 1591:   if ($ENV{'form.course'}||$course) {
 1592:     $typestyle.='Submitting as Comment<br />';
 1593:     foreach (split(/\,/,
 1594: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
 1595: 	     ) {
 1596: 	my $rec=&secapply($_,$defaultflag);
 1597:         if ($rec) { $to{$rec}=1; }
 1598:     } 
 1599:   }
 1600:   if ($ENV{'form.policy'}||$policy) {
 1601:     $typestyle.='Submitting as Policy Feedback<br />';
 1602:     foreach (split(/\,/,
 1603: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
 1604: 	     ) {
 1605: 	my $rec=&secapply($_,$defaultflag);
 1606:         if ($rec) { $to{$rec}=1; }
 1607:     } 
 1608:   }
 1609:   if ((scalar(%to) eq '0') && (!$defaultflag)) {
 1610:      ($typestyle,%to)=
 1611: 	 &decide_receiver($feedurl,$author,$question,$course,$policy,1);
 1612:   }
 1613:   return ($typestyle,%to);
 1614: }
 1615: 
 1616: sub feedback_available {
 1617:     my ($question,$course,$policy)=@_;
 1618:     my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
 1619:     return scalar(%to);
 1620: }
 1621: 
 1622: sub send_msg {
 1623:   my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
 1624:   my $status='';
 1625:   my $sendsomething=0;
 1626:   foreach (keys %to) {
 1627:     if ($_) {
 1628:       my $declutter=&Apache::lonnet::declutter($feedurl);
 1629:       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
 1630:                'Feedback ['.$declutter.']',$email,$citations,$feedurl,
 1631:                 $attachmenturl)=~/ok/) {
 1632: 	$status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
 1633:       } else {
 1634: 	$sendsomething++;
 1635:       }
 1636:     }
 1637:   }
 1638: 
 1639:     my %record=&Apache::lonnet::restore('_feedback');
 1640:     my ($temp)=keys %record;
 1641:     unless ($temp=~/^error\:/) {
 1642:        my %newrecord=();
 1643:        $newrecord{'resource'}=$feedurl;
 1644:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
 1645:        unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
 1646: 	   $status.='<br />'.&mt('Not registered').'<br />';
 1647:        }
 1648:     }
 1649:        
 1650:   return ($status,$sendsomething);
 1651: }
 1652: 
 1653: sub adddiscuss {
 1654:     my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
 1655:     my $status='';
 1656:     if (&discussion_open() &&
 1657: 	&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
 1658:         ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
 1659: 
 1660:     my %contrib=('message'      => $email,
 1661:                  'sendername'   => $ENV{'user.name'},
 1662:                  'senderdomain' => $ENV{'user.domain'},
 1663:                  'screenname'   => $ENV{'environment.screenname'},
 1664:                  'plainname'    => $ENV{'environment.firstname'}.' '.
 1665: 		                   $ENV{'environment.middlename'}.' '.
 1666:                                    $ENV{'environment.lastname'}.' '.
 1667:                                    $ENV{'enrironment.generation'},
 1668:                  'attachmenturl'=> $attachmenturl,
 1669:                  'subject'      => $subject);
 1670:     if ($ENV{'form.replydisc'}) {
 1671: 	$contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
 1672:     }
 1673:     if ($anon) {
 1674: 	$contrib{'anonymous'}='true';
 1675:     }
 1676:     if (($symb) && ($email)) {
 1677:         if ($ENV{'form.editdisc'}) {
 1678:             my %newcontrib = ();
 1679:             $contrib{'ip'}=$ENV{'REMOTE_ADDR'};
 1680:             $contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'};
 1681:             $contrib{'timestamp'} = time;
 1682:             $contrib{'history'} = '';
 1683:             my $numoldver = 0;
 1684:             my ($oldsymb,$oldidx)=split(/\:\:\:/,$ENV{'form.editdisc'});
 1685: # get timestamp for last post and history
 1686:             my %oldcontrib=&Apache::lonnet::restore($oldsymb,$ENV{'request.course.id'},
 1687:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1688:                      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1689:             if (defined($oldcontrib{$oldidx.':replyto'})) {
 1690:                 $contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'};
 1691:             }
 1692:             if (defined($oldcontrib{$oldidx.':history'})) {
 1693:                 if ($oldcontrib{$oldidx.':history'} =~ /:/) {
 1694:                     my @oldversions = split/:/,$oldcontrib{$oldidx.':history'};
 1695:                     $numoldver = @oldversions;
 1696:                 } else {
 1697:                     $numoldver = 1;
 1698:                 }
 1699:                 $contrib{'history'} = $oldcontrib{$oldidx.':history'}.':';
 1700:             }
 1701:             if (defined($oldcontrib{$oldidx.':subject'})) {
 1702:                 $contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.'::::'.$numoldver.'::::'.$contrib{'subject'};            
 1703:             } 
 1704:             if (defined($oldcontrib{$oldidx.':message'})) {
 1705:                 $contrib{'message'} = $oldcontrib{$oldidx.':message'}.'::::'.$numoldver.'::::'.$contrib{'message'};
 1706:             }
 1707:             $contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'};
 1708:             foreach (keys %contrib) {
 1709:                 my $key = $oldidx.':'.&Apache::lonnet::escape($oldsymb).':'.$_;                                                                               
 1710:                 $newcontrib{$key} = $contrib{$_};
 1711:             }
 1712:             my $put_reply = &Apache::lonnet::putstore($ENV{'request.course.id'},
 1713:                   \%newcontrib,
 1714:                   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1715:                   $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1716:             $status='Editing class discussion'.($anon?' (anonymous)':'');
 1717:         } else {
 1718:            $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
 1719:            &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
 1720:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1721: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1722:         }
 1723:         my %storenewentry=($symb => time);
 1724:         $status.='<br />'.&mt('Updating discussion time').': '.
 1725:         &Apache::lonnet::put('discussiontimes',\%storenewentry,
 1726:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1727: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1728:     }
 1729:     my %record=&Apache::lonnet::restore('_discussion');
 1730:     my ($temp)=keys %record;
 1731:     unless ($temp=~/^error\:/) {
 1732:        my %newrecord=();
 1733:        $newrecord{'resource'}=$symb;
 1734:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
 1735:        $status.='<br />'.&mt('Registering').': '.
 1736:                &Apache::lonnet::cstore(\%newrecord,'_discussion');
 1737:     }
 1738:     } else {
 1739: 	$status.='Failed.';
 1740:     }
 1741:     return $status.'<br />';   
 1742: }
 1743: 
 1744: # ----------------------------------------------------------- Preview function
 1745: 
 1746: sub show_preview {
 1747:     my $r=shift;
 1748:     my $message=&clear_out_html($ENV{'form.comment'});
 1749:     $message=~s/\n/\<br \/\>/g;
 1750:     $message=&Apache::lontexconvert::msgtexconverted($message);
 1751:     my $subject=&clear_out_html($ENV{'form.subject'});
 1752:     $subject=~s/\n/\<br \/\>/g;
 1753:     $subject=&Apache::lontexconvert::msgtexconverted($subject);
 1754:     $r->print('<table border="2"><tr><td>'.
 1755:        '<b>Subject:</b> '.$subject.'<br /><br />'.
 1756:        $message.'</td></tr></table>');
 1757: }
 1758: 
 1759: sub generate_preview_button {
 1760:     my $pre=&mt("Show Preview");
 1761:     return(<<ENDPREVIEW);
 1762: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
 1763: <input type="hidden" name="subject">
 1764: <input type="hidden" name="comment" />
 1765: <input type="button" value="$pre"
 1766: onClick="document.mailform.onsubmit();this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
 1767: </form>
 1768: ENDPREVIEW
 1769: }
 1770: 
 1771: sub handler {
 1772:   my $r = shift;
 1773:   if ($r->header_only) {
 1774:      &Apache::loncommon::content_type($r,'text/html');
 1775:      $r->send_http_header;
 1776:      return OK;
 1777:   }
 1778: 
 1779: # --------------------------- Get query string for limited number of parameters
 1780: 
 1781:   &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 1782:          ['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']);
 1783:   if ($ENV{'form.posterlist'}) {
 1784:       &Apache::loncommon::content_type($r,'text/html');
 1785:       $r->send_http_header;
 1786:       my $symb=$ENV{'form.posterlist'};
 1787:       my $sortposts = $ENV{'form.sortposts'};
 1788:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1789:       my $previous=$ENV{'form.previous'};
 1790:       my $feedurl = &Apache::lonnet::clutter($url);
 1791:  # backward compatibility (bulletin boards used to be 'wrapped')
 1792:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1793:           $feedurl=~s|^/adm/wrapper||;
 1794:       }
 1795:       &print_showposters($r,$symb,$previous,$feedurl,$sortposts);
 1796:       return OK;
 1797:   }
 1798:   if ($ENV{'form.userpick'}) {
 1799:       &Apache::loncommon::content_type($r,'text/html');
 1800:       $r->send_http_header;
 1801:       my $symb=$ENV{'form.userpick'};
 1802:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1803:       my $previous=$ENV{'form.previous'};
 1804: # backward compatibility (bulletin boards used to be 'wrapped')
 1805:       my $ressymb=$symb;
 1806:       unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1807:           $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1808:       }
 1809:       my $sort=$ENV{'form.sortposts'};
 1810:       my @posters = ();
 1811:       if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') {
 1812:           @posters = $ENV{'form.stuinfo'};
 1813:       } else {
 1814:           $posters[0] = $ENV{'form.stuinfo'};
 1815:       }
 1816:       my $numpicks = @posters;
 1817:       if (defined($ENV{'form.userpick'})) {
 1818:           my %discinfo = ();
 1819:           $discinfo{$ressymb.'_userpick'} = join('&',@posters);
 1820:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1821:       }
 1822:       my $feedurl = &Apache::lonnet::clutter($url);
 1823:  # backward compatibility (bulletin boards used to be 'wrapped')
 1824:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1825:           $feedurl=~s|^/adm/wrapper||;
 1826:       }
 1827:       &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks);
 1828:       return OK;
 1829:   }
 1830:   if ($ENV{'form.applysort'}) {
 1831:       &Apache::loncommon::content_type($r,'text/html');
 1832:       $r->send_http_header;
 1833:       my $symb=$ENV{'form.applysort'};
 1834:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1835:       my $previous=$ENV{'form.previous'};
 1836:       my $sort = $ENV{'form.sortposts'};
 1837:       my $rolefilter = $ENV{'form.rolefilter'};
 1838:       my $statusfilter = $ENV{'form.statusfilter'};
 1839:       my $secpick = $ENV{'form.sectionpick'};
 1840:       my $feedurl = &Apache::lonnet::clutter($url);
 1841:  # backward compatibility (bulletin boards used to be 'wrapped')
 1842:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1843:           $feedurl=~s|^/adm/wrapper||;
 1844:       }
 1845:       &redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick);
 1846:       return OK;
 1847:   } elsif ($ENV{'form.sortfilter'}) {
 1848:       &Apache::loncommon::content_type($r,'text/html');
 1849:       $r->send_http_header;
 1850:       my $symb=$ENV{'form.sortfilter'};
 1851:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1852:       my $previous=$ENV{'form.previous'};
 1853:       my $feedurl = &Apache::lonnet::clutter($url);
 1854:  # backward compatibility (bulletin boards used to be 'wrapped')
 1855:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1856:           $feedurl=~s|^/adm/wrapper||;
 1857:       }
 1858:       &print_sortfilter_options($r,$symb,$previous,$feedurl);
 1859:       return OK;
 1860:   } elsif ($ENV{'form.navmaps'}) {
 1861:       my %discinfo = ();
 1862:       my @resources = ();
 1863:       if ($ENV{'form.navmaps'} =~ /:/) {
 1864:           @resources = split/:/,$ENV{'form.navmaps'};
 1865:       } else {
 1866:           @resources = ("$ENV{'form.navmaps'}");
 1867:       }
 1868:       my $numitems = @resources;
 1869:       my $feedurl = '/adm/navmaps';
 1870:       if ($ENV{'form.navurl'}) {
 1871:           $feedurl .= '?'.$ENV{'form.navurl'};
 1872:       }
 1873:       my %lt = &Apache::lonlocal::texthash(
 1874:           'mnpa' => 'Marked "New" posts as read in a total of',
 1875:           'robb' => 'resources/bulletin boards.'
 1876:       );       
 1877:       foreach (@resources) {
 1878: # backward compatibility (bulletin boards used to be 'wrapped')
 1879:           my $ressymb=$_;
 1880:           if ($ressymb =~ m/bulletin___\d+___/) {
 1881:               unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1882:                   $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
 1883:               }
 1884:           }
 1885:           my $lastkey = $ressymb.'_lastread';
 1886:           $discinfo{$lastkey} = time;
 1887:       }
 1888:       &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1889:       &Apache::loncommon::content_type($r,'text/html');
 1890:       $r->send_http_header;
 1891:       $r->print (<<ENDREDIR);
 1892: <html>
 1893: <head>
 1894: <title>New posts marked as read</title>
 1895: <meta http-equiv="pragma" content="no-cache" />
 1896: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
 1897: </head>
 1898: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
 1899: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
 1900: <b>$lt{'mnpa'} $numitems $lt{'robb'}</b>
 1901: <form name="reldt" action="$feedurl" target="loncapaclient">
 1902: </form>
 1903: </body>
 1904: </html>
 1905: ENDREDIR
 1906:       return OK;
 1907:   } elsif ($ENV{'form.modifydisp'}) {
 1908:       &Apache::loncommon::content_type($r,'text/html');
 1909:       $r->send_http_header;
 1910:       my $symb=$ENV{'form.modifydisp'};
 1911:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1912:       my $previous=$ENV{'form.previous'};
 1913:       my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'};
 1914:       my $feedurl = &Apache::lonnet::clutter($url);
 1915:  # backward compatibility (bulletin boards used to be 'wrapped')  
 1916:       if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 1917:           $feedurl=~s|^/adm/wrapper||;
 1918:       }
 1919:       &print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl);
 1920:       return OK;
 1921:   } elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
 1922:       &Apache::loncommon::content_type($r,'text/html');
 1923:       $r->send_http_header;
 1924:       my $previous=$ENV{'form.previous'};
 1925:       my ($map,$ind,$url);
 1926:       if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) {
 1927: # ---------------------- Modify setting for identification of 'NEW' posts in this discussion
 1928:           my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'};
 1929:           my $ressymb = $symb;
 1930:           ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1931:           unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1932:               $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1933:           }
 1934:           my %discinfo = ();
 1935:           my $lastkey = $ressymb.'_lastread';
 1936:           my $ondispkey = $ressymb.'_markondisp';
 1937:           if ($ENV{'form.markondisp'}) {
 1938:               $discinfo{$lastkey} = time;
 1939:               $discinfo{$ondispkey} = 1;
 1940:           } elsif ($ENV{'form.markonread'}) {
 1941:               if ( $previous > 0 ) {
 1942:                   $discinfo{$lastkey} = $previous;
 1943:               }
 1944:               $discinfo{$ondispkey} = 0;
 1945:           }
 1946:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1947:       }
 1948:       if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
 1949: # ----------------------------------------------------------------- Modify display setting for this discussion 
 1950:           my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
 1951:           my $ressymb = $symb;
 1952:           ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1953:           unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1954:               $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1955:           }
 1956:           my %discinfo = ();
 1957:           if ($ENV{'form.allposts'}) {
 1958:               $discinfo{$ressymb.'_showonlyunread'} = 0;
 1959:           } elsif ($ENV{'form.onlyunread'}) {
 1960:               $discinfo{$ressymb.'_showonlyunread'} = 1;
 1961:           }
 1962:           &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1963:       }
 1964:       if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
 1965:           &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous);
 1966:       } else {
 1967:           &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0');
 1968:       }
 1969:       return OK;
 1970:   } elsif ($ENV{'form.markread'}) {
 1971: # ----------------------------------------------------------------- Mark new posts as read
 1972:       &Apache::loncommon::content_type($r,'text/html');
 1973:       $r->send_http_header;
 1974:       my $symb=$ENV{'form.markread'};
 1975:       my $ressymb = $symb;
 1976:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1977:       unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
 1978:           $ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
 1979:       }
 1980:       my %discinfo = ();
 1981:       my $lastkey = $ressymb.'_lastread';
 1982:       $discinfo{$lastkey} = time;
 1983:       &Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
 1984:       &redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0');
 1985:       return OK;
 1986:   } elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
 1987: # ----------------------------------------------------------------- Hide/unhide
 1988:     &Apache::loncommon::content_type($r,'text/html');
 1989:     $r->send_http_header;
 1990: 
 1991:     my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
 1992: 
 1993:     my ($symb,$idx)=split(/\:\:\:/,$entry);
 1994:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 1995: 
 1996:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
 1997:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 1998: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 1999: 
 2000:         
 2001:     my $currenthidden=$contrib{'hidden'};
 2002:     my $currentstudenthidden=$contrib{'studenthidden'};
 2003: 
 2004:     my $crs='/'.$ENV{'request.course.id'};
 2005:     if ($ENV{'request.course.sec'}) {
 2006:         $crs.='_'.$ENV{'request.course.sec'};
 2007:     }
 2008:     $crs=~s/\_/\//g;
 2009:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
 2010:     
 2011:     if ($ENV{'form.hide'}) {
 2012: 	$currenthidden.='.'.$idx.'.';
 2013:         unless ($seeid) {
 2014:             $currentstudenthidden.='.'.$idx.'.';
 2015:         }
 2016:     } else {
 2017:         $currenthidden=~s/\.$idx\.//g;
 2018:     }
 2019:     my %newhash=('hidden' => $currenthidden);
 2020:     if ( ($ENV{'form.hide'}) && (!$seeid) ) {
 2021:         $newhash{'studenthidden'} = $currentstudenthidden;
 2022:     }
 2023: 
 2024:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
 2025:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2026: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2027: 
 2028:     &redirect_back($r,&Apache::lonnet::clutter($url),
 2029:        &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
 2030:   } elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
 2031:       &Apache::loncommon::content_type($r,'text/html');
 2032:       $r->send_http_header;
 2033:       if ($ENV{'form.threadedon'}) {
 2034: 	  &Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
 2035: 	  &Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
 2036:       } else {
 2037:  	  &Apache::lonnet::del('environment',['threadeddiscussion']);
 2038: 	  &Apache::lonnet::delenv('environment\.threadeddiscussion');
 2039:       }
 2040:       my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
 2041:       my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 2042:       &redirect_back($r,&Apache::lonnet::clutter($url),
 2043: 		     &mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
 2044:   } elsif ($ENV{'form.deldisc'}) {
 2045: # --------------------------------------------------------------- Hide for good
 2046:     &Apache::loncommon::content_type($r,'text/html');
 2047:     $r->send_http_header;
 2048: 
 2049:     my $entry=$ENV{'form.deldisc'};
 2050: 
 2051:     my ($symb,$idx)=split(/\:\:\:/,$entry);
 2052:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
 2053: 
 2054:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
 2055:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2056: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2057: 
 2058:         
 2059:     my $currentdeleted=$contrib{'deleted'};
 2060:     
 2061:     $currentdeleted.='.'.$idx.'.';
 2062: 
 2063:     my %newhash=('deleted' => $currentdeleted);
 2064: 
 2065:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
 2066:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
 2067: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
 2068: 
 2069:     &redirect_back($r,&Apache::lonnet::clutter($url),
 2070:        &mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
 2071:   } elsif ($ENV{'form.preview'}) {
 2072: # -------------------------------------------------------- User wants a preview
 2073:       $r->content_type('text/html');
 2074:       $r->send_http_header;
 2075:       &show_preview($r);
 2076:   } else {
 2077: # ------------------------------------------------------------- Normal feedback
 2078:   my $feedurl=$ENV{'form.postdata'};
 2079:   $feedurl=~s/^http\:\/\///;
 2080:   $feedurl=~s/^$ENV{'SERVER_NAME'}//;
 2081:   $feedurl=~s/^$ENV{'HTTP_HOST'}//;
 2082:   $feedurl=~s/\?.+$//;
 2083: 
 2084:   my $symb;
 2085:   if ($ENV{'form.replydisc'}) {
 2086:       $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
 2087:       my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2088:       $feedurl=&Apache::lonnet::clutter($url);
 2089:   } elsif ($ENV{'form.editdisc'}) {
 2090:       $symb=(split(/\:\:\:/,$ENV{'form.editdisc'}))[0];
 2091:       my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2092:       $feedurl=&Apache::lonnet::clutter($url);
 2093:   } else {
 2094:       $symb=&Apache::lonnet::symbread($feedurl);
 2095:   }
 2096:   unless ($symb) {
 2097:       $symb=$ENV{'form.symb'};
 2098:       if ($symb) {
 2099: 	  my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
 2100:           $feedurl=&Apache::lonnet::clutter($url);
 2101:       }
 2102:   }
 2103:   my $goahead=1;
 2104:   if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
 2105:       unless ($symb) { $goahead=0; }
 2106:   }
 2107:   # backward compatibility (bulletin boards used to be 'wrapped')
 2108:   if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
 2109:       $feedurl=~s|^/adm/wrapper||;
 2110:   }
 2111:   if ($goahead) {
 2112: # Go ahead with feedback, no ambiguous reference
 2113:     &Apache::loncommon::content_type($r,'text/html');
 2114:     $r->send_http_header;
 2115:   
 2116:     if (
 2117:       (
 2118:        ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
 2119:       ) 
 2120:       || 
 2121:       ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
 2122:       ||
 2123:       ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
 2124:      ) {
 2125: # --------------------------------------------------- Print login screen header
 2126:     unless ($ENV{'form.sendit'}) {
 2127:       my $options=&screen_header($feedurl);
 2128:       if ($options) {
 2129: 	&mail_screen($r,$feedurl,$options);
 2130:       } else {
 2131: 	&fail_redirect($r,$feedurl);
 2132:       }
 2133:     } else {
 2134:       
 2135: # Get previous user input
 2136:       my $prevattempts=&Apache::loncommon::get_previous_attempt(
 2137:             $symb,$ENV{'user.name'},$ENV{'user.domain'},
 2138:             $ENV{'request.course.id'});
 2139: 
 2140: # Get output from resource
 2141:       my $usersaw=&resource_output($feedurl);
 2142: 
 2143: # Get resource answer (need to allow student to view grades for this to work)
 2144:       &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
 2145:       my $useranswer=&Apache::loncommon::get_student_answers(
 2146:                        $symb,$ENV{'user.name'},$ENV{'user.domain'},
 2147: 		       $ENV{'request.course.id'});
 2148:       &Apache::lonnet::delenv('allowed.vgr');
 2149: # Get attachments, if any, and not too large
 2150:       my $attachmenturl='';
 2151:       if ($ENV{'form.attachment.filename'}) {
 2152: 	  unless (length($ENV{'form.attachment'})>131072) {
 2153: 	      $attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,'feedback');
 2154: 	  }
 2155:       }
 2156: # Filter HTML out of message (could be nasty)
 2157:       my $message=&clear_out_html($ENV{'form.comment'});
 2158: 
 2159: # Assemble email
 2160:       my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
 2161:           $usersaw,$useranswer);
 2162:  
 2163: # Who gets this?
 2164:       my ($typestyle,%to) = &decide_receiver($feedurl);
 2165: 
 2166: # Actually send mail
 2167:       my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
 2168:           $attachmenturl,%to);
 2169: 
 2170: # Discussion? Store that.
 2171: 
 2172:       my $numpost=0;
 2173:       if ($ENV{'form.discuss'}) {
 2174:           my $subject = &clear_out_html($ENV{'form.subject'});
 2175: 	  $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
 2176: 	  $numpost++;
 2177:       }
 2178: 
 2179:       if ($ENV{'form.anondiscuss'}) {
 2180:           my $subject = &clear_out_html($ENV{'form.subject'});
 2181: 	  $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
 2182: 	  $numpost++;
 2183:       }
 2184: 
 2185: 
 2186: # Receipt screen and redirect back to where came from
 2187:       &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
 2188: 
 2189:     }
 2190:    } else {
 2191: # Unable to give feedback
 2192:     &no_redirect_back($r,$feedurl);
 2193:    }
 2194:   } else {
 2195: # Ambiguous Problem Resource
 2196:       if ( &Apache::lonnet::mod_perl_version() == 2 ) {
 2197: 	  &Apache::lonnet::cleanenv();
 2198:       }
 2199:       $r->internal_redirect('/adm/ambiguous');
 2200:   }
 2201: }
 2202:   return OK;
 2203: } 
 2204: 
 2205: 1;
 2206: __END__

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