--- loncom/interface/lonfeedback.pm 2004/11/19 19:11:33 1.141
+++ loncom/interface/lonfeedback.pm 2004/12/23 14:00:58 1.147
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.141 2004/11/19 19:11:33 raeburn Exp $
+# $Id: lonfeedback.pm,v 1.147 2004/12/23 14:00:58 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -68,13 +68,18 @@ sub discussion_visible {
}
sub list_discussion {
- my ($mode,$status,$ressymb)=@_;
+ my ($mode,$status,$ressymb,$imsextras)=@_;
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)) { return ''; }
my @bgcols = ("#cccccc","#eeeeee");
my $discussiononly=0;
@@ -84,7 +89,7 @@ sub list_discussion {
my $cid=$ENV{'request.course.id'};
if ($ENV{'request.course.sec'}) {
$crs.='_'.$ENV{'request.course.sec'};
- }
+ }
$crs=~s/\_/\//g;
unless ($ressymb) { $ressymb=&Apache::lonnet::symbread(); }
unless ($ressymb) { return ''; }
@@ -122,7 +127,18 @@ sub list_discussion {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['previous','sortposts','rolefilter','statusfilter','sectionpick','totposters']);
my $sortposts = $ENV{'form.sortposts'};
my $statusfilter = $ENV{'form.statusfilter'};
- my $sectionpick = $ENV{'form.sectionpick'};
+ my @sectionpick = ();
+ if ($ENV{'form.sectionpick'} =~ /,/) {
+ @sectionpick = split/,/,$ENV{'form.sectionpick'};
+ } else {
+ $sectionpick[0] = $ENV{'form.sectionpick'};
+ }
+ my @rolefilter = ();
+ if ($ENV{'form.rolefilter'} =~ /,/) {
+ @rolefilter = split/,/,$ENV{'form.rolefilter'};
+ } else {
+ $rolefilter[0] = $ENV{'form.rolefilter'};
+ }
my $totposters = $ENV{'form.totposters'};
$previous = $ENV{'form.previous'};
if ($previous > 0) {
@@ -140,13 +156,18 @@ sub list_discussion {
%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/:/,$_;
+ if ($role =~ /^cr/) {
+ $role = 'cr';
+ }
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;
+ if ($uname && $udom) {
+ push @{$roleinfo{$uname.':'.$udom}}, $role.':'.$sec.':'.$status;
+ }
}
my ($classlist) = &Apache::loncoursedata::get_classlist(
$ENV{'request.course.id'},
@@ -224,7 +245,7 @@ sub list_discussion {
$discinfo{$visitkey} = $visit;
&Apache::lonnet::put('nohist_'.$ENV{'request.course.id'}.'_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,$prevread,$sortposts,$encsymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$ENV{'form.rolefilter'},$sectionpick,$statusfilter,$toggkey,$outputtarget);
+ &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,\@rolefilter,\@sectionpick,$statusfilter,$toggkey,$outputtarget);
my $discussion='';
my $manifestfile;
@@ -309,15 +330,26 @@ sub list_discussion {
} 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);
+ 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'};
}
- $tempexport .= '/'.$ENV{'user.domain'}.'_'.$ENV{'user.name'};
if (!-e $tempexport) {
mkdir($tempexport,0700);
}
@@ -397,7 +429,7 @@ imscp_v1p1.xsd http://www.imsglobal.org/
if ($numhidden > 0) {
my $colspan = $maxdepth+1;
$discussion.="\n".'| '.
- ' $b } keys %alldiscussion);
}
my $currdepth = 0;
my $firstidx = $alldiscussion{$showposts[0]};
foreach (@showposts) {
- unless (($sortposts eq 'thread') || ($sortposts eq 'ascdate' && $ENV{'environment.threadeddiscussion'}) || ($outputtarget eq 'export')) {
+ unless (($sortposts eq 'thread') || (($sortposts eq '') && ($ENV{'environment.threadeddiscussion'})) || ($outputtarget eq 'export')) {
$alldiscussion{$_} = $_;
}
unless ( ($notshown{$alldiscussion{$_}} eq '1') || ($shown{$alldiscussion{$_}} == 0) ) {
@@ -481,8 +512,8 @@ imscp_v1p1.xsd http://www.imsglobal.org/
$imsitems{$alldiscussion{$_}}{'isvisible'}.'" identifieref="RES-'.$ressymb.'-'.$alldiscussion{$_}.'">'.
''.$imsitems{$alldiscussion{$_}}{'title'}.'';
$imsresources .= "\n".
- ''.
- ''."\n".
+ ''."\n".
+ ''."\n".
$imsfiles{$alldiscussion{$_}}{$imsitems{$alldiscussion{$_}}{'currversion'}}."\n".
'';
}
@@ -539,13 +570,54 @@ END
$discussion .= < |
|
-
+ |
$lt{'chgt'}?
|
END
+ if ($sortposts) {
+ my %sort_types = ();
+ my %role_types = ();
+ my %status_types = ();
+ &sort_filter_names(\%sort_types,\%role_types,\%status_types);
+
+ $discussion .= ''.&mt('Sorted by').': '.$sort_types{$sortposts}.'
';
+ if (defined($ENV{'form.totposters'})) {
+ $discussion .= &mt('Posts by').':';
+ if ($totposters > 0) {
+ foreach my $poster (@posters) {
+ $poster =~ s/:/\@/;
+ $discussion .= ' '.$poster.',';
+ }
+ $discussion =~ s/,$//;
+ } else {
+ $discussion .= &mt('None selected');
+ }
+ } else {
+ my $filterchoice ='';
+ if (@sectionpick > 0) {
+ $filterchoice = ''.&mt('sections').'- '.$ENV{'form.sectionpick'};
+ $filterchoice .= ' ';
+ }
+ if (@rolefilter > 0) {
+ $filterchoice .= ''.&mt('roles').'-';
+ foreach (@rolefilter) {
+ $filterchoice .= ' '.$role_types{$_}.',';
+ }
+ $filterchoice =~ s/,$//;
+ $filterchoice .= '
';
+ }
+ if ($statusfilter) {
+ $filterchoice .= ''.&mt('status').'- '.$status_types{$statusfilter};
+ }
+ if ($filterchoice) {
+ $discussion .= ''.&mt('Filters').': '.$filterchoice;
+ }
+ $discussion .= ' | ';
+ }
+ }
if ($dischash{$toggkey}) {
my $storebutton = &mt('Store read/unread changes');
$discussion.=''.
@@ -578,27 +650,31 @@ END
|;
close($manifestfile);
+ if ((defined($imsextras)) && ($$imsextras{'caller'} eq 'imsexport')) {
+ $discussion = $copyresult;
+ } else {
#Create zip file in prtspool
- my $imszipfile = '/prtspool/'.
- $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
- time.'_'.rand(1000000000).'.zip';
+ my $imszipfile = '/prtspool/'.
+ $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
+ time.'_'.rand(1000000000).'.zip';
# zip can cause an sh launch which can pass along all of %ENV
# which can be too large for /bin/sh to handle
- my %oldENV=%ENV;
- undef(%ENV);
- my $cwd = &getcwd();
- my $imszip = '/home/httpd/'.$imszipfile;
- chdir $tempexport;
- open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
- close(OUTPUT);
- chdir $cwd;
- %ENV=%oldENV;
- undef(%oldENV);
- $discussion .= 'Download the zip file from Discussion Posting Archive
';
- if ($copyresult) {
- $discussion .= 'The following errors occurred during export -
'.$copyresult;
+ my %oldENV=%ENV;
+ undef(%ENV);
+ my $cwd = &getcwd();
+ my $imszip = '/home/httpd/'.$imszipfile;
+ chdir $tempexport;
+ open(OUTPUT, "zip -r $imszip * 2> /dev/null |");
+ close(OUTPUT);
+ chdir $cwd;
+ %ENV=%oldENV;
+ undef(%oldENV);
+ $discussion .= 'Download the zip file from Discussion Posting Archive
';
+ if ($copyresult) {
+ $discussion .= 'The following errors occurred during export -
'.$copyresult;
+ }
}
} else {
$discussion .= '
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.
';
@@ -683,7 +759,6 @@ ENDDISCUSS
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,$prevread,$sortposts,$ressymb,$target,$readkey,$showunmark,$showonlyunread,$totposters,$rolefilter,$sectionpick,$statusfilter,$toggkey,$outputtarget) = @_;
-
my @original=();
my @index=();
my $symb=&Apache::lonenc::check_decrypt($ressymb);
@@ -696,6 +771,11 @@ sub build_posting_display {
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;
+ }
for (my $id=1;$id<=$contrib{'version'};$id++) {
my $idx=$id;
my $posttime = $contrib{$idx.':timestamp'};
@@ -708,7 +788,7 @@ sub build_posting_display {
my $origindex='0.';
my $numoldver=0;
if ($contrib{$idx.':replyto'}) {
- if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) {
+ if ( (($ENV{'environment.threadeddiscussion'}) && ($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;
@@ -903,7 +983,7 @@ sub build_posting_display {
}
if ($outputtarget eq 'export' || $message) {
my $thisindex=$idx;
- if ( (($ENV{'environment.threadeddiscussion'}) && (($sortposts eq '') || ($sortposts eq 'ascdate'))) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) {
+ if ( (($ENV{'environment.threadeddiscussion'}) && ($sortposts eq '')) || ($sortposts eq 'thread') || ($outputtarget eq 'export')) {
$thisindex=$origindex.substr('00'.$$replies[$$depth[$idx]],-2,2);
}
$$alldiscussion{$thisindex}=$idx;
@@ -944,46 +1024,33 @@ sub build_posting_display {
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 (defined($ENV{'form.totposters'})) {
+ 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 =~ m/^$rolematch$/) {
+ if ($role =~ /^cc:/) {
+ my $cc_regexp = $roleregexp.':[^:]*:'.$statusregexp;
+ if ($role =~ /$cc_regexp/) {
+ $$shown{$idx} = 1;
+ last;
+ }
+ } elsif ($role =~ /^$rolematch$/) {
$$shown{$idx} = 1;
last;
}
}
}
+ } else {
+ $$shown{$idx} = 1;
}
}
unless ($$notshown{$idx} == 1) {
@@ -1033,6 +1100,60 @@ sub build_posting_display {
}
}
+sub filter_regexp {
+ my ($rolefilter,$sectionpick,$statusfilter) = @_;
+ my ($roleregexp,$secregexp,$statusregexp);
+ my $skiptest = 1;
+ if (@{$rolefilter} > 0) {
+ my @okrolefilter = ();
+ foreach (@{$rolefilter}) {
+ unless ($_ eq '') {
+ push @okrolefilter, $_;
+ }
+ }
+ 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 (@{$sectionpick}) {
+ unless ($_ eq '') {
+ push @oksectionpick, $_;
+ }
+ }
+ 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,$type,$messages,$subjects,$allattachments,$attachtxt,$imsfiles,$screenname,$plainname,$numver) = @_;
my $discussion = '';
@@ -1681,30 +1802,13 @@ sub print_sortfilter_options {
my $section_sel = '';
my $numsections = 0;
my $numvisible = 5;
- my ($classlist) = &Apache::loncoursedata::get_classlist(
- $ENV{'request.course.id'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
- $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
-
- my $sec_index = &Apache::loncoursedata::CL_SECTION();
- my $status_index = &Apache::loncoursedata::CL_STATUS();
my %sectioncount = ();
- while (my ($student,$data) = each %$classlist) {
- my ($section,$status) = ($data->[$sec_index],
- $data->[$status_index]);
- unless ($section eq '' || $section =~ /^\s*$/) {
- if (!defined($sectioncount{$section})) {
- $sectioncount{$section} = 1;
- $numsections ++;
- } else {
- $sectioncount{$section} ++;
- }
- }
- }
-
- if ($ENV{'request.course.sec'} !~ /^\s*$/) {
- @sections = ($ENV{'request.course.sec'});
- $numvisible = 1;
+
+ $numsections = &Apache::loncommon::get_sections($ENV{'course.'.$ENV{'request.course.id'}.'.domain'},$ENV{'course.'.$ENV{'request.course.id'}.'.num'},\%sectioncount);
+
+ 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);
unshift(@sections,'all'); # Put 'all' at the front of the list
@@ -1726,19 +1830,49 @@ sub print_sortfilter_options {
'diop' => 'Display Options',
'curr' => 'Current setting ',
'actn' => 'Action',
- 'prca' => 'Options can be set that control the sort order of the posts, in addition to which posts are displayed.',
+ 'prca' => 'Set options that control the sort order of posts, and/or which posts are displayed.',
'soor' => 'Sort order',
- 'disp' => 'Specific user roles',
- 'actv' => 'Specific role status',
+ 'spur' => 'Specific user roles',
+ 'sprs' => 'Specific role status',
'spse' => 'Specific sections',
'psub' => 'Pick specific users (by name)',
'shal' => 'Show a list of current posters'
);
+
+ my %sort_types = ();
+ my %role_types = ();
+ my %status_types = ();
+ &sort_filter_names(\%sort_types,\%role_types,\%status_types);
+
$r->print(<
$lt{'diso'}
+
$bodytag
|