File:  [LON-CAPA] / loncom / interface / lonfeedback.pm
Revision 1.67: download - view: text, annotated - select for diffs
Tue Nov 4 03:32:55 2003 UTC (20 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Set up table for later display of threads.

    1: # The LearningOnline Network
    2: # Feedback
    3: #
    4: # $Id: lonfeedback.pm,v 1.67 2003/11/04 03:32:55 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: # (Internal Server Error Handler
   29: #
   30: # (Login Screen
   31: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
   32: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
   33: #
   34: # 3/1/1 Gerd Kortemeyer)
   35: #
   36: # 3/1,2/3,2/5,2/6,2/8 Gerd Kortemeyer
   37: # 2/9 Guy Albertelli
   38: # 2/10 Gerd Kortemeyer
   39: # 2/13 Guy Albertelli
   40: # 7/25 Gerd Kortemeyer
   41: # 7/26 Guy Albertelli
   42: # 7/26,8/10,10/1,11/5,11/6,12/27,12/29 Gerd Kortemeyer
   43: # YEAR=2002
   44: # 1/1,1/16 Gerd Kortemeyer
   45: #
   46: 
   47: package Apache::lonfeedback;
   48: 
   49: use strict;
   50: use Apache::Constants qw(:common);
   51: use Apache::lonmsg();
   52: use Apache::loncommon();
   53: use Apache::lontexconvert();
   54: use Apache::lonlocal;
   55: 
   56: sub list_discussion {
   57:     my ($mode,$status,$symb)=@_;
   58:     my $discussiononly=0;
   59:     if ($mode eq 'board') { $discussiononly=1; }
   60:     unless ($ENV{'request.course.id'}) { return ''; }
   61:     my $crs='/'.$ENV{'request.course.id'};
   62:     if ($ENV{'request.course.sec'}) {
   63: 	$crs.='_'.$ENV{'request.course.sec'};
   64:     }                 
   65:     $crs=~s/\_/\//g;
   66:     unless ($symb) {
   67: 	$symb=&Apache::lonnet::symbread();
   68:     }
   69:     unless ($symb) { return ''; }
   70:     my $seeid=&Apache::lonnet::allowed('rin',$crs);
   71:     my $viewgrades=&Apache::lonnet::allowed('vgr',$crs);
   72:     my %discussionitems=();
   73:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
   74: 			  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
   75: 			  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
   76:     my $visible=0;
   77:     if ($contrib{'version'}) {
   78: 	for (my $id=1;$id<=$contrib{'version'};$id++) {
   79: 	    my $idx=$id;
   80: 	    my $hidden=($contrib{'hidden'}=~/\.$idx\./);
   81: 	    my $deleted=($contrib{'deleted'}=~/\.$idx\./);
   82: 	    unless ((($hidden) && (!$seeid)) || ($deleted)) {
   83: 		$visible++;
   84: 		my $message=$contrib{$idx.':message'};
   85: 		$message=~s/\n/\<br \/\>/g;
   86: 		$message=&Apache::lontexconvert::msgtexconverted($message);
   87: 		if ($contrib{$idx.':attachmenturl'}) {
   88: 		    my ($fname,$ft)
   89:                         =($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/);
   90: 		    $message.='<p>'.&mt('Attachment').': <a href="'.
   91: 			&Apache::lonnet::tokenwrapper(
   92:                                              $contrib{$idx.':attachmenturl'}).
   93: 			'"><tt>'.$fname.'.'.$ft.'</tt></a></p>';
   94: 		}
   95: 		if ($message) {
   96: 		    if ($hidden) {
   97: 			$message='<font color="#888888">'.$message.'</font>';
   98: 		    }
   99: 		    my $screenname=&Apache::loncommon::screenname(
  100: 					    $contrib{$idx.':sendername'},
  101: 					    $contrib{$idx.':senderdomain'});
  102: 		    my $plainname=&Apache::loncommon::nickname(
  103: 					    $contrib{$idx.':sendername'},
  104: 					    $contrib{$idx.':senderdomain'});
  105: 		    
  106: 		    my $sender=&mt('Anonymous');
  107: 		    if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
  108: 			$sender=&Apache::loncommon::aboutmewrapper(
  109: 					 $plainname,
  110: 					 $contrib{$idx.':sendername'},
  111: 					 $contrib{$idx.':senderdomain'}).' ('.
  112: 					 $contrib{$idx.':sendername'}.' at '.
  113: 					 $contrib{$idx.':senderdomain'}.')';
  114: 			if ($contrib{$idx.':anonymous'}) {
  115: 			    $sender.=' ['.&mt('anonymous').'] '.
  116: 				$screenname;
  117: 			}
  118: 			if ($seeid) {
  119: 			    if ($hidden) {
  120: 				$sender.=' <a href="/adm/feedback?unhide='.
  121: 				    $symb.':::'.$idx.'">'.&mt('Make Visible').'</a>';
  122: 			    } else {
  123: 				$sender.=' <a href="/adm/feedback?hide='.
  124: 				    $symb.':::'.$idx.'">'.&mt('Hide').'</a>';
  125: 			    }                     
  126: 			    $sender.=' <a href="/adm/feedback?deldisc='.
  127: 				$symb.':::'.$idx.'">'.&mt('Delete').'</a>';
  128: 			}
  129: 			if (&Apache::lonnet::allowed('pch',
  130: 				   $ENV{'request.course.id'}.
  131: 	($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
  132: 			    $sender.=' <a href="/adm/feedback?replydisc='.
  133: 				$symb.':::'.$idx.'">'.&mt('Reply').'</a>';
  134: 			}
  135: 		    } else {
  136: 			if ($screenname) {
  137: 			    $sender='<i>'.$screenname.'</i>';
  138: 			}
  139: 		    }
  140: 		    my $vgrlink;
  141: 		    if ($viewgrades) {
  142: 			$vgrlink=&Apache::loncommon::submlink('Submissions',
  143:             $contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
  144: 		    }
  145: 		    $discussionitems{$idx}='<p><b>'.$sender.'</b> '.$vgrlink.' ('.
  146: 			localtime($contrib{$idx.':timestamp'}).
  147: 			'):<blockquote>'.$message.
  148: 			'</blockquote></p>';
  149: 	        }
  150: 	    } 
  151: 	}
  152:     }
  153:     my $discussion='';
  154:     if ($visible) {
  155: 	$discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
  156: 	foreach (sort { $a <=> $b } keys %discussionitems) {
  157: 	    $discussion.="\n<tr bgcolor='#CCCCCC'><td>".$discussionitems{$_}.
  158: 		"</td></tr>";
  159: 	}
  160:         $discussion.='</table>';
  161:     }
  162:     if ($discussiononly) {
  163: 	$discussion.=(<<ENDDISCUSS);
  164: <form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
  165: <input type="submit" name="discuss" value="Post Discussion" />
  166: <input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
  167: <input type="hidden" name="symb" value="$symb" />
  168: <input type="hidden" name="sendit" value="true" />
  169: <br />
  170: <font size="1">Note: in anonymous discussion, your name is visible only to
  171: course faculty</font><br />
  172: <textarea name="comment" cols="60" rows="10" wrap="hard"></textarea>
  173: <p>
  174: Attachment (128 KB max size): <input type="file" name="attachment" />
  175: </p>
  176: </form>
  177: ENDDISCUSS
  178:       $discussion.=&generate_preview_button();
  179:    }
  180:    return $discussion;
  181: }
  182: 
  183: sub mail_screen {
  184:   my ($r,$feedurl,$options) = @_;
  185:   my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
  186:                                           '','onLoad="window.focus();"');
  187:   my $title=&Apache::lonnet::gettitle($feedurl);
  188:   if (!$title) { $title = $feedurl; }
  189:   my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
  190:   $r->print(<<ENDDOCUMENT);
  191: <html>
  192: <head>
  193: <title>The LearningOnline Network with CAPA</title>
  194: <meta http-equiv="pragma" content="no-cache"></meta>
  195: <script type="text/javascript">
  196: //<!--
  197:     function gosubmit() {
  198:         var rec=0;
  199:         if (typeof(document.mailform.elements.author)!="undefined") {
  200:           if (document.mailform.elements.author.checked) {
  201:              rec=1;
  202:           } 
  203:         }
  204:         if (typeof(document.mailform.elements.question)!="undefined") {
  205:           if (document.mailform.elements.question.checked) {
  206:              rec=1;
  207:           } 
  208:         }
  209:         if (typeof(document.mailform.elements.course)!="undefined") {
  210:           if (document.mailform.elements.course.checked) {
  211:              rec=1;
  212:           } 
  213:         }
  214:         if (typeof(document.mailform.elements.policy)!="undefined") {
  215:           if (document.mailform.elements.policy.checked) {
  216:              rec=1;
  217:           } 
  218:         }
  219:         if (typeof(document.mailform.elements.discuss)!="undefined") {
  220:           if (document.mailform.elements.discuss.checked) {
  221:              rec=1;
  222:           } 
  223:         }
  224:         if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
  225:           if (document.mailform.elements.anondiscuss.checked) {
  226:              rec=1;
  227:           } 
  228:         }
  229: 
  230:         if (rec) {
  231: 	    document.mailform.submit();
  232:         } else {
  233:             alert('Please check a feedback type.');
  234: 	}
  235:     }
  236: //-->
  237: </script>
  238: </head>
  239: $bodytag
  240: <h2><tt>$title</tt></h2>
  241: <form action="/adm/feedback" method="post" name="mailform"
  242: enctype="multipart/form-data">
  243: <input type="hidden" name="postdata" value="$feedurl" />
  244: Please check at least one of the following feedback types:
  245: $options<hr />
  246: <p>My question/comment/feedback:</p>
  247: <p>
  248: $latexHelp
  249: <textarea name="comment" cols="60" rows="10" wrap="hard">
  250: </textarea></p>
  251: <p>
  252: Attachment (128 KB max size): <input type="file" name="attachment" />
  253: </p>
  254: <p>
  255: <input type="hidden" name="sendit" value="1" />
  256: <input type="button" value="Send Feedback" onClick='gosubmit();' />
  257: </p>
  258: </form>
  259: ENDDOCUMENT
  260: $r->print(&generate_preview_button().'</body></html>');
  261: }
  262: 
  263: sub fail_redirect {
  264:   my ($r,$feedurl) = @_;
  265:   $r->print (<<ENDFAILREDIR);
  266: <head><title>Feedback not sent</title>
  267: <meta http-equiv="pragma" content="no-cache" />
  268: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
  269: </head>
  270: <html>
  271: <body bgcolor="#FFFFFF">
  272: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
  273: <b>Sorry, no recipients  ...</b>
  274: </body>
  275: </html>
  276: ENDFAILREDIR
  277: }
  278: 
  279: sub redirect_back {
  280:   my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status) = @_;
  281:   $r->print (<<ENDREDIR);
  282: <head>
  283: <title>Feedback sent</title>
  284: <meta http-equiv="pragma" content="no-cache" />
  285: <meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl">
  286: </head>
  287: <html>
  288: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
  289: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
  290: $typestyle
  291: <b>Sent $sendsomething message(s), and $sendposts post(s).</b>
  292: <font color="red">$status</font>
  293: <form name="reldt" action="$feedurl" target="loncapaclient">
  294: </form>
  295: </body>
  296: </html>
  297: ENDREDIR
  298: }
  299: 
  300: sub no_redirect_back {
  301:   my ($r,$feedurl) = @_;
  302:   $r->print (<<ENDNOREDIR);
  303: <head><title>Feedback not sent</title>
  304: <meta http-equiv="pragma" content="no-cache" />
  305: ENDNOREDIR
  306: 
  307:   if ($feedurl!~/^\/adm\/feedback/) { 
  308:     $r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
  309:   }
  310:   
  311:   $r->print (<<ENDNOREDIRTWO);
  312: </head>
  313: <html>
  314: <body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
  315: <img align="right" src="/adm/lonIcons/lonlogos.gif" />
  316: <b>Sorry, no feedback possible on this resource  ...</b>
  317: </body>
  318: </html>
  319: ENDNOREDIRTWO
  320: }
  321: 
  322: sub screen_header {
  323:     my ($feedurl) = @_;
  324:     my $msgoptions='';
  325:     my $discussoptions='';
  326:     unless ($ENV{'form.replydisc'}) {
  327: 	if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
  328: 	    $msgoptions= 
  329: 		'<p><input type="checkbox" name="author" /> '.
  330: 		&mt('Feedback to resource author').'</p>';
  331: 	}
  332: 	if (&feedback_available(1)) {
  333: 	    $msgoptions.=
  334: 		'<br /><input type="checkbox" name="question" /> '.
  335: 		&mt('Question about resource content');
  336: 	}
  337: 	if (&feedback_available(0,1)) {
  338: 	    $msgoptions.=
  339: 		'<br /><input type="checkbox" name="course" /> '.
  340: 		&mt('Question/Comment/Feedback about course content');
  341: 	}
  342: 	if (&feedback_available(0,0,1)) {
  343: 	    $msgoptions.=
  344: 		'<br /><input type="checkbox" name="policy" /> '.
  345: 		&mt('Question/Comment/Feedback about course policy');
  346: 	}
  347:     }
  348:     if ($ENV{'request.course.id'}) {
  349: 	if (&Apache::lonnet::allowed('pch',
  350: 				     $ENV{'request.course.id'}.
  351: 				     ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
  352: 	    $discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" /> '.
  353: 		&mt('Contribution to course discussion of resource');
  354: 	    $discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
  355: 		&mt('Anonymous contribution to course discussion of resource').
  356: 		' <i>('.&mt('name only visible to course faculty').')</i>';
  357:       }
  358:     }
  359:     if ($msgoptions) { $msgoptions='<h2>'.&mt('Sending Messages').'</h2>'.$msgoptions; }
  360:     if ($discussoptions) { 
  361: 	$discussoptions='<h2>'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
  362:     return $msgoptions.$discussoptions;
  363: }
  364: 
  365: sub resource_output {
  366:   my ($feedurl) = @_;
  367:   my $usersaw=&Apache::lonnet::ssi_body($feedurl);
  368:   $usersaw=~s/\<body[^\>]*\>//gi;
  369:   $usersaw=~s/\<\/body\>//gi;
  370:   $usersaw=~s/\<html\>//gi;
  371:   $usersaw=~s/\<\/html\>//gi;
  372:   $usersaw=~s/\<head\>//gi;
  373:   $usersaw=~s/\<\/head\>//gi;
  374:   $usersaw=~s/action\s*\=/would_be_action\=/gi;
  375:   return $usersaw;
  376: }
  377: 
  378: sub clear_out_html {
  379:   my ($message,$override)=@_;
  380:   my $cid=$ENV{'request.course.id'};
  381:   if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
  382:       ($override)) {
  383:       # allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG> 
  384:       # <BLOCKQUOTE> <DIV .*> <DIV> <IMG>
  385:       my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
  386: 		BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
  387:                 M=>1);
  388: 
  389:       $message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
  390: 	  {($html{uc($2)}&&(length($1)<1000))?"\<$1":"\&lt;$1"}/ge;
  391:       $message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
  392: 	  {($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\&gt;"}/ge;
  393:   } else {
  394:       $message=~s/\</\&lt\;/g;
  395:       $message=~s/\>/\&gt\;/g;
  396:   }
  397:   return $message;
  398: }
  399: 
  400: sub assemble_email {
  401:   my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
  402:   my $email=<<"ENDEMAIL";
  403: Refers to <a href="$feedurl">$feedurl</a>
  404: 
  405: $message
  406: ENDEMAIL
  407:     my $citations=<<"ENDCITE";
  408: <h2>Previous attempts of student (if applicable)</h2>
  409: $prevattempts
  410: <br /><hr />
  411: <h2>Original screen output (if applicable)</h2>
  412: $usersaw
  413: <h2>Correct Answer(s) (if applicable)</h2>
  414: $useranswer
  415: ENDCITE
  416:   return ($email,$citations);
  417: }
  418: 
  419: sub secapply {
  420:     my $rec=shift;
  421:     my $defaultflag=shift;
  422:     $rec=~s/\s+//g;
  423:     $rec=~s/\@/\:/g;
  424:     my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
  425:     if ($sections) {
  426: 	foreach (split(/\;/,$sections)) {
  427:             if (($_ eq $ENV{'request.course.sec'}) ||
  428:                 ($defaultflag && ($_ eq '*'))) {
  429:                 return $adr; 
  430:             }
  431:         }
  432:     } else {
  433:        return $rec;
  434:     }
  435:     return '';
  436: }
  437: 
  438: sub decide_receiver {
  439:   my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
  440:   my $typestyle='';
  441:   my %to=();
  442:   if ($ENV{'form.author'}||$author) {
  443:     $typestyle.='Submitting as Author Feedback<br>';
  444:     $feedurl=~/^\/res\/(\w+)\/(\w+)\//;
  445:     $to{$2.':'.$1}=1;
  446:   }
  447:   if ($ENV{'form.question'}||$question) {
  448:     $typestyle.='Submitting as Question<br>';
  449:     foreach (split(/\,/,
  450: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
  451: 	     ) {
  452: 	my $rec=&secapply($_,$defaultflag);
  453:         if ($rec) { $to{$rec}=1; }
  454:     } 
  455:   }
  456:   if ($ENV{'form.course'}||$course) {
  457:     $typestyle.='Submitting as Comment<br />';
  458:     foreach (split(/\,/,
  459: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
  460: 	     ) {
  461: 	my $rec=&secapply($_,$defaultflag);
  462:         if ($rec) { $to{$rec}=1; }
  463:     } 
  464:   }
  465:   if ($ENV{'form.policy'}||$policy) {
  466:     $typestyle.='Submitting as Policy Feedback<br />';
  467:     foreach (split(/\,/,
  468: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
  469: 	     ) {
  470: 	my $rec=&secapply($_,$defaultflag);
  471:         if ($rec) { $to{$rec}=1; }
  472:     } 
  473:   }
  474:   if ((scalar(%to) eq '0') && (!$defaultflag)) {
  475:      ($typestyle,%to)=
  476: 	 &decide_receiver($feedurl,$author,$question,$course,$policy,1);
  477:   }
  478:   return ($typestyle,%to);
  479: }
  480: 
  481: sub feedback_available {
  482:     my ($question,$course,$policy)=@_;
  483:     my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
  484:     return scalar(%to);
  485: }
  486: 
  487: sub send_msg {
  488:   my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
  489:   my $status='';
  490:   my $sendsomething=0;
  491:   foreach (keys %to) {
  492:     if ($_) {
  493:       my $declutter=&Apache::lonnet::declutter($feedurl);
  494:       unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
  495:                'Feedback ['.$declutter.']',$email,$citations,$feedurl,
  496:                 $attachmenturl)=~/ok/) {
  497: 	$status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
  498:       } else {
  499: 	$sendsomething++;
  500:       }
  501:     }
  502:   }
  503: 
  504:     my %record=&Apache::lonnet::restore('_feedback');
  505:     my ($temp)=keys %record;
  506:     unless ($temp=~/^error\:/) {
  507:        my %newrecord=();
  508:        $newrecord{'resource'}=$feedurl;
  509:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
  510:        unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
  511: 	   $status.='<br />'.&mt('Not registered').'<br />';
  512:        }
  513:     }
  514:        
  515:   return ($status,$sendsomething);
  516: }
  517: 
  518: sub adddiscuss {
  519:     my ($symb,$email,$anon,$attachmenturl)=@_;
  520:     my $status='';
  521:     if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
  522:         ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
  523: 
  524:     my %contrib=('message'      => $email,
  525:                  'sendername'   => $ENV{'user.name'},
  526:                  'senderdomain' => $ENV{'user.domain'},
  527:                  'screenname'   => $ENV{'environment.screenname'},
  528:                  'plainname'    => $ENV{'environment.firstname'}.' '.
  529: 		                   $ENV{'environment.middlename'}.' '.
  530:                                    $ENV{'environment.lastname'}.' '.
  531:                                    $ENV{'enrironment.generation'},
  532:                  'attachmenturl'=> $attachmenturl);
  533:     if ($ENV{'form.replydisc'}) {
  534: 	$contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
  535:     }
  536:     if ($anon) {
  537: 	$contrib{'anonymous'}='true';
  538:     }
  539:     if (($symb) && ($email)) {
  540:        $status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
  541:         &Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
  542:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  543: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  544:         my %storenewentry=($symb => time);
  545:         $status.='<br />'.&mt('Updating discussion time').': '.
  546:         &Apache::lonnet::put('discussiontimes',\%storenewentry,
  547:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  548: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  549:     }
  550:     my %record=&Apache::lonnet::restore('_discussion');
  551:     my ($temp)=keys %record;
  552:     unless ($temp=~/^error\:/) {
  553:        my %newrecord=();
  554:        $newrecord{'resource'}=$symb;
  555:        $newrecord{'subnumber'}=$record{'subnumber'}+1;
  556:        $status.='<br />'.&mt('Registering').': '.
  557:                &Apache::lonnet::cstore(\%newrecord,'_discussion');
  558:     }
  559:     } else {
  560: 	$status.='Failed.';
  561:     }
  562:     return $status.'<br />';   
  563: }
  564: 
  565: # ----------------------------------------------------------- Preview function
  566: 
  567: sub show_preview {
  568:     my $r=shift;
  569:     my $message=&clear_out_html($ENV{'form.comment'});
  570:     $message=~s/\n/\<br \/\>/g;
  571:     $message=&Apache::lontexconvert::msgtexconverted($message);
  572:     $r->print('<table border="2"><tr><td>'.
  573:        $message.'</td></tr></table>');
  574: }
  575: 
  576: sub generate_preview_button {
  577:     my $pre=&mt("Show Preview");
  578:     return(<<ENDPREVIEW);
  579: <form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
  580: <input type="hidden" name="comment" />
  581: <input type="button" value="$pre"
  582: onClick="this.form.comment.value=document.mailform.comment.value;this.form.submit();" />
  583: </form>
  584: ENDPREVIEW
  585: }
  586: sub handler {
  587:   my $r = shift;
  588:   if ($r->header_only) {
  589:      $r->content_type('text/html');
  590:      $r->send_http_header;
  591:      return OK;
  592:   }
  593: 
  594: # --------------------------- Get query string for limited number of parameters
  595: 
  596:    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  597:          ['hide','unhide','deldisc','postdata','preview','replydisc']);
  598: 
  599:   if (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
  600: # ----------------------------------------------------------------- Hide/unhide
  601:     $r->content_type('text/html');
  602:     $r->send_http_header;
  603: 
  604:     my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
  605: 
  606:     my ($symb,$idx)=split(/\:\:\:/,$entry);
  607:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
  608: 
  609:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
  610:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  611: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  612: 
  613:         
  614:     my $currenthidden=$contrib{'hidden'};
  615:     
  616:     if ($ENV{'form.hide'}) {
  617: 	$currenthidden.='.'.$idx.'.';
  618:     } else {
  619:         $currenthidden=~s/\.$idx\.//g;
  620:     }
  621:     my %newhash=('hidden' => $currenthidden);
  622: 
  623:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
  624:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  625: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  626: 
  627:     &redirect_back($r,&Apache::lonnet::clutter($url),
  628:        &mt('Changed discussion status').'<br />','0','0');
  629:   } elsif ($ENV{'form.deldisc'}) {
  630: # --------------------------------------------------------------- Hide for good
  631:     $r->content_type('text/html');
  632:     $r->send_http_header;
  633: 
  634:     my $entry=$ENV{'form.deldisc'};
  635: 
  636:     my ($symb,$idx)=split(/\:\:\:/,$entry);
  637:     my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
  638: 
  639:     my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
  640:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  641: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  642: 
  643:         
  644:     my $currentdeleted=$contrib{'deleted'};
  645:     
  646:     $currentdeleted.='.'.$idx.'.';
  647: 
  648:     my %newhash=('deleted' => $currentdeleted);
  649: 
  650:     &Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
  651:                      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  652: 		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  653: 
  654:     &redirect_back($r,&Apache::lonnet::clutter($url),
  655:        &mt('Changed discussion status').'<br />','0','0');
  656:   } elsif ($ENV{'form.preview'}) {
  657: # -------------------------------------------------------- User wants a preview
  658:       &show_preview($r);
  659:   } else {
  660: # ------------------------------------------------------------- Normal feedback
  661:   my $feedurl=$ENV{'form.postdata'};
  662:   $feedurl=~s/^http\:\/\///;
  663:   $feedurl=~s/^$ENV{'SERVER_NAME'}//;
  664:   $feedurl=~s/^$ENV{'HTTP_HOST'}//;
  665:   $feedurl=~s/\?.+$//;
  666: 
  667:   my $symb;
  668:   if ($ENV{'form.replydisc'}) {
  669:       $symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
  670:       my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
  671:       $feedurl=&Apache::lonnet::clutter($url);
  672:   } else {
  673:       $symb=&Apache::lonnet::symbread($feedurl);
  674:   }
  675:   unless ($symb) {
  676:       $symb=$ENV{'form.symb'};
  677:       if ($symb) {
  678: 	  my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
  679:           $feedurl=&Apache::lonnet::clutter($url);
  680:       }
  681:   }
  682:   my $goahead=1;
  683:   if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  684:       unless ($symb) { $goahead=0; }
  685:   }
  686: 
  687:   if ($goahead) {
  688: # Go ahead with feedback, no ambiguous reference
  689:     $r->content_type('text/html');
  690:     $r->send_http_header;
  691:   
  692:     if (
  693:       (
  694:        ($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
  695:       ) 
  696:       || 
  697:       ($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
  698:       ||
  699:       ($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
  700:      ) {
  701: # --------------------------------------------------- Print login screen header
  702:     unless ($ENV{'form.sendit'}) {
  703:       my $options=&screen_header($feedurl);
  704:       if ($options) {
  705: 	&mail_screen($r,$feedurl,$options);
  706:       } else {
  707: 	&fail_redirect($r,$feedurl);
  708:       }
  709:     } else {
  710:       
  711: # Get previous user input
  712:       my $prevattempts=&Apache::loncommon::get_previous_attempt(
  713:             $symb,$ENV{'user.name'},$ENV{'user.domain'},
  714:             $ENV{'request.course.id'});
  715: 
  716: # Get output from resource
  717:       my $usersaw=&resource_output($feedurl);
  718: 
  719: # Get resource answer (need to allow student to view grades for this to work)
  720:       &Apache::lonnet::appenv(('allowed.vgr'=>'F'));
  721:       my $useranswer=&Apache::loncommon::get_student_answers(
  722:                        $symb,$ENV{'user.name'},$ENV{'user.domain'},
  723: 		       $ENV{'request.course.id'});
  724:       &Apache::lonnet::delenv('allowed.vgr');
  725: # Get attachments, if any, and not too large
  726:       my $attachmenturl='';
  727:       if ($ENV{'form.attachment.filename'}) {
  728: 	  unless (length($ENV{'form.attachment'})>131072) {
  729: 	      $attachmenturl=&Apache::lonnet::userfileupload('attachment');
  730: 	  }
  731:       }
  732: # Filter HTML out of message (could be nasty)
  733:       my $message=&clear_out_html($ENV{'form.comment'});
  734: 
  735: # Assemble email
  736:       my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
  737:           $usersaw,$useranswer);
  738:  
  739: # Who gets this?
  740:       my ($typestyle,%to) = &decide_receiver($feedurl);
  741: 
  742: # Actually send mail
  743:       my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
  744:           $attachmenturl,%to);
  745: 
  746: # Discussion? Store that.
  747: 
  748:       my $numpost=0;
  749:       if ($ENV{'form.discuss'}) {
  750: 	  $typestyle.=&adddiscuss($symb,$message,0,$attachmenturl);
  751: 	  $numpost++;
  752:       }
  753: 
  754:       if ($ENV{'form.anondiscuss'}) {
  755: 	  $typestyle.=&adddiscuss($symb,$message,1,$attachmenturl);
  756: 	  $numpost++;
  757:       }
  758: 
  759: 
  760: # Receipt screen and redirect back to where came from
  761:       &redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status);
  762: 
  763:     }
  764:    } else {
  765: # Unable to give feedback
  766:     &no_redirect_back($r,$feedurl);
  767:    }
  768:   } else {
  769: # Ambiguous Problem Resource
  770:       if ( &Apache::lonnet::mod_perl_version() == 2 ) {
  771: 	  &Apache::lonnet::cleanenv();
  772:       }
  773:       $r->internal_redirect('/adm/ambiguous');
  774:   }
  775: }
  776:   return OK;
  777: } 
  778: 
  779: 1;
  780: __END__

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