File:
[LON-CAPA] /
loncom /
interface /
lonfeedback.pm
Revision
1.389:
download - view:
text,
annotated -
select for diffs
Tue Jan 18 17:33:13 2022 UTC (2 years, 3 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Bug 6955
- If IP-based blocking set in domain config is in effect for user's
current IP address, and 'Messaging 'is among blocked functions:
(a) 'Send Feedback' (in course context), for resource(s) which allow it
is only messaging mechanism available to users with out 'evb' priv.
(b) Subject and Content for messages sent to instructor(s) via 'Send Feedback'
are replaced in user's Sent Folder with: "Not shown due to IP block".
# The LearningOnline Network
# Feedback
#
# $Id: lonfeedback.pm,v 1.389 2022/01/18 17:33:13 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::lonnet;
use Apache::lonhtmlcommon();
use Apache::lonnavmaps;
use Apache::lonenc();
use Apache::lonrss();
use HTML::LCParser();
#use HTML::Tidy::libXML;
use Apache::lonspeller();
use Apache::longroup;
use Archive::Zip qw( :ERROR_CODES );
use LONCAPA qw(:DEFAULT :match);
sub discussion_open {
my ($status,$symb)=@_;
# Advanced roles can always discuss
if ($env{'request.role.adv'}) { return 1; }
# Get discussion closing date
my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb);
# If it is defined and in the future, the instructor wants this discussion to be open
if (defined($close) && $close ne '' && $close > time) {
return 1;
}
# It was not explicitly open, check if the problem is available.
# If the problem is not available, close the discussion
if (defined($status) &&
!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
|| $status eq 'OPEN')) {
return 0;
}
# The problem is available, but check if the instructor explictly closed discussion
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)) {
if (!$env{'request.role.adv'}) { return 0; }
}
}
return 1;
}
sub discussion_vote_available {
my ($status,$symb)=@_;
my $canvote=&Apache::lonnet::EXT('resource.0.discussvote',$symb);
if ((lc($canvote) eq 'yes') ||
((lc($canvote) eq 'notended') && (&discussion_open($status,$symb)))) {
return 1;
}
}
sub get_realsymb {
my ($symb) = @_;
my $realsymb = $symb;
if ($symb=~/^bulletin___/) {
my $filename=(&Apache::lonnet::decode_symb($symb))[2];
$filename=~s{^adm/wrapper/}{};
$realsymb=&Apache::lonnet::symbread($filename);
}
return $realsymb;
}
sub list_discussion {
my ($mode,$status,$ressymb,$imsextras,$group)=@_;
unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); }
unless ($ressymb) { return ''; }
$ressymb=&wrap_symb($ressymb);
my $outputtarget=$env{'form.grade_target'};
if (defined($env{'form.export'})) {
if($env{'form.export'}) {
$outputtarget = 'export';
}
}
if (defined($imsextras)) {
if ($$imsextras{'caller'} eq 'imsexport') {
$outputtarget = 'export';
}
}
my ($nofooter,$nodisclink,$nofdbklink);
if (not &discussion_visible($status)) {
if ($mode ne 'board') {
($nofooter,$nodisclink,$nofdbklink) = &check_menucoll();
if ($nofooter || $nofdbklink) {
return '<br />';
} else {
&Apache::lonenc::check_encrypt(\$ressymb);
return '<br /><div class="LC_feedback_link">'.&send_message_link($ressymb)."</div>";
}
}
}
if ($group ne '' && $mode eq 'board') {
if (&check_group_priv($group,'vgb') ne 'ok') {
return '';
}
}
unless ($outputtarget eq 'export') {
($nofooter,$nodisclink,$nofdbklink) = &check_menucoll();
}
unless ($nofooter) {
my ($blocked,$blocktext) =
&Apache::loncommon::blocking_status('boards');
if ($blocked) {
my $footer = '<br /><div class="LC_feedback_link">';
unless ($nodisclink) {
$footer .= '<span class="LC_feedback_link">'.$blocktext.'</span>';
}
&Apache::lonenc::check_encrypt(\$ressymb);
if ($mode ne 'board') {
unless ($nofdbklink) {
$footer.=&send_message_link($ressymb);
}
}
$footer.='</div>';
return $footer;
}
}
my @bgcols = ("LC_disc_old_item","LC_disc_new_item");
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;
my $encsymb=&Apache::lonenc::check_encrypt($ressymb);
my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
&& ($ressymb=~/$LONCAPA::assess_re/));
my %usernamesort = ();
my %namesort =();
my %subjectsort = ();
# Get discussion display settings for this discussion
my $lastkey = $ressymb.'_lastread';
my $showkey = $ressymb.'_showonlyunread';
my $markkey = $ressymb.'_showonlyunmark',
my $visitkey = $ressymb.'_visit';
my $ondispkey = $ressymb.'_markondisp';
my $userpickkey = $ressymb.'_userpick';
my $toggkey = $ressymb.'_readtoggle';
my $readkey = $ressymb.'_read';
$ressymb=$encsymb;
my %dischash = &Apache::lonnet::get('nohist_'.$cid.'_discuss',[$lastkey,$showkey,$markkey,$visitkey,$ondispkey,$userpickkey,$toggkey,$readkey],$env{'user.domain'},$env{'user.name'});
my %discinfo = ();
my $showonlyunread = 0;
my $showunmark = 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','grouppick','totposters']);
my $sortposts = $env{'form.sortposts'};
my $statusfilter = $env{'form.statusfilter'};
my @sectionpick = split(/,/,$env{'form.sectionpick'});
my @grouppick = split(/,/,$env{'form.grouppick'});
my @rolefilter = split(/,/,$env{'form.rolefilter'});
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};
}
}
my $cdom = $env{'course.'.$cid.'.domain'};
my $cnum = $env{'course.'.$cid.'.num'};
my $crstype = &Apache::loncommon::course_type();
# Get information about students and non-students in course for filtering display of posts
my %roleshash = ();
my %roleinfo = ();
my ($classgroups,$studentgroups);
if ($env{'form.rolefilter'}) {
%roleshash = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
foreach my $rolekey (keys(%roleshash)) {
my ($role,$uname,$udom,$sec) = split(/:/,$rolekey);
if ($role =~ /^cr/) {
$role = 'cr';
}
my ($end,$start) = split(/:/,$roleshash{$rolekey});
my $now = time;
my $status = 'Active';
if (($now < $start) || ($end > 0 && $now > $end)) {
$status = 'Expired';
}
if ($uname && $udom) {
push(@{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status);
}
}
my ($classlist,$keylist) =
&Apache::loncoursedata::get_classlist($cdom,$cnum);
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);
}
($classgroups,$studentgroups) =
&Apache::loncoursedata::get_group_memberships($classlist,$keylist,
$cdom,$cnum);
}
# Get discussion display default settings for user
if ($env{'environment.discdisplay'} eq 'unread') {
$showonlyunread = 1;
}
if ($env{'environment.discmarkread'} eq 'ondisp') {
$markondisp = 1;
}
# Override user's default if user specified display setting for this discussion
if (defined($dischash{$ondispkey})) {
unless ($dischash{$ondispkey} eq '') {
$markondisp = $dischash{$ondispkey};
}
}
if ($markondisp) {
$discinfo{$lastkey} = time;
}
if (defined($dischash{$showkey})) {
unless ($dischash{$showkey} eq '') {
$showonlyunread = $dischash{$showkey};
}
}
if (defined($dischash{$markkey})) {
unless ($dischash{$markkey} eq '') {
$showunmark = $dischash{$markkey};
}
}
if (defined($dischash{$visitkey})) {
unless ($dischash{$visitkey} eq '') {
$visit = $dischash{$visitkey};
}
}
$visit ++;
my $seeid;
if (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$seeid = 1;
}
my $seehidden = &can_see_hidden($mode,$ressymb,undef,$group,$cdom,$cnum,$crs);
# Is voting on discussions available
my $realsymb = &get_realsymb($ressymb);
my $canvote = &discussion_vote_available($status,$realsymb);
my @discussionitems=();
my %shown = ();
my @posteridentity=();
my $current=0;
my $visible=0;
my @depth=();
my @replies = ();
my %alldiscussion=();
my %imsitems=();
my %imsfiles=();
my %notshown = ();
my %newitem = ();
my $maxdepth=0;
my %anonhash=();
my $anoncnt=0;
my $now = time;
$discinfo{$visitkey} = $visit;
&Apache::lonnet::put('nohist_'.$cid.'_discuss',\%discinfo,$env{'user.domain'},$env{'user.name'});
&build_posting_display(\%usernamesort,\%subjectsort,\%namesort,\%notshown,\%newitem,\%dischash,\%shown,\%alldiscussion,\%imsitems,\%imsfiles,\%roleinfo,\@discussionitems,\@replies,\@depth,\@posters,\$maxdepth,\$visible,\$newpostsflag,\$current,$status,$viewgrades,$seeid,$seehidden,$canvote,$prevread,$sortposts,$encsymb,$readkey,$showunmark,$showonlyunread,$totposters,\@rolefilter,\@sectionpick,\@grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,\%anonhash,$anoncnt,$group);
my $discussion='';
my $manifestfile;
my $manifestok=0;
my $tempexport;
my $imsresources;
my $copyresult;
my $function = &Apache::loncommon::get_users_function();
my %lt = &Apache::lonlocal::texthash(
'cuse' => 'My settings for this discussion',
'allposts' => 'All posts',
'unread' => 'New posts only',
'unmark' => 'Unread only',
'ondisp' => 'Once displayed',
'onmark' => 'Once marked not NEW',
'toggoff' => 'Off',
'toggon' => 'On',
'disa' => 'Posts to be displayed',
'npce' => 'Posts cease to be marked "NEW"',
'epcb' => 'Each post can be toggled read/unread',
'chgt' => 'Change',
'disp' => 'Display',
'nolo' => 'Not new',
'togg' => 'Toggle read/unread',
'aner' => 'An error occurred opening the manifest file.',
'difo' => 'Discussion for',
'aerr' => 'An error occurred opening the export file for posting',
'discussions' => 'DISCUSSIONS'
);
my %js_lt = &Apache::lonlocal::texthash(
'aysu' => 'Are you sure you want to delete this post?',
'dpwn' => 'Deleted posts will no longer be visible to you and other students',
'bwco' => 'but will continue to be visible to your instructor',
'depo' => 'Deleted posts will no longer be visible to you or anyone else.',
);
&js_escape(\%js_lt);
my $currdisp = $lt{'allposts'};
my $currmark = $lt{'onmark'};
my $currtogg = $lt{'toggoff'};
my $dispchange = $lt{'unread'};
my $markchange = $lt{'ondisp'};
my $toggchange = $lt{'toggon'};
my $chglink = '/adm/feedback?modifydisp='.$ressymb;
my $displinkA = 'onlyunread';
my $displinkB = 'onlyunmark';
my $marklink = 'markondisp';
my $togglink = 'toggon';
if ($markondisp) {
$currmark = $lt{'ondisp'};
$markchange = $lt{'onmark'};
$marklink = 'markonread';
}
if ($showonlyunread) {
$currdisp = $lt{'unread'};
$dispchange = $lt{'allposts'};
$displinkA = 'allposts';
}
if ($showunmark) {
$currdisp = $lt{'unmark'};
$dispchange = $lt{'unmark'};
$displinkA='allposts';
$displinkB='onlyunread';
$showonlyunread = 0;
}
if ($dischash{$toggkey}) {
$currtogg = $lt{'toggon'};
$toggchange = $lt{'toggoff'};
$togglink = 'toggoff';
}
$chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink;
if ($newpostsflag) {
$chglink .= '&previous='.$prevread;
}
$chglink.=&group_args($group);
if ($visible) {
# Print the discusssion
if ($outputtarget eq 'tex') {
$discussion.='<tex>{\tiny \vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
'\textbf{'.$lt{'discussions'}.'}\makebox[2 cm][b]{\hrulefill}\vskip 0 mm'.
'\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
'\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}}</tex>';
} elsif ($outputtarget eq 'export') {
# Create temporary directory if this is an export
my $now = time;
if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) {
$tempexport = $$imsextras{'tempexport'};
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
$tempexport .= '/'.$$imsextras{'count'};
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
} else {
$tempexport = $Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/ims_exports';
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
$tempexport .= '/'.$now;
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
$tempexport .= '/'.$env{'user.domain'}.'_'.$env{'user.name'};
}
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
# open manifest file
my $manifest = '/imsmanifest.xml';
my $manifestfilename = $tempexport.$manifest;
if ($manifestfile = Apache::File->new('>'.$manifestfilename)) {
$manifestok=1;
print $manifestfile qq|<?xml version="1.0" encoding="UTF-8"?>
<manifest xmlns="http://www.imsglobal.org/xsd/imscp_v1p1" xmlns:imsmd="http://www.imsglobal.org/xsd/imsmd_v1p2"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
identifier="MANIFEST-$ressymb" xsi:schemaLocation="http://www.imsglobal.org/xsd/imscp_v1p1
imscp_v1p1.xsd http://www.imsglobal.org/xsd/imsmd_v1p2 imsmd_v1p2p2.xsd">
<organizations default="$ressymb">
<organization identifier="$ressymb">
<title>$lt{'difo'} $ressymb</title>\n|;
} else {
$discussion .= $lt{'aner'}.'<br />';
}
} else {
my $colspan=$maxdepth+1;
$discussion.= &Apache::lonhtmlcommon::scripttag(qq|
function verifydelete (caller,symb,idx,newflag,previous,groupparm) {
var symbparm = symb+':::'+idx
var prevparm = ""
if (newflag == 1) {
prevparm = "&previous="+previous
}
if (caller == 'studentdelete') {
if (confirm("$js_lt{'aysu'}\\n$js_lt{'dpwn'},\\n$js_lt{'bwco'}")) {
document.location.href = "/adm/feedback?hide="+symbparm+prevparm+groupparm
}
} else {
if (caller == 'seeiddelete') {
if (confirm("$js_lt{'aysu'}\\n$js_lt{'depo'}")) {
document.location.href = "/adm/feedback?deldisc="+symbparm+prevparm+groupparm
}
}
}
}
|);
$discussion.='<form name="readchoices" method="post" action="/adm/feedback?chgreads='.$ressymb.'" >'.
"\n".'<table width="100%" class="LC_discussion">';
$discussion .= &action_links_bar($colspan,$ressymb,$visible,
$newpostsflag,$group,
$prevread,$markondisp,$seehidden);
my $escsymb=&escape($ressymb);
my $numhidden = keys(%notshown);
if ($numhidden > 0) {
my $colspan = $maxdepth+1;
$discussion.="\n".'<tr><td bgcolor="#CCCCCC" colspan="'.$colspan.'">';
my $href = '/adm/feedback?allposts=1&symb='.$escsymb;
if ($newpostsflag) {
$href .= '&previous='.$prevread;
}
$href .= &group_args($group);
if ($showunmark) {
$discussion .= &mt('[_1]Show all posts[_2] to display [quant,_3,post] previously marked read',
'<a href="'.$href.'">','</a>',$numhidden);
} else {
$discussion .= &mt('[_1]Show all posts[_2] to display [quant,_3,post] previously viewed',
'<a href="'.$href.'">','</a>',$numhidden);
}
$discussion .= '<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 my $key (sort(keys(%subjectsort))) {
push(@showposts, @{$subjectsort{$key}});
}
} elsif ($sortposts eq 'username') {
foreach my $domain (sort(keys(%usernamesort))) {
foreach my $key (sort(keys(%{$usernamesort{$domain}}))) {
push(@showposts, @{$usernamesort{$domain}{$key}});
}
}
} elsif ($sortposts eq 'lastfirst') {
foreach my $last (sort(keys(%namesort))) {
foreach my $key (sort(keys(%{$namesort{$last}}))) {
push(@showposts, @{$namesort{$last}{$key}});
}
}
} else {
@showposts = (sort { $a <=> $b } keys(%alldiscussion));
}
my $currdepth = 0;
my $firstidx = $alldiscussion{$showposts[0]};
foreach my $post (@showposts) {
unless (($sortposts eq 'thread') ||
(($sortposts eq '') && (!$env{'environment.unthreadeddiscussion'})) ||
($outputtarget eq 'export')) {
$alldiscussion{$post} = $post;
}
unless ( ($notshown{$alldiscussion{$post}} eq '1') || ($shown{$alldiscussion{$post}} == 0) ) {
if ($outputtarget ne 'tex' && $outputtarget ne 'export') {
$discussion.="\n<tr>";
}
my $thisdepth=$depth[$alldiscussion{$post}];
if ($outputtarget ne 'tex' && $outputtarget ne 'export') {
for (1..$thisdepth) {
$discussion.='<td> </td>';
}
}
my $colspan=$maxdepth-$thisdepth+1;
if ($outputtarget eq 'tex') {
#cleanup block
$discussionitems[$alldiscussion{$post}]=~s/<table([^>]*)>/<table TeXwidth="90 mm">/;
$discussionitems[$alldiscussion{$post}]=~s/<tr([^>]*)><td([^>]*)>/<tr><td TeXwidth="20 mm" align="left">/;
my $threadinsert='';
if ($thisdepth > 0) {
$threadinsert='<br /><strong>Reply: '.$thisdepth.'</strong>';
}
$discussionitems[$alldiscussion{$post}]=~s/<\/td><td([^>]*)>/$threadinsert<\/td><td TeXwidth="65 mm" align="left">/;
$discussionitems[$alldiscussion{$post}]=~s/(<b>|<\/b>|<\/a>|<a([^>]+)>)//g;
$discussionitems[$alldiscussion{$post}]='<tex>\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}</tex>'.$discussionitems[$alldiscussion{$post}];
$discussion.=$discussionitems[$alldiscussion{$post}];
} elsif ($outputtarget eq 'export') {
my $postfilename = $alldiscussion{$post}.'-'.$imsitems{$alldiscussion{$post}}{'timestamp'}.'.html';
if ($manifestok) {
if (($depth[$alldiscussion{$post}] <= $currdepth) && ($alldiscussion{$post} != $firstidx)) {
print $manifestfile ' </item>'."\n";
}
$currdepth = $depth[$alldiscussion{$post}];
print $manifestfile "\n".
'<item identifier="ITEM-'.$ressymb.'-'.$alldiscussion{$post}.'" isvisible="'.
$imsitems{$alldiscussion{$post}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$post}.'">'.
'<title>'.$imsitems{$alldiscussion{$post}}{'title'}.'</title></item>';
$imsresources .= "\n".
'<resource identifier="RES-'.$ressymb.'-'.$alldiscussion{$post}.'" type="webcontent" href="'.$postfilename.'">'."\n".
'<file href="'.$postfilename.'">'."\n".
$imsfiles{$alldiscussion{$post}}{$imsitems{$alldiscussion{$post}}{'currversion'}}.'</file>'."\n".
'</resource>';
}
my $postingfile;
my $postingfilename = $tempexport.'/'.$postfilename;
if ($postingfile = Apache::File->new('>'.$postingfilename)) {
print $postingfile '<html><head><title>'.&mt('Discussion Post').'</title></head><body>'.
$imsitems{$alldiscussion{$post}}{'title'}.' '.
$imsitems{$alldiscussion{$post}}{'sender'}.
$imsitems{$alldiscussion{$post}}{'timestamp'}.'<br /><br />'.
$imsitems{$alldiscussion{$post}}{'message'}.'<br />'.
$imsitems{$alldiscussion{$post}}{'attach'}.'</body></html>'."\n";
close($postingfile);
} else {
$discussion .= $lt{'aerr'}.' '.$alldiscussion{$post}.'<br />';
}
$copyresult.=&replicate_attachments($imsitems{$alldiscussion{$post}}{'allattachments'},$tempexport);
} else {
$discussion.='<td class="'.$bgcols[$newitem{$alldiscussion{$post}}].
'" colspan="'.$colspan.'">'. $discussionitems[$alldiscussion{$post}].
'</td></tr>';
}
}
}
unless ($outputtarget eq 'tex' || $outputtarget eq 'export') {
my $colspan=$maxdepth+1;
$discussion .= <<END;
<tr>
<td colspan="$colspan">
<table width="100%">
<tr>
<td class="LC_disc_action_left">
<font size="-1"><b>$lt{'cuse'}</b>:
END
if ($newpostsflag) {
$discussion .=
'1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'nolo'}.' - <i>'.$currmark.'</i>';
if ($dischash{$toggkey}) {
$discussion .= ' 3. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>';
}
} else {
if ($dischash{$toggkey}) {
$discussion .= '1. '.$lt{'disp'}.' - <i>'.$currdisp.'</i> 2. '.$lt{'togg'}.' - <i>'.$currtogg.'</i>';
} else {
$discussion .=
$lt{'disp'}.' - <i>'.$currdisp.'</i>';
}
}
$discussion .= <<END;
<b><a href="$chglink">$lt{'chgt'}</a></b></font>
</td>
END
if ($sortposts) {
my %sort_types = ();
my %role_types = ();
my %status_types = ();
&sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype);
$discussion .= '<td class="LC_disc_action_right"><font size="-1"><b>'.&mt('Sorted by').'</b>: '.$sort_types{$sortposts}.'<br />';
if (defined($env{'form.totposters'})) {
$discussion .= &mt('Posts by').':';
if ($totposters > 0) {
foreach my $poster (@posters) {
$discussion .= ' '.$poster.',';
}
$discussion =~ s/,$//;
} else {
$discussion .= &mt('None selected');
}
} else {
my $filterchoice ='';
if (@sectionpick > 0) {
$filterchoice = '<i>'.&mt('sections').'</i>- '.$env{'form.sectionpick'};
$filterchoice .= ' ';
}
if (@grouppick > 0) {
$filterchoice = '<i>'.&mt('groups').'</i>- '.$env{'form.grouppick'};
$filterchoice .= ' ';
}
if (@rolefilter > 0) {
$filterchoice .= '<i>'.&mt('roles').'</i>-';
foreach my $role (@rolefilter) {
$filterchoice .= ' '.$role_types{$role}.',';
}
$filterchoice =~ s/,$//;
$filterchoice .= '<br />'.(' ' x8);
}
if ($statusfilter) {
$filterchoice .= '<i>'.&mt('status').'</i>- '.$status_types{$statusfilter};
}
if ($filterchoice) {
$discussion .= '<b>'.&mt('Filters').'</b>: '.$filterchoice;
}
}
$discussion .= '</font></td>';
}
if ($dischash{$toggkey}) {
my $storebutton = &mt('Save read/unread changes');
$discussion.='<td align="right">'.
'<input type="hidden" name="discsymb" value="'.$ressymb.'" />'."\n".
'<input type="button" name="readoptions" value="'.$storebutton.'"'.
' onclick="this.form.submit();" />'."\n".
'</td>';
}
$discussion .= (<<END);
</tr>
</table>
</td>
</tr>
END
$discussion .= &action_links_bar($colspan,$ressymb,$visible,
$newpostsflag,$group,
$prevread,$markondisp,$seehidden);
$discussion .= "</table></form>\n";
}
if ($outputtarget eq 'export') {
if ($manifestok) {
while ($currdepth > 0) {
print $manifestfile " </item>\n";
$currdepth --;
}
print $manifestfile qq|
</organization>
</organizations>
<resources>
$imsresources
</resources>
</manifest>
|;
close($manifestfile);
if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) {
$discussion = $copyresult;
} else {
#Create zip file in prtspool
if (($env{'user.name'} =~ /^$match_username$/)
&& ($env{'user.domain'} =~ /^$match_domain$/)) {
my $now = time();
my $imszipfile = '/prtspool/'.
join('_',$env{'user.name'},$env{'user.domain'},$now).
'_'.rand(1000000000).'.zip';
my $zip = Archive::Zip->new();
$zip->addTree($tempexport);
my $imszip = '/home/httpd/'.$imszipfile;
if ($zip->writeToFileNamed($imszip) == AZ_OK) {
$discussion .= &mt('Download the zip file from [_1]Discussion Posting Archive[_2]',
'<a href="'.$imszipfile.'">','</a>').'<br />';
} else {
$discussion .= &mt('Failed to create zip file').'<br />';
}
if ($copyresult) {
$discussion .= '<span class="LC_error">'.
&mt('The following errors occurred during export:').
'</span><br />'.$copyresult;
}
} else {
$discussion .= '<p class="LC_error">'.
&mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating the zip file.').'</p>';
}
}
} else {
$discussion .= '<p class="LC_error">'.
&mt('Unfortunately you will not be able to retrieve an archive of the discussion posts at this time, because there was a problem creating a manifest file.').'</p>';
}
return $discussion;
}
}
if ($discussiononly) {
my $now = time;
my $attachnum = 0;
my $currnewattach = [];
my $currdelold = [];
my $comment = '';
my $subject = '';
if ($env{'form.origpage'}) {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['addnewattach','deloldattach','delnewattach','timestamp','idx','subject','comment']);
$subject = &unescape($env{'form.subject'});
$comment = &unescape($env{'form.comment'});
my @keepold = ();
&process_attachments($currnewattach,$currdelold,\@keepold);
if (@{$currnewattach} > 0) {
$attachnum += @{$currnewattach};
}
}
if ((&discussion_open($status)) && ($outputtarget ne 'tex')) {
if (($group ne '') && ($mode eq 'board')) {
if ((&check_group_priv($group,'pgd') eq 'ok') &&
($ressymb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})) {
$discussion .=
&postingform_display($mode,$ressymb,$now,$subject,
$comment,$outputtarget,$attachnum,
$currnewattach,$currdelold,
$group,$crstype);
}
} else {
if (&Apache::lonnet::allowed('pch',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$discussion.=
&postingform_display($mode,$ressymb,$now,$subject,
$comment,$outputtarget,$attachnum,
$currnewattach,$currdelold,'',$crstype);
} else {
$discussion.= '<span class="LC_feedback_link">'.
&mt('This discussion is closed.').'</span>';
}
}
}
if (!(&discussion_open($status)) && ($outputtarget ne 'tex')) {
$discussion.= '<span class="LC_feedback_link">'.
&mt('This discussion is closed.').'</span>';
}
} elsif ($outputtarget ne 'tex') {
unless ($nofooter) {
$discussion.='<div class="LC_feedback_link">';
unless ($nodisclink) {
if (&discussion_open($status) &&
&Apache::lonnet::allowed('pch',
$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$discussion.= &send_feedback_link($ressymb);
if ($env{'request.role.adv'}) {
my $close = &Apache::lonnet::EXT('resource.0.discussend',$ressymb);
my $canvote = &Apache::lonnet::EXT('resource.0.discussvote',$ressymb);
if (defined($close) && $close ne '' && $close < time) {
if ($canvote eq 'notended') {
$discussion .= ' '.&mt('(Posting and voting closed for [_1] roles)',
&Apache::lonnet::plaintext('st',$crstype));
} else {
$discussion .= ' '.&mt('(Closed for [_1] roles)',
&Apache::lonnet::plaintext('st',$crstype));
}
}
}
} else {
$discussion.= '<span class="LC_feedback_link">'.&mt('This discussion is closed.').'</span>';
}
}
unless ($nofdbklink) {
$discussion.= &send_message_link($ressymb);
}
$discussion.='</div>';
}
}
return $discussion;
}
sub check_menucoll {
my ($nofooter,$nodisclink,$nofdbklink);
my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect();
if ($menucoll) {
if (ref($menuref) eq 'HASH') {
if ($menuref->{'foot'} eq 'n') {
$nofooter = 1;
} else {
unless ($menuref->{'disc'}) {
$nodisclink = 1;
}
unless ($menuref->{'fdbk'}) {
$nofdbklink = 1;
}
}
}
}
return ($nofooter,$nodisclink,$nofdbklink);
}
sub can_see_hidden {
my ($mode,$ressymb,$feedurl,$group,$cdom,$cnum,$crs) = @_;
my $seehidden;
if ($env{'request.course.id'}) {
unless ($cdom ne '' && $cnum ne '') {
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
}
if ($crs eq '') {
$crs = '/'.$env{'request.course.id'};
if ($env{'request.course.sec'}) {
$crs.='_'.$env{'request.course.sec'};
}
$crs=~s{_}{/}g;
}
if ($mode eq '') {
$mode='board';
if ($feedurl =~ /$LONCAPA::assess_re/) {
$mode='problem';
}
}
if (($group ne '') && ($mode eq 'board') &&
($ressymb =~ m{^bulletin___\d+\Q___adm/wrapper/adm/$cdom/$cnum/\E\d+/bulletinboard$})) {
if (&check_group_priv($group,'dgp') eq 'ok') {
$seehidden = 1;
}
} else {
$seehidden=&Apache::lonnet::allowed('rin',$crs);
}
}
return $seehidden;
}
sub discussion_link {
my ($ressymb,$linktext,$cmd,$item,$flag,$prev,$adds,$title)=@_;
my $link='/adm/feedback?inhibitmenu=yes&modal=yes&'.$cmd.'='.&escape($ressymb).':::'.$item;
if ($flag) { $link .= '&previous='.$prev; }
if ($adds) { $link .= $adds; }
my $width=600;
my $height=600;
if (($cmd eq 'hide') || ($cmd eq 'unhide') || ($cmd eq 'like') || ($cmd eq 'unlike')) {
$width=300;
$height=200;
}
return &Apache::loncommon::modal_link($link,$linktext,$width,$height,undef,undef,$title);
}
sub send_feedback_link {
my ($ressymb) = @_;
return '<span class="LC_feedback_link">'.
&discussion_link($ressymb,
'<img alt="" class="LC_noBorder" src="'.
&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').
'" /><span class="LC_menubuttons_inline_text">'.&mt('Post Discussion').'</span>',
'replydisc').
'</span>';
}
sub send_message_link {
my ($ressymb) = @_;
my $output = '<span class="LC_message_link">'.
&discussion_link($ressymb,
'<img alt="" class="LC_noBorder" src="'.
&Apache::loncommon::lonhttpdurl('/res/adm/pages/feedback.png').
'" /><span class="LC_menubuttons_inline_text">'.&mt('Send Feedback').'</span>',
'sendmessageonly').
'</span>';
return $output;
}
sub action_links_bar {
my ($colspan,$ressymb,$visible,$newpostsflag,$group,$prevread,$markondisp,
$seehidden) = @_;
my $discussion = '<tr><td colspan="'.$colspan.'">'.
'<table width="100%"><tr>'.
'<td class="LC_disc_action_left">';
my $escsymb=&escape($ressymb);
if ($visible) {
$discussion .= '<a href="/adm/feedback?cmd=threadedon&symb='.$escsymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= &group_args($group);
$discussion .='">'.&mt('Threaded View').'</a> '.
'<a href="/adm/feedback?cmd=threadedoff&symb='.$escsymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= &group_args($group);
$discussion .='">'.&mt('Chronological View').'</a> ';
my $otherviewurl='/adm/feedback?cmd=sortfilter&symb='.$escsymb.'&inhibitmenu=yes&modal=yes';
if ($newpostsflag) {
$otherviewurl .= '&previous='.$prevread;
}
$otherviewurl .= &group_args($group);
$discussion .= &Apache::loncommon::modal_link($otherviewurl,&mt('Other Views ...'),800,340);
$discussion .= '<br />';
}
$discussion .='<a href="/adm/feedback?export='.$escsymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= &group_args($group);
$discussion .= '">'.&mt('Export').'</a>';
if ($seehidden) {
$discussion .= ' ';
$discussion .='<a href="/adm/feedback?undeleteall='.$escsymb;
if ($newpostsflag) {
$discussion .= '&previous='.$prevread;
}
$discussion .= &group_args($group);
$discussion .= '">'.&mt('Undelete all deleted entries').'</a>';
}
$discussion.='</td>';
if ($newpostsflag) {
if (!$markondisp) {
$discussion .='<td class="LC_disc_action_right"><a href="/adm/preferences?action=changediscussions';
$discussion .= &group_args($group);
$discussion .= '">'.
&mt('My general preferences on what is marked as NEW').
'</a><br /><a href="/adm/feedback?markread=1&symb='.$escsymb;
$discussion .= &group_args($group);
$discussion .= '">'.&mt('Mark NEW posts no longer new').'</a></td>';
} else {
$discussion .= '<td> </td>';
}
} else {
$discussion .= '<td> </td>';
}
$discussion .= '</tr></table></td></tr>';
return $discussion;
}
sub postingform_display {
my ($mode,$ressymb,$now,$subject,$comment,$outputtarget,$attachnum,
$currnewattach,$currdelold,$group,$crstype) = @_;
my $newattachmsg;
my %lt = &Apache::lonlocal::texthash(
'note' => 'Note: in anonymous discussion, your name is visible only to course faculty',
'title' => 'Title',
'podi' => 'Post Discussion',
'poan' => 'Post Anonymous Discussion',
'newa' => 'New attachments',
);
if ($crstype eq 'Community') {
$lt{'note'} = &mt('Note: in anonymous discussion, your name is visible only to community facilitators');
}
my ($postingform,$textareaclass);
if (&Apache::lonhtmlcommon::htmlareabrowser()) {
$postingform = &Apache::lonhtmlcommon::htmlareaselectactive();
$textareaclass = 'class="LC_richDefaultOff"';
if ($env{'request.course.id'}) {
unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) {
undef($textareaclass);
}
}
}
my $postanon;
if (&Apache::lonnet::allowed('pac',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$postanon = '<input type="submit" name="anondiscuss" value="'.$lt{'poan'}.'" />';
}
$postingform .= (<<ENDDISCUSS);
<form action="/adm/feedback" method="post" name="mailform" enctype="multipart/form-data"> <input type="submit" name="discuss" value="$lt{'podi'}" />
$postanon<input type="hidden" name="symb" value="$ressymb" />
<input type="hidden" name="sendit" value="true" />
<input type="hidden" name="timestamp" value="$now" />
<a name="newpost"></a>
<font size="1">$lt{'note'}</font><br />
<b>$lt{'title'}:</b> <input type="text" name="subject" value="$subject" size="30" /><br />
<textarea name="comment" cols="80" rows="14" id="comment" $textareaclass>$comment</textarea>
ENDDISCUSS
if ($env{'form.origpage'}) {
$postingform .= '<input type="hidden" name="origpage" value="'.
$env{'form.origpage'}.'" />'."\n";
foreach my $att (@{$currnewattach}) {
$postingform .= '<input type="hidden" name="currnewattach" '.
'value="'.$att.'" />'."\n";
}
}
if (exists($env{'form.ref'})) {
$postingform .= '<input type="hidden" name="ref" value="'.
$env{'form.ref'}.'" />';
}
if ($group ne '') {
$postingform .='<input type="hidden" name="group" value="'.$group.'" />';
}
my $blockblog = &Apache::loncommon::blocking_status('blogs');
if (!$blockblog) {
$postingform .= &add_blog_checkbox($crstype);
}
$postingform .= "</form>\n";
$postingform .= &generate_attachments_button('',$attachnum,$ressymb,
$now,$currnewattach,
$currdelold,'',$mode,
$blockblog);
if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) {
$newattachmsg = '<br /><b>'.$lt{'newa'}.'</b><br />';
if (@{$currnewattach} > 1) {
$newattachmsg .= '<ol>';
foreach my $item (@{$currnewattach}) {
$item =~ m#.*/([^/]+)$#;
$newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n";
}
$newattachmsg .= '</ol>'."\n";
} else {
$$currnewattach[0] =~ m#.*/([^/]+)$#;
$newattachmsg .= '<a href="'.$$currnewattach[0].'">'.$1.'</a><br />'."\n";
}
}
$postingform .= $newattachmsg;
$postingform .= &generate_preview_button();
return $postingform;
}
sub build_posting_display {
my ($usernamesort,$subjectsort,$namesort,$notshown,$newitem,$dischash,$shown,$alldiscussion,$imsitems,$imsfiles,$roleinfo,$discussionitems,$replies,$depth,$posters,$maxdepth,$visible,$newpostsflag,$current,$status,$viewgrades,$seeid,$seehidden,$canvote,$prevread,$sortposts,$ressymb,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$grouppick,$classgroups,$statusfilter,$toggkey,$outputtarget,$anonhash,$anoncnt,$group) = @_;
my @original=();
my @index=();
my $skip_group_check = 0;
my $symb=&Apache::lonenc::check_decrypt($ressymb);
my $escsymb=&escape($ressymb);
# These are the discussion contributions
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 (%likes,%userlikes,%userunlikes,@theselikes,$oneplus,$twoplus,$oneminus,$twominus);
my $thisuser=$env{'user.name'}.':'.$env{'user.domain'};
if ($seeid || $canvote) {
# And these are the likes/unlikes
%likes=&Apache::lonnet::dump('disclikes',
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'},
'^'.$symb.':');
# Array with likes to figure out averages, etc.
@theselikes=();
# Hashes containing likes and unlikes for this user.
%userlikes=();
%userunlikes=();
}
# Is the user allowed to see the real name behind anonymous postings?
my $see_anonymous =
&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''));
if ((@{$grouppick} == 0) || (grep(/^all$/,@{$grouppick}))) {
$skip_group_check = 1;
}
# Deletions and hiddens are just lists. Split them up into a hash for quicker lookup
my (%deletions,%hiddens);
if ($contrib{'deleted'}) {
my $deleted = $contrib{'deleted'};
$deleted =~ s/^\.//;
$deleted =~ s/\.$//;
%deletions = map { $_ => 1 } (split(/\.\./,$deleted));
}
if ($contrib{'hidden'}) {
my $hidden = $contrib{'hidden'};
$hidden =~ s/^\.//;
$hidden =~ s/\.$//;
%hiddens = map { $_ => 1 } (split(/\.\./,$hidden));
}
# Versions if store/restore are used to actually store the messages.
if ($contrib{'version'}) {
my $oldest = $contrib{'1:timestamp'};
if ($prevread eq '0') {
$prevread = $oldest-1;
}
my ($skiptest,$rolematch,$roleregexp,$secregexp,$statusregexp);
if ($sortposts) {
($skiptest,$roleregexp,$secregexp,$statusregexp) =
&filter_regexp($rolefilter,$sectionpick,$statusfilter);
$rolematch = $roleregexp.':'.$secregexp.':'.$statusregexp;
}
my %votestyle;
if ($seeid || $canvote) {
# We need to go through this twice, first to get the likes/dislikes, then to actually build the display
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
next if ($contrib{$idx.':deleted'});
next if ($contrib{$idx.':hidden'});
unless ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx}) || (!$contrib{$idx.':message'})) {
push(@theselikes,$likes{$symb.':'.$idx.':likes'});
if ($likes{$symb.':'.$idx.':likes'} ne '') {
if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') {
if (exists($likes{$symb.':'.$idx.':likers'}{$thisuser})) {
$userlikes{$idx} = 1;
}
}
if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') {
if (exists($likes{$symb.':'.$idx.':unlikers'}{$thisuser})) {
$userunlikes{$idx} = 1;
}
}
}
}
}
# Figure out average likes and standard deviation if there are enough
# discussions to warrant that
my $ave=0;
my $stddev=10000;
if ($#theselikes>1) {
my $sum=0;
my $num=$#theselikes+1;
foreach my $thislike (@theselikes) {
$sum+=$thislike;
}
$ave=$sum/$num;
my $sumsq=0;
foreach my $thislike (@theselikes) {
$sumsq+=($thislike-$ave)*($thislike-$ave);
}
$stddev=sqrt($sumsq/$num);
}
# Now we know the average likes $ave and the standard deviation $stddev
# Get the boundaries for markup
$oneplus=$ave+$stddev;
$twoplus=$ave+2.*$stddev;
$oneminus=$ave-$stddev;
$twominus=$ave-2.*$stddev;
if ($#theselikes>1) {
foreach my $class ('twoplus','oneplus','zero','oneminus','twominus') {
my $fontstyle = $env{'course.'.$env{'request.course.id'}.'.discussion_post_fonts_'.$class};
if ($fontstyle ne '') {
my ($size,$weight,$style,$other) = split(/,/,$fontstyle);
if ($size ne '') {
$votestyle{$class} .= 'font-size: '.$size.';';
}
if ($weight ne '') {
$votestyle{$class} .= 'font-weight: '.$weight.';';
}
if ($style ne '') {
$votestyle{$class} .= 'font-style: '.$style.';';
}
if ($other ne '') {
$votestyle{$class} .= $other;
}
if ($votestyle{$class} ne '') {
$votestyle{$class} = 'style="'.$votestyle{$class}.'"';
}
}
}
}
}
#
# This is now the real loop. Go through all entries, pick up what we need
#
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
next if ($contrib{$idx.':deleted'});
next if ($contrib{$idx.':hidden'});
# If we get here, we are actually going to display the message - we don't know where and we don't know if we display
# previous edits, but it counts as one entry
my $posttime = $contrib{$idx.':timestamp'};
if ($prevread <= $posttime) {
$$newpostsflag = 1;
}
my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./);
my $origindex='0.';
my $numoldver=0;
if ($contrib{$idx.':replyto'}) {
if ( ((!$env{'environment.unthreadeddiscussion'}) && ($sortposts eq '')) ||
($sortposts eq 'thread') || ($outputtarget eq 'export')) {
# 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 ((($hiddens{$idx}) && (!$seehidden)) || ($deletions{$idx})) {
$$visible++;
if ($contrib{$idx.':history'}) {
if ($contrib{$idx.':history'} =~ /:/) {
my @oldversions = split(/:/,$contrib{$idx.':history'});
$numoldver = @oldversions;
} else {
$numoldver = 1;
}
}
$$current = $numoldver;
my %messages = ();
my %subjects = ();
my %attachtxt = ();
my %allattachments = ();
my ($screenname,$plainname,$showaboutme);
my $sender = &mt('Anonymous');
# Anonymous users getting number within a discussion
# Since idx is in static order, this should give the same sequence every time.
my $key=$contrib{$idx.':sendername'}.'@'.$contrib{$idx.':senderdomain'};
unless ($$anonhash{$key}) {
$anoncnt++;
$$anonhash{$key}=&mt('Anonymous').' '.$anoncnt;
}
my ($message,$subject,$vgrlink,$ctlink);
&get_post_contents(\%contrib,$idx,$seeid,$seehidden,$outputtarget,\%messages,\%subjects,\%allattachments,\%attachtxt,$imsfiles,\$screenname,\$plainname,\$showaboutme,$numoldver);
# Set up for sorting by subject
unless ($outputtarget eq 'export') {
$message=$messages{$numoldver};
$message.=$attachtxt{$numoldver};
$subject=$subjects{$numoldver};
if ($message) {
if ($hiddens{$idx}) {
$message='<font color="#888888">'.$message.'</font>';
if ($studenthidden) {
$message .='<br /><br />Deleted by poster (student).';
}
}
if ($subject eq '') {
if (defined($$subjectsort{'__No subject'})) {
push(@{$$subjectsort{'__No subject'}}, $idx);
} else {
@{$$subjectsort{'__No subject'}} = ("$idx");
}
} else {
if (defined($$subjectsort{$subject})) {
push(@{$$subjectsort{$subject}}, $idx);
} else {
@{$$subjectsort{$subject}} = ("$idx");
}
}
if (!$contrib{$idx.':anonymous'} || $see_anonymous) {
if ($showaboutme) {
$sender = &Apache::loncommon::aboutmewrapper(
$plainname,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'});
} else {
$sender = $plainname;
}
if ($see_anonymous) {
$sender .= ' ('.$contrib{$idx.':sendername'}.':'.
$contrib{$idx.':senderdomain'}.')';
}
$sender = '<b>'.$sender.'</b>';
if ($contrib{$idx.':anonymous'}) {
$sender.=' <font color="red"><b>['.$$anonhash{$key}.']</b></font> '.
$screenname;
}
if ($see_anonymous) {
$sender.=&Apache::loncommon::student_image_tag($contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
}
# 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 ($outputtarget ne 'tex') {
# Add karma stars
my $karma=&userkarma($contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'});
for (my $i=1;$i<=$karma;$i++) {
$sender.='<img border="0" src="/res/adm/pages/star.gif" alt="'.&mt('Contributor Kudos').'" />';
}
# Can people edit this?
if (&editing_allowed($escsymb.':::'.$idx,$group)) {
if (($env{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($env{'user.name'} eq $contrib{$idx.':sendername'})) {
$sender.=' '.
&discussion_link($ressymb,&mt('Edit'),'editdisc',$idx,$$newpostsflag,$prevread,&group_args($group));
unless ($seehidden) {
my $grpargs = &group_args($group);
$sender.=" <a href=\"javascript:verifydelete('studentdelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')";
$sender .= '">'.&mt('Delete').'</a>';
}
}
}
if ($seehidden) {
if ($hiddens{$idx}) {
unless ($studenthidden) {
$sender.=' '.
&discussion_link($ressymb,&mt('Make Visible'),'unhide',$idx,$$newpostsflag,$prevread,&group_args($group));
}
} else {
$sender.=' '.
&discussion_link($ressymb,&mt('Hide'),'hide',$idx,$$newpostsflag,$prevread,&group_args($group));
}
my $grpargs = &group_args($group);
$sender.=
" <a href=\"javascript:verifydelete('seeiddelete','$escsymb','$idx','$$newpostsflag','$prevread','$grpargs')\">";
$sender .= &mt('Delete').'</a>';
}
}
} else {
if ($screenname) {
$sender='<i>'.$screenname.'</i>';
} else {
$sender='<i>'.$$anonhash{$key}.'</i>';
}
$sender = '<b>'.$sender.'</b>';
# 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 ($outputtarget ne 'tex') {
if (&discussion_open($status)) {
if (($group ne '') &&
(&check_group_priv($group,'pgd') eq 'ok')) {
$sender.=' '.
&discussion_link($ressymb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread,&group_args($group));
} elsif (&Apache::lonnet::allowed('pch',
$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.
$env{'request.course.sec'}:''))) {
$sender.=' '.
&discussion_link($ressymb,&mt('Reply'),'replydisc',$idx,$$newpostsflag,$prevread);
}
}
if ($viewgrades) {
$vgrlink=&Apache::loncommon::submlink(&mt('Submissions'),
$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$ressymb);
}
if ($$dischash{$readkey}=~/\.$idx\./) {
$ctlink = '<label><b>'.&mt('Mark unread').'?</b> <input type="checkbox" name="postunread_'.$idx.'" /></label>';
} else {
$ctlink = '<label><b>'.&mt('Mark read').'?</b> <input type="checkbox" name="postread_'.$idx.'" /></label>';
}
}
}
#figure out at what position this needs to print
}
if ($outputtarget eq 'export' || $message) {
my $thisindex=$idx;
if ( ((!$env{'environment.unthreadeddiscussion'}) && ($sortposts eq '')) ||
($sortposts eq 'thread') || ($outputtarget eq 'export')) {
$thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2);
}
$$alldiscussion{$thisindex}=$idx;
$$shown{$idx} = 0;
$index[$idx]=$thisindex;
}
if ($outputtarget eq 'export') {
%{$$imsitems{$idx}} = ();
$$imsitems{$idx}{'isvisible'}='true';
if ($hiddens{$idx}) {
$$imsitems{$idx}{'isvisible'}='false';
}
$$imsitems{$idx}{'title'}=$subjects{$numoldver};
$$imsitems{$idx}{'message'}=$messages{$numoldver};
$$imsitems{$idx}{'attach'}=$attachtxt{$numoldver};
$$imsitems{$idx}{'timestamp'}=$contrib{$idx.':timestamp'};
$$imsitems{$idx}{'sender'}=$plainname.' ('.
$contrib{$idx.':sendername'}.':'.
$contrib{$idx.':senderdomain'}.')';
$$imsitems{$idx}{'isanonymous'}='false';
if ($contrib{$idx.':anonymous'}) {
$$imsitems{$idx}{'isanonymous'}='true';
}
$$imsitems{$idx}{'currversion'}=$numoldver;
%{$$imsitems{$idx}{'allattachments'}}=%allattachments;
unless ($messages{$numoldver} eq '' && $attachtxt{$numoldver} eq '') {
$$shown{$idx} = 1;
}
} else {
if ($message) {
my $spansize = 2;
my ($uname,$udom);
if ($showonlyunread && $prevread > $posttime) {
$$notshown{$idx} = 1;
} elsif ($showunmark && $$dischash{$readkey}=~/\.$idx\./) {
$$notshown{$idx} = 1;
} else {
# apply filters
$uname = $contrib{$idx.':sendername'};
$udom = $contrib{$idx.':senderdomain'};
my $poster = $uname.':'.$udom;
if ($env{'form.totposters'} ne '') {
if ($totposters == 0) {
$$shown{$idx} = 0;
} elsif ($totposters > 0) {
if (grep/^$poster$/,@{$posters}) {
$$shown{$idx} = 1;
}
}
} elsif ($sortposts) {
if ($skiptest) {
$$shown{$idx} = 1;
} else {
foreach my $role (@{$$roleinfo{$poster}}) {
if ($role =~ /^cc:/) {
my $cc_regexp = $roleregexp.':[^:]*:'.$statusregexp;
if ($role =~ /$cc_regexp/) {
$$shown{$idx} = 1;
last;
}
} elsif ($role =~ /^$rolematch$/) {
$$shown{$idx} = 1;
last;
}
}
}
if ($$shown{$idx} && !$skip_group_check) {
my $showflag = 0;
if (ref($$classgroups{$poster}{active}) eq 'HASH') {
foreach my $grp (@{$grouppick}) {
if (grep/^\Q$grp\E$/,
keys(%{$$classgroups{$poster}{active}})) {
$showflag = 1;
last;
}
}
}
if ($showflag) {
$$shown{$idx} = 1;
} else {
$$shown{$idx} = 0;
}
}
} else {
$$shown{$idx} = 1;
}
}
unless ($$notshown{$idx} == 1) {
if ($prevread > 0 && $prevread <= $posttime) {
$$newitem{$idx} = 1;
$$discussionitems[$idx] .= '<font color="#FF0000"><b>'.&mt('NEW').' </b></font>';
} else {
$$newitem{$idx} = 0;
}
$$discussionitems[$idx] .= '<b>'.$subject.'</b> '.
$sender.' '.$vgrlink.' ('.
&Apache::lonlocal::locallocaltime($posttime).')';
if ($$dischash{$toggkey}) {
$$discussionitems[$idx].=' '.$ctlink;
}
my $thislikes=$likes{$symb.':'.$idx.':likes'};
my $likestyle;
if ($seeid || $canvote) {
# Figure out size based on likes
my $class = 'zero';
my $thislikes=$likes{$symb.':'.$idx.':likes'};
if ($thislikes>$twoplus) {
$class = 'twoplus';
} elsif ($thislikes>$oneplus) {
$class = 'oneplus';
}
if ($thislikes<$twominus) {
$class = 'twominus';
} elsif ($thislikes<$oneminus) {
$class = 'oneminus';
}
$likestyle = $votestyle{$class};
}
# Actually glue in the message itself
$$discussionitems[$idx].= '<br /><blockquote>'.
"<div $likestyle>".
$message.
'</div></blockquote>';
if ($canvote) {
my $ownpost;
if (($uname eq $env{'user.name'}) &&
($udom eq $env{'user.domain'})) {
$ownpost = 1;
}
# Put in the like and unlike buttons
if ($ownpost || (($hiddens{$idx}) && ($seehidden))) {
my $novote;
if ($ownpost) {
$novote = &mt('No voting for your own posts.');
} else {
$novote = &mt('No voting for hidden posts.');
}
&html_escape(\$novote);
$$discussionitems[$idx].=
'<a href="javascript:alert('."'$novote'".');" style="text-decoration: none;">'.
'<img border="0" src="/res/adm/pages/thumbsup_novote.png" alt="'.$novote.'" /> '.
'<img border="0" src="/res/adm/pages/thumbsdown_novote.png" alt="'.$novote.'" /></a>';
} else {
if ($userlikes{$idx}) {
$$discussionitems[$idx].='<img border="0" src="/res/adm/pages/thumbsup_gray.png" alt="'.&mt('You like this posting').'" />';
} else {
$$discussionitems[$idx].=' '.&discussion_link($ressymb,'<img border="0" src="/res/adm/pages/thumbsup.png" alt="'.&mt('Like').'" />','like',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Like this posting"));
}
if ($userunlikes{$idx}) {
$$discussionitems[$idx].='<img border="0" src="/res/adm/pages/thumbsdown_gray.png" alt="'.&mt('You unlike this posting').'" />';
} else {
$$discussionitems[$idx].=' '.&discussion_link($ressymb,'<img border="0" src="/res/adm/pages/thumbsdown.png" alt="'.&mt('Unlike').'" />','unlike',$idx,$$newpostsflag,$prevread,&group_args($group),&mt("Unlike this posting"));
}
}
}
if ($seeid || $canvote) {
my $thislikes=$likes{$symb.':'.$idx.':likes'};
if ($thislikes>0) {
$$discussionitems[$idx].=' ('.&mt("[_1] likes",$thislikes).')';
} elsif ($thislikes<0) {
$$discussionitems[$idx].=' ('.&mt("[_1] unlikes",abs($thislikes)).')';
}
}
# If there is any history to this post, inform the reader
if ($contrib{$idx.':history'}) {
my @postversions = ();
$$discussionitems[$idx] .= ' '.&mt('This post has been edited by the author.');
if ($seehidden) {
$$discussionitems[$idx] .= ' '.
&discussion_link($ressymb,&mt('Display all versions'),'allversions',$idx,$$newpostsflag,$prevread,&group_args($group));
}
$$discussionitems[$idx].='<br/>'.&mt('Earlier version(s) were posted on: ');
if ($contrib{$idx.':history'} =~ m/:/) {
@postversions = split(/:/,$contrib{$idx.':history'});
} else {
@postversions = ("$contrib{$idx.':history'}");
}
for (my $i=0; $i<@postversions; $i++) {
my $version = $i+1;
$$discussionitems[$idx] .= '<b>'.$version.'.</b> - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' ';
}
}
# end of unless ($$notshown ...)
}
# end of if ($message) ...
}
# end of the else-branch of target being export
}
# end of unless hidden or deleted
}
# end of the loop over all discussion entries
}
# end of "if there actually are any discussions
}
# end of subroutine "build_posting_display"
}
sub filter_regexp {
my ($rolefilter,$sectionpick,$statusfilter) = @_;
my ($roleregexp,$secregexp,$statusregexp);
my $skiptest = 1;
if (@{$rolefilter} > 0) {
my @okrolefilter = ();
foreach my $role (@{$rolefilter}) {
unless ($role eq '') {
push(@okrolefilter, $role);
}
}
if (@okrolefilter > 0) {
if (grep/^all$/,@okrolefilter) {
$roleregexp='[^:]+';
} else {
if (@okrolefilter == 1) {
$roleregexp=$okrolefilter[0];
} else {
$roleregexp='('.join('|',@okrolefilter).')';
}
$skiptest = 0;
}
}
}
if (@{$sectionpick} > 0) {
my @oksectionpick = ();
foreach my $sec (@{$sectionpick}) {
unless ($sec eq '') {
push(@oksectionpick, $sec);
}
}
if ((@oksectionpick > 0) && (!grep/^all$/,@oksectionpick)) {
if (@oksectionpick == 1) {
$secregexp = $oksectionpick[0];
} else {
$secregexp .= '('.join('|',@oksectionpick).')';
}
$skiptest = 0;
} else {
$secregexp .= '[^:]*';
}
}
if (defined($statusfilter) && $statusfilter ne '') {
if ($statusfilter eq 'all') {
$statusregexp = '[^:]+';
} else {
$statusregexp = $statusfilter;
$skiptest = 0;
}
}
return ($skiptest,$roleregexp,$secregexp,$statusregexp);
}
sub get_post_contents {
my ($contrib,$idx,$seeid,$seehidden,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$showaboutme,$numver) = @_;
my $discussion = '';
my $start=$numver;
my $end=$numver + 1;
%{$$imsfiles{$idx}}=();
if ($type eq 'allversions') {
unless($seehidden) {
$discussion=&mt('You do not have privileges to view all versions of posts.').' '.&mt('Please select a different role.');
return $discussion;
}
}
# $$screenname=&Apache::loncommon::screenname(
# $$contrib{$idx.':sendername'},
# $$contrib{$idx.':senderdomain'});
$$plainname=&Apache::loncommon::nickname(
$$contrib{$idx.':sendername'},
$$contrib{$idx.':senderdomain'});
$$screenname=$$contrib{$idx.':screenname'};
$$showaboutme = &Apache::lonnet::usertools_access($$contrib{$idx.':sendername'},
$$contrib{$idx.':senderdomain'},
'aboutme');
my $sender = $$plainname;
if ($$showaboutme) {
$sender = &Apache::loncommon::aboutmewrapper(
$$plainname,
$$contrib{$idx.':sendername'},
$$contrib{$idx.':senderdomain'});
}
if ($seeid) {
$sender .= ' ('.$$contrib{$idx.':sendername'}.':'.
$$contrib{$idx.':senderdomain'}.')';
}
my $attachmenturls = $$contrib{$idx.':attachmenturl'};
my @postversions = ();
if ($type eq 'allversions' || $type eq 'export') {
$start = 0;
if ($$contrib{$idx.':history'}) {
@postversions = split(/:/,$$contrib{$idx.':history'});
}
&get_post_versions($messages,$$contrib{$idx.':message'},1);
&get_post_versions($subjects,$$contrib{$idx.':subject'},1);
push(@postversions,$$contrib{$idx.':timestamp'});
$end = @postversions;
} else {
&get_post_versions($messages,$$contrib{$idx.':message'},1,$numver);
&get_post_versions($subjects,$$contrib{$idx.':subject'},1,$numver);
}
if ($$contrib{$idx.':anonymous'}) {
$sender.=' ['.&mt('anonymous').'] '.$$screenname;
}
if ($type eq 'allversions') {
$discussion=('<b>'.$sender.'</b><br /><ul>');
}
for (my $i=$start; $i<$end; $i++) {
my ($timesent,$attachmsg);
my %currattach = ();
$timesent = &Apache::lonlocal::locallocaltime($postversions[$i]);
unless (&contains_block_html($messages->{$i})) {
&newline_to_br(\$messages->{$i});
}
$$messages{$i}=&Apache::lontexconvert::msgtexconverted($$messages{$i});
$$subjects{$i}=~s/\n/\<br \/\>/g;
$$subjects{$i}=&Apache::lontexconvert::msgtexconverted($$subjects{$i});
if ($attachmenturls) {
&extract_attachments($attachmenturls,$idx,$i,\$attachmsg,$allattachments,\%currattach);
}
if ($type eq 'export') {
$$imsfiles{$idx}{$i} = '';
if ($attachmsg) {
$$attachtxt{$i} = '<br />'.&mt('Attachments').':<br />';
foreach my $key (sort(keys(%currattach))) {
if ($$allattachments{$key}{'filename'} =~ m-^/uploaded/([^/]+/[^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
my $fname = $1.$3.'/'.$4;
$$imsfiles{$idx}{$i} .= '<file href="'.$fname.'" />'."\n";
$$attachtxt{$i}.= '<a href="'.$fname.'">'.$4.'</a><br />';
}
}
}
} else {
if ($attachmsg) {
$$attachtxt{$i} = '<br />'.&mt('Attachments').':'.$attachmsg.'<br />';
} else {
$$attachtxt{$i} = '';
}
}
if ($type eq 'allversions') {
$discussion.= <<"END";
<li><b>$$subjects{$i}</b>, $timesent<br />
$$messages{$i}<br />
$$attachtxt{$i}</li>
END
}
}
if ($type eq 'allversions') {
$discussion.='</ul>';
return $discussion;
} else {
return;
}
}
sub replicate_attachments {
my ($attachrefs,$tempexport) = @_;
my $response;
foreach my $id (keys(%{$attachrefs})) {
if ($$attachrefs{$id}{'filename'} =~ m-^/uploaded/([^/]+)/([^/]+)(/feedback)?(/?\d*)/([^/]+)$-) {
my $path = $tempexport;
my $tail = $1.'/'.$2.$4;
my @extras = split(/\//,$tail);
my $destination = $tempexport.'/'.$1.'/'.$2.$4.'/'.$5;
if (!-e $destination) {
my $i= 0;
while ($i<@extras) {
$path .= '/'.$extras[$i];
if (!-e $path) {
mkdir($path,0700);
}
$i ++;
}
my ($content,$rtncode);
my $uploadreply = &Apache::lonnet::getuploaded('GET',$$attachrefs{$id}{'filename'},$1,$2,$content,$rtncode);
if ($uploadreply eq 'ok') {
my $attachcopy;
if ($attachcopy = Apache::File->new('>'.$destination)) {
print $attachcopy $content;
close($attachcopy);
} else {
$response .= &mt('Error copying file attachment - [_1] to IMS package',$5).': '.$!.'<br />'."\n";
}
} else {
&Apache::lonnet::logthis("Replication of attachment failed when building IMS export of discussion posts - domain: $1, course: $2, file: $$attachrefs{$id}{'filename'} -error: $rtncode");
$response .= &mt('Error copying file attachment - [_1] to IMS package: ',$5).$rtncode.'<br />'."\n";
}
}
}
}
return $response;
}
sub mail_screen {
my ($r,$feedurl,$options,$caller_symb,$attachmaxtext) = @_;
if (exists($env{'form.origpage'})) {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','currnewattach','addnewattach','deloldattach','delnewattach','timestamp','idx','anondiscuss','discuss','blog','group','ref']);
}
my %lt = &Apache::lonlocal::texthash(
'myqu' => 'Question/comment/feedback:',
'reta' => 'Retained attachments',
'atta' => 'Attachment',
);
if ($env{'form.editdisc'} || $env{'form.replydisc'}){
$lt{'myqu'} = &mt('Post Discussion');
}
my $restitle = &get_resource_title($caller_symb,$feedurl);
my $quote='';
my $subject = '';
my $comment = '';
my $prevtag = '';
my $parentmsg = '';
my ($symb,$idx,$attachmenturls);
my $numoldver = 0;
my $attachmsg = '';
my $newattachmsg = '';
my @currnewattach = ();
my @currdelold = ();
my @keepold = ();
my %attachments = ();
my %currattach = ();
my $attachnum = 0;
my $anonchk = (<<END);
function anonchk() {
for (var i=0; i < document.mailform.discuss.length; i++) {
if (document.mailform.discuss[i].checked) {
document.attachment.discuss.value =
document.mailform.discuss[i].value;
}
}
if (document.mailform.blog.checked) {
document.attachment.blog.value = 1;
}
return
}
END
my $anonscript;
if (exists($env{'form.origpage'})) {
$anonscript = (<<END);
function setposttype() {
var disc = "$env{'form.discuss'}";
for (var i=0; i < document.mailform.discuss.length; i++) {
if (disc == document.mailform.discuss[i].value) {
document.mailform.discuss[i].checked = 1;
}
}
var blog = "$env{'form.blog'}";
if (blog == 1) {
document.mailform.blog.checked=1;
}
return
}
END
} else {
$anonscript = (<<END);
function setposttype() {
return
}
END
}
if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) {
if ($env{'form.replydisc'}) {
($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'});
} else {
($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'});
}
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 $numoldver = 0;
if ($contrib{$idx.':history'}) {
if ($contrib{$idx.':history'} =~ /:/) {
my @oldversions = split(/:/,$contrib{$idx.':history'});
$numoldver = @oldversions;
} else {
$numoldver = 1;
}
}
if ($idx > 0) {
my (%msgversions,%subversions,$htmldecode);
$htmldecode = 0;
if ($env{'form.replydisc'}) {
$htmldecode = 1;
}
&get_post_versions(\%msgversions,$contrib{$idx.':message'},0,$numoldver);
&get_post_versions(\%subversions,$contrib{$idx.':subject'},$htmldecode,
$numoldver);
$subject = $subversions{$numoldver};
if ($env{'form.replydisc'}) {
$quote = $msgversions{$numoldver};
$subject = &HTML::Entities::encode(&mt('Re: ').$subject,'<>&"');
} else {
$comment = $msgversions{$numoldver};
}
}
if ($env{'form.editdisc'}) {
$attachmenturls = $contrib{$idx.':attachmenturl'};
if (defined($contrib{$idx.':replyto'})) {
$parentmsg = $contrib{$idx.':replyto'};
}
unless (exists($env{'form.origpage'})) {
my $anonflag = 'nonanon';
if ($contrib{$idx.':anonymous'}) {
$anonflag = 'anon';
}
$anonscript = (<<END);
function setposttype () {
var currtype = "$anonflag";
for (var i=0; i<document.mailform.discuss.length; i++) {
if (document.mailform.elements.discuss[i].value == currtype ) {
document.mailform.elements.discuss[i].checked=1;
}
}
return
}
END
}
}
}
if ($env{'form.previous'}) {
$prevtag = '<input type="hidden" name="previous" value="'.$env{'form.previous'}.'" />';
}
}
if ($env{'form.origpage'}) {
$subject = &unescape($env{'form.subject'});
$comment = &unescape($env{'form.comment'});
&process_attachments(\@currnewattach,\@currdelold,\@keepold);
}
my $latexHelp=&Apache::loncommon::helpLatexCheatsheet(undef,undef,1,($env{'form.modal'}?'popup':0));
my $send=&mt('Send');
my $alert = &mt('Please select a feedback type.');
&js_escape(\$alert);
my $js= <<END;
<script type="text/javascript">
//<!--
function gosubmit() {
var rec=0;
if (typeof(document.mailform.elements.discuss)!="undefined") {
if (typeof(document.mailform.elements.discuss.length) == "undefined") {
if (document.mailform.elements.discuss.checked ) {
rec=1;
}
} else {
for (var i=0; i<document.mailform.elements.discuss.length; i++) {
if (document.mailform.elements.discuss[i].checked ) {
rec=1;
}
}
}
}
if (typeof(document.mailform.elements.blog)!="undefined") {
if (document.mailform.elements.blog.checked) {
rec=1;
}
}
if (rec) {
if (typeof(document.mailform.onsubmit)=='function') {
document.mailform.onsubmit();
}
document.mailform.submit();
} else {
alert('$alert');
}
}
$anonchk
$anonscript
//-->
</script>
<script type="text/javascript" src="/res/adm/includes/file_upload.js"></script>
END
my ($textareaheader,$textareaclass);
if (&Apache::lonhtmlcommon::htmlareabrowser()) {
$textareaheader = &Apache::lonhtmlcommon::htmlareaselectactive();
$textareaclass = 'class="LC_richDefaultOff"';
if ($env{'request.course.id'}) {
unless (($env{'course.'.$env{'request.course.id'}.'.allow_limited_html_in_feedback'} =~ /^\s*yes\s*$/i) || ($env{'form.sendmessageonly'})) {
undef($textareaclass);
}
}
}
# Breadcrumbs
my $brcrum = [{'href' => '',
'text' => 'Resource Feedback and Discussion'}];
my %onload = ('onload' => 'window.focus();setposttype();');
my %parms=('add_entries' => \%onload);
if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; }
my $start_page=
&Apache::loncommon::start_page('Resource Feedback and Discussion',$js,\%parms);
if ($quote ne '') {
$quote = &HTML::Entities::decode($quote);
unless (&contains_block_html($quote)) {
&newline_to_br(\$quote);
}
$quote=&Apache::lonhtmlcommon::start_pick_box().
&Apache::lonhtmlcommon::row_title(&mt('Quote')).
&Apache::lontexconvert::msgtexconverted($quote).
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::end_pick_box();
}
my $header='';
unless ($env{'form.modal'}) {
$header="<h2><tt>$restitle</tt></h2>";
}
$r->print(<<END);
$start_page
<h1>$lt{'myqu'}</h1>
$header
<form action="/adm/feedback" method="post" name="mailform"
enctype="multipart/form-data">
$prevtag
<input type="hidden" name="postdata" value="$feedurl" />
<input type="hidden" name="modal" value="$env{'form.modal'}" />
END
if ($env{'form.replydisc'}) {
$r->print(<<END);
<input type="hidden" name="replydisc" value="$env{'form.replydisc'}" />
END
} elsif ($env{'form.editdisc'}) {
$r->print(<<END);
<input type="hidden" name="editdisc" value="$env{'form.editdisc'}" />
<input type="hidden" name="parentmsg" value="$parentmsg" />
END
}
$r->print(<<END);
$options
<br />
END
$r->print(&Apache::lonhtmlcommon::start_pick_box());
$r->print(<<END);
$quote
<p>
$textareaheader
</p>
<p>
$latexHelp
</p>
<p>
END
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject')));
$r->print('<input type="text" name="subject" size="30" value="'.
$subject.'" /></p>');
$r->print(&Apache::lonhtmlcommon::row_closure());
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Message')));
$r->print('<textarea name="comment" id="comment" cols="55" rows="10" '.
$textareaclass.'>'.$comment.
'</textarea>');
$r->print(&Apache::lonhtmlcommon::row_closure(1));
$r->print(&Apache::lonhtmlcommon::end_pick_box());
if ( ($env{'form.editdisc'}) || ($env{'form.replydisc'}) ) {
if ($env{'form.origpage'}) {
foreach my $attach (@currnewattach) {
$r->print('<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n");
}
foreach my $oldatt (@currdelold) {
$r->print('<input type="hidden" name="deloldattach" value="'.$oldatt.'" />'."\n");
}
}
if ($env{'form.editdisc'}) {
if ($attachmenturls) {
&extract_attachments($attachmenturls,$idx,$numoldver,\$attachmsg,\%attachments,\%currattach,\@currdelold);
$attachnum = scalar(keys(%currattach));
foreach my $key (keys(%currattach)) {
$r->print('<input type="hidden" name="keepold" value="'.$key.'" />'."\n");
}
}
}
} else {
$r->print(<<END);
<p>
$lt{'atta'} $attachmaxtext: <input type="file" name="attachment" class="LC_flUpload" />
<input type="hidden" id="LC_free_space" value="131072" />
</p>
END
}
if (exists($env{'form.group'})) {
$r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />');
}
if (exists($env{'form.ref'})) {
$r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />');
}
$r->print(<<END);
<input type="hidden" name="sendit" value="1" /><br /><br />
<input type="button" value="$send" onclick='gosubmit();' />
</form>
END
if ($env{'form.editdisc'} || $env{'form.replydisc'}) {
my $now = time;
my $ressymb = $symb;
&Apache::lonenc::check_encrypt(\$ressymb);
my $postidx = '';
if ($env{'form.editdisc'}) {
$postidx = $idx;
}
if (@currnewattach > 0) {
$attachnum += @currnewattach;
}
my $blockblog = &Apache::loncommon::blocking_status('blogs');
if ($attachnum > 0) {
if (@currnewattach > 0) {
$newattachmsg .= '<br /><b>'.&mt('New attachments').'</b><br />';
if (@currnewattach > 1) {
$newattachmsg .= '<ol>';
foreach my $item (@currnewattach) {
$item =~ m#.*/([^/]+)$#;
$newattachmsg .= '<li><a href="'.$item.'">'.$1.'</a></li>'."\n";
}
$newattachmsg .= '</ol>'."\n";
} else {
$currnewattach[0] =~ m#.*/([^/]+)$#;
$newattachmsg .= '<a href="'.$currnewattach[0].'">'.$1.'</a><br />'."\n";
}
}
if ($attachmsg) {
$r->print("<br /><b>$lt{'reta'}</b>:$attachmsg<br />\n");
}
if ($newattachmsg) {
$r->print("$newattachmsg");
}
}
$r->print(&generate_attachments_button($postidx,$attachnum,$ressymb,$now,\@currnewattach,\@currdelold,$numoldver,'',$blockblog));
}
$r->print(&generate_preview_button().
&Apache::loncommon::end_page());
}
sub print_display_options {
my ($r,$symb,$previous,$dispchgA,$dispchgB,$markchg,$toggchg,$feedurl) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $function = &Apache::loncommon::get_users_function();
my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
$env{'user.domain'});
my %lt = &Apache::lonlocal::texthash(
'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 discussion board or resource, and',
'unwh' => 'Under what circumstances posts are identified as "NEW", and',
'wipa' => 'Whether individual posts can be marked as read/unread',
'allposts' => 'All posts',
'unread' => 'New posts only',
'unmark' => 'Posts not marked read',
'ondisp' => 'Once displayed',
'onmark' => 'Once marked not NEW',
'toggon' => 'Shown',
'toggoff' => 'Not shown',
'disa' => 'Posts displayed?',
'npmr' => 'New posts cease to be identified as "NEW"?',
'dotm' => 'Option to mark each post as read/unread?',
'chgt' => 'Change to ',
'mkdf' => 'Set to ',
'yhni' => 'You have not indicated that you wish to change any of the discussion settings',
'ywbr' => 'You will be returned to the previous page if you click OK.'
);
my %js_lt = &Apache::lonlocal::texthash(
'yhni' => 'You have not indicated that you wish to change any of the discussion settings',
'ywbr' => 'You will be returned to the previous page if you click OK.'
);
&js_escape(\%js_lt);
my $dispchangeA = $lt{'unread'};
my $dispchangeB = $lt{'unmark'};
my $markchange = $lt{'ondisp'};
my $toggchange = $lt{'toggon'};
my $currdisp = $lt{'allposts'};
my $currmark = $lt{'onmark'};
my $discdisp = 'allposts';
my $discmark = 'onmark';
my $currtogg = $lt{'toggoff'};
my $disctogg = 'toggoff';
if ($dispchgA eq 'allposts') {
$dispchangeA = $lt{'allposts'};
$currdisp = $lt{'unread'};
$discdisp = 'unread';
}
if ($markchg eq 'markonread') {
$markchange = $lt{'onmark'};
$currmark = $lt{'ondisp'};
$discmark = 'ondisp';
}
if ($dispchgB eq 'onlyunread') {
$dispchangeB = $lt{'unread'};
$currdisp = $lt{'unmark'};
$discdisp = 'unmark';
}
if ($toggchg eq 'toggoff') {
$toggchange = $lt{'toggoff'};
$currtogg = $lt{'toggon'};
$disctogg = 'toggon';
}
my $js = <<END;
<script type="text/javascript">
function discdispChk(caller) {
var disctogg = '$toggchg'
if (caller == 0) {
if (document.modifydisp.discdisp[0].checked == true) {
if (document.modifydisp.discdisp[1].checked == true) {
document.modifydisp.discdisp[1].checked = false
}
}
}
if (caller == 1) {
if (document.modifydisp.discdisp[1].checked == true) {
if (document.modifydisp.discdisp[0].checked == true) {
document.modifydisp.discdisp[0].checked = false
}
if (disctogg == 'toggon') {
document.modifydisp.disctogg.checked = true
}
if (disctogg == 'toggoff') {
document.modifydisp.disctogg.checked = false
}
}
}
if (caller == 2) {
var dispchgB = '$dispchgB'
if (disctogg == 'toggoff') {
if (document.modifydisp.disctogg.checked == true) {
if (dispchgB == 'onlyunmark') {
document.modifydisp.discdisp[1].checked = false
}
}
}
}
}
function setDisp() {
var prev = "$previous"
var chktotal = 0
if (document.modifydisp.discdisp[0].checked == true) {
document.modifydisp.$dispchgA.value = "$symb"
chktotal ++
}
if (document.modifydisp.discdisp[1].checked == true) {
document.modifydisp.$dispchgB.value = "$symb"
chktotal ++
}
if (document.modifydisp.discmark.checked == true) {
document.modifydisp.$markchg.value = "$symb"
chktotal ++
}
if (document.modifydisp.disctogg.checked == true) {
document.modifydisp.$toggchg.value = "$symb"
chktotal ++
}
if (chktotal > 0) {
document.modifydisp.submit()
} else {
if(confirm("$js_lt{'yhni'}. \\n$js_lt{'ywbr'}")) {
if (prev > 0) {
location.href = "$feedurl?previous=$previous"
} else {
location.href = "$feedurl"
}
}
}
}
</script>
END
my $start_page =
&Apache::loncommon::start_page('Discussion display options',$js);
my $end_page =
&Apache::loncommon::end_page();
$r->print(<<END);
$start_page
<form name="modifydisp" method="post" action="/adm/feedback">
$lt{'sdpf'}<br/> $lt{'prca'} <ol><li>$lt{'whpo'}</li><li>$lt{'unwh'}</li><li>$lt{'wipa'}</li></ol>
<br />
END
$r->print(&Apache::loncommon::start_data_table());
$r->print(<<END);
<tr>
<th>$lt{'pref'}</td>
<th>$lt{'curr'}</td>
<th>$lt{'actn'}?</td>
</tr>
END
$r->print(&Apache::loncommon::start_data_table_row());
$r->print(<<END);
<td>$lt{'disa'}</td>
<td>$lt{$discdisp}</td>
<td><label><input type="checkbox" name="discdisp" onclick="discdispChk('0')" /> $lt{'chgt'} "$dispchangeA"</label>
<br />
<label><input type="checkbox" name="discdisp" onclick="discdispChk('1')" /> $lt{'chgt'} "$dispchangeB"</label>
</td>
END
$r->print(&Apache::loncommon::end_data_table_row());
$r->print(&Apache::loncommon::start_data_table_row());
$r->print(<<END);
<td>$lt{'npmr'}</td>
<td>$lt{$discmark}</td>
<td><label><input type="checkbox" name="discmark" />$lt{'chgt'} "$markchange"</label></td>
END
$r->print(&Apache::loncommon::end_data_table_row());
$r->print(&Apache::loncommon::start_data_table_row());
$r->print(<<END);
<td>$lt{'dotm'}</td>
<td>$lt{$disctogg}</td>
<td><label><input type="checkbox" name="disctogg" onclick="discdispChk('2')" />$lt{'chgt'} "$toggchange"</label></td>
END
my $save = &mt('Save');
$r->print(&Apache::loncommon::end_data_table_row());
$r->print(&Apache::loncommon::end_data_table());
$r->print(<<END);
<br />
<br />
<input type="hidden" name="symb" value="$symb" />
<input type="hidden" name="previous" value="$previous" />
<input type="hidden" name="$dispchgA" value="" />
<input type="hidden" name="$dispchgB" value="" />
<input type="hidden" name="$markchg" value="" />
<input type="hidden" name="$toggchg" value="" />
<input type="button" name="sub" value="$save" onclick="javascript:setDisp()" />
END
if (exists($env{'form.group'})) {
$r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />');
}
if (exists($env{'form.ref'})) {
$r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />');
}
$r->print("
<br />
<br />
</form>
$end_page
");
return;
}
sub print_sortfilter_options {
my ($r,$symb,$previous,$feedurl) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::lonenc::check_encrypt(\$symb);
my @sections;
my $section_sel = '';
my $numvisible = 5;
my @groups;
my $group_sel = '';
my $numgroupvis = 5;
my %sectioncount = &Apache::loncommon::get_sections();
my @courseroles = qw(st ad ep ta in);
my $crstype = &Apache::loncommon::course_type();
my $ccrole = 'cc';
if ($crstype eq 'Community') {
$ccrole = 'co';
}
push(@courseroles,$ccrole);
if ($env{'request.course.sec'} !~ /^\s*$/) { #Restrict section choice to current section
@sections = ('all',$env{'request.course.sec'});
$numvisible = 2;
} else {
@sections = sort {$a cmp $b} keys(%sectioncount);
if (scalar(@sections) < 4) {
$numvisible = scalar(@sections) + 1;
}
unshift(@sections,'all'); # Put 'all' at the front of the list
}
foreach my $sec (@sections) {
$section_sel .= " <option value=\"$sec\">$sec</option>\n";
}
if (&check_group_priv() eq 'ok') {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
@groups = sort {$a cmp $b} keys(%curr_groups);
if (scalar(@groups) < 4) {
$numgroupvis = scalar(@groups) + 1;
}
unshift(@groups,'all'); # Put 'all' at the front of the list
} else {
my @coursegroups = split(/:/,$env{'request.course.groups'});
if (@coursegroups > 0) {
@coursegroups = sort {$a cmp $b} @coursegroups;
@groups = ('all',@coursegroups);
if (scalar(@groups) < 4) {
$numgroupvis = scalar(@groups) + 1;
}
} else {
@groups = ('all');
$numgroupvis = 1;
}
}
foreach my $group (@groups) {
$group_sel .= " <option value=\"$group\">$group</option>\n";
}
my $function = &Apache::loncommon::get_users_function();
my $tabcolor = &Apache::loncommon::designparm($function.'.tabbg',
$env{'user.domain'});
my %lt = &Apache::lonlocal::texthash(
'diop' => 'Display Options',
'curr' => 'Current setting ',
'actn' => 'Action',
'prca' => 'Set options that control the sort order of posts, and/or which posts are displayed.',
'soor' => 'Sort order',
'spur' => 'Specific user roles',
'sprs' => 'Specific role status',
'spse' => 'Specific sections',
'spgr' => 'Specific groups',
'psub' => 'Pick specific users (by name)',
'shal' => 'Show a list of current posters',
'stor' => 'Save changes',
);
my %sort_types = ();
my %role_types = ();
my %status_types = ();
&sort_filter_names(\%sort_types,\%role_types,\%status_types,$crstype);
my $js = <<END;
<script type="text/javascript">
function verifyFilter() {
var rolenum = 0
for (var i=0; i<document.modifyshown.rolefilter.length; i++) {
if (document.modifyshown.rolefilter.options[i].selected == true) {
rolenum ++
}
}
if (rolenum == 0) {
document.modifyshown.rolefilter.options[0].selected = true
}
var secnum = 0
for (var i=0; i<document.modifyshown.sectionpick.length; i++) {
if (document.modifyshown.sectionpick.options[i].selected == true) {
secnum ++
}
}
if (secnum == 0) {
document.modifyshown.sectionpick.options[0].selected = true
}
var grpnum = 0
for (var i=0; i<document.modifyshown.grouppick.length; i++) {
if (document.modifyshown.grouppick.options[i].selected == true) {
grpnum ++
}
}
if (grpnum == 0) {
document.modifyshown.grouppick.options[0].selected = true
}
document.modifyshown.submit();
}
</script>
END
my $start_page=
&Apache::loncommon::start_page('Discussion options',$js);
my $end_page=
&Apache::loncommon::end_page();
$r->print(<<END);
$start_page
<form name="modifyshown" method="post" action="/adm/feedback">
<b>$lt{'diso'}</b><br/> $lt{'prca'}
<br />
<table border="0">
<tr>
<th>$lt{'soor'}</th>
<th> </th>
<th>$lt{'sprs'}</th>
<th> </th>
<th>$lt{'spur'}</th>
<th> </th>
<th>$lt{'spse'}</th>
<th> </th>
<th>$lt{'spgr'}</th>
<th> </th>
<th>$lt{'psub'}</th>
</tr>
<tr>
<td align="center" valign="top">
<select name="sortposts">
<option value="ascdate" selected="selected">$sort_types{'ascdate'}</option>
<option value="descdate">$sort_types{'descdate'}</option>
<option value="thread">$sort_types{'thread'}</option>
<option value="subject">$sort_types{'subject'}</option>
<option value="username">$sort_types{'username'}</option>
<option value="lastfirst">$sort_types{'lastfirst'}</option>
</select>
</td>
<td> </td>
<td align="center" valign="top">
<select name="statusfilter">
<option value="all" selected="selected">$status_types{'all'}</option>
<option value="Active">$status_types{'Active'}</option>
<option value="Expired">$status_types{'Expired'}</option>
<option value="Future">$status_types{'Future'}</option>
</select>
</td>
<td> </td>
<td align="center" valign="top">
<select name="rolefilter" multiple="multiple" size="5">
<option value="all">$role_types{'all'}</option>
<option value="st">$role_types{'st'}</option>
<option value="$ccrole">$role_types{$ccrole}</option>
<option value="in">$role_types{'in'}</option>
<option value="ta">$role_types{'ta'}</option>
<option value="ep">$role_types{'ep'}</option>
<option value="ad">$role_types{'ad'}</option>
<option value="cr">$role_types{'cr'}</option>
</select>
</td>
<td> </td>
<td align="center" valign="top">
<select name="sectionpick" multiple="multiple" size="$numvisible">
$section_sel
</select>
</td>
<td> </td>
<td align="center" valign="top">
<select name="grouppick" multiple="multiple" size="$numvisible">
$group_sel
</select>
</td>
<td> </td>
<td valign="top"><label><input type="checkbox" name="posterlist" value="$symb" />$lt{'shal'}</label></td>
</tr>
</table>
<br />
<input type="hidden" name="inhibitmenu" value="$env{'form.inhibitmenu'}" />
<input type="hidden" name="modal" value="$env{'form.modal'}" />
<input type="hidden" name="previous" value="$previous" />
<input type="hidden" name="applysort" value="$symb" />
<input type="button" name="sub" value="$lt{'stor'}" onclick="verifyFilter()" />
END
if (exists($env{'form.group'})) {
$r->print('<input type="hidden" name="group" value="'.$env{'form.group'}.'" />');
}
if (exists($env{'form.ref'})) {
$r->print('<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />');
}
$r->print("
<br />
<br />
</form>
$end_page
");
}
sub print_showposters {
my ($r,$symb,$previous,$feedurl,$sortposts) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::lonenc::check_encrypt(\$symb);
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $group = $env{'form.group'};
my $ressymb = &wrap_symb($symb);
my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum);
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
my %namesort = ();
my %postcounts = ();
my %lt = &Apache::lonlocal::texthash(
sele => 'Select',
full => 'Fullname',
usdo => 'Username:domain',
post => 'Posts',
);
if ($contrib{'version'}) {
for (my $idx=1;$idx<=$contrib{'version'};$idx++) {
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
my $deleted=($contrib{'deleted'}=~/\.$idx\./);
unless ((($hidden) && (!$seehidden)) || ($deleted)) {
if ((!$contrib{$idx.':anonymous'}) || (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
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");
}
}
}
}
}
my $start_page = &Apache::loncommon::start_page('Discussion options');
my $table_start =&Apache::loncommon::start_data_table();
$r->print(<<END);
$start_page
<form name="pickpostersform" method="post" action="">
<br />
$table_start
<tr>
<th>#</th>
<th>$lt{'sele'}</th>
<th>$lt{'full'} <font color="#999999">($lt{'usdo'})</font></th>
<th>$lt{'post'}</th>
</tr>
END
my $count = 0;
foreach my $last (sort(keys(%namesort))) {
foreach my $first (sort(keys(%{$namesort{$last}}))) {
foreach my $user (sort(@{$namesort{$last}{$first}})) {
my ($uname,$udom) = split(/:/,$user);
if (!$uname || !$udom) {
next;
} else {
$count ++;
$r->print(&Apache::loncommon::start_data_table_row().
'<td align="right">'.$count.'</td>
<td align="center"><label><input name="stuinfo" type="checkbox" value="'.$user.'" /></td>
<td>'.$last.', '.$first.' ('.$uname.':'.$udom.')</label></td>
<td>'.$postcounts{$user}.'</td>'.
&Apache::loncommon::end_data_table_row());
}
}
}
}
$r->print(&Apache::loncommon::end_data_table());
my $end_page = &Apache::loncommon::end_page();
$r->print(<<END);
<br />
<input type="hidden" name="sortposts" value="$sortposts" />
<input type="hidden" name="modal" value="$env{'form.modal'}" />
<input type="hidden" name="userpick" value="$symb" />
<input type="button" name="store" value="Display posts" onclick="javascript:document.pickpostersform.submit()" />
</form>
$end_page
END
}
sub get_post_versions {
my ($versions,$incoming,$htmldecode,$numver) = @_;
if ($incoming =~ /^<version num="0">/) {
my $p = HTML::LCParser->new(\$incoming);
my $done = 0;
while ( (my $token = $p->get_tag("version")) && (!$done)) {
my $num = $token->[1]{num};
my $text = $p->get_text("/version");
if (defined($numver)) {
if ($num == $numver) {
if ($htmldecode) {
$text = &HTML::Entities::decode($text);
}
$$versions{$numver}=$text;
$done = 1;
}
} else {
if ($htmldecode) {
$text = &HTML::Entities::decode($text);
}
$$versions{$num}=$text;
}
}
} else {
if (!defined($numver)) {
$numver = 0;
}
if ($htmldecode) {
$$versions{$numver} = $incoming;
} else {
$$versions{$numver} = &HTML::Entities::encode($incoming,'<>&"');
}
}
return;
}
sub get_post_attachments {
my ($attachments,$attachmenturls) = @_;
my $num;
if ($attachmenturls =~ m/^<attachment id="0">/) {
my $p = HTML::LCParser->new(\$attachmenturls);
while (my $token = $p->get_tag("attachment","filename","post")) {
if ($token->[0] eq "attachment") {
$num = $token->[1]{id};
%{$$attachments{$num}} =();
} elsif ($token->[0] eq "filename") {
$$attachments{$num}{'filename'} = $p->get_text("/filename");
} elsif ($token->[0] eq "post") {
my $id = $token->[1]{id};
$$attachments{$num}{$id} = $p->get_text("/post");
}
}
} else {
%{$$attachments{'0'}} = ();
$$attachments{'0'}{'filename'} = $attachmenturls;
$$attachments{'0'}{'0'} = 'n';
}
return;
}
sub fail_redirect {
my ($r,$feedurl,$delay) = @_;
if ($feedurl=~/^\/adm\//) { $feedurl.='?register=1' };
my %lt = &Apache::lonlocal::texthash(
'sorr' => 'Sorry, no recipients ...',
);
my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
my %parms=('only_body' => 1);
if ($delay !~ /^\d+(|\.\d+)$/) {
$delay = 0;
}
if ($env{'form.modal'}) {
my $onload = 'document.forms.reldt.submit()';
if ($delay) {
my $js_delay = int(1000 * $delay);
$onload = "setTimeout(function(){
document.forms.reldt.submit();
},$js_delay);";
}
$parms{'add_entries'}={'onload' => $onload};
} else {
$parms{'redirect'}=[$delay,$feedurl];
}
$r->print(&Apache::loncommon::start_page('Feedback not sent',undef,\%parms));
my $windowname = 'loncapaclient';
if ($env{'request.lti.login'}) {
$windowname .= 'lti';
}
$r->print(<<ENDFAILREDIR);
<img align="right" src="$logo" />
<p class="LC_warning">$lt{'sorr'}</p>
<form name="reldt" action="$feedurl" target="$windowname">
</form>
ENDFAILREDIR
$r->print(&Apache::loncommon::end_page());
}
sub redirect_back {
my ($r,$feedurl,$typestyle,$sendsomething,$sendposts,$blog,$status,$previous,$sort,
$rolefilter,$statusfilter,$sectionpick,$grouppick,$numpicks,$group,$toolarge,$delay) = @_;
my $sorttag = '';
my $roletag = '';
my $statustag = '';
my $sectag = '';
my $grptag = '';
my $userpicktag = '';
my $qrystr = '';
my $prevtag = '';
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&dewrapper(\$feedurl);
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)) {
my $userpickqry = 'totposters='.$numpicks;
$feedurl .= '&'.$userpickqry;
$userpicktag = '<input type="hidden" name="totposters" value="'.$numpicks.'" />';
} else {
if (ref($sectionpick) eq 'ARRAY') {
$feedurl .= '&sectionpick=';
$sectag .= '<input type="hidden" name="sectionpick" value="';
foreach my $sec (@{$sectionpick}) {
$feedurl .= $sec.',';
$sectag .= $sec.',';
}
$feedurl =~ s/,$//;
$sectag =~ s/,$//;
$sectag .= '" />';
} else {
$feedurl .= '&sectionpick='.$sectionpick;
$sectag = '<input type="hidden" name="sectionpick" value="'.$sectionpick.'" />';
}
if (ref($grouppick) eq 'ARRAY') {
$feedurl .= '&grouppick=';
$sectag .= '<input type="hidden" name="grouppick" value="';
foreach my $grp (@{$grouppick}) {
$feedurl .= $grp.',';
$grptag .= $grp.',';
}
$feedurl =~ s/,$//;
$grptag =~ s/,$//;
$grptag .= '" />';
} else {
$feedurl .= '&grouppick='.$grouppick;
$grptag = '<input type="hidden" name="grouppick" value="'.$grouppick.'" />';
}
if (ref($rolefilter) eq 'ARRAY') {
$feedurl .= '&rolefilter=';
$roletag .= '<input type="hidden" name="rolefilter" value="';
foreach my $role (@{$rolefilter}) {
$feedurl .= $role.',';
$roletag .= $role.',';
}
$feedurl =~ s/,$//;
$roletag =~ s/,$//;
$roletag .= '" />';
} else {
$feedurl .= '&rolefilter='.$rolefilter;
$roletag = '<input type="hidden" name="rolefilter" value="'.$rolefilter.'" />';
}
$feedurl .= '&statusfilter='.$statusfilter;
$statustag ='<input type="hidden" name="statusfilter" value="'.$statusfilter.'" />';
}
}
my $grouptag;
if ($group ne '') {
$grouptag = '<input type="hidden" name="group" value="'.$group.'" />';
my $refarg;
if (exists($env{'form.ref'})) {
$refarg = '&ref='.$env{'form.ref'};
$grouptag .= '<input type="hidden" name="ref" value="'.$env{'form.ref'}.'" />';
}
if ($feedurl =~ /\?/) {
$feedurl .= '&group='.$group.$refarg;
} else {
$feedurl .= '?group='.$group.$refarg;
}
}
&Apache::lonenc::check_encrypt(\$feedurl);
my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
my %parms=('only_body' => 1);
if ($delay !~ /^\d+(|\.\d+)$/) {
$delay = 0;
}
if ($env{'form.modal'}) {
my $onload = 'document.forms.reldt.submit()';
if ($delay) {
my $js_delay = int(1000 * $delay);
$onload = "setTimeout(function(){
document.forms.reldt.submit();
},$js_delay);";
}
$parms{'add_entries'}={'onload' => $onload};
} else {
$parms{'redirect'}=[$delay,$feedurl];
}
my $start_page=
&Apache::loncommon::start_page('Feedback sent',undef,\%parms);
my $end_page = &Apache::loncommon::end_page();
my $windowname = 'loncapaclient';
if ($env{'request.lti.login'}) {
$windowname .= 'lti';
}
$r->print(<<ENDREDIR);
$start_page
<img align="right" src="$logo" />
$typestyle
<b>Sent $sendsomething message(s), and $sendposts post(s).</b>
$blog
$toolarge
<font color="red">$status</font>
<form name="reldt" action="$feedurl" target="$windowname">
$prevtag
$sorttag
$statustag
$roletag
$sectag
$grptag
$userpicktag
$grouptag
</form>
$end_page
ENDREDIR
}
sub no_redirect_back {
my ($r,$feedurl,$delay) = @_;
my $nofeed=&mt('Sorry, no feedback possible on this resource ...');
my $form_for_modal;
my %parms=('only_body' => 1,
'bgcolor' => '#FFFFFF',);
if ($delay !~ /^\d+(|\.\d+)$/) {
$delay = 0;
}
if ($env{'form.modal'}) {
if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) {
my $onload = 'document.forms.reldt.submit()';
if ($delay) {
my $js_delay = int(1000 * $delay);
$onload = "setTimeout(function(){
document.forms.reldt.submit();
},$js_delay);";
}
$parms{'add_entries'}={'onload' => $onload};
my $windowname = 'loncapaclient';
if ($env{'request.lti.login'}) {
$windowname .= 'lti';
}
$form_for_modal = <<ENDFORM;
<form name="reldt" action="$feedurl" target="$windowname">
</form>
ENDFORM
}
} else {
if (($feedurl !~ m{^/adm/feedback}) && ($feedurl ne '')) {
$parms{'redirect'}=[$delay,$feedurl];
}
}
my $start_page=
&Apache::loncommon::start_page('Feedback not sent',undef,
\%parms);
my $end_page = &Apache::loncommon::end_page();
my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
$r->print (<<ENDNOREDIRTWO);
$start_page
<img align="right" src="$logo" />
<b>$nofeed</b>
<br />
$form_for_modal
$end_page
ENDNOREDIRTWO
}
sub screen_header {
my ($feedurl,$symb,$group) = @_;
my %default = &Apache::lonlocal::texthash (
question => 'Question about resource content',
comment => 'Question/Comment/Feedback about course content',
policy => 'Question/Comment/Feedback about course policy',
);
my $contribdisc = &mt('Contribution to course discussion of resource');
my $anoncontrib = &mt('Anonymous contribution to course discussion of resource');
my $namevis = &mt('name only visible to course faculty');
my $crstype;
if ($env{'request.course.id'}) {
$crstype = &Apache::loncommon::course_type();
if ($crstype eq 'Community') {
$default{'comment'} = &mt('Question/Comment/Feedback about community content');
$default{'policy'} = &mt('Question/Comment/Feedback about community policy');
$contribdisc = &mt('Contribution to community discussion of resource');
$anoncontrib = &mt('Anonymous contribution to community discussion of resource');
$namevis = &mt('name only visible to community facilitators');
}
}
my $msgoptions='';
my $discussoptions='';
my $checkradio = '';
my $blockblog;
my (%fdbkoptions,%discoptions);
unless (($env{'form.replydisc'}) || ($env{'form.editdisc'})) {
if (($feedurl=~/^\/res\//) && ($feedurl!~/^\/res\/adm/) && ($env{'user.adv'})) {
$fdbkoptions{'author'} = 1;
}
if (&feedback_available(1)) {
$fdbkoptions{'question'} = 1;
}
if (&feedback_available(0,1)) {
$fdbkoptions{'course'} = 1;
}
if (&feedback_available(0,0,1)) {
$fdbkoptions{'policy'} = 1;
}
}
if (($env{'request.course.id'}) && (!$env{'form.sendmessageonly'})) {
my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('boards');
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $realsymb = &get_realsymb($symb);
if (!$blocked && &discussion_open(undef,$realsymb) &&
(&Apache::lonnet::allowed('pch',
$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) ||
(($group ne '') && ($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$}) && (&check_group_priv($group,'pgd') eq 'ok')))) {
$discoptions{'nonanon'} = 1;
if (&Apache::lonnet::allowed('pac',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$discoptions{'anon'} = 1;
}
$blockblog = &Apache::loncommon::blocking_status('blogs');
}
}
my $total = scalar(keys(%fdbkoptions)) + scalar(keys(%discoptions));
return if (!$total);
if ($total == 1) {
$checkradio = ' checked="checked"';
}
if (keys(%fdbkoptions)) {
if ($fdbkoptions{'author'}) {
$msgoptions =
'<label><input type="radio" name="discuss" value="author"'.$checkradio.' /> '.
&mt('Feedback to resource author').'</label><br />';
}
foreach my $item ('question','comment','policy') {
my $type = $item;
if ($item eq 'comment') {
$type = 'course';
}
my $optionhash=$env{'course.'.$env{'request.course.id'}.'.'.$item.'.email.text'};
if ($fdbkoptions{$type}) {
$msgoptions .=
'<label><input type="radio" name="discuss" value="'.$type.'"'.$checkradio.' />'.
($optionhash?$optionhash:$default{$item}).'</label><br />';
}
}
}
if (keys(%discoptions)) {
if ($discoptions{'nonanon'}) {
$discussoptions='<label><input type="radio" name="discuss" value="nonanon" checked="checked" /> '.
$contribdisc.
'</label>';
}
if ($discoptions{'anon'}) {
$discussoptions .= '<br /><label><input type="radio" name="discuss" value="anon"'.$checkradio.' /> '.
$anoncontrib.
' <i>('.$namevis.')</i></label> '.
'<a href="/adm/preferences?action=changescreenname">'.&mt('Change Screenname').'</a>';
}
if (!$blockblog) {
$discussoptions.= &add_blog_checkbox($crstype);
}
}
if ($msgoptions) {
$msgoptions='<tr><th><img src="'.&Apache::loncommon::lonhttpdurl('/res/adm/pages/feedback.png').'" />'
.'<br />'.&mt('Send Feedback').'<br />'.&Apache::lonhtmlcommon::coursepreflink(&mt('Feedback Settings'),'feedback').'</th>'.
'<td>'.$msgoptions.'</td></tr>';
}
if ($discussoptions) {
$discussoptions='<tr><th><img src="'.&Apache::loncommon::lonhttpdurl('/adm/lonMisc/chat.gif').'" alt="" />'
.'<br />'.&mt('Discussion Contributions').'<br />'.&Apache::lonhtmlcommon::coursepreflink(&mt('Discussion Settings'),'discussion').'</th>'.
'<td>'.$discussoptions.'</td></tr>';
}
return &Apache::loncommon::start_data_table().$msgoptions.$discussoptions.&Apache::loncommon::end_data_table();
}
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)=@_;
# Always allow the <m>-tag
my %html=(M=>1);
# Check if more is allowed
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> <TABLE> <TR> <TD> <TH> <TBODY>
%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, PRE=>1, DIV=>1, IMG=>1,
M=>1, CHEM=>1, ALGEBRA=>1, SUB=>1, SUP=>1, SPAN=>1,
H1=>1, H2=>1, H3=>1, H4=>1, H5=>1, H6=>1,
TABLE=>1, TR=>1, TD=>1, TH=>1, TBODY=>1);
}
# Do the substitution of everything that is not explicitly allowed
$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;
return $message;
}
sub assemble_email {
my ($message,$prevattempts,$usersaw,$useranswer)=@_;
my %lt = &Apache::lonlocal::texthash(
'prev' => 'Previous attempts of student (if applicable)',
'orig' => 'Original screen output (if applicable)',
'corr' => 'Correct Answer(s) (if applicable)',
);
if (&Apache::loncommon::course_type() eq 'Community') {
$lt{'prev'} = &mt('Previous attempts of member (if applicable)');
}
my $email=<<"ENDEMAIL";
$message
ENDEMAIL
my $citations=<<"ENDCITE";
<h2>$lt{'prev'}</h2>
$prevattempts
<br /><hr />
<h2>$lt{'orig'}</h2>
$usersaw
<h2>$lt{'corr'}</h2>
$useranswer
ENDCITE
return ($email,$citations);
}
sub feedback_available {
my ($question,$course,$policy)=@_;
my ($typestyle,%to)=&Apache::lonmsg::decide_receiver('',0,$question,
$course,$policy);
return scalar(%to);
}
sub send_msg {
my ($title,$feedurl,$email,$citations,$attachmenturl,$symb,$clientip,%to)=@_;
my $status='';
my $sendsomething=0;
my $delay;
my $senthide;
my %setters;
my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
&Apache::loncommon::blockcheck(\%setters,'com',$clientip);
if ($by_ip) {
$senthide = 1;
}
my $restitle = &get_resource_title($symb,$feedurl);
if ($title=~/^Error/) { $title=&mt('Feedback').': '.$title; }
unless ($title=~/\w/) { $title=&mt('Feedback'); }
foreach my $key (keys(%to)) {
if ($key) {
my ($user,$domain) = split(/\:/,$key,2);
if (!defined($user)) {
$status.='<br />'.&mt('Error sending message to [_1], no user specified.',$key);
} elsif (!defined($domain)) {
$status.='<br />'.&mt('Error sending message to [_1], no domain specified.',$key);
} else {
unless (&Apache::lonmsg::user_normal_msg($user,$domain,
$title.' ['.$restitle.']',$email,$citations,$feedurl,
$attachmenturl,undef,undef,$symb,$restitle,undef,
undef,undef,undef,$senthide)=~/ok/) {
$status.='<br />'.&mt('Error sending message to').' '.$key.'<br />';
} else {
$sendsomething++;
}
}
}
}
if ($sendsomething && $senthide) {
if ($by_ip) {
my $showdom = &Apache::lonnet::domain($blockdom);
if ($showdom eq '') {
$showdom = $blockdom;
}
$delay = 4;
$status.='<br />'.&mt("Message content of feedback you send to instructor(s) from your current IP address: [_1] will be unavailable in your 'Sent' folder.",$clientip).
'<ul><li>'.
&mt('This does not affect delivery of feedback to your instructor(s).').
'</li><li>'.
&mt('Note: some types of communication functionality are blocked for certain IP address(es).').
'</li><li>'.
&mt('This restriction was set by an administrator in the [_1] LON-CAPA domain.',
$showdom).
'</li></ul><br />';
}
}
# Records of number of feedback messages are kept under the "symb" called "_feedback"
# There are two entries within the framework of a course:
# - the URLs for which feedback was provided
# - the total number of contributions
if ($sendsomething) {
my %record=&getfeedbackrecords();
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,$delay);
}
# Routine to get the complete feedback records
sub getfeedbackrecords {
my ($uname,$udom,$course)=@_;
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=&Apache::lonnet::restore('_feedback',$course,$udom,$uname);
return %record;
}
# Routine to get feedback statistics
sub getfeedbackstats {
my %record=&getfeedbackrecords(@_);
return ($record{'subnumber'},$record{'points'},$record{'totallikes'});
}
# Store feedback credit
sub storefeedbackpoints {
my ($points,$uname,$udom,$course)=@_;
unless ($points) { $points=0; }
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=('grader_user' => $env{'user.name'},
'grader_domain' => $env{'user.domain'},
'points' => $points);
return &Apache::lonnet::cstore(\%record,'_feedback',$course,$udom,$uname);
}
# Store feedback "likes"
sub storefeedbacklikes {
my ($likes,$uname,$udom,$course)=@_;
unless ($likes) { $likes=0; }
if ($likes>0) { $likes=1; }
if ($likes<0) { $likes=-1; }
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=&getfeedbackrecords($uname,$udom,$course);
my $totallikes=$record{'totallikes'};
$totallikes+=$likes;
my %newrecord=('likes_user' => $env{'user.name'},
'likes_domain' => $env{'user.domain'},
'likes' => $likes,
'totallikes' => $totallikes);
return &Apache::lonnet::cstore(\%newrecord,'_feedback',$course,$udom,$uname);
}
sub adddiscuss {
my ($symb,$email,$anon,$attachmenturl,$subject,$group)=@_;
my $status='';
my $realsymb = &get_realsymb($symb);
my ($cnum,$cdom);
if ($env{'request.course.id'}) {
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
}
if (&discussion_open(undef,$realsymb) &&
(&Apache::lonnet::allowed('pch',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) ||
(($group ne '') && (&check_group_priv($group,'pgd') eq 'ok') &&
($symb =~ m{^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$})))) {
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)) {
my $now = time;
if ($env{'form.editdisc'}) {
$contrib{'ip'}=&Apache::lonnet::get_requestor_ip();
$contrib{'host'}=$Apache::lonnet::perlvar{'lonHostID'};
$contrib{'timestamp'} = $now;
$contrib{'history'} = '';
my $numoldver = 0;
my ($oldsymb,$oldidx)=split(/\:\:\:/,$env{'form.editdisc'});
&Apache::lonenc::check_decrypt(\$oldsymb);
$oldsymb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
# get timestamp for last post and history
my %oldcontrib=&Apache::lonnet::restore($oldsymb,$env{'request.course.id'},
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
if (defined($oldcontrib{$oldidx.':replyto'})) {
$contrib{'replyto'} = $oldcontrib{$oldidx.':replyto'};
}
if (defined($oldcontrib{$oldidx.':history'})) {
if ($oldcontrib{$oldidx.':history'} =~ /:/) {
my @oldversions = split(/:/,$oldcontrib{$oldidx.':history'});
$numoldver = @oldversions;
} else {
$numoldver = 1;
}
$contrib{'history'} = $oldcontrib{$oldidx.':history'}.':';
}
my $numnewver = $numoldver + 1;
if (defined($oldcontrib{$oldidx.':subject'})) {
if ($oldcontrib{$oldidx.':subject'} =~ /^<version num="0">/) {
$contrib{'subject'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>';
$contrib{'subject'} = $oldcontrib{$oldidx.':subject'}.$contrib{'subject'};
} else {
$contrib{'subject'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':subject'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'subject'},'<>&"').'</version>';
}
}
if (defined($oldcontrib{$oldidx.':message'})) {
if ($oldcontrib{$oldidx.':message'} =~ /^<version num="0">/) {
$contrib{'message'} = '<version num="'.$numnewver.'">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>';
$contrib{'message'} = $oldcontrib{$oldidx.':message'}.$contrib{'message'};
} else {
$contrib{'message'} = '<version num="0">'.&HTML::Entities::encode($oldcontrib{$oldidx.':message'},'<>&"').'</version><version num="1">'.&HTML::Entities::encode($contrib{'message'},'<>&"').'</version>';
}
}
$contrib{'history'} .= $oldcontrib{$oldidx.':timestamp'};
my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'},
$oldsymb,$oldidx,\%contrib,
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
$status='Editing class discussion'.($anon?' (anonymous)':'');
} else {
$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 => $now);
$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=&getdiscussionrecords();
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');
&updatekarma();
}
} else {
$status.='Failed.';
}
return $status.'<br />';
}
# Routine to get the complete discussion records
sub getdiscussionrecords {
my ($uname,$udom,$course)=@_;
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=&Apache::lonnet::restore('_discussion',$course,$udom,$uname);
return %record;
}
# Routine to get discussion statistics
sub getdiscussionstats {
my %record=&getdiscussionrecords(@_);
my $totalvotes = $record{'totallikes'} + $record{'totalunlikes'};
return ($record{'subnumber'},$record{'points'},$record{'totallikes'},$totalvotes);
}
# Calculate discussion karma
sub calcdiscussionkarma {
my ($subs,$pts,$likes,$votes)=&getdiscussionstats(@_);
my $karma=0;
if ($votes>0) {
$karma=int(.1+5.*(1.-exp(-$subs/10.))*$likes/$votes);
if ($karma<0) { $karma=0; }
if ($karma>5) { $karma=5; }
}
return $karma;
}
# Update karma
sub updatekarma {
my ($uname,$udom,$course)=@_;
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my $karma=&calcdiscussionkarma($uname,$udom,$course);
&Apache::lonnet::cstore({ 'karma' => $karma },'_discussion',$course,$udom,$uname);
&Apache::lonnet::do_cache_new('karma',$uname.':'.$udom.':'.$course,$karma,3600);
return $karma;
}
# Retrieve karma
sub userkarma {
my ($uname,$udom,$course)=@_;
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my $hashkey=$uname.':'.$udom.':'.$course;
my ($karma,$cached)=&Apache::lonnet::is_cached_new('karma',$hashkey);
if ($cached) {
return $karma;
}
my %userdisc=&getdiscussionrecords($uname,$udom,$course);
$karma=$userdisc{'karma'};
&Apache::lonnet::do_cache_new('karma',$hashkey,$karma,3600);
return $karma;
}
# Store discussion credit
sub storediscussionpoints {
my ($points,$uname,$udom,$course)=@_;
unless ($points) { $points=0; }
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=('grader_user' => $env{'user.name'},
'grader_domain' => $env{'user.domain'},
'points' => $points);
return &Apache::lonnet::cstore(\%record,'_discussion',$course,$udom,$uname);
}
# Store discussion "likes"
sub storediscussionlikes {
my ($chglikes,$chgunlikes,$uname,$udom,$course,$context)=@_;
unless ($uname) { $uname=$env{'user.name'}; }
unless ($udom) { $udom=$env{'user.domain'}; }
unless ($course) { $course=$env{'request.course.id'}; }
my %record=&getdiscussionrecords($uname,$udom,$course);
my $totallikes=$record{'totallikes'};
my $totalunlikes=$record{'totalunlikes'};
$totallikes += $chglikes;
$totalunlikes += $chgunlikes;
my %newrecord=('likes_user' => $env{'user.name'},
'likes_domain' => $env{'user.domain'},
'totallikes' => $totallikes,
'totalunlikes' => $totalunlikes,
'context' => $context);
my $status=&Apache::lonnet::cstore(\%newrecord,'_discussion',$course,$udom,$uname);
if ($status eq 'ok') {
&updatekarma($uname,$udom,$course);
}
return $status;
}
sub get_discussion_info {
my ($idx,%contrib) = @_;
my $changelast = 0;
my $count = 0;
my $hiddenflag = 0;
my $deletedflag = 0;
my ($hidden,$deleted,%info,$newlastdisc);
my $version = $contrib{'version'};
if ($version) {
for (my $id=$version; $id>0; $id--) {
my $vkeys=$contrib{$id.':keys'};
my @keys=split(/:/,$vkeys);
if (grep(/^hidden$/,@keys)) {
if (!$hiddenflag) {
$hidden = $contrib{$id.':hidden'};
$hiddenflag = 1;
}
} elsif (grep(/^deleted$/,@keys)) {
if (!$deletedflag) {
$deleted = $contrib{$id.':deleted'};
$deletedflag = 1;
}
} else {
if (($hidden !~/\.$id\./) && ($deleted !~/\.$id\./)) {
$count++;
$info{$count}{'id'} = $id;
$info{$count}{'timestamp'}=$contrib{$id.':timestamp'};
}
}
}
if ($info{'1'}{'id'} == $idx) {
$changelast = 1;
if ($count > 1) {
$newlastdisc = $info{'2'}{'timestamp'};
} else {
$newlastdisc = 0;
}
}
}
return ($changelast,$newlastdisc);
}
# ----------------------------------------------------------- Preview function
sub show_preview {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $start_page=
&Apache::loncommon::start_page('Preview',undef,
{'only_body' => 1,});
my $message=&clear_out_html($env{'form.comment'});
&newline_to_br(\$message);
$message=&Apache::lonspeller::markeduptext($message);
$message=&Apache::lontexconvert::msgtexconverted($message);
my $subject=&clear_out_html($env{'form.subject'});
$subject=~s/\n/\<br \/\>/g;
$subject=&Apache::lontexconvert::msgtexconverted($subject);
my $end_page = &Apache::loncommon::end_page();
$r->print($start_page
.'<h1>'.&mt('Preview').'</h1>'
.&Apache::lonhtmlcommon::start_pick_box()
.&Apache::lonhtmlcommon::row_title(&mt('Subject'))
.$subject
.&Apache::lonhtmlcommon::row_closure()
.&Apache::lonhtmlcommon::row_title(&mt('Message'))
.$message
.&Apache::lonhtmlcommon::row_closure(1)
.&Apache::lonhtmlcommon::end_pick_box()
.$end_page
);
}
sub contains_block_html {
my ($message)=@_;
return ($message =~ m{
<(br|h1|h2|h3|h4|h5|h6|p|ol|ul|table|pre|address|blockquote|center|div)
\s*
(\w+\=['"]\w+['"])*
\s*
(
\s*/>|
>.*</\1\s*>
)}xs
);
}
sub tidy_html {
my ($message)=@_;
# my $tidy = HTML::Tidy::libXML->new();
# my $xhtml = $tidy->clean($message, 'utf-8', 1);
# $xhtml =~ m/<body>(.*)<\/body>/is;
# my $clean = $1;
# # remove any empty block-level tags
# $clean =~ s/<(table|p|div|tbody|blockquote|m|pre|algebra|center|ol|ul|span|h1|h2|h3|h4|h5|h6)\s*\/>//i;
# $message=$clean;
return $message;
}
sub newline_to_br {
my ($message)=@_;
my $newmessage;
my $parser=HTML::LCParser->new($message);
while (my $token=$parser->get_token()) {
if ($token->[0] eq 'T') {
my $text=$token->[1];
$text=~s/\n/\<br \/\>/g;
$newmessage.=$text;
} elsif ($token->[0] eq 'D' || $token->[0] eq 'C') {
$newmessage.=$token->[1];
} elsif ($token->[0] eq 'PI' || $token->[0] eq 'E') {
$newmessage.=$token->[2];
} elsif ($token->[0] eq 'S') {
$newmessage.=$token->[4];
}
}
$$message=$newmessage;
}
sub generate_preview_button {
my ($formname,$fieldname)=@_;
unless ($formname) { $formname='mailform'; }
unless ($fieldname) { $fieldname='comment'; }
my $pre=&mt("Show Preview and Check Spelling");
return(<<ENDPREVIEW);
<br />
<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="if (typeof(document.$formname.onsubmit)=='function') {document.$formname.onsubmit();};this.form.comment.value=document.$formname.$fieldname.value;this.form.subject.value=document.$formname.subject.value;this.form.submit();" />
</form>
ENDPREVIEW
}
sub modify_attachments {
my ($r,$currnewattach,$currdelold,$symb,$idx,$attachmenturls,
$attachmaxtext,$toolarge)=@_;
my %lt = &Apache::lonlocal::texthash(
'subj' => 'Subject',
'chth' => 'Check the checkboxes for any you wish to remove.',
'thef' => 'The following attachments have been uploaded for inclusion with this posting.',
'adda' => 'Add a new attachment to this post',
'stch' => 'Save Changes',
'clic' => 'Add/remove attachments',
);
my $js = <<END;
<script type="text/javascript">
function setAction () {
document.modattachments.action = document.modattachments.origpage.value;
document.modattachments.submit();
}
</script>
<script type="text/javascript" src="/res/adm/includes/file_upload.js"></script>
END
# Breadcrumbs
my $brcrum = [{'href' => '',
'text' => 'Discussion Post Attachments'}];
my %parms=('only_body' => 1);
if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; }
my $start_page =
&Apache::loncommon::start_page('Discussion Post Attachments',$js,\%parms);
my $orig_subject = &unescape($env{'form.subject'});
my $subject=&clear_out_html($orig_subject);
$subject=~s/\n/\<br \/\>/g;
$subject=&Apache::lontexconvert::msgtexconverted($subject);
my $timestamp=$env{'form.timestamp'};
my $numoldver=$env{'form.numoldver'};
my $msg = '';
my %attachments = ();
my %currattach = ();
if ($idx) {
&extract_attachments($attachmenturls,$idx,$numoldver,\$msg,\%attachments,\%currattach,$currdelold);
}
&Apache::lonenc::check_encrypt(\$symb);
my $end_page =
&Apache::loncommon::end_page();
$r->print(<<END);
$start_page
$toolarge
<form name="modattachments" method="post" enctype="multipart/form-data" action="/adm/feedback?attach=$symb">
<h1>$lt{'clic'}</h1>
END
$r->print(&Apache::lonhtmlcommon::start_pick_box());
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Subject')));
$r->print('<b>'.$subject.'</b>');
$r->print(&Apache::lonhtmlcommon::row_closure());
$r->print(&Apache::lonhtmlcommon::row_title($lt{'adda'}));
$r->print('<input type="file" name="addnewattach" class="LC_flUpload" />'
.'<input type="hidden" id="LC_free_space" value="131072" />'
.'<input type="button" name="upload" value="Upload" '
.'onclick="this.form.submit()" /> '.$attachmaxtext);
if(($idx)||(ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)){
$r->print(&Apache::lonhtmlcommon::row_closure());
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Attachments')));
if ($idx) {
if ($attachmenturls) {
my @currold = keys(%currattach);
if (@currold > 0) {
$r->print($lt{'thfo'}.'<br />'.$lt{'chth'}.'<br />'."\n");
foreach my $id (@currold) {
my $attachurl = &HTML::Entities::decode($attachments{$id}{'filename'});
$attachurl =~ m#/([^/]+)$#;
$r->print('<label><input type="checkbox" name="deloldattach" value="'.$id.'" /> '.$1.'</label><br />'."\n");
}
$r->print("<br />");
}
}
}
if ((ref($currnewattach) eq 'ARRAY') && (@{$currnewattach} > 0)) {
$r->print($lt{'chth'}.'<br />'."\n");
foreach my $attach (@{$currnewattach}) {
$attach =~ m#/([^/]+)$#;
$r->print('<label><input type="checkbox" name="delnewattach" value="'.$attach.'" /> '.$1.'</label><br />'."\n");
}
}
}
$r->print(&Apache::lonhtmlcommon::row_closure(1));
$r->print(&Apache::lonhtmlcommon::end_pick_box());
$r->print(<<END);
<input type="hidden" name="subject" value="$env{'form.subject'}" />
<input type="hidden" name="comment" value="$env{'form.comment'}" />
<input type="hidden" name="timestamp" value="$env{'form.timestamp'}" />
<input type="hidden" name="idx" value="$env{'form.idx'}" />
<input type="hidden" name="numoldver" value="$env{'form.numoldver'}" />
<input type="hidden" name="origpage" value="$env{'form.origpage'}" />
<input type="hidden" name="blog" value="$env{'form.blog'}" />
<input type="hidden" name="discuss" value="$env{'form.discuss'}" />
END
foreach my $item (@{$currnewattach}) {
$r->print('<input type="hidden" name="currnewattach" value="'.$item.'" />'."\n");
}
foreach my $item (@{$currdelold}) {
$r->print('<input type="hidden" name="deloldattach" value="'.$item.'" />'."\n");
}
$r->print(<<END);
<input type="button" name="rtntoedit" value="$lt{'stch'}" onclick="setAction()" />
</form>
$end_page
END
return;
}
sub process_attachments {
my ($currnewattach,$currdelold,$keepold) = @_;
@{$currnewattach}=
&Apache::loncommon::get_env_multiple('form.currnewattach');
@{$currdelold}=
&Apache::loncommon::get_env_multiple('form.deloldattach');
if (exists($env{'form.delnewattach'})) {
my @currdelnew =
&Apache::loncommon::get_env_multiple('form.delnewattach');
my @currnew = ();
foreach my $newone (@{$currnewattach}) {
my $delflag = 0;
foreach my $item (@currdelnew) {
if ($newone eq $item) {
$delflag = 1;
last;
}
}
unless ($delflag) {
push(@currnew, $newone);
}
}
@{$currnewattach} = @currnew;
}
@{$keepold} = &Apache::loncommon::get_env_multiple('form.keepold');
}
sub generate_attachments_button {
my ($idx,$attachnum,$ressymb,$now,$currnewattach,$deloldattach,
$numoldver,$mode,$blockblog) = @_;
my $origpage = $ENV{'REQUEST_URI'};
my $att=$attachnum.' '.&mt("attachments");
my %lt = &Apache::lonlocal::texthash(
'clic' => 'Add/remove attachments',
);
my $response = (<<END);
<br />
<form name="attachment" action="/adm/feedback?attach=$ressymb" method="post">
<input type="button" value="$lt{'clic'}"
onclick="if (typeof(document.mailform.onsubmit)=='function') {document.mailform.onsubmit();};this.form.comment.value=escape(document.mailform.comment.value);this.form.subject.value=escape(document.mailform.subject.value);
END
if (!$blockblog) {
$response .= 'setblogvalue();';
}
unless ($mode eq 'board') {
$response .= 'javascript:anonchk();';
}
$response .= (<<ENDATTACH);
this.form.submit();" />
<input type="hidden" name="origpage" value="$origpage" />
<input type="hidden" name="idx" value="$idx" />
<input type="hidden" name="timestamp" value="$now" />
<input type="hidden" name="subject" />
<input type="hidden" name="comment" />
<input type="hidden" name="blog" value="0" />
<input type="hidden" name="discuss" value="0" />
<input type="hidden" name="numoldver" value="$numoldver" />
ENDATTACH
if (defined($deloldattach)) {
if (@{$deloldattach} > 0) {
foreach my $delatt (@{$deloldattach}) {
$response .= '<input type="hidden" name="deloldattach" value="'.$delatt.'" />'."\n";
}
}
}
if (defined($currnewattach)) {
if (@{$currnewattach} > 0) {
foreach my $attach (@{$currnewattach}) {
$response .= '<input type="hidden" name="currnewattach" value="'.$attach.'" />'."\n";
}
}
}
$response .= '</form>';
return $response;
}
sub extract_attachments {
my ($attachmenturls,$idx,$numoldver,$message,$attachments,$currattach,$currdelold) = @_;
%{$attachments}=();
&get_post_attachments($attachments,$attachmenturls);
foreach my $id (sort(keys(%{$attachments}))) {
if (exists($$attachments{$id}{$numoldver})) {
if (defined($currdelold)) {
if (@{$currdelold} > 0) {
unless (grep/^$id$/,@{$currdelold}) {
$$currattach{$id} = $$attachments{$id}{$numoldver};
}
} else {
$$currattach{$id} = $$attachments{$id}{$numoldver};
}
} else {
$$currattach{$id} = $$attachments{$id}{$numoldver};
}
}
}
my @attached = (sort { $a <=> $b } keys(%{$currattach}));
if (@attached == 1) {
my $id = $attached[0];
my $attachurl;
if ($attachmenturls =~ m/^<attachment id="0">/) {
$attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
} else {
$attachurl = $$attachments{$id}{'filename'};
}
$attachurl=~m|/([^/]+)$|;
$$message.='<br /><a href="'.$attachurl.'"><tt>'.
$1.'</tt></a><br />';
&Apache::lonnet::allowuploaded('/adm/feedback',
$attachurl);
} elsif (@attached > 1) {
$$message.='<ol>';
foreach my $attach (@attached) {
my $id = $attach;
my $attachurl = &HTML::Entities::decode($$attachments{$id}{'filename'});
my ($fname)
=($attachurl=~m|/([^/]+)$|);
$$message .= '<li><a href="'.$attachurl.
'"><tt>'.
$fname.'</tt></a></li>';
&Apache::lonnet::allowuploaded('/adm/feedback',
$attachurl);
}
$$message .= '</ol>';
}
}
sub construct_attachmenturl {
my ($currnewattach,$keepold,$symb,$idx)=@_;
my $oldattachmenturl;
my $newattachmenturl;
my $startnum = 0;
my $currver = 0;
if (($env{'form.editdisc'}) && ($idx)) {
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
$oldattachmenturl = $contrib{$idx.':attachmenturl'};
if ($contrib{$idx.':history'}) {
if ($contrib{$idx.':history'} =~ /:/) {
my @oldversions = split(/:/,$contrib{$idx.':history'});
$currver = 1 + scalar(@oldversions);
} else {
$currver = 2;
}
} else {
$currver = 1;
}
if ($oldattachmenturl) {
if ($oldattachmenturl =~ m/^<attachment id="0">/) {
my %attachments = ();
my $prevver = $currver-1;
&get_post_attachments(\%attachments,$oldattachmenturl);
my $numattach = scalar(keys(%attachments));
$startnum += $numattach;
foreach my $num (sort {$a <=> $b} keys(%attachments)) {
$newattachmenturl .= '<attachment id="'.$num.'"><filename>'.$attachments{$num}{'filename'}.'</filename>';
foreach my $item (sort {$a <=> $b} keys(%{$attachments{$num}})) {
unless ($item eq 'filename') {
$newattachmenturl .= '<post id="'.$item.'">'.$attachments{$num}{$item}.'</post>';
}
}
if (grep/^$num$/,@{$keepold}) {
$newattachmenturl .= '<post id="'.$currver.'">'.$attachments{$num}{$prevver}.'</post>';
}
$newattachmenturl .= '</attachment>';
}
} else {
$newattachmenturl = '<attachment id="0"><filename>'.&HTML::Entities::encode($oldattachmenturl).'</filename><post id="0">n</post>';
unless (grep/^0$/,@{$keepold}) {
$newattachmenturl .= '<post id="1">n</post>';
}
$newattachmenturl .= '</attachment>';
$startnum ++;
}
}
}
for (my $i=0; $i<@{$currnewattach}; $i++) {
my $attachnum = $startnum + $i;
$newattachmenturl .= '<attachment id="'.$attachnum.'"><filename>'.&HTML::Entities::encode($$currnewattach[$i]).'</filename><post id="'.$currver.'">n</post></attachment>';
}
return $newattachmenturl;
}
sub add_blog_checkbox {
my ($crstype) = @_;
my $checkstatus;
if ($env{'form.blog'}) {
$checkstatus = 'checked="checked"';
}
my $output = '
<script type="text/javascript">
function setblogvalue() {
if (document.mailform.blog.checked) {
document.attachment.blog.value = 1;
} else {
document.attachment.blog.value = 0;
}
}
</script><br />
<label><input type="checkbox" name="blog" '.$checkstatus.' /> ';
if ($crstype eq 'Community') {
$output .= &mt('Add to my public community blog');
} else {
$output .= &mt('Add to my public course blog');
}
$output .= '</label><br />'."\n";
return $output;
}
sub has_discussion {
my $resourcesref = shift;
my $navmap = Apache::lonnavmaps::navmap->new();
if (defined($navmap)) {
my @allres=$navmap->retrieveResources();
foreach my $resource (@allres) {
if ($resource->hasDiscussion()) {
my $ressymb = $resource->wrap_symb();
if (ref($resourcesref) eq 'ARRAY') {
push(@{$resourcesref}, $ressymb);
}
}
}
} else {
&Apache::lonnet::logthis('Has discussion check failed - could not create navmap object.');
}
return;
}
sub sort_filter_names {
my ($sort_types,$role_types,$status_types,$crstype) = @_;
if (ref($sort_types) eq 'HASH') {
%{$sort_types} = (
ascdate => 'Date order - oldest first',
descdate => 'Date order - newest first',
thread => 'Threaded',
subject => 'By subject',
username => 'By domain and username',
lastfirst => 'By last name, first name'
);
}
my @courseroles = qw(st in ta ep ad);
if ($crstype eq 'Community') {
push(@courseroles,'co');
} else {
push(@courseroles,'cc');
}
if (ref($role_types) eq 'HASH') {
foreach my $role (@courseroles) {
$role_types->{$role} = &Apache::lonnet::plaintext($role,$crstype);
}
$role_types->{'all'} = 'All roles';
$role_types->{'cr'} = 'Custom role';
}
if (ref($status_types) eq 'HASH') {
%{$status_types} = (
all => 'Roles of any status',
Active => 'Only active roles',
Expired => 'Only past roles',
Future => 'Only future roles',
);
}
}
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'},
['like','unlike','modal','hide','unhide','deldisc','undeleteall','postdata','preview','replydisc','editdisc','cmd','symb','onlyunread','allposts','onlyunmark','previous','markread','markonread','markondisp','toggoff','toggon','modifydisp','changes','navtime','navmaps','navurl','sortposts','applysort','rolefilter','statusfilter','sectionpick','groupick','posterlist','userpick','attach','origpage','currnewattach','deloldattach','keepold','allversions','export','sendmessageonly','group','ref']);
my $group = $env{'form.group'};
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my %attachmax = (
text => &mt('(128 KB max size)'),
num => 131072,
);
if ($env{'form.editdisc'}) {
if (!(&editing_allowed($env{'form.editdisc'},$group))) {
my $symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0];
my ($map,$id,$url)=&Apache::lonnet::decode_symb($symb);
my $feedurl=&Apache::lonnet::clutter($url);
&redirect_back($r,$feedurl,&mt('Editing not permitted').'<br />',
'0','0','','',$env{'form.previous'},undef,undef,undef,
undef,undef,undef,$group);
return OK;
}
}
if ($env{'form.discsymb'}) {
my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.discsymb'});
my $readkey = $symb.'_read';
my $chgcount = 0;
my %readinghash = &Apache::lonnet::get('nohist_'.$env{'request.course.id'}.'_discuss',[$readkey],$env{'user.domain'},$env{'user.name'});
foreach my $key (keys(%env)) {
if ($key =~ m/^form\.postunread_(\d+)/) {
if ($readinghash{$readkey} =~ /\.$1\./) {
$readinghash{$readkey} =~ s/\.$1\.//;
$chgcount ++;
}
} elsif ($key =~ m/^form\.postread_(\d+)/) {
unless ($readinghash{$readkey} =~ /\.$1\./) {
$readinghash{$readkey} .= '.'.$1.'.';
$chgcount ++;
}
}
}
if ($chgcount > 0) {
&Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
\%readinghash,$env{'user.domain'},$env{'user.name'});
}
&redirect_back($r,$feedurl,&mt('Marked postings read/unread').'<br />',
'0','0','','',$env{'form.previous'},'','','',
undef,undef,undef,$group);
return OK;
}
if ($env{'form.allversions'}) {
&Apache::loncommon::content_type($r,'text/html');
&Apache::loncommon::no_cache($r);
$r->send_http_header;
# Breadcrumbs
my $brcrum = [{'href' => '',
'text' => 'Discussion Post Versions'}];
my %parms=();
if ($env{'form.modal'} ne 'yes') { $parms{'bread_crumbs'} = $brcrum; }
$r->print(&Apache::loncommon::start_page('Discussion Post Versions',undef,\%parms));
my ($symb,$idx)=split(/\:\:\:/,$env{'form.allversions'});
($symb, my $feedurl)=&get_feedurl_and_clean_symb($symb);
my $ressymb = &wrap_symb($symb);
my $seeid;
if (&Apache::lonnet::allowed('rin',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$seeid = 1;
}
my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum);
if ($idx > 0) {
my %messages = ();
my %subjects = ();
my %attachmsgs = ();
my %allattachments = ();
my %imsfiles = ();
my ($screenname,$plainname,$showaboutme);
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
$r->print(&get_post_contents(\%contrib,$idx,$seeid,$seehidden,'allversions',\%messages,\%subjects,\%allattachments,\%attachmsgs,\%imsfiles,\$screenname,\$plainname,\$showaboutme));
}
$r->print(&Apache::loncommon::end_page());
return OK;
}
if ($env{'form.posterlist'}) {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'});
&print_showposters($r,$symb,$env{'form.previous'},$feedurl,
$env{'form.sortposts'});
return OK;
}
if ($env{'form.userpick'}) {
my @posters = &Apache::loncommon::get_env_multiple('form.stuinfo');
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.userpick'});
my $numpicks = @posters;
my %discinfo;
$discinfo{$symb.'_userpick'} = join('&',@posters);
&Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
\%discinfo,$env{'user.domain'},$env{'user.name'});
&redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',
'',$env{'form.previous'},$env{'form.sortposts'},'','','',
'',$numpicks,$group);
return OK;
}
if ($env{'form.applysort'}) {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.applysort'});
&redirect_back($r,$feedurl,&mt('Changed sort/filter').'<br />','0','0','',
'',$env{'form.previous'},$env{'form.sortposts'},
$env{'form.rolefilter'},$env{'form.statusfilter'},
$env{'form.sectionpick'},$env{'form.grouppick'},
undef,$group);
return OK;
} elsif ($env{'form.cmd'} eq 'sortfilter') {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
&print_sortfilter_options($r,$symb,$env{'form.previous'},$feedurl);
return OK;
} elsif ($env{'form.navtime'}) {
my %discinfo = ();
my @resources = ();
if (defined($env{'form.navmaps'})) {
if ($env{'form.navmaps'} =~ /:/) {
@resources = split(/:/,$env{'form.navmaps'});
} else {
@resources = ("$env{'form.navmaps'}");
}
} else {
&has_discussion(\@resources);
}
my $numitems = @resources;
my $feedurl = '/adm/navmaps';
if ($env{'form.navurl'}) { $feedurl .= '?'.$env{'form.navurl'}; }
my %lt = &Apache::lonlocal::texthash(
'twnp' => 'There are currently no resources or discussion boards with unread discussion postings.'
);
foreach my $res (@resources) {
my $ressymb=$res;
&Apache::lonenc::check_decrypt(\$ressymb);
my $lastkey = $ressymb.'_lastread';
$discinfo{$lastkey} = $env{'form.navtime'};
}
my $textline = '<b>'.
&mt('Marked "New" posts as read in a total of [_1] resources/discussion boards.',
$numitems).
'</b>';
if ($numitems > 0) {
&Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
\%discinfo,$env{'user.domain'},$env{'user.name'});
} else {
$textline = "<b>$lt{'twnp'}</b>";
}
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my $logo=&Apache::loncommon::lonhttpdurl('/adm/lonIcons/lonlogos.gif');
my %onload;
my $start_page=
&Apache::loncommon::start_page('New posts marked as read',undef,
{'redirect' => [2,$feedurl],
'only_body' => 1,
'add_entries' => \%onload});
my $end_page = &Apache::loncommon::end_page();
my $windowname = 'loncapaclient';
if ($env{'request.lti.login'}) {
$windowname .= 'lti';
}
$r->print (<<ENDREDIR);
$start_page
<img align="right" src="$logo" />
$textline
<form name="reldt" action="$feedurl" target="$windowname">
</form>
<br />
$end_page
ENDREDIR
return OK;
} elsif ($env{'form.modifydisp'}) {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.modifydisp'});
my ($dispchgA,$dispchgB,$markchg,$toggchg) =
split(/_/,$env{'form.changes'});
&print_display_options($r,$symb,$env{'form.previous'},$dispchgA,
$dispchgB,$markchg,$toggchg,$feedurl);
return OK;
} elsif ($env{'form.markondisp'} || $env{'form.markonread'} ||
$env{'form.allposts'} || $env{'form.onlyunread'} ||
$env{'form.onlyunmark'} || $env{'form.toggoff'} ||
$env{'form.toggon'} || $env{'form.markread'}) {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
my %discinfo;
# ------------------------ Modify setting for read/unread toggle for each post
if ($env{'form.toggoff'}) { $discinfo{$symb.'_readtoggle'}=0; }
if ($env{'form.toggon'}) { $discinfo{$symb.'_readtoggle'}=1; }
# --------- Modify setting for identification of 'NEW' posts in this discussion
if ($env{'form.markondisp'}) {
$discinfo{$symb.'_lastread'} = time;
$discinfo{$symb.'_markondisp'} = 1;
}
if ($env{'form.markonread'}) {
if ( $env{'form.previous'} > 0 ) {
$discinfo{$symb.'_lastread'} = $env{'form.previous'};
}
$discinfo{$symb.'_markondisp'} = 0;
}
# --------------------------------- Modify display setting for this discussion
if ($env{'form.allposts'}) {
$discinfo{$symb.'_showonlyunread'} = 0;
$discinfo{$symb.'_showonlyunmark'} = 0;
}
if ($env{'form.onlyunread'}) { $discinfo{$symb.'_showonlyunread'} = 1; }
if ($env{'form.onlyunmark'}) { $discinfo{$symb.'_showonlyunmark'} = 1; }
# ----------------------------------------------------- Mark new posts not NEW
if ($env{'form.markread'}) { $discinfo{$symb.'_lastread'} = time; }
&Apache::lonnet::put('nohist_'.$env{'request.course.id'}.'_discuss',
\%discinfo,$env{'user.domain'},$env{'user.name'});
my $previous=$env{'form.previous'};
if ($env{'form.markondisp'}) { $previous=undef; }
&redirect_back($r,$feedurl,&mt('Changed display status').'<br />',
'0','0','','',$previous,'','','','','','',$group);
return OK;
} elsif (($env{'form.hide'}) || ($env{'form.unhide'})) {
# ----------------------------------------------------------------- Hide/unhide
my $entry=$env{'form.hide'}?$env{'form.hide'}:$env{'form.unhide'};
my ($symb,$idx)=split(/\:\:\:/,$entry);
($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb);
my $ressymb = &wrap_symb($symb);
my $seehidden = &can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum);
unless (($seehidden) || (&editing_allowed($env{'form.hide'},$group))) {
&redirect_back($r,$feedurl,&mt('Hiding not permitted').'<br />',
'0','0','','',$env{'form.previous'},'','','','',
undef,undef,$group);
return OK;
}
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
my $currenthidden=$contrib{'hidden'};
my $currentstudenthidden=$contrib{'studenthidden'};
if ($env{'form.hide'}) {
$currenthidden.='.'.$idx.'.';
unless ($seehidden) {
$currentstudenthidden.='.'.$idx.'.';
}
} else {
$currenthidden=~s/\.$idx\.//g;
}
my %newhash=('hidden' => $currenthidden);
if ( ($env{'form.hide'}) && (!$seehidden) ) {
$newhash{'studenthidden'} = $currentstudenthidden;
}
if ($env{'form.hide'}) {
my $changelast = 0;
my $newlast;
($changelast,$newlast) = &get_discussion_info($idx,%contrib);
if ($changelast) {
&Apache::lonnet::put('discussiontimes',{$symb => $newlast},
$cdom,$cnum);
}
}
my $result;
if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'},
$cdom,$cnum) eq 'ok') {
my $prefix=$symb.':'.$idx.':';
my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,
'^'.$prefix);
my ($totallikes,$totalunlikes);
if (ref($likes{$prefix.'likers'}) eq 'HASH') {
$totallikes = scalar(keys(%{$likes{$prefix.'likers'}}));
}
if (ref($likes{$prefix.'unlikers'}) eq 'HASH') {
$totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}}));
}
if ($totallikes || $totalunlikes) {
my ($chglikes,$chgunlikes,$context);
if ($env{'form.hide'}) {
$chglikes = -1 * $totallikes;
$chgunlikes = -1 * $totalunlikes;
$context = 'hide';
} else {
$chglikes = $totallikes;
$chgunlikes = $totalunlikes;
$context = 'unhide';
}
&storediscussionlikes($chglikes,$chgunlikes,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'},
$env{'request.course.id'},
$context);
}
$result = &mt('Changed discussion status');
} else {
$result = &mt('Discussion status unchanged');
}
&redirect_back($r,$feedurl,$result.'<br />','0','0','','',
$env{'form.previous'},undef,undef,undef,
undef,undef,undef,$group);
return OK;
} elsif (($env{'form.like'}) || ($env{'form.unlike'})) {
# ----------------------------------------------------------------- Like/unlike
my $entry=$env{'form.like'}?$env{'form.like'}:$env{'form.unlike'};
my ($symb,$idx)=split(/\:\:\:/,$entry);
($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb);
my $result;
if ($idx > 0) {
my $realsymb = &get_realsymb($symb);
my $status='OPEN';
if ($Apache::lonhomework::parsing_a_problem ||
$Apache::lonhomework::parsing_a_task) {
$status=$Apache::inputtags::status[-1];
}
if (&discussion_vote_available($status,$realsymb)) {
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
my $ownpost;
if (($contrib{$idx.':sendername'} eq $env{'user.name'}) &&
($contrib{$idx.':senderdomain'} eq $env{'user.domain'})) {
$ownpost = 1;
}
if ($ownpost || $contrib{$idx.':hidden'} || $contrib{$idx.':deleted'}) {
$result = &mt('Vote not registered.').' ';
}
if ($ownpost) {
$result .= &mt('No voting for your own posts.');
} elsif ($contrib{$idx.':hidden'}) {
$result .= &mt('No voting for hidden posts.');
} elsif ($contrib{$idx.':deleted'}) {
$result .= &mt('No voting for deleted posts.');
} else {
#
# Likes and unlikes are in db-file "disclikes" of the course
# The prefix is the $symb to identify the resource discussion,
# and the $idx to identify the entry
#
my $prefix=$symb.':'.$idx.':';
my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,
'^'.$prefix);
# Get current like or unlike status for the $idx for this user.
my $thisuser=$env{'user.name'}.':'.$env{'user.domain'};
my ($userlikes,$userunlikes);
if (ref($likes{$prefix.'likers'}) eq 'HASH') {
if (exists($likes{$prefix.'likers'}{$thisuser})) {
$userlikes = 1;
}
}
if (ref($likes{$prefix.'unlikers'}) eq 'HASH') {
if (exists($likes{$prefix.'unlikers'}{$thisuser})) {
$userunlikes = 1;
}
}
# Get the current "likes" count
my $likescount=$likes{$prefix.'likes'};
# Find out if they already voted
# Users cannot like a post twice, or unlike it twice.
# They can change their mind, though.
my $alreadyflag=0;
my $votetype;
if ($env{'form.like'}) {
if ($userlikes) {
$alreadyflag=1;
} elsif ($userunlikes) {
delete($likes{$prefix.'unlikers'}{$thisuser});
$votetype = 'switch';
$likescount++;
} else {
if (ref($likes{$prefix.'likers'}) eq 'HASH') {
$likes{$prefix.'likers'}{$thisuser} = 1;
} else {
$likes{$prefix.'likers'} = {$thisuser => 1};
}
$likescount++;
}
} else {
if ($userunlikes) {
$alreadyflag=1;
} elsif ($userlikes) {
delete($likes{$prefix.'likers'}{$thisuser});
$votetype = 'switch';
$likescount--;
} else {
if (ref($likes{$prefix.'unlikers'}) eq 'HASH') {
$likes{$prefix.'unlikers'}{$thisuser} = 1;
} else {
$likes{$prefix.'unlikers'} = {$thisuser => 1};
}
$likescount--;
}
}
# $alreadyflag would be 1 if they tried to double-like or double-unlike
if ($alreadyflag) {
if ($env{'form.like'}) {
$result= &mt("'Like' already registered");
} else {
$result= &mt("'Unlike' already registered");
}
} else {
my %newhash=($prefix.'likes' => $likescount,
$prefix.'likers' => $likes{$prefix.'likers'},
$prefix.'unlikers' => $likes{$prefix.'unlikers'});
# Store data in db-file "disclikes"
if (&Apache::lonnet::put('disclikes',\%newhash,$cdom,$cnum) eq 'ok') {
# Also store with the person who posted the liked/unliked entry
my ($chglike,$chgunlike);
if ($env{'form.like'}) {
if ($votetype eq 'switch') {
$chglike = 0;
$chgunlike = -1;
} else {
$chglike = 1;
$chgunlike = 0;
}
&storediscussionlikes($chglike,$chgunlike,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'},
$env{'request.course.id'},'like');
$result=&mt("Registered 'Like'");
} else {
if ($votetype eq 'switch') {
$chglike = -1;
$chgunlike = 0;
} else {
$chglike = 0;
$chgunlike = 1;
}
&storediscussionlikes($chglike,$chgunlike,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'},
$env{'request.course.id'},'unlike');
$result=&mt("Registered 'Unlike'");
}
} else {
# Oops, something went wrong
$result=&mt("Failed to register vote");
}
}
}
} else {
$result=&mt('Voting unavailable for this discussion');
}
} else {
$result=&mt('Invalid post number');
}
&redirect_back($r,$feedurl,$result.'<br />',
'0','0','','',$env{'form.previous'},undef,undef,undef,
undef,undef,undef,$group);
return OK;
} elsif ($env{'form.cmd'}=~/^(threadedoff|threadedon)$/) {
my ($symb,$feedurl)=&get_feedurl_and_clean_symb($env{'form.symb'});
if ($env{'form.cmd'} eq 'threadedoff') {
&Apache::lonnet::put('environment',{'unthreadeddiscussion' => 'on'});
&Apache::lonnet::appenv({'environment.unthreadeddiscussion' => 'on'});
&Apache::lonnet::del('environment',['threadeddiscussion']);
&Apache::lonnet::delenv('environment.threadeddiscussion');
} else {
&Apache::lonnet::put('environment',{'threadeddiscussion' => 'on'});
&Apache::lonnet::appenv({'environment.threadeddiscussion' => 'on'});
&Apache::lonnet::del('environment',['unthreadeddiscussion']);
&Apache::lonnet::delenv('environment.unthreadeddiscussion');
}
&redirect_back($r,$feedurl,&mt('Changed discussion view mode').'<br />',
'0','0','','',$env{'form.previous'},undef,undef,undef,
undef,undef,undef,$group);
return OK;
} elsif ($env{'form.deldisc'}) {
# --------------------------------------------------------------- Hide for good
my ($symb,$idx)=split(/\:\:\:/,$env{'form.deldisc'});
($symb,my $feedurl)=&get_feedurl_and_clean_symb($symb);
my $ressymb=&wrap_symb($symb);
unless (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) {
&redirect_back($r,$feedurl,&mt('Deletion not permitted').'<br />',
'0','0','','',$env{'form.previous'},'','','','',
undef,undef,$group);
return OK;
}
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
my ($changelast,$newlast) = &get_discussion_info($idx,%contrib);
if ($changelast) {
&Apache::lonnet::put('discussiontimes',{$symb => $newlast},
$cdom,$cnum);
}
my %newhash=('deleted' => $contrib{'deleted'}.".$idx.");
my $result;
if (&Apache::lonnet::store(\%newhash,$symb,$env{'request.course.id'},
$cdom,$cnum) eq 'ok') {
$result = &mt('Changed discussion status');
my $prefix=$symb.':'.$idx.':';
my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,
'^'.$prefix);
my ($totallikes,$totalunlikes);
if (ref($likes{$prefix.'likers'}) eq 'HASH') {
$totallikes = scalar(keys(%{$likes{$prefix.'likers'}}));
}
if (ref($likes{$prefix.'unlikers'}) eq 'HASH') {
$totalunlikes = scalar(keys(%{$likes{$prefix.'unlikers'}}));
}
if ($totallikes || $totalunlikes) {
my $chglikes = -1 * $totallikes;
my $chgunlikes = -1 * $totalunlikes;
&storediscussionlikes($chglikes,$chgunlikes,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'},
$env{'request.course.id'},
'delete');
}
} else {
$result = &mt('Discussion status unchanged');
}
&redirect_back($r,$feedurl,$result.'<br />','0','0','','',
$env{'form.previous'},undef,undef,undef,
undef,undef,undef,$group);
return OK;
} elsif ($env{'form.preview'}) {
# -------------------------------------------------------- User wants a preview
&show_preview($r);
return OK;
} elsif ($env{'form.attach'}) {
# -------------------------------------------------------- Work on attachments
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['subject','comment','addnewattach','delnewattach','timestamp','numoldver','idx','discuss','blog']);
my (@currnewattach,@currdelold,@keepold,$toolarge);
&process_attachments(\@currnewattach,\@currdelold,\@keepold);
if (exists($env{'form.addnewattach.filename'})) {
if (length($env{'form.addnewattach'})<=$attachmax{'num'}) {
my $subdir = 'feedback/'.$env{'form.timestamp'};
my $newattachment=&Apache::lonnet::userfileupload('addnewattach',undef,$subdir);
push(@currnewattach, $newattachment);
} else {
$toolarge = '<p><span class="LC_warning">'.&mt('Attachment not included - exceeded permitted length').'</span><br /></p>';
}
}
my $attachmenturls;
my ($symb) = &get_feedurl_and_clean_symb($env{'form.attach'});
my $idx = $env{'form.idx'};
if ($idx) {
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
$attachmenturls = $contrib{$idx.':attachmenturl'};
}
&modify_attachments($r,\@currnewattach,\@currdelold,$symb,$idx,
$attachmenturls,$attachmax{'text'},$toolarge);
return OK;
} elsif ($env{'form.export'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.export'});
my $mode='board';
my $status='OPEN';
my $previous=$env{'form.previous'};
if ($feedurl =~ /$LONCAPA::assess_re/) {
$mode='problem';
$status=$Apache::inputtags::status[-1];
}
my $discussion = &list_discussion($mode,$status,$symb);
my $start_page =
&Apache::loncommon::start_page('Resource Feedback and Discussion');
my $end_page =
&Apache::loncommon::end_page();
$r->print($start_page.$discussion.$end_page);
return OK;
} elsif ($env{'form.undeleteall'}) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
my ($symb,$feedurl) = &get_feedurl_and_clean_symb($env{'form.undeleteall'});
my $ressymb=&wrap_symb($symb);
$r->print(&Apache::loncommon::start_page('Undelete all deleted discussion entries'));
if (&can_see_hidden('',$ressymb,$feedurl,$group,$cdom,$cnum)) {
my %contrib=&Apache::lonnet::restore($symb,$env{'request.course.id'},
$cdom,$cnum);
$contrib{'deleted'} =~ s/^\.//;
$contrib{'deleted'} =~ s/\.$//;
my $confirm_msg;
if ($contrib{'deleted'} ne '') {
if (&Apache::lonnet::store({'deleted' => ''},$symb,$env{'request.course.id'},
$cdom,$cnum) eq 'ok') {
my %likes=&Apache::lonnet::dump('disclikes',$cdom,$cnum,'^'.$symb.':');
my @ids = split(/\.\./,$contrib{'deleted'});
my (%chglikes,%chgunlikes);
foreach my $idx (@ids) {
my $uname = $contrib{$idx.':sendername'};
my $udom = $contrib{$idx.':senderdomain'};
my ($totallikes,$totalunlikes);
if (ref($likes{$symb.':'.$idx.':likers'}) eq 'HASH') {
$totallikes = scalar(keys(%{$likes{$symb.':'.$idx.':likers'}}));
}
if (ref($likes{$symb.':'.$idx.':unlikers'}) eq 'HASH') {
$totalunlikes = scalar(keys(%{$likes{$symb.':'.$idx.':unlikers'}}));
}
if ($totallikes || $totalunlikes) {
$chglikes{$uname.':'.$udom} += $totallikes;
$chgunlikes{$uname.':'.$udom} += $totalunlikes;
}
}
foreach my $user (keys(%chglikes)) {
my ($uname,$udom) = split(/:/,$user);
&storediscussionlikes($chglikes{$user},$chgunlikes{$user},
$uname,$udom,$env{'request.course.id'},
'undelete');
}
$confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("Undeleted all entries"));
} else {
$confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("Failed to undelete entries"),1);
}
} else {
$confirm_msg = &Apache::lonhtmlcommon::confirm_success(&mt("No entries to undelete"),1);
}
$r->print(
'<br />'
.&Apache::loncommon::confirmwrapper($confirm_msg)
.&Apache::lonhtmlcommon::actionbox(
["<a href='$feedurl'>".&mt("Return and reload")."</a>"])
);
}
$r->print(&Apache::loncommon::end_page());
return OK;
} else {
# ------------------------------------------------------------- Normal feedback
my $feedurl=$env{'form.postdata'};
$feedurl=~s/^https?\:\/\///;
$feedurl=~s/^$ENV{'SERVER_NAME'}//;
$feedurl=~s/^$ENV{'HTTP_HOST'}//;
$feedurl=~s/\?.+$//;
my $symb;
if ($env{'form.replydisc'}) {
$symb=(split(/\:\:\:/,$env{'form.replydisc'}))[0];
} elsif ($env{'form.editdisc'}) {
$symb=(split(/\:\:\:/,$env{'form.editdisc'}))[0];
} elsif ($env{'form.origpage'}) {
$symb="";
} elsif ($env{'form.sendmessageonly'}) {
$symb=(split(/\:\:\:/,$env{'form.sendmessageonly'}))[0];
} else {
$symb=&Apache::lonnet::symbread($feedurl);
}
unless ($symb) {
$symb=$env{'form.symb'};
}
if (defined($symb)) {
($symb,$feedurl)=&get_feedurl_and_clean_symb($symb);
} else {
# backward compatibility (bulletin boards used to be 'wrapped')
&Apache::lonenc::check_decrypt(\$feedurl);
&dewrapper(\$feedurl);
}
my $goahead=1;
if ($feedurl=~/$LONCAPA::assess_re/) {
unless ($symb) { $goahead=0; }
}
if (!$goahead) {
# Ambiguous Problem Resource
$r->internal_redirect('/adm/ambiguous');
return OK;
}
if ($feedurl eq '') {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
&no_redirect_back($r);
return OK;
}
# Go ahead with feedback, no ambiguous reference
unless (
(
($feedurl=~m:^/res:) && ($feedurl!~m:^/res/adm:)
)
||
($env{'request.course.id'} && ($feedurl!~m:^/adm:))
||
($env{'request.course.id'} && ($symb=~/^bulletin\_\_\_/))
||
(($env{'request.course.id'}) && ($feedurl =~ /ext\.tool$/))
) {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
# Unable to give feedback
&Apache::lonenc::check_encrypt(\$feedurl);
&no_redirect_back($r,$feedurl,2);
return OK;
}
# --------------------------------------------------- Print login screen header
unless ($env{'form.sendit'}) {
&Apache::lonenc::check_encrypt(\$feedurl);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
if (($env{'form.replydisc'}) || ($env{'form.editdisc'})) {
my ($blocked,$blocktext) =
&Apache::loncommon::blocking_status('boards');
if ($blocked) {
$r->print(&blocked_reply_or_edit($blocktext));
return OK;
}
}
my $options=&screen_header($feedurl,$symb,$group);
if ($options) {
&mail_screen($r,$feedurl,$options,$symb,$attachmax{'text'});
} else {
&fail_redirect($r,$feedurl,1);
}
return OK;
}
# 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
&Apache::lonenc::check_encrypt(\$feedurl);
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 $usersymb = &Apache::lonenc::check_encrypt($symb);
my $useranswer=
&Apache::loncommon::get_student_answers(
$usersymb,$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='';
my $toolarge='';
if (($env{'form.origpage'}) || ($env{'form.editdisc'}) ||
($env{'form.replydisc'})) {
my ($symb,$idx);
if ($env{'form.replydisc'}) {
($symb,$idx)=split(/\:\:\:/,$env{'form.replydisc'});
} elsif ($env{'form.editdisc'}) {
($symb,$idx)=split(/\:\:\:/,$env{'form.editdisc'});
} elsif ($env{'form.origpage'}) {
$symb = $env{'form.symb'};
}
&Apache::lonenc::check_decrypt(\$symb);
my @currnewattach = ();
my @deloldattach = ();
my @keepold = ();
&process_attachments(\@currnewattach,\@deloldattach,\@keepold);
$symb=~s|(bulletin___\d+___)adm/wrapper/|$1|;
$attachmenturl=&construct_attachmenturl(\@currnewattach,\@keepold,$symb,$idx);
} elsif ($env{'form.attachment.filename'}) {
if (length($env{'form.attachment'})<=$attachmax{'num'}) {
my $now = time;
my $subdir = 'feedback/'.$now;
$attachmenturl=&Apache::lonnet::userfileupload('attachment',undef,$subdir);
} else {
$toolarge = '<p><span class="LC_warning">'.&mt('Attachment not included - exceeded permitted length').'</span><br /></p>';
}
}
# Filter HTML out of message (could be nasty)
my $override;
if ($env{'form.discuss'} =~ /^(?:author|question|course|policy)$/) {
$override = 1;
}
my $message=&clear_out_html($env{'form.comment'},$override);
# Assemble email
my ($email,$citations)=&assemble_email($message,$prevattempts,
$usersaw,$useranswer);
# Who gets this?
my ($typestyle,%to) = &Apache::lonmsg::decide_receiver($feedurl);
# Actually send mail
my $clientip = &Apache::lonnet::get_requestor_ip($r);
my ($status,$numsent,$delay)=&send_msg(&clear_out_html($env{'form.subject'}),
$feedurl,$email,$citations,
$attachmenturl,$usersymb,$clientip,%to);
# Discussion? Store that.
my $numpost=0;
if ( ($env{'form.discuss'} ne ''
&& $env{'form.discuss'} !~ /^(?:author|question|course|policy)/)
|| $env{'form.anondiscuss'} ne '') {
my $subject = &clear_out_html($env{'form.subject'});
my $anonmode;
if (&Apache::lonnet::allowed('pac',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) {
$anonmode=($env{'form.discuss'} eq 'anon' || $env{'form.anondiscuss'} );
}
$typestyle.=&adddiscuss($symb,$message,$anonmode,$attachmenturl,
$subject,$group);
$numpost++;
}
# Add to blog?
my $blog='';
if ($env{'form.blog'}) {
my $subject = &clear_out_html($env{'form.subject'});
$status.=&Apache::lonrss::addentry($env{'user.name'},
$env{'user.domain'},
'CourseBlog_'.$env{'request.course.id'},
$subject,$message,$feedurl,'public');
if (&Apache::loncommon::course_type() eq 'Community') {
$blog='<br />'.&mt('Added to my community blog').'<br />';
} else {
$blog='<br />'.&mt('Added to my course blog').'<br />';
}
}
# Receipt screen and redirect back to where came from
&redirect_back($r,$feedurl,$typestyle,$numsent,$numpost,$blog,$status,$env{'form.previous'},
undef,undef,undef,undef,undef,undef,$group,$toolarge,$delay);
}
return OK;
}
sub blocked_reply_or_edit {
my ($blocktext) = @_;
return
&Apache::loncommon::start_page('Resource Feedback and Discussion').
$blocktext.'<br /><br /><a href="javascript:history.go(-1)">'.
&mt('Back to previous page').
&Apache::loncommon::end_page();
}
sub wrap_symb {
my ($ressymb)=@_;
if ($ressymb =~ /bulletin___\d+___/) {
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
}
return $ressymb;
}
sub dewrapper {
my ($feedurl)=@_;
if ($$feedurl=~m|^/adm/wrapper/adm/.*/bulletinboard$|) {
$$feedurl=~s|^/adm/wrapper||;
}
}
sub get_feedurl {
my ($symb)=@_;
my ($map,$ind,$url)=&Apache::lonnet::decode_symb($symb);
my $feedurl = &Apache::lonnet::clutter($url);
&dewrapper(\$feedurl);
return $feedurl;
}
sub get_feedurl_and_clean_symb {
my ($symb)=@_;
&Apache::lonenc::check_decrypt(\$symb);
# backward compatibility (bulletin boards used to be 'wrapped')
unless ($symb =~ m|bulletin___\d+___adm/wrapper|) {
$symb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
my $feedurl = &get_feedurl($symb);
return ($symb,$feedurl);
}
sub editing_allowed {
my ($postid,$group) = @_;
$postid = &unescape($postid);
my $can_edit = 0;
if ($group ne '') {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
if ($postid =~ m|^bulletin___\d+___adm/wrapper(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
if (&check_group_priv($group,'egp') eq 'ok') {
$can_edit = 1;
}
return $can_edit;
}
}
my $cid = $env{'request.course.id'};
my $role = (split(/\./,$env{'request.role'}))[0];
my $section = $env{'request.course.sec'};
my $allow_editing_config =
$env{'course.'.$cid.'.allow_discussion_post_editing'};
if ($allow_editing_config =~ m/^\s*yes\s*$/i) {
$can_edit = 1;
} else {
foreach my $editor (split(/,/,$allow_editing_config)) {
my ($editor_role,$editor_sec) = split(/:/,$editor);
if ($editor_role eq $role
&& defined($editor_sec)
&& defined($section)
&& $editor_sec eq $section) {
$can_edit = 1;
last;
}
if ($editor_role eq $role
&& !defined($editor_sec)) {
$can_edit = 1;
}
}
}
return $can_edit;
}
sub check_group_priv {
my ($group,$grp_priv) = @_;
foreach my $priv ('mdg','vcg') {
my $checkcourse = $env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'');
if (&Apache::lonnet::allowed($priv,$checkcourse)) {
return 'ok';
}
}
if ($grp_priv && $group ne '') {
if (&Apache::lonnet::allowed($grp_priv,$env{'request.course.id'}.'/'.$group)) {
return 'ok';
}
}
return '';
}
sub group_args {
my ($group) = @_;
if ($group eq '') { return ''; }
my $extra_args = '&group='.$group;
if (exists($env{'form.ref'})) {
$extra_args .= '&ref='.$env{'form.ref'};
}
return $extra_args;
}
sub get_resource_title {
my ($symb,$feedurl) = @_;
my ($restitle,$plainurl);
if (defined($symb)) {
my $plain_symb = &Apache::lonenc::check_decrypt($symb);
$restitle = &Apache::lonnet::gettitle($plain_symb);
}
if (defined($feedurl)) {
$plainurl = &Apache::lonenc::check_decrypt($feedurl);
}
if (!defined($restitle)) {
if (defined($feedurl)) {
$restitle = &Apache::lonnet::gettitle($plainurl);
}
}
if ($plainurl ne $feedurl) {
my ($plain_filename) = ($plainurl =~ m-/([^/]+)$-);
if ($plain_filename eq $restitle) {
$restitle = &mt('Untitled resource');
}
}
if ($restitle eq '') {
$restitle = &mt('Untitled resource');
}
return $restitle;
}
1;
__END__
=pod
=head1 NAME
Apache::lonfeedback.pm
=head1 SYNOPSIS
Handles feedback from students to instructors and system administrators.
Provides a screenshot of the current resource, as well as previous attempts if the resource was a homework.
Used by lonmsg.pm.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
=head1 OVERVIEW
None
=head1 SUBROUTINES
=over
=item discussion_open()
=item discussion_visible()
=item discussion_vote_available()
=item get_realsymb()
=item list_discussion()
=item can_see_hidden()
=item discussion_link()
=item send_feedback_link()
=item send_message_link()
=item action_links_bar()
=item postingform_display()
=item build_posting_display
=item filter_regexp()
=item get_post_contents()
=item replicate_attachments()
=item mail_screen()
=item print_display_options()
=item print_sortfilter_options()
=item print_showposters()
=item get_post_versions()
=item get_post_attachments()
=item fail_redirect()
=item redirect_back()
=item no_redirect_back()
=item screen_header()
=item resource_output()
=item clear_out_html()
=item assemble_email()
=item feedback_available()
=item send_msg()
=item adddiscuss()
=item get_discussion_info()
=item show_preview()
=item newline_to_br()
=item tidy_html()
=item generate_preview_button()
=item modify_attachments()
=item process_attachments()
=item generate_attachments_button()
=item extract_attachments()
=item construct_attachmenturl()
=item add_blog_checkbox()
=item has_discussion()
=item sort_filter_names()
=item handler()
=item blocked_reply_or_edit()
=item wrap_symb()
=item dewrapper()
=item get_feedurl()
=item get_feedurl_and_clean_symb()
=item editing_allowed()
=item check_group_priv()
=item group_args()
=item get_resource_title()
=back
=cut
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