--- loncom/interface/lonfeedback.pm 2004/08/10 18:01:25 1.114
+++ loncom/interface/lonfeedback.pm 2010/08/14 17:48:13 1.299
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.114 2004/08/10 18:01:25 sakharuk Exp $
+# $Id: lonfeedback.pm,v 1.299 2010/08/14 17:48:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,18 +35,36 @@ 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 Cwd;
+use LONCAPA;
sub discussion_open {
- my ($status)=@_;
+ 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;
}
- my $close=&Apache::lonnet::EXT('resource.0.discussend');
+# The problem is available, but check if the instructor explictly closed discussion
if (defined($close) && $close ne '' && $close < time) {
return 0;
}
@@ -58,40 +76,70 @@ sub discussion_visible {
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;
+ if (!$env{'request.role.adv'}) { return 0; }
}
}
return 1;
}
sub list_discussion {
- my ($mode,$status,$symb,$ttarget,$tagstack,$parstack,$parser,$safeeval)=@_;
- my $outputtarget=$ENV{'form.grade_target'};
- if (not &discussion_visible($status)) { return ''; }
- my @bgcols = ("#cccccc","#eeeeee");
+ 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';
+ }
+ }
+ if (not &discussion_visible($status)) {
+ if ($mode ne 'board') {
+ &Apache::lonenc::check_encrypt(\$ressymb);
+ return '
'.&send_message_link($ressymb)."
";
+ }
+ }
+ if ($group ne '' && $mode eq 'board') {
+ if (&check_group_priv($group,'vgb') ne 'ok') {
+ return '';
+ }
+ }
+
+ my ($blocked,$blocktext) =
+ &Apache::loncommon::blocking_status('boards');
+ if ($blocked) {
+ $blocktext = '
'.$blocktext."";
+ &Apache::lonenc::check_encrypt(\$ressymb);
+ if ($mode ne 'board') {
+ $blocktext.=&send_message_link($ressymb).'
';
+ }else{
+ $blocktext.="";
+ }
+ return $blocktext;
+ }
+
+ 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;
- unless ($symb) {
- $symb=&Apache::lonnet::symbread();
+ 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'};
}
- unless ($symb) { return ''; }
+ $crs=~s/\_/\//g;
+ my $encsymb=&Apache::lonenc::check_encrypt($ressymb);
+ my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
+ && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form|task)$/));
+
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';
@@ -102,8 +150,8 @@ sub list_discussion {
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'});
+ $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;
@@ -112,16 +160,18 @@ sub list_discussion {
my $previous = 0;
my $visit = 0;
my $newpostsflag = 0;
- my @posters = split/\&/,$dischash{$userpickkey};
+ 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'};
+ &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})) {
@@ -130,439 +180,125 @@ sub list_discussion {
}
}
+ 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 = ();
- 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 ($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';
}
- push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
+ if ($uname && $udom) {
+ 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 ($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;
+ push(@{$roleinfo{$student}}, 'st:'.$section.':'.$status);
}
+ ($classgroups,$studentgroups) =
+ &Apache::loncoursedata::get_group_memberships($classlist,$keylist,
+ $cdom,$cnum);
}
# 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') {
+ if ($env{'environment.discdisplay'} eq 'unread') {
$showonlyunread = 1;
}
- my $discmarkread=$userenv{'discmarkread'};
- if ($discmarkread eq 'ondisp') {
+ if ($env{'environment.discmarkread'} eq 'ondisp') {
$markondisp = 1;
}
# Override user's default if user specified display setting for this discussion
if (defined($dischash{$ondispkey})) {
- $markondisp = $dischash{$ondispkey};
+ unless ($dischash{$ondispkey} eq '') {
+ $markondisp = $dischash{$ondispkey};
+ }
}
if ($markondisp) {
$discinfo{$lastkey} = time;
}
if (defined($dischash{$showkey})) {
- $showonlyunread = $dischash{$showkey};
+ unless ($dischash{$showkey} eq '') {
+ $showonlyunread = $dischash{$showkey};
+ }
}
if (defined($dischash{$markkey})) {
- $showunmark = $dischash{$markkey};
+ unless ($dischash{$markkey} eq '') {
+ $showunmark = $dischash{$markkey};
+ }
}
if (defined($dischash{$visitkey})) {
- $visit = $dischash{$visitkey};
+ unless ($dischash{$visitkey} eq '') {
+ $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 $seeid;
+ if (($group ne '') && ($mode eq 'board') &&
+ ($ressymb =~ m|^bulletin___\d+___adm/wrapper/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard$|)) {
+ if (&check_group_priv($group,'dgp') eq 'ok') {
+ $seeid = 1;
+ }
+ } else {
+ $seeid=&Apache::lonnet::allowed('rin',$crs);
+ }
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 $current=0;
my $visible=0;
my @depth=();
- my @original=();
- my @index=();
- my @replies=();
+ my @replies = ();
my %alldiscussion=();
+ my %imsitems=();
+ my %imsfiles=();
my %notshown = ();
my %newitem = ();
my $maxdepth=0;
-
+ my %anonhash=();
+ my $anoncnt=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'} =~ /^/) {
- my %versions = ();
- &get_post_versions(\%versions,$contrib{$idx.':message'},$numoldver);
- $message = &HTML::Entities::decode($versions{$numoldver});
- } 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'} =~ /^/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] .= '
-