version 1.814, 2006/12/11 14:06:05
|
version 1.816, 2006/12/28 19:59:48
|
Line 53 use Time::HiRes qw( gettimeofday tv_inte
|
Line 53 use Time::HiRes qw( gettimeofday tv_inte
|
use Cache::Memcached; |
use Cache::Memcached; |
use Digest::MD5; |
use Digest::MD5; |
use Math::Random; |
use Math::Random; |
use lib '/home/httpd/lib/perl'; |
|
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
|
Line 878 sub devalidate_getsection_cache {
|
Line 877 sub devalidate_getsection_cache {
|
&devalidate_cache_new('getsection',$hashid); |
&devalidate_cache_new('getsection',$hashid); |
} |
} |
|
|
|
sub courseid_to_courseurl { |
|
my ($courseid) = @_; |
|
#already url style courseid |
|
return $courseid if ($courseid =~ m{^/}); |
|
|
|
if (exists($env{'course.'.$courseid.'.num'})) { |
|
my $cnum = $env{'course.'.$courseid.'.num'}; |
|
my $cdom = $env{'course.'.$courseid.'.domain'}; |
|
return "/$cdom/$cnum"; |
|
} |
|
|
|
my %courseinfo=&Apache::lonnet::coursedescription($courseid); |
|
if (exists($courseinfo{'num'})) { |
|
return "/$courseinfo{'domain'}/$courseinfo{'num'}"; |
|
} |
|
|
|
return undef; |
|
} |
|
|
sub getsection { |
sub getsection { |
my ($udom,$unam,$courseid)=@_; |
my ($udom,$unam,$courseid)=@_; |
my $cachetime=1800; |
my $cachetime=1800; |
Line 901 sub getsection {
|
Line 919 sub getsection {
|
# If there is more than one expired role, choose the one which ended last. |
# If there is more than one expired role, choose the one which ended last. |
# If there is a role which has expired, return it. |
# If there is a role which has expired, return it. |
# |
# |
|
$courseid = &courseid_to_courseurl($courseid); |
foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', |
foreach my $line (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', |
&homeserver($unam,$udom)))) { |
&homeserver($unam,$udom)))) { |
my ($key,$value)=split(/\=/,$line,2); |
my ($key,$value)=split(/\=/,$line,2); |
Line 4494 sub get_users_groups {
|
Line 4513 sub get_users_groups {
|
@usersgroups = split(/:/,$grouplist); |
@usersgroups = split(/:/,$grouplist); |
} else { |
} else { |
$grouplist = ''; |
$grouplist = ''; |
my %roleshash = &dump('roles',$udom,$uname,$courseid); |
my $courseurl = &courseid_to_courseurl($courseid); |
|
my %roleshash = &dump('roles',$udom,$uname,$courseurl); |
my ($tmp) = keys(%roleshash); |
my ($tmp) = keys(%roleshash); |
if ($tmp=~/^error:/) { |
if ($tmp=~/^error:/) { |
&logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); |
&logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); |
Line 4503 sub get_users_groups {
|
Line 4523 sub get_users_groups {
|
'.default_enrollment_end_date'}; |
'.default_enrollment_end_date'}; |
my $now = time; |
my $now = time; |
foreach my $key (keys(%roleshash)) { |
foreach my $key (keys(%roleshash)) { |
if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { |
if ($key =~ /^\Q$courseurl\E\/(\w+)\_gr$/) { |
my $group = $1; |
my $group = $1; |
if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) { |
if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) { |
my $start = $2; |
my $start = $2; |