# The LearningOnline Network
# Feedback
#
# $Id: lonfeedback.pm,v 1.111 2004/08/01 16:05:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
package Apache::lonfeedback;
use strict;
use Apache::Constants qw(:common);
use Apache::lonmsg();
use Apache::loncommon();
use Apache::lontexconvert();
use Apache::lonlocal; # must not have ()
use Apache::lonhtmlcommon();
use Apache::lonspeller();
sub discussion_open {
my ($status)=@_;
if (defined($status) &&
!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
|| $status eq 'OPEN')) {
return 0;
}
my $close=&Apache::lonnet::EXT('resource.0.discussend');
if (defined($close) && $close ne '' && $close < time) {
return 0;
}
return 1;
}
sub discussion_visible {
my ($status)=@_;
if (not &discussion_open($status)) {
my $hidden=&Apache::lonnet::EXT('resource.0.discusshide');
if (lc($hidden) eq 'yes' or $hidden eq '' or !defined($hidden)) {
return 0;
}
}
return 1;
}
sub list_discussion {
my ($mode,$status,$symb)=@_;
my $outputtarget=$ENV{'form.grade_target'};
if (not &discussion_visible($status)) { return ''; }
my @bgcols = ("#cccccc","#eeeeee");
my $discussiononly=0;
if ($mode eq 'board') { $discussiononly=1; }
unless ($ENV{'request.course.id'}) { return ''; }
my $crs='/'.$ENV{'request.course.id'};
my $cid=$ENV{'request.course.id'};
if ($ENV{'request.course.sec'}) {
$crs.='_'.$ENV{'request.course.sec'};
}
$crs=~s/\_/\//g;
unless ($symb) {
$symb=&Apache::lonnet::symbread();
}
unless ($symb) { return ''; }
my %usernamesort = ();
my %namesort =();
my %subjectsort = ();
# backward compatibility (bulletin boards used to be 'wrapped')
my $ressymb=$symb;
if ($mode eq 'board') {
unless ($ressymb =~ m|bulletin___\d+___adm/wrapper|) {
$ressymb=~s|(bulletin___\d+___)|$1adm/wrapper|;
}
}
# Get discussion display settings for this discussion
my $lastkey = $ressymb.'_lastread';
my $showkey = $ressymb.'_showonlyunread';
my $markkey = $ressymb.'_showonlyunmark',
my $visitkey = $ressymb.'_visit';
my $ondispkey = $ressymb.'_markondisp';
my $userpickkey = $ressymb.'_userpick';
my $toggkey = $ressymb.'_readtoggle';
my $readkey = $ressymb.'_read';
my %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_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','totposters']);
my $sortposts = $ENV{'form.sortposts'};
my $rolefilter = $ENV{'form.rolefilter'};
my $statusfilter = $ENV{'form.statusfilter'};
my $sectionpick = $ENV{'form.sectionpick'};
my $totposters = $ENV{'form.totposters'};
$previous = $ENV{'form.previous'};
if ($previous > 0) {
$prevread = $previous;
} elsif (defined($dischash{$lastkey})) {
unless ($dischash{$lastkey} eq '') {
$prevread = $dischash{$lastkey};
}
}
# Get information about students and non-students in course for filtering display of posts
my %roleshash = ();
my %roleinfo = ();
if ($rolefilter) {
%roleshash = &Apache::lonnet::dump('nohist_userroles',$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
foreach (keys %roleshash) {
my ($role,$uname,$udom,$sec) = split/:/,$_;
my ($end,$start) = split/:/,$roleshash{$_};
my $now = time;
my $status = 'Active';
if (($now < $start) || ($end > 0 && $now > $end)) {
$status = 'Expired';
}
push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
}
my ($classlist) = &Apache::loncoursedata::get_classlist(
$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $sec_index = &Apache::loncoursedata::CL_SECTION();
my $status_index = &Apache::loncoursedata::CL_STATUS();
while (my ($student,$data) = each %$classlist) {
my ($section,$status) = ($data->[$sec_index],
$data->[$status_index]);
push @{$roleinfo{$student}}, 'st:'.$section.':'.$status;
}
}
# Get discussion display default settings for user
my %userenv = &Apache::lonnet::get('environment',['discdisplay','discmarkread'],$ENV{'user.domain'},$ENV{'user.name'});
my $discdisplay=$userenv{'discdisplay'};
if ($discdisplay eq 'unread') {
$showonlyunread = 1;
}
my $discmarkread=$userenv{'discmarkread'};
if ($discmarkread eq 'ondisp') {
$markondisp = 1;
}
# Override user's default if user specified display setting for this discussion
if (defined($dischash{$ondispkey})) {
$markondisp = $dischash{$ondispkey};
}
if ($markondisp) {
$discinfo{$lastkey} = time;
}
if (defined($dischash{$showkey})) {
$showonlyunread = $dischash{$showkey};
}
if (defined($dischash{$markkey})) {
$showunmark = $dischash{$markkey};
}
if (defined($dischash{$visitkey})) {
$visit = $dischash{$visitkey};
}
$visit ++;
my $seeid=&Apache::lonnet::allowed('rin',$crs);
my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
&& ($symb=~/\.(problem|exam|quiz|assess|survey|form)$/));
my @discussionitems=();
my %shown = ();
my @posteridentity=();
my %contrib=&Apache::lonnet::restore($ressymb,$ENV{'request.course.id'},
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
my $visible=0;
my @depth=();
my @original=();
my @index=();
my @replies=();
my %alldiscussion=();
my %notshown = ();
my %newitem = ();
my $maxdepth=0;
my $target='';
unless ($ENV{'browser.interface'} eq 'textual' ||
$ENV{'environment.remote'} eq 'off' ) {
$target='target="LONcom"';
}
my $now = time;
$discinfo{$visitkey} = $visit;
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_discuss',\%discinfo,$ENV{'user.domain'},$ENV{'user.name'});
if ($contrib{'version'}) {
my $oldest = $contrib{'1:timestamp'};
if ($prevread eq '0') {
$prevread = $oldest-1;
}
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
my $posttime = $contrib{$idx.':timestamp'};
if ($prevread <= $posttime) {
$newpostsflag = 1;
}
my $hidden=($contrib{'hidden'}=~/\.$idx\./);
my $studenthidden=($contrib{'studenthidden'}=~/\.$idx\./);
my $deleted=($contrib{'deleted'}=~/\.$idx\./);
my $origindex='0.';
my $numoldver=0;
if ($contrib{$idx.':replyto'}) {
if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
# this is a follow-up message
$original[$idx]=$original[$contrib{$idx.':replyto'}];
$depth[$idx]=$depth[$contrib{$idx.':replyto'}]+1;
$origindex=$index[$contrib{$idx.':replyto'}];
if ($depth[$idx]>$maxdepth) { $maxdepth=$depth[$idx]; }
} else {
$original[$idx]=0;
$depth[$idx]=0;
}
} else {
# this is an original message
$original[$idx]=0;
$depth[$idx]=0;
}
if ($replies[$depth[$idx]]) {
$replies[$depth[$idx]]++;
} else {
$replies[$depth[$idx]]=1;
}
unless ((($hidden) && (!$seeid)) || ($deleted)) {
$visible++;
if ($contrib{$idx.':history'}) {
if ($contrib{$idx.':history'} =~ /:/) {
my @oldversions = split/:/,$contrib{$idx.':history'};
$numoldver = @oldversions;
} else {
$numoldver = 1;
}
}
my ($message,$subject);
if ($idx > 0) {
if ($contrib{$idx.':message'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) {
$message = $1;
} else {
$message = $contrib{$idx.':message'};
}
} else {
$message=$contrib{$idx.':message'};
}
my $attachmenturls = $contrib{$idx.':attachmenturl'};
$message=~s/\n/\ /g;
$message=&Apache::lontexconvert::msgtexconverted($message);
if ($idx > 0) {
if ($contrib{$idx.':subject'} =~ /.*::::\Q$numoldver\E::::(.+?)$/si) {
$subject = $1;
} else {
$subject = $contrib{$idx.':subject'};
}
} else {
$subject=$contrib{$idx.':subject'};
}
if (defined($subject)) {
$subject=~s/\n/\ /g;
$subject=&Apache::lontexconvert::msgtexconverted($subject);
}
if ($attachmenturls) {
my @attachments = ();
my %currattach = ();
&extract_attachments($attachmenturls,$idx,$numoldver,\$message,\@attachments,\%currattach);
}
if ($message) {
if ($hidden) {
$message=''.$message.'';
if ($studenthidden) {
$message .='
Deleted by poster (student).';
}
}
my $screenname=&Apache::loncommon::screenname(
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'});
my $plainname=&Apache::loncommon::nickname(
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'});
my $sender=&mt('Anonymous');
# Set up for sorting by subject
if ($contrib{$idx.':subject'} eq '') {
if (defined($subjectsort{'__No subject'})) {
push @{$subjectsort{'__No subject'}}, $idx;
} else {
@{$subjectsort{'__No subject'}} = ("$idx");
}
} else {
if (defined($subjectsort{$contrib{$idx.':subject'}})) {
push @{$subjectsort{$contrib{$idx.':subject'}}}, $idx;
} else {
@{$subjectsort{$contrib{$idx.':subject'}}} = ("$idx");
}
}
if ((!$contrib{$idx.':anonymous'}) || ($seeid)) {
$sender=&Apache::loncommon::aboutmewrapper(
$plainname,
$contrib{$idx.':sendername'},
$contrib{$idx.':senderdomain'}).' ('.
$contrib{$idx.':sendername'}.' at '.
$contrib{$idx.':senderdomain'}.')';
if ($contrib{$idx.':anonymous'}) {
$sender.=' ['.&mt('anonymous').'] '.
$screenname;
}
# Set up for sorting by domain, then username
unless (defined($usernamesort{$contrib{$idx.':senderdomain'}})) {
%{$usernamesort{$contrib{$idx.':senderdomain'}}} = ();
}
if (defined($usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}})) {
push @{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}}, $idx;
} else {
@{$usernamesort{$contrib{$idx.':senderdomain'}}{$contrib{$idx.':sendername'}}} = ("$idx");
}
# Set up for sorting by last name, then first name
my %names = &Apache::lonnet::get('environment',['firstname','lastname'],
$contrib{$idx.':senderdomain'},$contrib{$idx.':sendername'});
my $lastname = $names{'lastname'};
my $firstname = $names{'firstname'};
if ($lastname eq '') {
$lastname = '_';
}
if ($firstname eq '') {
$firstname = '_';
}
unless (defined($namesort{$lastname})) {
%{$namesort{$lastname}} = ();
}
if (defined($namesort{$lastname}{$firstname})) {
push @{$namesort{$lastname}{$firstname}}, $idx;
} else {
@{$namesort{$lastname}{$firstname}} = ("$idx");
}
if ($ENV{"course.$cid.allow_discussion_post_editing"} =~ m/yes/i) {
if (($ENV{'user.domain'} eq $contrib{$idx.':senderdomain'}) && ($ENV{'user.name'} eq $contrib{$idx.':sendername'})) {
$sender.=' '.&mt('Edit').''; unless ($seeid) {
$sender.=" ';
}
}
}
if ($seeid) {
if ($hidden) {
unless ($studenthidden) {
$sender.=' '.&mt('Make Visible').'';
}
} else {
$sender.=' '.&mt('Hide').'';
}
$sender.=' '.&mt('Delete').'';
}
} else {
if ($screenname) {
$sender=''.$screenname.'';
}
# Set up for sorting by domain, then username for anonymous
unless (defined($usernamesort{'__anon'})) {
%{$usernamesort{'__anon'}} = ();
}
if (defined($usernamesort{'__anon'}{'__anon'})) {
push @{$usernamesort{'__anon'}{'__anon'}}, $idx;
} else {
@{$usernamesort{'__anon'}{'__anon'}} = ("$idx");
}
# Set up for sorting by last name, then first name for anonymous
unless (defined($namesort{'__anon'})) {
%{$namesort{'__anon'}} = ();
}
if (defined($namesort{'__anon'}{'__anon'})) {
push @{$namesort{'__anon'}{'__anon'}}, $idx;
} else {
@{$namesort{'__anon'}{'__anon'}} = ("$idx");
}
}
if (&discussion_open($status) &&
&Apache::lonnet::allowed('pch',
$ENV{'request.course.id'}.
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:''))) {
$sender.=' '.&mt('Reply').'';
}
my $vgrlink;
if ($viewgrades) {
$vgrlink=&Apache::loncommon::submlink('Submissions',
$contrib{$idx.':sendername'},$contrib{$idx.':senderdomain'},$symb);
}
my $ctlink;
if ($dischash{$readkey}=~/\.$idx\./) {
$ctlink = ''.&mt('Mark unread').'? ';
} else {
$ctlink = ''.&mt('Mark read').'? ';
}
#figure out at what position this needs to print
my $thisindex=$idx;
if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
$thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
}
$alldiscussion{$thisindex}=$idx;
$shown{$idx} = 0;
$index[$idx]=$thisindex;
my $spansize = 2;
if ($showonlyunread && $prevread > $posttime) {
$notshown{$idx} = 1;
} elsif ($showunmark && $dischash{$readkey}=~/\.$idx\./) {
$notshown{$idx} = 1;
} else {
# apply filters
my $uname = $contrib{$idx.':sendername'};
my $udom = $contrib{$idx.':senderdomain'};
my $poster = $uname.':'.$udom;
my $rolematch = '';
my $skiptest = 1;
if ($totposters > 0) {
if (grep/^$poster$/,@posters) {
$shown{$idx} = 1;
}
} else {
if ($rolefilter) {
if ($rolefilter eq 'all') {
$rolematch = '([^:]+)';
} else {
$rolematch = $rolefilter;
$skiptest = 0;
}
}
if ($sectionpick) {
if ($sectionpick eq 'all') {
$rolematch .= ':([^:]*)';
} else {
$rolematch .= ':'.$sectionpick;
$skiptest = 0;
}
}
if ($statusfilter) {
if ($statusfilter eq 'all') {
$rolematch .= ':([^:]+)';
} else {
$rolematch .= ':'.$statusfilter;
$skiptest = 0;
}
}
if ($skiptest) {
$shown{$idx} = 1;
} else {
foreach my $role (@{$roleinfo{$poster}}) {
if ($role =~ m/^$rolematch$/) {
$shown{$idx} = 1;
last;
}
}
}
}
}
unless ($notshown{$idx} == 1) {
if ($prevread > 0 && $prevread <= $posttime) {
$newitem{$idx} = 1;
$discussionitems[$idx] .= '