[LON-CAPA-cvs] cvs: loncom /interface/spreadsheet Spreadsheet.pm assesscalc.pm classcalc.pm lonspreadsheet.pm studentcalc.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Mon, 01 May 2006 06:17:33 -0000
This is a MIME encoded message
--raeburn1146464253
Content-Type: text/plain
raeburn Mon May 1 02:17:33 2006 EDT
Modified files:
/loncom/interface/spreadsheet assesscalc.pm classcalc.pm
lonspreadsheet.pm Spreadsheet.pm
studentcalc.pm
/loncom/lonnet/perl lonnet.pm
Log:
Determination of parameters for spreadsheet now correctly cascades for cases where a user has multiple active groups. Also groups are passed in argument list for Spreadsheet object as array reference. Lastly lonnet::get_users_groups function modified to only return user's active groups, except in case when user status has expired (and default end access date for students has also passed), in which case user's groups which were still active less than 24 hours before default end date are also included in user's groups. [For consistency with students groups returned by loncoursedata::get_students_groups()].
--raeburn1146464253
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060501021733.txt"
Index: loncom/interface/spreadsheet/assesscalc.pm
diff -u loncom/interface/spreadsheet/assesscalc.pm:1.52 loncom/interface/spreadsheet/assesscalc.pm:1.53
--- loncom/interface/spreadsheet/assesscalc.pm:1.52 Thu Apr 6 16:24:13 2006
+++ loncom/interface/spreadsheet/assesscalc.pm Mon May 1 02:17:16 2006
@@ -1,5 +1,5 @@
#
-# $Id: assesscalc.pm,v 1.52 2006/04/06 20:24:13 raeburn Exp $
+# $Id: assesscalc.pm,v 1.53 2006/05/01 06:17:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -302,12 +302,12 @@
##################################################
sub parmval {
my $self = shift;
- my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn,$cgroup)=@_;
- $uname = $self->{'name'} if (! defined($uname));
- $udom = $self->{'domain'} if (! defined($udom));
- $csec = $self->{'section'} if (! defined($csec));
- $cgroup = $self->{'group'} if (! defined($cgroup));
- $symb = $self->{'symb'} if (! defined($symb));
+ my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn,$groups)=@_;
+ $uname = $self->{'name'} if (! defined($uname));
+ $udom = $self->{'domain'} if (! defined($udom));
+ $csec = $self->{'section'} if (! defined($csec));
+ $groups = $self->{'groups'} if (! defined($groups));
+ $symb = $self->{'symb'} if (! defined($symb));
#
my $result='';
#
@@ -325,10 +325,6 @@
my $courseprefix = $self->{'cid'};
my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'};
#
- my $grplevel=$courseprefix.'.['.$cgroup.'].'.$what;
- my $grplevelr=$courseprefix.'.['.$cgroup.'].'.$symbparm;
- my $grplevelm=$courseprefix.'.['.$cgroup.'].'.$mapparm;
- #
my $seclevel = $courseprefix.'.['.$csec.'].'.$what;
my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm;
my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm;
@@ -346,11 +342,16 @@
return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm}));
return $useropt{$ucourselevel} if (defined($useropt{$ucourselevel}));
}
- # check group
- if (defined($cgroup)) {
- return $courseopt{$grplevelr} if (defined($courseopt{$grplevelr}));
- return $courseopt{$grplevelm} if (defined($courseopt{$grplevelm}));
- return $courseopt{$grplevel} if (defined($courseopt{$grplevel}));
+ # check groups
+ if (defined($groups) && ref($groups eq 'ARRAY')) {
+ foreach my $group (@{$groups}) {
+ foreach my $level ($symbparm,$mapparm,$what) {
+ my $item = $courseprefix.'.['.$group.'].'.$level;
+ if (defined($courseopt{$item})) {
+ return $courseopt{$item};
+ }
+ }
+ }
}
# check section
if (defined($csec)) {
@@ -382,7 +383,7 @@
my $newwhat=$rwhat;
$newwhat=~s/\Q$space\E/$part/;
my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1,
- $mapname,$id,$fn);
+ $mapname,$id,$fn,$groups);
if (defined($partgeneral)) { return $partgeneral; }
}
if ($recurse) { return undef; }
@@ -647,7 +648,7 @@
my $value = $self->parmval($parmname,$self->{'symb'},
$self->{'name'},$self->{'domain'},
$self->{'section'},undef,
- $mapname,$id,$fn);
+ $mapname,$id,$fn,$self->{'groups'});
$parameters{$parmname} =$value;
}
untie(%parmhash);
Index: loncom/interface/spreadsheet/classcalc.pm
diff -u loncom/interface/spreadsheet/classcalc.pm:1.26 loncom/interface/spreadsheet/classcalc.pm:1.27
--- loncom/interface/spreadsheet/classcalc.pm:1.26 Thu Apr 6 16:24:13 2006
+++ loncom/interface/spreadsheet/classcalc.pm Mon May 1 02:17:16 2006
@@ -1,5 +1,5 @@
#
-# $Id: classcalc.pm,v 1.26 2006/04/06 20:24:13 raeburn Exp $
+# $Id: classcalc.pm,v 1.27 2006/05/01 06:17:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -83,7 +83,8 @@
my $self = shift;
my ($toprow,$bottomrow);
&Apache::lonstatistics::clear_classlist_variables();
- foreach (['Sections',&Apache::lonstatistics::SectionSelect('Section','multpile',3)],
+ foreach (['Sections',&Apache::lonstatistics::SectionSelect('Section','multiple',3)],
+ ['Groups',&Apache::lonstatistics::GroupSelect('Group','multiple',3)],
['Enrollment Status',&Apache::lonhtmlcommon::StatusOptions(undef,undef,3)],
['Output Format',$self->output_selector()]) {
my ($name,$selector) = @{$_};
@@ -144,6 +145,7 @@
'username' => 'Username',
'domain' => 'Domain',
'section' => 'Section',
+ 'groups' => 'Groups',
'row' => 'Row',
);
my $tableheader =<<"END";
@@ -189,6 +191,7 @@
<th>$header{'username'}</th>
<th>$header{'domain'}</th>
<th>$header{'section'}</th>
+ <th>$header{'groups'}</th>
<th>$header{'status'}</th>
END
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
@@ -215,6 +218,7 @@
'<td>'.$link.$student->{'username'}.'</a></td>'.
'<td>'.$student->{'domain'} .'</td>'.
'<td>'.$student->{'section'} .'</td>'.
+ '<td>'.$student->{'groups'} .'</td>'.
'<td>'.$student->{'status'} .'</td>'.
$self->html_row($num_uneditable,$rownum,$exportcolor,
$importcolor).
@@ -232,7 +236,7 @@
#
# Write a header row
$cols_output = 0;
- foreach my $value ('Fullname','Username','Domain','Section','Status','ID') {
+ foreach my $value ('Fullname','Username','Domain','Section','Group','Status','ID') {
$worksheet->write($rows_output,$cols_output++,&mt($value),$format->{'h4'});
}
$rows_output++;
@@ -247,6 +251,7 @@
$student->{'username'},
$student->{'domain'},
$student->{'section'},
+ $student->{'groups'},
$student->{'status'},
$student->{'id'});
$self->excel_output_row($worksheet,$rownum,$rows_output++,
@@ -263,7 +268,7 @@
#
# Write a header row
$self->csv_output_row($filehandle,undef,
- (&mt('Fullname'),&mt('Username'),&mt('Domain'),&mt('Section'),&mt('Status'),&mt('ID')));
+ (&mt('Fullname'),&mt('Username'),&mt('Domain'),&mt('Section'),&mt('Group'),&mt('Status'),&mt('ID')));
#
# Write each students row
foreach my $student (@Students) {
@@ -274,6 +279,7 @@
$student->{'username'},
$student->{'domain'},
$student->{'section'},
+ $student->{'groups'},
$student->{'status'},
$student->{'id'});
$self->csv_output_row($filehandle,$rownum,@studentdata);
@@ -329,6 +335,7 @@
'username' => 'Username',
'domain' => 'Domain',
'section' => 'Section',
+ 'groups' => 'Groups',
);
#
# Prepare to output rows
@@ -341,6 +348,7 @@
<th>$header{'username'}</th>
<th>$header{'domain'}</th>
<th>$header{'section'}</th>
+ <th>$header{'groups'}</th>
<th>$header{'status'}</th>
END
if ($show_expire_link) {
@@ -362,6 +370,7 @@
'<td>'.$link.$student->{'username'}.'</a></td>'.
'<td>'.$student->{'domain'} .'</td>'.
'<td>'.$student->{'section'} .'</td>'.
+ '<td>'.$student->{'groups'} .'</td>'.
'<td>'.$student->{'status'} .'</td>');
if ($show_expire_link) {
$r->print('<td>'.
@@ -407,7 +416,7 @@
my $sname = $student->{'username'}.':'.$student->{'domain'};
my $studentsheet = Apache::studentcalc->new
($student->{'username'},$student->{'domain'},undef,undef,
- $student->{'section'},$student->{'group'} );
+ $student->{'section'},$student->{'groupref'} );
if ($connection->aborted()) { $self->cleanup(); return; }
my @exportdata = $studentsheet->export_data($r);
if ($studentsheet->badcalc()) {
Index: loncom/interface/spreadsheet/lonspreadsheet.pm
diff -u loncom/interface/spreadsheet/lonspreadsheet.pm:1.46 loncom/interface/spreadsheet/lonspreadsheet.pm:1.47
--- loncom/interface/spreadsheet/lonspreadsheet.pm:1.46 Mon Apr 10 18:59:16 2006
+++ loncom/interface/spreadsheet/lonspreadsheet.pm Mon May 1 02:17:16 2006
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.46 2006/04/10 22:59:16 albertel Exp $
+# $Id: lonspreadsheet.pm,v 1.47 2006/05/01 06:17:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -266,22 +266,13 @@
$env{'form.sdomain'} = $domain;
my $section = &Apache::lonnet::getsection($domain,$name,
$env{'request.course.id'});
- my $group;
- my @groups = ();
+ my @groups;
if (($env{'user.name'} eq $name) && ($env{'user.domain'} eq $domain)) {
- @groups=&Apache::lonnet::sort_course_groups(
- $env{'request.course.groups'},
- $env{'request.course.id'});
+ @groups = &Apache::lonnet::sort_course_groups($env{'request.course.id'},
+ split(':',$env{'request.course.groups'}));
} else {
- my $grouplist = &Apache::lonnet::get_users_groups($domain,$name,
+ @groups = &Apache::lonnet::get_users_groups($domain,$name,
$env{'request.course.id'});
- if ($grouplist) {
- @groups=&Apache::lonnet::sort_course_groups($grouplist,
- $env{'request.course.id'});
- }
- }
- if (@groups > 0) {
- $group = $groups[0];
}
##
@@ -467,15 +458,15 @@
my $spreadsheet = undef;
if ($sheettype eq 'classcalc') {
$spreadsheet = Apache::classcalc->new($name,$domain,$filename,undef,
- $section,$group);
+ $section,\@groups);
} elsif ($sheettype eq 'studentcalc') {
$spreadsheet = Apache::studentcalc->new($name,$domain,$filename,undef,
- $section,$group);
+ $section,\@groups);
} elsif ($sheettype eq 'assesscalc' &&
defined($symb) &&
$allowed_to_edit) {
$spreadsheet = Apache::assesscalc->new($name,$domain,$filename,$symb,
- $section,$group);
+ $section,\@groups);
} else {
return HTTP_NOT_ACCEPTABLE;
}
Index: loncom/interface/spreadsheet/Spreadsheet.pm
diff -u loncom/interface/spreadsheet/Spreadsheet.pm:1.67 loncom/interface/spreadsheet/Spreadsheet.pm:1.68
--- loncom/interface/spreadsheet/Spreadsheet.pm:1.67 Thu Apr 6 16:24:13 2006
+++ loncom/interface/spreadsheet/Spreadsheet.pm Mon May 1 02:17:16 2006
@@ -1,5 +1,5 @@
#
-# $Id: Spreadsheet.pm,v 1.67 2006/04/06 20:24:13 raeburn Exp $
+# $Id: Spreadsheet.pm,v 1.68 2006/05/01 06:17:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -85,7 +85,7 @@
my $class = ref($this) || $this;
my ($stype) = ($class =~ /Apache::(.*)$/);
#
- my ($name,$domain,$filename,$usymb,$section,$group)=@_;
+ my ($name,$domain,$filename,$usymb,$section,$groups)=@_;
if (defined($usymb) && ref($usymb)) {
$usymb = $usymb->symb;
}
@@ -99,21 +99,18 @@
$section = &Apache::lonnet::getsection($domain,$name,
$env{'request.course.id'});
}
- if (! defined($group) || $group eq '') {
- my $grouplist = &Apache::lonnet::get_users_groups($domain,$name,
- $env{'request.course.id'});
- if ($grouplist) {
- my @groups = &Apache::lonnet::sort_course_groups($grouplist,
+ if (! defined($groups)) {
+
+ my @usersgroups = &Apache::lonnet::get_users_groups($domain,$name,
$env{'request.course.id'});
- $group = $groups[0];
- }
+ $groups = \@usersgroups;
}
#
my $self = {
name => $name,
domain => $domain,
section => $section,
- group => $group,
+ groups => $groups,
type => $stype,
symb => $usymb,
errorlog => '',
Index: loncom/interface/spreadsheet/studentcalc.pm
diff -u loncom/interface/spreadsheet/studentcalc.pm:1.38 loncom/interface/spreadsheet/studentcalc.pm:1.39
--- loncom/interface/spreadsheet/studentcalc.pm:1.38 Thu Apr 6 16:24:13 2006
+++ loncom/interface/spreadsheet/studentcalc.pm Mon May 1 02:17:16 2006
@@ -1,5 +1,5 @@
#
-# $Id: studentcalc.pm,v 1.38 2006/04/06 20:24:13 raeburn Exp $
+# $Id: studentcalc.pm,v 1.39 2006/05/01 06:17:16 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -572,7 +572,7 @@
$assess_filename,
$resource->symb,
$self->{'section'},
- $self->{'group'});
+ $self->{'groups'});
my @exportdata = $assessSheet->export_data($r);
#
if ($assessSheet->badcalc()) {
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.732 loncom/lonnet/perl/lonnet.pm:1.733
--- loncom/lonnet/perl/lonnet.pm:1.732 Wed Apr 26 11:47:38 2006
+++ loncom/lonnet/perl/lonnet.pm Mon May 1 02:17:32 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.732 2006/04/26 15:47:38 albertel Exp $
+# $Id: lonnet.pm,v 1.733 2006/05/01 06:17:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4016,31 +4016,51 @@
sub get_users_groups {
my ($udom,$uname,$courseid) = @_;
+ my @usersgroups;
my $cachetime=1800;
$courseid=~s/\_/\//g;
$courseid=~s/^(\w)/\/$1/;
my $hashid="$udom:$uname:$courseid";
- my ($result,$cached)=&is_cached_new('getgroups',$hashid);
- if (defined($cached)) { return $result; }
-
- my %roleshash = &dump('roles',$udom,$uname,$courseid);
- my ($tmp) = keys(%roleshash);
- if ($tmp=~/^error:/) {
- &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
- return '';
- } else {
- my $grouplist;
- foreach my $key (keys %roleshash) {
- if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
- unless ($roleshash{$key} =~ /_\d+_\-1$/) { # deleted membership
- $grouplist .= $1.':';
+ my ($grouplist,$cached)=&is_cached_new('getgroups',$hashid);
+ if (defined($cached)) {
+ @usersgroups = split/:/,$grouplist;
+ } else {
+ $grouplist = '';
+ my %roleshash = &dump('roles',$udom,$uname,$courseid);
+ my ($tmp) = keys(%roleshash);
+ if ($tmp=~/^error:/) {
+ &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
+ } else {
+ my $access_end = $env{'course.'.$courseid.
+ '.default_enrollment_end_date'};
+ my $now = time;
+ foreach my $key (keys %roleshash) {
+ if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
+ my $group = $1;
+ if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) {
+ my $start = $2;
+ my $end = $1;
+ if ($start == -1) { next; } # deleted from group
+ if (($start!=0) && ($start>$now)) { next; }
+ if (($end!=0) && ($end<$now)) {
+ if ($access_end && $access_end < $now) {
+ if ($access_end - $end < 86400) {
+ push(@usersgroups,$group);
+ }
+ }
+ next;
+ }
+ push(@usersgroups,$group);
+ }
}
}
+ @usersgroups = &sort_course_groups($courseid,@usersgroups);
+ $grouplist = join(':',@usersgroups);
+ &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
}
- $grouplist =~ s/:$//;
- return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
}
+ return @usersgroups;
}
sub devalidate_getgroups_cache {
@@ -5159,17 +5179,15 @@
if (($env{'user.name'} eq $uname) &&
($env{'user.domain'} eq $udom)) {
$section=$env{'request.course.sec'};
- @groups=&sort_course_groups($env{'request.course.groups'},$courseid);
+ @groups = split(/:/,$env{'request.course.groups'});
+ @groups=&sort_course_groups($courseid,@groups);
} else {
if (! defined($usection)) {
$section=&getsection($udom,$uname,$courseid);
} else {
$section = $usection;
}
- my $grouplist = &get_users_groups($udom,$uname,$courseid);
- if ($grouplist) {
- @groups=&sort_course_groups($grouplist,$courseid);
- }
+ @groups = &get_users_groups($udom,$uname,$courseid);
}
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
@@ -5293,8 +5311,8 @@
}
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
- my ($grouplist,$courseid) = @_;
- my @groups = sort(split(/:/,$grouplist));
+ my ($courseid,@groups) = @_;
+ @groups = sort(@groups);
return @groups;
}
--raeburn1146464253--