File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.80:
download - view:
text,
annotated -
select for diffs
Wed May 5 21:04:14 2004 UTC (20 years ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Posts in discussions now identified as "NEW" if posts were added since user's last visit to resource or bulletin board. "Speech bubbles" in NAVMAP also displayed for each resource or bulletin board if posts have been added since last visit.
User can set display to be all posts, or only unread posts. To support cases where there are several "NEW" posts, the time of the previous visit is passed in a query string during hide/make visible, reply or delete operations so that the differentiation of "NEW" posts is retained until the user leaves the bulletin board. This behavior does not currently apply to discussions associated with resources.
# The LearningOnline Network
# Feedback
#
# $Id: lonfeedback.pm,v 1.80 2004/05/05 21:04:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::lonfeedback;
use strict;
use Apache::Constants qw(:common);
use Apache::lonmsg();
use Apache::loncommon();
use Apache::lontexconvert();
use Apache::lonlocal;
sub list_discussion {
my ($mode,$status,$symb,$previous)=@_;
# &Apache::lonnet::logthis("status is $status");
if (!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
|| $status eq 'OPEN')) {
return '';
}
my $discussiononly=0;
if ($mode eq 'board') { $discussiononly=1; }
unless ($ENV{'request.course.id'}) { return ''; }
my $crs='/'.$ENV{'request.course.id'};
if ($ENV{'request.course.sec'}) {
$crs.='_'.$ENV{'request.course.sec'};
}
$crs=~s/\_/\//g;
unless ($symb) {
$symb=&Apache::lonnet::symbread();
}
unless ($symb) { return ''; }
# backward compatibility (bulletin boards used to be 'wrapped')
my $ressymb=$symb;
if ($mode eq 'board') {
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
}
# Get discussion display settings for this discussion
my $lastkey = $ressymb.'_lastread';
my $showkey = $ressymb.'_showonlyunread';
my $visitkey = $ressymb.'_visit';
my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey],$ENV{'user.domain'},$ENV{'user.name'});
my $showonlyunread = 0;
my $prevread = 0;
my $visit = 0;
my $newpostsflag = 0;
if ($previous > 0) {
$prevread = $previous;
} elsif (defined($dischash{$lastkey})) {
$prevread = $dischash{$lastkey};
}
if (defined($dischash{$showkey})) {
$showonlyunread = $dischash{$showkey};
}
if (defined($dischash{$visitkey})) {
$visit = $dischash{$visitkey};
}
$visit ++;
my $seeid=&Apache::lonnet::allowed('rin',$crs);
my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
&& ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
my @discussionitems=();
my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $visible=0;
my @depth=();
my @original=();
my @index=();
my @replies=();
my %alldiscussion=();
my %notshown = ();
my $maxdepth=0;
my $target='';
unless ($ENV{'browser.interface'} eq 'textual' ||
$ENV{'environment.remote'} eq 'off' ) {
$target='target="LONcom"';
}
my $now = time;
my %discinfo = ();
$discinfo{$visitkey} = $visit;
$discinfo{$lastkey} = $now;
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
if ($contrib{'version'}) {
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
my $posttime = $contrib{$idx.':timestamp'};
if ($prevread > 0 && $prevread <= $posttime) {
$newpostsflag = 1;
}
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
my $deleted=($contrib{'deleted'}=~/\.$idx\./);
my $origindex='0.';
if (($contrib{$idx.':replyto'}) && ($ENV{'environment.threadeddiscussion'})) {
# this is a follow-up message
$original[$idx]=$original[$contrib{$idx.':replyto'}];
$depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1;
$origindex=$index[$contrib{$idx.':replyto'}];
if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; }
} else {
# this is an original message
$original[$idx]=0;
$depth[$idx]=0;
}
if ($replies[$depth[$idx]]) {
$replies[$depth[$idx]]++;
} else {
$replies[$depth[$idx]]=1;
}
unless ((($hidden) && (!$seeid)) || ($deleted)) {
$visible++;
my $message=$contrib{$idx.':message'};
$message=~s/\n/\<br \/\>/g;
$message=&Apache::lontexconvert::msgtexconverted($message);
my $subject=$contrib{$idx.':subject'};
if (defined($subject)) {
$subject=~s/\n/\<br \/\>/g;
$subject=&Apache::lontexconvert::msgtexconverted($subject);
}
if ($contrib{$idx.':attachmenturl'}) {
my ($fname,$ft)
=($contrib{$idx.':attachmenturl'}=~/\/(\w+)\.(\w+)$/);
$message.='<p>'.&mt('Attachment').': <a href="'.
&Apache::lonnet::tokenwrapper(
$contrib{$idx.':attachmenturl'}).
'"><tt>'.$fname.'.'.$ft.'</tt></a></p>';
}
if ($message) {
if ($hidden) {
$message='<font color="#888888">'.$message.'</font>';
}
my $screenname=&Apache::loncommon::screenname(
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'});
my $plainname=&Apache::loncommon::nickname(
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'});
my $sender=&mt('Anonymous');
if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
$sender=&Apache::loncommon::aboutmewrapper(
$plainname,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'}).' ('.
$contrib{$idx.':sendername'}.' at '.
$contrib{$idx.':senderdomain'}.')';
if ($contrib{$idx.':anonymous'}) {
$sender.=' ['.&mt('anonymous').'] '.
$screenname;
}
if ($seeid) {
if ($hidden) {
$sender.=' <a href="/adm/feedback?unhide='.
$ressymb.':::'.$idx;
if ($newpostsflag) {
$sender .= '&previous='.$prevread;
}
$sender .= '">'.&mt('Make Visible').'</a>';
} else {
$sender.=' <a href="/adm/feedback?hide='.
$ressymb.':::'.$idx;
if ($newpostsflag) {
$sender .= '&previous='.$prevread;
}
$sender .= '">'.&mt('Hide').'</a>';
}
$sender.=' <a href="/adm/feedback?deldisc='.
$ressymb.':::'.$idx;
if ($newpostsflag) {
$sender .= '&previous='.$prevread;
}
$sender .= '">'.&mt('Delete').'</a>';
}
} else {
if ($screenname) {
$sender='<i>'.$screenname.'</i>';
}
}
if (&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
$sender.=' <a href="/adm/feedback?replydisc='.
$ressymb.':::'.$idx;
if ($newpostsflag) {
$sender .= '&previous='.$prevread;
}
$sender .= '" '.$target.'>'.&mt('Reply').'</a>';
}
my $vgrlink;
if ($viewgrades) {
$vgrlink=&Apache::loncommon::submlink('Submissions',
$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
}
#figure out at what position this needs to print
my $thisindex=$idx;
if ($ENV{'environment.threadeddiscussion'}) {
$thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
}
$alldiscussion{$thisindex}=$idx;
$index[$idx]=$thisindex;
my $spansize = 2;
if ($showonlyunread && $prevread > $posttime) {
$notshown{$idx} = 1;
} else {
$discussionitems[$idx]='<p><table border="0" width="100%"><tr>';
if ($prevread > 0 && $prevread <= $posttime) {
$discussionitems[$idx] .= '<td align="left" bgcolor="#FFFFFF"><font color="#FF0000">NEW</font></td>';
}
$discussionitems[$idx] .= '<td align ="left"> '.
'<b>'.$subject.'</b> '.
$sender.'</b> '.$vgrlink.' ('.
localtime($posttime).')</td></tr>'.
'</table><blockquote>'.$message.'</blockquote></p>';
}
}
}
}
}
my $discussion='';
if ($visible) {
# Print the discusssion
$discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
if ($visible>2) {
my $colspan=$maxdepth+1;
$discussion.='<tr><td bgcolor="DDDDBB" colspan="'.$colspan.'">'.
'<table border="0" width="100%" bgcolor="#DDDDBB"><tr><td align="left">'.
'<a href="/adm/feedback?threadedon='.$ressymb.'">'.&mt('Threaded View').'</a> '.
'<a href="/adm/feedback?threadedoff='.$ressymb.'">'.&mt('Chronological View').'</a> </td>'.
'<td align="right"><a href="/adm/feedback?';
if ($showonlyunread) {
$discussion .= 'allposts='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .='">'.&mt('Show all posts').'?';
} else {
$discussion .= 'onlyunread='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= '">'.&mt('Show only unread posts').'?';
}
$discussion .= '</a> </td></tr></table></td></tr>';
}
my $numhidden = keys %notshown;
if ($numhidden > 0) {
my $colspan = $maxdepth+1;
$discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
'<a href="/adm/feedback?allposts='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= '">'.&mt('Show all posts').'</a> '.&mt('to display').' '.
$numhidden.' '.&mt('previously viewed posts').
'<br/></td></tr>';
}
foreach (sort { $a <=> $b } keys %alldiscussion) {
unless ($notshown{$alldiscussion{$_}} eq '1') {
$discussion.="\n<tr>";
my $thisdepth=$depth[$alldiscussion{$_}];
for (1..$thisdepth) {
$discussion.='<td> </td>';
}
my $colspan=$maxdepth-$thisdepth+1;
$discussion.='<td bgcolor="#CCCCCC" colspan="'.$colspan.'">'.
$discussionitems[$alldiscussion{$_}].
'</td></tr>';
}
}
$discussion.='</table><br /><br />';
}
if ($discussiononly) {
$discussion.=(<<ENDDISCUSS);
<form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data">
<input type="submit" name="discuss" value="Post Discussion" />
<input type="submit" name="anondiscuss" value="Post Anonymous Discussion" />
<input type="hidden" name="symb" value="$ressymb" />
<input type="hidden" name="sendit" value="true" />
<br />
<font size="1">Note: in anonymous discussion, your name is visible only to
course faculty</font><br />
<b>Title:</b> <input type="text" name="subject" value="" size="30" /><br /><br />
<textarea name="comment" cols="60" rows="10" wrap="hard"></textarea>
<p>
Attachment (128 KB max size): <input type="file" name="attachment" />
</p>
</form>
ENDDISCUSS
$discussion.=&generate_preview_button();
} else {
if (&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
$discussion.='<table bgcolor="#BBBBBB"><tr><td><a href="/adm/feedback?replydisc='.
$symb.':::" '.$target.'>'.
'<img src="/adm/lonMisc/chat.gif" border="0" />'.
&mt('Post Discussion').'</a></td></tr></table>';
}
}
return $discussion;
}
sub mail_screen {
my ($r,$feedurl,$options) = @_;
my $bodytag=&Apache::loncommon::bodytag('Resource Feedback and Discussion',
'','onLoad="window.focus();"');
my $title=&Apache::lonnet::gettitle($feedurl);
if (!$title) { $title = $feedurl; }
my $quote='';
my $subject = '';
my $prevtag = '';
if ($ENV{'form.replydisc'}) {
my ($symb,$idx)=split(/\:\:\:/,$ENV{'form.replydisc'});
my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
unless (($contrib{'hidden'}=~/\.$idx\./) || ($contrib{'deleted'}=~/\.$idx\./)) {
my $message=$contrib{$idx.':message'};
$message=~s/\n/\<br \/\>/g;
$quote='<blockquote>'.&Apache::lontexconvert::msgtexconverted($message).'</blockquote>';
if ($idx > 0) {
$subject = 'Re: '.$contrib{$idx.':subject'};
}
}
if ($ENV{'form.previous'}) {
$prevtag = '<input type="hidden" name="previous" value="'.$ENV{'form.previous'}.'" />';
}
}
my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
my $send=&mt('Send');
$r->print(<<ENDDOCUMENT);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
<meta http-equiv="pragma" content="no-cache"></meta>
<script type="text/javascript">
//<!--
function gosubmit() {
var rec=0;
if (typeof(document.mailform.elements.author)!="undefined") {
if (document.mailform.elements.author.checked) {
rec=1;
}
}
if (typeof(document.mailform.elements.question)!="undefined") {
if (document.mailform.elements.question.checked) {
rec=1;
}
}
if (typeof(document.mailform.elements.course)!="undefined") {
if (document.mailform.elements.course.checked) {
rec=1;
}
}
if (typeof(document.mailform.elements.policy)!="undefined") {
if (document.mailform.elements.policy.checked) {
rec=1;
}
}
if (typeof(document.mailform.elements.discuss)!="undefined") {
if (document.mailform.elements.discuss.checked) {
rec=1;
}
}
if (typeof(document.mailform.elements.anondiscuss)!="undefined") {
if (document.mailform.elements.anondiscuss.checked) {
rec=1;
}
}
if (rec) {
document.mailform.submit();
} else {
alert('Please check a feedback type.');
}
}
//-->
</script>
</head>
$bodytag
<h2><tt>$title</tt></h2>
<form action="/adm/feedback" method="post" name="mailform"
enctype="multipart/form-data">
$prevtag
<input type="hidden" name="postdata" value="$feedurl" />
<input type="hidden" name="replydisc" value="$ENV{'form.replydisc'}" />
Please check at least one of the following feedback types:
$options<hr />
$quote
<p>My question/comment/feedback:</p>
<p>
$latexHelp
Title: <input type="text" name="subject" size="30" value="$subject" /></p>
<p>
<textarea name="comment" cols="60" rows="10" wrap="hard">
</textarea></p>
<p>
Attachment (128 KB max size): <input type="file" name="attachment" />
</p>
<p>
<input type="hidden" name="sendit" value="1" />
<input type="button" value="$send" onClick='gosubmit();' />
</p>
</form>
ENDDOCUMENT
$r->print(&generate_preview_button().'</body></html>');
}
sub fail_redirect {
my ($r,$feedurl) = @_;
if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
$r->print (<<ENDFAILREDIR);
<html>
<head><title>Feedback not sent</title>
<meta http-equiv="pragma" content="no-cache" />
<meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
</head>
<body bgcolor="#FFFFFF">
<img align="right" src="/adm/lonIcons/lonlogos.gif" />
<b>Sorry, no recipients ...</b>
</body>
</html>
ENDFAILREDIR
}
sub redirect_back {
my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$status,$previous) = @_;
my $prevtag = '';
my $qrystr = '';
if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
if ($previous > 0) {
$qrystr = 'previous='.$previous;
if ($feedurl =~ /\?register=1/) {
$feedurl .= '&'.$qrystr;
} else {
$feedurl .= '?'.$qrystr;
}
$prevtag = '<input type="hidden" name="previous" value="'.$previous.'" />';
}
$r->print (<<ENDREDIR);
<html>
<head>
<title>Feedback sent</title>
<meta http-equiv="pragma" content="no-cache" />
<meta HTTP-EQUIV="Refresh" CONTENT="2; url=$feedurl" />
</head>
<body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { this.document.reldt.submit(); self.close(); }'>
<img align="right" src="/adm/lonIcons/lonlogos.gif" />
$typestyle
<b>Sent $sendsomething message(s), and $sendposts post(s).</b>
<font color="red">$status</font>
<form name="reldt" action="$feedurl" target="loncapaclient">
$prevtag
</form>
</body>
</html>
ENDREDIR
}
sub no_redirect_back {
my ($r,$feedurl) = @_;
$r->print (<<ENDNOREDIR);
<html>
<head><title>Feedback not sent</title>
<meta http-equiv="pragma" content="no-cache" />
ENDNOREDIR
if ($feedurl!~/^\/adm\/feedback/) {
$r->print('<meta HTTP-EQUIV="Refresh" CONTENT="2; url='.$feedurl.'">');
}
$r->print (<<ENDNOREDIRTWO);
</head>
<body bgcolor="#FFFFFF" onLoad='if (window.name!="loncapaclient") { self.close(); }'>
<img align="right" src="/adm/lonIcons/lonlogos.gif" />
<b>Sorry, no feedback possible on this resource ...</b>
</body>
</html>
ENDNOREDIRTWO
}
sub screen_header {
my ($feedurl) = @_;
my $msgoptions='';
my $discussoptions='';
unless ($ENV{'form.replydisc'}) {
if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/)) {
$msgoptions=
'<p><input type="checkbox" name="author" /> '.
&mt('Feedback to resource author').'</p>';
}
if (&feedback_available(1)) {
$msgoptions.=
'<br /><input type="checkbox" name="question" /> '.
&mt('Question about resource content');
}
if (&feedback_available(0,1)) {
$msgoptions.=
'<br /><input type="checkbox" name="course" /> '.
&mt('Question/Comment/Feedback about course content');
}
if (&feedback_available(0,0,1)) {
$msgoptions.=
'<br /><input type="checkbox" name="policy" /> '.
&mt('Question/Comment/Feedback about course policy');
}
}
if ($ENV{'request.course.id'}) {
if (&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
$discussoptions='<input type="checkbox" name="discuss" onClick="this.form.anondiscuss.checked=false;" '.
($ENV{'form.replydisc'}?' checked="1"':'').' /> '.
&mt('Contribution to course discussion of resource');
$discussoptions.='<br /><input type="checkbox" name="anondiscuss" onClick="this.form.discuss.checked=false;" /> '.
&mt('Anonymous contribution to course discussion of resource').
' <i>('.&mt('name only visible to course faculty').')</i>';
}
}
if ($msgoptions) { $msgoptions='<h2><img src="/adm/lonMisc/feedback.gif" />'.&mt('Sending Messages').'</h2>'.$msgoptions; }
if ($discussoptions) {
$discussoptions='<h2><img src="/adm/lonMisc/chat.gif" />'.&mt('Discussion Contributions').'</h2>'.$discussoptions; }
return $msgoptions.$discussoptions;
}
sub resource_output {
my ($feedurl) = @_;
my $usersaw=&Apache::lonnet::ssi_body($feedurl);
$usersaw=~s/\<body[^\>]*\>//gi;
$usersaw=~s/\<\/body\>//gi;
$usersaw=~s/\<html\>//gi;
$usersaw=~s/\<\/html\>//gi;
$usersaw=~s/\<head\>//gi;
$usersaw=~s/\<\/head\>//gi;
$usersaw=~s/action\s*\=/would_be_action\=/gi;
return $usersaw;
}
sub clear_out_html {
my ($message,$override)=@_;
my $cid=$ENV{'request.course.id'};
if (($ENV{"course.$cid.allow_limited_html_in_feedback"} =~ m/yes/i) ||
($override)) {
# allows <B> <I> <P> <A> <LI> <OL> <UL> <EM> <BR> <TT> <STRONG>
# <BLOCKQUOTE> <DIV .*> <DIV> <IMG>
my %html=(B=>1, I=>1, P=>1, A=>1, LI=>1, OL=>1, UL=>1, EM=>1,
BR=>1, TT=>1, STRONG=>1, BLOCKQUOTE=>1, DIV=>1, IMG=>1,
M=>1);
$message =~ s/\<(\/?\s*(\w+)[^\>\<]*)/
{($html{uc($2)}&&(length($1)<1000))?"\<$1":"\<$1"}/ge;
$message =~ s/(\<?\s*(\w+)[^\<\>]*)\>/
{($html{uc($2)}&&(length($1)<1000))?"$1\>":"$1\>"}/ge;
} else {
$message=~s/\</\<\;/g;
$message=~s/\>/\>\;/g;
}
return $message;
}
sub assemble_email {
my ($feedurl,$message,$prevattempts,$usersaw,$useranswer)=@_;
my $email=<<"ENDEMAIL";
Refers to <a href="$feedurl">$feedurl</a>
$message
ENDEMAIL
my $citations=<<"ENDCITE";
<h2>Previous attempts of student (if applicable)</h2>
$prevattempts
<br /><hr />
<h2>Original screen output (if applicable)</h2>
$usersaw
<h2>Correct Answer(s) (if applicable)</h2>
$useranswer
ENDCITE
return ($email,$citations);
}
sub secapply {
my $rec=shift;
my $defaultflag=shift;
$rec=~s/\s+//g;
$rec=~s/\@/\:/g;
my ($adr,$sections)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
if ($sections) {
foreach (split(/\;/,$sections)) {
if (($_ eq $ENV{'request.course.sec'}) ||
($defaultflag && ($_ eq '*'))) {
return $adr;
}
}
} else {
return $rec;
}
return '';
}
sub decide_receiver {
my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
my $typestyle='';
my %to=();
if ($ENV{'form.author'}||$author) {
$typestyle.='Submitting as Author Feedback<br>';
$feedurl=~/^\/res\/(\w+)\/(\w+)\//;
$to{$2.':'.$1}=1;
}
if ($ENV{'form.question'}||$question) {
$typestyle.='Submitting as Question<br>';
foreach (split(/\,/,
$ENV{'course.'.$ENV{'request.course.id'}.'.question.email'})
) {
my $rec=&secapply($_,$defaultflag);
if ($rec) { $to{$rec}=1; }
}
}
if ($ENV{'form.course'}||$course) {
$typestyle.='Submitting as Comment<br />';
foreach (split(/\,/,
$ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'})
) {
my $rec=&secapply($_,$defaultflag);
if ($rec) { $to{$rec}=1; }
}
}
if ($ENV{'form.policy'}||$policy) {
$typestyle.='Submitting as Policy Feedback<br />';
foreach (split(/\,/,
$ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'})
) {
my $rec=&secapply($_,$defaultflag);
if ($rec) { $to{$rec}=1; }
}
}
if ((scalar(%to) eq '0') && (!$defaultflag)) {
($typestyle,%to)=
&decide_receiver($feedurl,$author,$question,$course,$policy,1);
}
return ($typestyle,%to);
}
sub feedback_available {
my ($question,$course,$policy)=@_;
my ($typestyle,%to)=&decide_receiver('',0,$question,$course,$policy);
return scalar(%to);
}
sub send_msg {
my ($feedurl,$email,$citations,$attachmenturl,%to)=@_;
my $status='';
my $sendsomething=0;
foreach (keys %to) {
if ($_) {
my $declutter=&Apache::lonnet::declutter($feedurl);
unless (&Apache::lonmsg::user_normal_msg(split(/\:/,$_),
'Feedback ['.$declutter.']',$email,$citations,$feedurl,
$attachmenturl)=~/ok/) {
$status.='<br />'.&mt('Error sending message to').' '.$_.'<br />';
} else {
$sendsomething++;
}
}
}
my %record=&Apache::lonnet::restore('_feedback');
my ($temp)=keys %record;
unless ($temp=~/^error\:/) {
my %newrecord=();
$newrecord{'resource'}=$feedurl;
$newrecord{'subnumber'}=$record{'subnumber'}+1;
unless (&Apache::lonnet::cstore(\%newrecord,'_feedback') eq 'ok') {
$status.='<br />'.&mt('Not registered').'<br />';
}
}
return ($status,$sendsomething);
}
sub adddiscuss {
my ($symb,$email,$anon,$attachmenturl,$subject)=@_;
my $status='';
if (&Apache::lonnet::allowed('pch',$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
my %contrib=('message' => $email,
'sendername' => $ENV{'user.name'},
'senderdomain' => $ENV{'user.domain'},
'screenname' => $ENV{'environment.screenname'},
'plainname' => $ENV{'environment.firstname'}.' '.
$ENV{'environment.middlename'}.' '.
$ENV{'environment.lastname'}.' '.
$ENV{'enrironment.generation'},
'attachmenturl'=> $attachmenturl,
'subject' => $subject);
if ($ENV{'form.replydisc'}) {
$contrib{'replyto'}=(split(/\:\:\:/,$ENV{'form.replydisc'}))[1];
}
if ($anon) {
$contrib{'anonymous'}='true';
}
if (($symb) && ($email)) {
$status='Adding to class discussion'.($anon?' (anonymous)':'').': '.
&Apache::lonnet::store(\%contrib,$symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my %storenewentry=($symb => time);
$status.='<br />'.&mt('Updating discussion time').': '.
&Apache::lonnet::put('discussiontimes',\%storenewentry,
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
}
my %record=&Apache::lonnet::restore('_discussion');
my ($temp)=keys %record;
unless ($temp=~/^error\:/) {
my %newrecord=();
$newrecord{'resource'}=$symb;
$newrecord{'subnumber'}=$record{'subnumber'}+1;
$status.='<br />'.&mt('Registering').': '.
&Apache::lonnet::cstore(\%newrecord,'_discussion');
}
} else {
$status.='Failed.';
}
return $status.'<br />';
}
# ----------------------------------------------------------- Preview function
sub show_preview {
my $r=shift;
my $message=&clear_out_html($ENV{'form.comment'});
$message=~s/\n/\<br \/\>/g;
$message=&Apache::lontexconvert::msgtexconverted($message);
my $subject=&clear_out_html($ENV{'form.subject'});
$subject=~s/\n/\<br \/\>/g;
$subject=&Apache::lontexconvert::msgtexconverted($subject);
$r->print('<table border="2"><tr><td>'.
'<b>Subject:</b> '.$subject.'<br /><br />'.
$message.'</td></tr></table>');
}
sub generate_preview_button {
my $pre=&mt("Show Preview");
return(<<ENDPREVIEW);
<form name="preview" action="/adm/feedback?preview=1" method="post" target="preview">
<input type="hidden" name="subject">
<input type="hidden" name="comment" />
<input type="button" value="$pre"
onClick="this.form.comment.value=document.mailform.comment.value;this.form.subject.value=document.mailform.subject.value;this.form.submit();" />
</form>
ENDPREVIEW
}
sub handler {
my $r = shift;
if ($r->header_only) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK;
}
# --------------------------- Get query string for limited number of parameters
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['hide','unhide','deldisc','postdata','preview','replydisc','threadedon','threadedoff','onlyunread','allposts','previous']);
if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
# ----------------------------------------------------------------- Modify display setting for this discussion
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my %readinghash = ();
if ($contrib{'version'}) {
if ($ENV{'form.allposts'}) {
$readinghash{$symb.'_showonlyunread'} = 0;
} elsif ($ENV{'form.onlyunread'}) {
$readinghash{$symb.'_showonlyunread'} = 1;
}
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%readinghash,$ENV{'user.domain'},$ENV{'user.name'});
}
&redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0','',$ENV{'form.previous'});
return OK;
} elsif (($ENV{'form.hide'}) || ($ENV{'form.unhide'})) {
# ----------------------------------------------------------------- Hide/unhide
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $entry=$ENV{'form.hide'}?$ENV{'form.hide'}:$ENV{'form.unhide'};
my ($symb,$idx)=split(/\:\:\:/,$entry);
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $currenthidden=$contrib{'hidden'};
if ($ENV{'form.hide'}) {
$currenthidden.='.'.$idx.'.';
} else {
$currenthidden=~s/\.$idx\.//g;
}
my %newhash=('hidden' => $currenthidden);
&Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
&redirect_back($r,&Apache::lonnet::clutter($url),
&mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
} elsif (($ENV{'form.threadedon'}) || ($ENV{'form.threadedoff'})) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if ($ENV{'form.threadedon'}) {
&Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
&Apache::lonnet::appenv('environment.threadeddiscussion' => 'on');
} else {
&Apache::lonnet::del('environment',['threadeddiscussion']);
&Apache::lonnet::delenv('environment\.threadeddiscussion');
}
my $symb=$ENV{'form.threadedon'}?$ENV{'form.threadedon'}:$ENV{'form.threadedoff'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
&redirect_back($r,&Apache::lonnet::clutter($url),
&mt('Changed discussion view mode').'<br />','0','0','',$ENV{'form.previous'});
} elsif ($ENV{'form.deldisc'}) {
# --------------------------------------------------------------- Hide for good
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $entry=$ENV{'form.deldisc'};
my ($symb,$idx)=split(/\:\:\:/,$entry);
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my %contrib=&Apache::lonnet::restore($symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $currentdeleted=$contrib{'deleted'};
$currentdeleted.='.'.$idx.'.';
my %newhash=('deleted' => $currentdeleted);
&Apache::lonnet::store(\%newhash,$symb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
&redirect_back($r,&Apache::lonnet::clutter($url),
&mt('Changed discussion status').'<br />','0','0','',$ENV{'form.previous'});
} elsif ($ENV{'form.preview'}) {
# -------------------------------------------------------- User wants a preview
$r->content_type('text/html');
$r->send_http_header;
&show_preview($r);
} else {
# ------------------------------------------------------------- Normal feedback
my $feedurl=$ENV{'form.postdata'};
$feedurl=~s/^http\:\/\///;
$feedurl=~s/^$ENV{'SERVER_NAME'}//;
$feedurl=~s/^$ENV{'HTTP_HOST'}//;
$feedurl=~s/\?.+$//;
my $symb;
if ($ENV{'form.replydisc'}) {
$symb=(split(/\:\:\:/,$ENV{'form.replydisc'}))[0];
my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
$feedurl=&Apache::lonnet::clutter($url);
} else {
$symb=&Apache::lonnet::symbread($feedurl);
}
unless ($symb) {
$symb=$ENV{'form.symb'};
if ($symb) {
my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
$feedurl=&Apache::lonnet::clutter($url);
}
}
my $goahead=1;
if ($feedurl=~/\.(problem|exam|quiz|assess|survey|form)$/) {
unless ($symb) { $goahead=0; }
}
# backward compatibility (bulltin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
if ($goahead) {
# Go ahead with feedback, no ambiguous reference
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if (
(
($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
)
||
($ENV{'request.course.id'} && ($feedurl!~m:^/adm:))
||
($ENV{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
) {
# --------------------------------------------------- Print login screen header
unless ($ENV{'form.sendit'}) {
my $options=&screen_header($feedurl);
if ($options) {
&mail_screen($r,$feedurl,$options);
} else {
&fail_redirect($r,$feedurl);
}
} else {
# Get previous user input
my $prevattempts=&Apache::loncommon::get_previous_attempt(
$symb,$ENV{'user.name'},$ENV{'user.domain'},
$ENV{'request.course.id'});
# Get output from resource
my $usersaw=&resource_output($feedurl);
# Get resource answer (need to allow student to view grades for this to work)
&Apache::lonnet::appenv(('allowed.vgr'=>'F'));
my $useranswer=&Apache::loncommon::get_student_answers(
$symb,$ENV{'user.name'},$ENV{'user.domain'},
$ENV{'request.course.id'});
&Apache::lonnet::delenv('allowed.vgr');
# Get attachments, if any, and not too large
my $attachmenturl='';
if ($ENV{'form.attachment.filename'}) {
unless (length($ENV{'form.attachment'})>131072) {
$attachmenturl=&Apache::lonnet::userfileupload('attachment');
}
}
# Filter HTML out of message (could be nasty)
my $message=&clear_out_html($ENV{'form.comment'});
# Assemble email
my ($email,$citations)=&assemble_email($feedurl,$message,$prevattempts,
$usersaw,$useranswer);
# Who gets this?
my ($typestyle,%to) = &decide_receiver($feedurl);
# Actually send mail
my ($status,$numsent)=&send_msg($feedurl,$email,$citations,
$attachmenturl,%to);
# Discussion? Store that.
my $numpost=0;
if ($ENV{'form.discuss'}) {
my $subject = &clear_out_html($ENV{'form.subject'});
$typestyle.=&adddiscuss($symb,$message,0,$attachmenturl,$subject);
$numpost++;
}
if ($ENV{'form.anondiscuss'}) {
my $subject = &clear_out_html($ENV{'form.subject'});
$typestyle.=&adddiscuss($symb,$message,1,$attachmenturl,$subject);
$numpost++;
}
# Receipt screen and redirect back to where came from
&redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$status,$ENV{'form.previous'});
}
} else {
# Unable to give feedback
&no_redirect_back($r,$feedurl);
}
} else {
# Ambiguous Problem Resource
if ( &Apache::lonnet::mod_perl_version() == 2 ) {
&Apache::lonnet::cleanenv();
}
$r->internal_redirect('/adm/ambiguous');
}
}
return OK;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonfeedback.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface