File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.101:
download - view:
text,
annotated -
select for diffs
Wed Jul 21 23:57:24 2004 UTC (19 years, 9 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Use filtering to control which posts are displayed. 1. Restrict display of posts to users with specific roles, status, sections OR 2. Select from list of users whoc have posted. User interface needs more work.
# The LearningOnline Network
# Feedback
#
# $Id: lonfeedback.pm,v 1.101 2004/07/21 23:57:24 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; # must not have ()
use Apache::lonhtmlcommon();
sub discussion_open {
my ($status)=@_;
if (defined($status) &&
!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
|| $status eq 'OPEN')) {
return 0;
}
my $close=&Apache::lonnet::EXT('resource.0.discussend');
if (defined($close) && $close ne '' && $close < time) {
return 0;
}
return 1;
}
sub discussion_visible {
my ($status)=@_;
if (not &discussion_open($status)) {
my $hidden=&Apache::lonnet::EXT('resource.0.discusshide');
if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) {
return 0;
}
}
return 1;
}
sub list_discussion {
my ($mode,$status,$symb)=@_;
my $outputtarget=$ENV{'form.grade_target'};
if (not &discussion_visible($status)) { return ''; }
my @bgcols = ("#cccccc","#eeeeee");
my $discussiononly=0;
if ($mode eq 'board') { $discussiononly=1; }
unless ($ENV{'request.course.id'}) { return ''; }
my $crs='/'.$ENV{'request.course.id'};
my $cid=$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 ''; }
my %usernamesort = ();
my %namesort =();
my %subjectsort = ();
# 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 $ondispkey = $ressymb.'_markondisp';
my $userpickkey = $ressymb.'_userpick';
my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'});
my %discinfo = ();
my $showonlyunread = 0;
my $markondisp = 0;
my $prevread = 0;
my $previous = 0;
my $visit = 0;
my $newpostsflag = 0;
my @posters = split/\&/,$dischash{$userpickkey};
# Retain identification of "NEW" posts identified in last display, if continuing 'previous' browsing of posts.
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']);
my $sortposts = $ENV{'form.sortposts'};
my $rolefilter = $ENV{'form.rolefilter'};
my $statusfilter = $ENV{'form.statusfilter'};
my $sectionpick = $ENV{'form.sectionpick'};
my $totposters = $ENV{'form.totposters'};
$previous = $ENV{'form.previous'};
if ($previous > 0) {
$prevread = $previous;
} elsif (defined($dischash{$lastkey})) {
unless ($dischash{$lastkey} eq '') {
$prevread = $dischash{$lastkey};
}
}
# Get information about students and non-stundents in course for filtering display of posts
my %roleshash = ();
my %roleinfo = ();
if ($rolefilter) {
%roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
foreach (keys %roleshash) {
my ($role,$uname,$udom,$sec) = split/:/,$_;
my ($end,$start) = split/:/,$roleshash{$_};
my $now = time;
my $status = 'Active';
if (($now < $start) || ($end > 0 && $now > $end)) {
$status = 'Expired';
}
push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
}
my ($classlist) = &Apache::loncoursedata::get_classlist(
$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();
while (my ($student,$data) = each %$classlist) {
my ($section,$status) = ($data->[$sec_index],
$data->[$status_index]);
push @{$roleinfo{$student}}, 'st:'.$section.':'.$status;
}
}
# Get discussion display default settings for user
my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'});
my $discdisplay=$userenv{'discdisplay'};
if ($discdisplay eq 'unread') {
$showonlyunread = 1;
}
my $discmarkread=$userenv{'discmarkread'};
if ($discmarkread eq 'ondisp') {
$markondisp = 1;
}
# Override user's default if user specified display setting for this discussion
if (defined($dischash{$ondispkey})) {
$markondisp = $dischash{$ondispkey};
}
if ($markondisp) {
$discinfo{$lastkey} = time;
}
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 %shown = ();
my @posteridentity=();
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 %newitem = ();
my $maxdepth=0;
my $target='';
unless ($ENV{'browser.interface'} eq 'textual' ||
$ENV{'environment.remote'} eq 'off' ) {
$target='target="LONcom"';
}
my $now = time;
$discinfo{$visitkey} = $visit;
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
if ($contrib{'version'}) {
my $oldest = $contrib{'1:timestamp'};
if ($prevread eq '0') {
$prevread = $oldest-1;
}
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
my $posttime = $contrib{$idx.':timestamp'};
if ($prevread <= $posttime) {
$newpostsflag = 1;
}
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
my $deleted=($contrib{'deleted'}=~/\.$idx\./);
my $origindex='0.';
if ($contrib{$idx.':replyto'}) {
if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
# 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 {
$original[$idx]=0;
$depth[$idx]=0;
}
} 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)
=($contrib{$idx.':attachmenturl'}=~m|/([^/]+)$|);
&Apache::lonnet::allowuploaded('/adm/feedback',
$contrib{$idx.':attachmenturl'});
$message.='<p>'.&mt('Attachment').
': <a href="'.$contrib{$idx.':attachmenturl'}.'"><tt>'.
$fname.'</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');
# Set up for sorting by subject
if ($contrib{$idx.':subject'} eq '') {
if (defined($subjectsort{'__No subject'})) {
push @{$subjectsort{'__No subject'}}, $idx;
} else {
@{$subjectsort{'__No subject'}} = ("$idx");
}
} else {
if (defined($subjectsort{$contrib{$idx.':subject'}})) {
push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx;
} else {
@{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx");
}
}
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;
}
# Set up for sorting by domain, then username
unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) {
%{$usernamesort{$contrib{$idx.':senderdomain'}}} = ();
}
if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) {
push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx;
} else {
@{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx");
}
# Set up for sorting by last name, then first name
my %names = &Apache::lonnet::get('environment',['firstname','lastname'],
$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
my $lastname = $names{'lastname'};
my $firstname = $names{'firstname'};
if ($lastname eq '') {
$lastname = '_';
}
if ($firstname eq '') {
$firstname = '_';
}
unless (defined($namesort{$lastname})) {
%{$namesort{$lastname}} = ();
}
if (defined($namesort{$lastname}{$firstname})) {
push @{$namesort{$lastname}{$firstname}}, $idx;
} else {
@{$namesort{$lastname}{$firstname}} = ("$idx");
}
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>';
}
# Set up for sorting by domain, then username for anonymous
unless (defined($usernamesort{'__anon'})) {
%{$usernamesort{'__anon'}} = ();
}
if (defined($usernamesort{'__anon'}{'__anon'})) {
push @{$usernamesort{'__anon'}{'__anon'}}, $idx;
} else {
@{$usernamesort{'__anon'}{'__anon'}} = ("$idx");
}
# Set up for sorting by last name, then first name for anonymous
unless (defined($namesort{'__anon'})) {
%{$namesort{'__anon'}} = ();
}
if (defined($namesort{'__anon'}{'__anon'})) {
push @{$namesort{'__anon'}{'__anon'}}, $idx;
} else {
@{$namesort{'__anon'}{'__anon'}} = ("$idx");
}
}
if (&discussion_open($status) &&
&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'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
$thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
}
$alldiscussion{$thisindex}=$idx;
$shown{$idx} = 0;
$index[$idx]=$thisindex;
my $spansize = 2;
if ($showonlyunread && $prevread > $posttime) {
$notshown{$idx} = 1;
} else {
my $uname = $contrib{$idx.':sendername'};
my $udom = $contrib{$idx.':senderdomain'};
my $poster = $uname.':'.$udom;
my $rolematch = '';
my $skiptest = 1;
if ($totposters > 0) {
if (grep/^$poster$/,@posters) {
$shown{$idx} = 1;
}
} else {
if ($rolefilter) {
if ($rolefilter eq 'all') {
$rolematch = '([^:]+)';
} else {
$rolematch = $rolefilter;
$skiptest = 0;
}
}
if ($sectionpick) {
if ($sectionpick eq 'all') {
$rolematch .= ':([^:]*)';
} else {
$rolematch .= ':'.$sectionpick;
$skiptest = 0;
}
}
if ($statusfilter) {
if ($statusfilter eq 'all') {
$rolematch .= ':([^:]+)';
} else {
$rolematch .= ':'.$statusfilter;
$skiptest = 0;
}
}
if ($skiptest) {
$shown{$idx} = 1;
} else {
foreach my $role (@{$roleinfo{$poster}}) {
if ($role =~ m/^$rolematch$/) {
$shown{$idx} = 1;
last;
}
}
}
}
}
unless ($notshown{$idx} == 1) {
if ($prevread > 0 && $prevread <= $posttime) {
$newitem{$idx} = 1;
$discussionitems[$idx] .= '
<p><table border="0" width="100%">
<tr><td align="left"><font color="#FF0000"><b>NEW</b></font></td>';
} else {
$newitem{$idx} = 0;
$discussionitems[$idx] .= '
<p><table border="0" width="100%">
<tr><td align="left"> </td>';
}
$discussionitems[$idx] .= '<td align ="left"> '.
'<b>'.$subject.'</b> '.
$sender.'</b> '.$vgrlink.' ('.
localtime($posttime).')</td></tr>'.
'</table><blockquote>'.$message.'</blockquote></p>';
}
}
}
}
}
my $discussion='';
my $function = &Apache::loncommon::get_users_function();
my $color = &Apache::loncommon::designparm($function.'.tabbg',
$ENV{'user.domain'});
my %lt = &Apache::lonlocal::texthash(
'cuse' => 'Current discussion settings',
'allposts' => 'All posts',
'unread' => 'New posts only',
'ondisp' => 'Once displayed',
'onmark' => 'Once marked read',
'disa' => 'Posts to be displayed',
'npce' => 'Posts cease to be marked "NEW"',
'chgt' => 'Change',
'disp' => 'Display',
'nolo' => 'Not new',
);
my $currdisp = $lt{'allposts'};
my $currmark = $lt{'onmark'};
my $dispchange = $lt{'unread'};
my $markchange = $lt{'ondisp'};
my $chglink = '/adm/feedback?modifydisp='.$ressymb;
my $displink = 'onlyunread';
my $marklink = 'markondisp';
if ($markondisp) {
$currmark = $lt{'ondisp'};
$markchange = $lt{'onmark'};
$marklink = 'markonread';
}
if ($showonlyunread) {
$currdisp = $lt{'unread'};
$dispchange = $lt{'allposts'};
$displink = 'allposts';
}
$chglink .= '&changes='.$displink.'_'.$marklink;
if ($newpostsflag) {
$chglink .= '&previous='.$prevread;
}
if ($visible) {
# Print the discusssion
if ($outputtarget ne 'tex') {
my $colspan=$maxdepth+1;
$discussion.='<table bgcolor="#AAAAAA" cellpadding="2" cellspacing="2" border="0">';
$discussion .='<tr><td bgcolor="#DDDDBB" colspan="'.$colspan.'">'.
'<table border="0" width="100%" bgcolor="#DDDDBB"><tr>';
if ($visible>2) {
$discussion.='<td align="left">'.
'<a href="/adm/feedback?threadedon='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .='">'.&mt('Threaded View').'</a> '.
'<a href="/adm/feedback?threadedoff='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .='">'.&mt('Chronological View').'</a>
<a href= "/adm/feedback?sortfilter='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .='">'.&mt('Sorting/Filtering options').'</a>  ';
} else {
$discussion .= '<td align="left">';
}
$discussion .='<a href= "/adm/feedback?export='.$ressymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= '">'.&mt('Export').'?</a> </td>';
if ($newpostsflag) {
if (!$markondisp) {
$discussion .='<td align="right"><a href="/adm/feedback?markread='.$ressymb.'">'.&mt('Mark new posts as read').'</a> ';
} else {
$discussion .= '<td> </td>';
}
} else {
$discussion .= '<td> </td>';
}
$discussion .= '</tr></table></td></tr>';
} else {
$discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
'\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'.
'\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'.
'\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
'\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}';
}
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>';
}
# Choose sort mechanism
my @showposts = ();
if ($sortposts eq 'descdate') {
@showposts = (sort { $b <=> $a } keys %alldiscussion);
} elsif ($sortposts eq 'thread') {
@showposts = (sort { $a <=> $b } keys %alldiscussion);
} elsif ($sortposts eq 'subject') {
foreach (sort keys %subjectsort) {
push @showposts, @{$subjectsort{$_}};
}
} elsif ($sortposts eq 'username') {
foreach my $domain (sort keys %usernamesort) {
foreach (sort keys %{$usernamesort{$domain}}) {
push @showposts, @{$usernamesort{$domain}{$_}};
}
}
} elsif ($sortposts eq 'lastfirst') {
foreach my $last (sort keys %namesort) {
foreach (sort keys %{$namesort{$last}}) {
push @showposts, @{$namesort{$last}{$_}};
}
}
} else {
$sortposts = 'ascdate';
@showposts = (sort { $a <=> $b } keys %alldiscussion);
}
foreach (@showposts) {
unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'})) {
$alldiscussion{$_} = $_;
}
unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) {
if ($outputtarget ne 'tex') {
$discussion.="\n<tr>";
} else {
$discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}';
}
my $thisdepth=$depth[$alldiscussion{$_}];
if ($outputtarget ne 'tex') {
for (1..$thisdepth) {
$discussion.='<td> </td>';
}
}
my $colspan=$maxdepth-$thisdepth+1;
if ($outputtarget ne 'tex') {
$discussion.='<td bgcolor="'.$bgcols[$newitem{$alldiscussion{$_}}].'" colspan="'.$colspan.'">'.
$discussionitems[$alldiscussion{$_}].
'</td></tr>';
} else {
#cleanup block
$discussionitems[$alldiscussion{$_}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
$discussionitems[$alldiscussion{$_}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
my $threadinsert='';
if ($thisdepth > 0) {
$threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>';
}
$discussionitems[$alldiscussion{$_}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/;
$discussionitems[$alldiscussion{$_}]=~s/<a([^>]+)>(Hide|Delete|Reply|Submissions)<\/a>//g;
$discussionitems[$alldiscussion{$_}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g;
#FIXME xmlparse can't be safely called from inside xmlparse
# due to the global variables that are use, the safe
# space etc. I expect this has unforseen issues that
# need resolving.
$discussion.=&Apache::lonxml::xmlparse('','tex',$discussionitems[$alldiscussion{$_}]);
}
}
}
if ($outputtarget ne 'tex') {
my $colspan=$maxdepth+1;
$discussion .= <<END;
<tr bgcolor="#FFFFFF">
<td colspan="$colspan" valign="top">
<table border="0" bgcolor="#FFFFFF" width="100%" cellspacing="2" cellpadding="2">
<tr>
<td align="left">
<table border="0" cellpadding="0" cellspacing="4">
<tr>
<td>
<font size="-1"><b>$lt{'cuse'}</b>:</td>
<td> </td>
END
if ($newpostsflag) {
$discussion .=
'<td><font size="-1">1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i></font></td>';
} else {
$discussion .=
'<td><font size="-1">'.$lt{'disp'}.' - <i>'.$currdisp.'</i></font></td>';
}
$discussion .= <<END;
<td> </td>
<td>
<font size="-1"><b><a href="$chglink">$lt{'chgt'}</a>?</font></b></td>
</tr>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>
<br /><br />
END
}
}
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="80" rows="14" wrap="hard"></textarea>
<p>
Attachment (128 KB max size): <input type="file" name="attachment" />
</p>
</form>
ENDDISCUSS
if ($outputtarget ne 'tex') {
$discussion.=&generate_preview_button();
}
} else {
if (&discussion_open($status) &&
&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
if ($outputtarget ne 'tex') {
$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 $htmlheader=&Apache::lonhtmlcommon::htmlareaheaders();
my $onsubmit='';
if ((&Apache::lonhtmlcommon::htmlareabrowser()) &&
(!&Apache::lonhtmlcommon::htmlareablocked())) {
$onsubmit='document.mailform.onsubmit();';
}
my $send=&mt('Send');
$r->print(<<ENDDOCUMENT);
<html>
<head>
<title>The LearningOnline Network with CAPA</title>
<meta http-equiv="pragma" content="no-cache"></meta>
$htmlheader
<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) {
$onsubmit
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" id="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().
&Apache::lonhtmlcommon::htmlareaselectactive('comment').
'</body></html>');
}
sub print_display_options {
my ($r,$symb,$previous,$dispchg,$markchg,$feedurl) = @_;
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
my $function = &Apache::loncommon::get_users_function();
my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
$ENV{'user.domain'});
my $bodytag=&Apache::loncommon::bodytag('Discussion options',
'','');
my %lt = &Apache::lonlocal::texthash(
'dido' => 'Discussion display options',
'pref' => 'Display Preference',
'curr' => 'Current setting ',
'actn' => 'Action',
'deff' => 'Default for all discussions',
'prca' => 'Preferences can be set for this discussion that determine ....',
'whpo' => 'Which posts are displayed when you display this bulletin board or resource, and',
'unwh' => 'Under what circumstances posts are identfied as "New."',
'allposts' => 'All posts',
'unread' => 'New posts only',
'ondisp' => 'Once displayed',
'onmark' => 'Once marked as read',
'disa' => 'Posts displayed?',
'npmr' => 'New posts cease to be identified as "New"?',
'chgt' => 'Change to ',
'mkdf' => 'Set to ',
'yhni' => 'You have not indicated that you wish to change either of the discussion settings',
'ywbr' => 'You will be returned to the previous page if you click OK.'
);
my $dispchange = $lt{'unread'};
my $markchange = $lt{'ondisp'};
my $currdisp = $lt{'allposts'};
my $currmark = $lt{'onmark'};
my $discdisp = 'allposts';
my $discmark = 'onmark';
if ($dispchg eq 'allposts') {
$dispchange = $lt{'allposts'};
$currdisp = $lt{'unread'};
$discdisp = 'unread';
}
if ($markchg eq 'markonread') {
$markchange = $lt{'onmark'};
$currmark = $lt{'ondisp'};
$discmark = 'ondisp';
}
$r->print(<<END);
<html>
<head>
<title>$lt{'dido'}</title>
<meta http-equiv="pragma" content="no-cache" />
<script>
function setDisp() {
var prev = "$previous"
var chktotal = 0
if (document.modifydisp.discdisp.checked == true) {
document.modifydisp.$dispchg.value = "$symb"
chktotal ++
}
if (document.modifydisp.discmark.checked == true) {
document.modifydisp.$markchg.value = "$symb"
chktotal ++
}
if (chktotal > 0) {
document.modifydisp.submit()
} else {
if(confirm("$lt{'yhni'}. \\n$lt{'ywbr'}")) {
if (prev > 0) {
location.href = "$feedurl?previous=$previous"
} else {
location.href = "$feedurl"
}
}
}
}
</script>
</head>
$bodytag
<form name="modifydisp" method="post" action="/adm/feedback">
$lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li></ol>
<br />
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="100%" bgcolor="#000000">
<table width="100%" border="0" cellpadding="1" cellspacing="0">
<tr>
<td width="100%" bgcolor="#000000">
<table border="0" cellpadding="3" cellspacing="1" bgcolor="#FFFFFF">
<tr bgcolor="$tabcolor">
<td><b>$lt{'pref'}</b></td>
<td><b>$lt{'curr'}</b></td>
<td><b>$lt{'actn'}?</b></td>
</tr>
<tr bgcolor="#dddddd">
<td>$lt{'disa'}</td>
<td>$lt{$discdisp}</td>
<td><input type="checkbox" name="discdisp" /> $lt{'chgt'} "$dispchange"</td>
</tr><tr bgcolor="#eeeeee">
<td>$lt{'npmr'}</td>
<td>$lt{$discmark}</td>
<td><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</td>
</tr>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>
<br />
<br />
<input type="hidden" name="previous" value="$previous" />
<input type="hidden" name="$dispchg" value=""/>
<input type="hidden" name="$markchg" value=""/>
<input type="button" name="sub" value="Store Changes" onClick="javascript:setDisp()" />
<br />
<br />
</form>
</body>
</html>
END
return;
}
sub print_sortfilter_options {
my ($r,$symb,$previous,$feedurl) = @_;
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
my @sections = ();
my $section_sel = '';
my $numsections = 0;
my $numvisible = 5;
my ($classlist) = &Apache::loncoursedata::get_classlist(
$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();
my %sectioncount = ();
while (my ($student,$data) = each %$classlist) {
my ($section,$status) = ($data->[$sec_index],
$data->[$status_index]);
unless ($section eq '' || $section =~ /^\s*$/) {
if (!defined($sectioncount{$section})) {
$sectioncount{$section} = 1;
$numsections ++;
} else {
$sectioncount{$section} ++;
}
}
}
if ($ENV{'request.course.sec'} !~ /^\s*$/) {
@sections = ($ENV{'request.course.sec'});
$numvisible = 1;
} else {
@sections = sort {$a cmp $b} keys(%sectioncount);
unshift(@sections,'all'); # Put 'all' at the front of the list
if ($numsections < 4) {
$numvisible = $numsections + 1;
}
}
foreach (@sections) {
$section_sel .= " <option value=\"$_\" />$_\n";
}
my $function = &Apache::loncommon::get_users_function();
my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
$ENV{'user.domain'});
my $bodytag=&Apache::loncommon::bodytag('Discussion options',
'','');
my %lt = &Apache::lonlocal::texthash(
'diso' => 'Discussion sorting and filtering options',
'diop' => 'Display Options',
'curr' => 'Current setting ',
'actn' => 'Action',
'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
'soor' => 'Sort order',
'disp' => 'Specific user roles',
'actv' => 'Specific role status',
'spse' => 'Specific sections',
'psub' => 'Pick specific users (by name)',
'shal' => 'Show a list of current posters'
);
$r->print(<<END);
<html>
<head>
<title>$lt{'diso'}</title>
<meta http-equiv="pragma" content="no-cache" />
</head>
$bodytag
<form name="modifyshown" method="post" action="/adm/feedback">
<b>$lt{'diso'}</b><br/> $lt{'prca'}
<br /><br />
<table border="0">
<tr>
<td><b>$lt{'soor'}</b></td>
<td> </td>
<td><b>$lt{'disp'}</b></td>
<td> </td>
<td><b>$lt{'actv'}</b></td>
<td> </td>
<td><b>$lt{'spse'}</b></td>
<td> </td>
<td><b>$lt{'psub'}</b></td>
</tr>
<tr>
<td>
<select name="sortposts">
<option value="ascdate" />Date order - oldest first
<option value="descdate" />Date order - newest first
<option value="thread" />Threaded
<option value="subject" />By subject
<option value="username" />By domain and username
<option value="lastfirst" />By last name, first name
</select>
</td>
<td> </td>
<td>
<select name="rolefilter" multiple="true" size="5">
<option value="all" />All users
<option value="st" />Students
<option value="cc" />Course Coordinators
<option value="in" />Instructors
<option value="ta" />TAs
<option value="pr" />Exam proctors
<option value="cr" />Custom roles
</select>
</td>
<td> </td>
<td>
<select name="statusfilter">
<option value="all" />Roles of any status
<option value="Active" />Only active roles
<option value="Expired" />Only inactive roles
</select>
</td>
<td> </td>
<td>
<select name="sectionpick" multiple="true" size="$numvisible">
$section_sel
</select>
</td>
<td> </td>
<td><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</td>
</tr>
</table>
<br />
<br />
<input type="hidden" name="previous" value="$previous" />
<input type="hidden" name="applysort" value="$symb" />
<input type="button" name="sub" value="Store Changes" onClick="javascript:document.modifyshown.submit()" />
<br />
<br />
</form>
</body>
</html>
END
}
sub print_showposters {
my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
# backward compatibility (bulletin boards used to be 'wrapped')
my $ressymb=$symb;
if ($ressymb =~ /bulletin___\d+___/) {
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
}
my $crs='/'.$ENV{'request.course.id'};
$crs=~s/\_/\//g;
my $seeid=&Apache::lonnet::allowed('rin',$crs);
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 %namesort = ();
my %postcounts = ();
my %lt=&Apache::lonlocal::texthash(
'diso' => 'Discussion filtering options',
);
my $bodytag=&Apache::loncommon::bodytag('Discussion options',
'','');
if ($contrib{'version'}) {
for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
my $deleted=($contrib{'deleted'}=~/\.$idx\./);
unless ((($hidden) && (!$seeid)) || ($deleted)) {
if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
my %names = &Apache::lonnet::get('environment',['firstname','lastname'],$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
my $lastname = $names{'lastname'};
my $firstname = $names{'firstname'};
if ($lastname eq '') {
$lastname = '_';
}
if ($firstname eq '') {
$firstname = '_';
}
unless (defined($namesort{$lastname})) {
%{$namesort{$lastname}} = ();
}
my $poster = $contrib{$idx.':sendername'}.':'.$contrib{$idx.':senderdomain'};
$postcounts{$poster} ++;
if (defined($namesort{$lastname}{$firstname})) {
if (!grep/^$poster$/,@{$namesort{$lastname}{$firstname}}) {
push @{$namesort{$lastname}{$firstname}}, $poster;
}
} else {
@{$namesort{$lastname}{$firstname}} = ("$poster");
}
}
}
}
}
$r->print(<<END);
<html>
<head>
<title>$lt{'diso'}</title>
<meta http-equiv="pragma" content="no-cache" />
</head>
$bodytag
<form name="pickpostersform" method="post">
<table border="0">
<tr>
<td bgcolor="#777777">
<table border="0" cellpadding="3">
<tr bgcolor="#e6ffff">
<td><b>No.</b></td>
<td><b>Select</b></td>
<td><b>Fullname</b><font color="#999999">(Username/domain)</font></td>
<td><b>Posts</td>
</tr>
END
my $count = 0;
foreach my $last (sort keys %namesort) {
foreach my $first (sort keys %{$namesort{$last}}) {
foreach (sort @{$namesort{$last}{$first}}) {
my ($uname,$udom) = split/:/,$_;
if (!$uname || !$udom) {
next;
} else {
$count ++;
$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>');
}
}
}
}
$r->print(<<END);
</table>
</td>
</tr>
</table>
<br />
<input type="hidden" name="sortposts" value="$sortposts" />
<input type="hidden" name="userpick" value="$symb" />
<input type="button" name="store" value="Display posts" onClick="javascript:document.pickpostersform.submit()" />
</form>
</body>
</html>
END
}
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,$sort,$rolefilter,$statusfilter,$secpick,$numpicks) = @_;
my $sorttag = '';
my $roletag = '';
my $statustag = '';
my $sectag = '';
my $userpicktag = '';
my $qrystr = '';
my $prevtag = '';
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
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.'" />';
}
if (defined($sort)) {
my $sortqry = 'sortposts='.$sort;
if (($feedurl =~ /\?register=1/) || ($feedurl =~ /\?previous=/)) {
$feedurl .= '&'.$sortqry;
} else {
$feedurl .= '?'.$sortqry;
}
$sorttag = '<input type="hidden" name="sortposts" value="'.$sort.'" />';
if ( (defined($numpicks)) && ($numpicks > 0) ) {
my $userpickqry = 'totposters='.$numpicks;
$feedurl .= '&'.$userpickqry;
$userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
} else {
my $roleqry = 'rolefilter='.$rolefilter;
$feedurl .= '&'.$roleqry;
$roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
$feedurl .= '&statusfilter='.$statusfilter;
$statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
$feedurl .= '§ionpick='.$secpick;
$sectag = '<input type="hidden" name="sectionpick" value="'.$secpick.'" />';
}
}
$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
$sorttag
$statustag
$roletag
$sectag
$userpicktag
</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 (&discussion_open() &&
&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)=@_;
unless (&Apache::lonhtmlcommon::htmlareablocked()) { return $message; }
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> <M> <SPAN> <H1> <H2> <H3> <H4> <SUB>
# <SUP>
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, SUB=>1, SUP=>1, SPAN=>1,
H1=>1, H2=>1, H3=>1, H4=>1, H5=>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 (&discussion_open() &&
&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="document.mailform.onsubmit();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','markread','markonread','markondisp','modifydisp','changes','navmaps','navurl','sortfilter','sortposts','applysort','rolefilter','statusfilter','sectionpick','posterlist','userpick']);
if ($ENV{'form.posterlist'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.posterlist'};
my $sortposts = $ENV{'form.sortposts'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $previous=$ENV{'form.previous'};
my $feedurl = &Apache::lonnet::clutter($url);
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
&print_showposters($r,$symb,$previous,$feedurl,$sortposts);
return OK;
}
if ($ENV{'form.userpick'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.userpick'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $previous=$ENV{'form.previous'};
# backward compatibility (bulletin boards used to be 'wrapped')
my $ressymb=$symb;
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
my $sort=$ENV{'form.sortposts'};
my @posters = ();
if (ref($ENV{'form.stuinfo'}) eq 'ARRAY') {
@posters = $ENV{'form.stuinfo'};
} else {
$posters[0] = $ENV{'form.stuinfo'};
}
my $numpicks = @posters;
if (defined($ENV{'form.userpick'})) {
my %discinfo = ();
$discinfo{$ressymb.'_userpick'} = join('&',@posters);
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
}
my $feedurl = &Apache::lonnet::clutter($url);
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
&redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,'','','',$numpicks);
return OK;
}
if ($ENV{'form.applysort'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.applysort'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $previous=$ENV{'form.previous'};
my $sort = $ENV{'form.sortposts'};
my $rolefilter = $ENV{'form.rolefilter'};
my $statusfilter = $ENV{'form.statusfilter'};
my $secpick = $ENV{'form.sectionpick'};
my $feedurl = &Apache::lonnet::clutter($url);
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
&redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',$previous,$sort,$rolefilter,$statusfilter,$secpick);
return OK;
} elsif ($ENV{'form.sortfilter'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.sortfilter'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $previous=$ENV{'form.previous'};
my $feedurl = &Apache::lonnet::clutter($url);
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
&print_sortfilter_options($r,$symb,$previous,$feedurl);
return OK;
} elsif ($ENV{'form.navmaps'}) {
my %discinfo = ();
my @resources = ();
if ($ENV{'form.navmaps'} =~ /:/) {
@resources = split/:/,$ENV{'form.navmaps'};
} else {
@resources = ("$ENV{'form.navmaps'}");
}
my $numitems = @resources;
my $feedurl = '/adm/navmaps';
if ($ENV{'form.navurl'}) {
$feedurl .= '?'.$ENV{'form.navurl'};
}
my %lt = &Apache::lonlocal::texthash(
'mnpa' => 'Marked "New" posts as read in a total of',
'robb' => 'resources/bulletin boards.'
);
foreach (@resources) {
# backward compatibility (bulletin boards used to be 'wrapped')
my $ressymb=$_;
if ($ressymb =~ m/bulletin___\d+___/) {
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper/|;
}
}
my $lastkey = $ressymb.'_lastread';
$discinfo{$lastkey} = time;
}
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$r->print (<<ENDREDIR);
<html>
<head>
<title>New posts marked as read</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" />
<b>$lt{'mnpa'} $numitems $lt{'robb'}</b>
<form name="reldt" action="$feedurl" target="loncapaclient">
</form>
</body>
</html>
ENDREDIR
return OK;
} elsif ($ENV{'form.modifydisp'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.modifydisp'};
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $previous=$ENV{'form.previous'};
my ($dispchg,$markchg) = split/_/,$ENV{'form.changes'};
my $feedurl = &Apache::lonnet::clutter($url);
# backward compatibility (bulletin boards used to be 'wrapped')
if ($feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$feedurl=~s|^/adm/wrapper||;
}
&print_display_options($r,$symb,$previous,$dispchg,$markchg,$feedurl);
return OK;
} elsif (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $previous=$ENV{'form.previous'};
my ($map,$ind,$url);
if (($ENV{'form.markondisp'}) || ($ENV{'form.markonread'})) {
# ---------------------- Modify setting for identification of 'NEW' posts in this discussion
my $symb=$ENV{'form.markondisp'}?$ENV{'form.markondisp'}:$ENV{'form.markonread'};
my $ressymb = $symb;
($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
my %discinfo = ();
my $lastkey = $ressymb.'_lastread';
my $ondispkey = $ressymb.'_markondisp';
if ($ENV{'form.markondisp'}) {
$discinfo{$lastkey} = time;
$discinfo{$ondispkey} = 1;
} elsif ($ENV{'form.markonread'}) {
if ( $previous > 0 ) {
$discinfo{$lastkey} = $previous;
}
$discinfo{$ondispkey} = 0;
}
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
}
if (($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'})) {
# ----------------------------------------------------------------- Modify display setting for this discussion
my $symb=$ENV{'form.allposts'}?$ENV{'form.allposts'}:$ENV{'form.onlyunread'};
my $ressymb = $symb;
($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
my %discinfo = ();
if ($ENV{'form.allposts'}) {
$discinfo{$ressymb.'_showonlyunread'} = 0;
} elsif ($ENV{'form.onlyunread'}) {
$discinfo{$ressymb.'_showonlyunread'} = 1;
}
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
}
if (($ENV{'form.markonread'}) || ($ENV{'form.allposts'}) || ($ENV{'form.onlyunread'}) ) {
&redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0','',$previous);
} else {
&redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed display status').'<br />','0','0');
}
return OK;
} elsif ($ENV{'form.markread'}) {
# ----------------------------------------------------------------- Mark new posts as read
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $symb=$ENV{'form.markread'};
my $ressymb = $symb;
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
my %discinfo = ();
my $lastkey = $ressymb.'_lastread';
$discinfo{$lastkey} = time;
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
&redirect_back($r,&Apache::lonnet::clutter($url),&mt('Changed reading status').'<br />','0','0');
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 (bulletin 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',undef,'feedback');
}
}
# 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