File:  [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.105: download - view: text, annotated - select for diffs
Sat Jul 24 18:13:04 2004 UTC (19 years, 11 months ago) by www
Branches: MAIN
CVS tags: HEAD
More comprehensive fix for Bug #3232 - detects presence of HTMLarea at
runtime, since HTMLarea - even if the code is sent out - can "decide" to
not load.

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

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