--- loncom/interface/lonfeedback.pm 2004/07/28 18:50:26 1.108
+++ loncom/interface/lonfeedback.pm 2004/11/19 19:43:05 1.142
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.108 2004/07/28 18:50:26 raeburn Exp $
+# $Id: lonfeedback.pm,v 1.142 2004/11/19 19:43:05 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,16 +36,20 @@ use Apache::loncommon();
use Apache::lontexconvert();
use Apache::lonlocal; # must not have ()
use Apache::lonhtmlcommon();
+use Apache::lonnavmaps;
+use Apache::lonenc();
+use HTML::LCParser();
use Apache::lonspeller();
+use Cwd;
sub discussion_open {
- my ($status)=@_;
+ my ($status,$symb)=@_;
if (defined($status) &&
!($status eq 'CAN_ANSWER' || $status eq 'CANNOT_ANSWER'
|| $status eq 'OPEN')) {
return 0;
}
- my $close=&Apache::lonnet::EXT('resource.0.discussend');
+ my $close=&Apache::lonnet::EXT('resource.0.discussend',$symb);
if (defined($close) && $close ne '' && $close < time) {
return 0;
}
@@ -57,16 +61,20 @@ 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)=@_;
-
+ my ($mode,$status,$ressymb)=@_;
my $outputtarget=$ENV{'form.grade_target'};
+ if (defined($ENV{'form.export'})) {
+ if($ENV{'form.export'}) {
+ $outputtarget = 'export';
+ }
+ }
if (not &discussion_visible($status)) { return ''; }
my @bgcols = ("#cccccc","#eeeeee");
my $discussiononly=0;
@@ -78,30 +86,31 @@ sub list_discussion {
$crs.='_'.$ENV{'request.course.sec'};
}
$crs=~s/\_/\//g;
- unless ($symb) {
- $symb=&Apache::lonnet::symbread();
- }
- unless ($symb) { return ''; }
+ unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); }
+ unless ($ressymb) { return ''; }
+ $ressymb=&wrap_symb($ressymb);
+ my $encsymb=&Apache::lonenc::check_encrypt($ressymb);
+ my $viewgrades=(&Apache::lonnet::allowed('vgr',$crs)
+ && ($ressymb=~/\.(problem|exam|quiz|assess|survey|form)$/));
+
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 %dischash = &Apache::lonnet::get('nohist_'.$ENV{'request.course.id'}.'_discuss',[$lastkey,$showkey,$visitkey,$ondispkey,$userpickkey],$ENV{'user.domain'},$ENV{'user.name'});
+ my $toggkey = $ressymb.'_readtoggle';
+ my $readkey = $ressymb.'_read';
+ $ressymb=$encsymb;
+ 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;
@@ -112,7 +121,6 @@ sub list_discussion {
# 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'};
@@ -128,7 +136,7 @@ sub list_discussion {
# Get information about students and non-students in course for filtering display of posts
my %roleshash = ();
my %roleinfo = ();
- if ($rolefilter) {
+ if ($ENV{'form.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/:/,$_;
@@ -154,48 +162,54 @@ sub list_discussion {
}
# 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})) {
+ 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 @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;
@@ -205,332 +219,19 @@ sub list_discussion {
$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);
- }
-#figure out at what position this needs to print
- my $thisindex=$idx;
- if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread')) {
- $thisindex=$origindex.substr('00'.$replies[$depth[$idx]],-2,2);
- }
- $alldiscussion{$thisindex}=$idx;
- $shown{$idx} = 0;
- $index[$idx]=$thisindex;
- my $spansize = 2;
- if ($showonlyunread && $prevread > $posttime) {
- $notshown{$idx} = 1;
- } else {
-# 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] .= '
-
- NEW | ';
- } else {
- $newitem{$idx} = 0;
- $discussionitems[$idx] .= '
-
- | ';
- }
- $discussionitems[$idx] .= ' '.
- ''.$subject.' '.
- $sender.' '.$vgrlink.' ('.
- localtime($posttime).') |
'.
- '
'.$message.'
';
- if ($contrib{$idx.':history'}) {
- my @postversions = ();
- $discussionitems[$idx] .= '
'.&mt('This post has been edited by the author.').'
'.&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] .= ''.$version.'. - '.&Apache::lonlocal::locallocaltime($postversions[$i]).' ';
- }
- $discussionitems[$idx] .= '
';
- }
- }
- }
- }
- }
- }
+ &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,$prevread,$sortposts,$encsymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$ENV{'form.rolefilter'},$sectionpick,$statusfilter,$toggkey,$outputtarget);
my $discussion='';
+ my $manifestfile;
+ my $manifestok=0;
+ my $tempexport;
+ my $imsresources;
+ my $copyresult;
my $function = &Apache::loncommon::get_users_function();
my $color = &Apache::loncommon::designparm($function.'.tabbg',
@@ -539,22 +240,31 @@ sub list_discussion {
'cuse' => 'Current discussion settings',
'allposts' => 'All posts',
'unread' => 'New posts only',
+ 'unmark' => 'Unread only',
'ondisp' => 'Once displayed',
- 'onmark' => 'Once marked read',
+ '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',
);
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 $displink = 'onlyunread';
+ my $displinkA = 'onlyunread';
+ my $displinkB = 'onlyunmark';
my $marklink = 'markondisp';
+ my $togglink = 'toggon';
if ($markondisp) {
$currmark = $lt{'ondisp'};
@@ -565,10 +275,24 @@ sub list_discussion {
if ($showonlyunread) {
$currdisp = $lt{'unread'};
$dispchange = $lt{'allposts'};
- $displink = '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='.$displink.'_'.$marklink;
+ $chglink .= '&changes='.$displinkA.'_'.$displinkB.'_'.$marklink.'_'.$togglink;
if ($newpostsflag) {
$chglink .= '&previous='.$prevread;
@@ -576,7 +300,45 @@ sub list_discussion {
if ($visible) {
# Print the discusssion
- if ($outputtarget ne 'tex') {
+ if ($outputtarget eq 'tex') {
+ $discussion.='\vskip 0 mm\noindent\makebox[2 cm][b]{\hrulefill}'.
+ '\textbf{DISCUSSIONS}\makebox[2 cm][b]{\hrulefill}'.
+ '\vskip 0 mm\noindent\textbf{'.$lt{'cuse'}.'}:\vskip 0 mm'.
+ '\noindent\textbf{'.$lt{'disa'}.'}: \textit{'.$currdisp.'}\vskip 0 mm'.
+ '\noindent\textbf{'.$lt{'npce'}.'}: \textit{'.$currmark.'}';
+ } elsif ($outputtarget eq 'export') {
+# Create temporary directory if this is an export
+ my $now = time;
+ $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|
+
+
+
+
+ Discussion for $ressymb\n|;
+ } else {
+ $discussion .= 'An error occurred opening the manifest file.
';
+ }
+ } else {
my $colspan=$maxdepth+1;
$discussion.= qq|
|;
- $discussion.='