version 1.523.2.4, 2004/09/17 02:41:21
|
version 1.523.2.9, 2004/11/06 01:14:05
|
Line 795 sub getsection {
|
Line 795 sub getsection {
|
if ($key eq $courseid.'_st') { $section=''; } |
if ($key eq $courseid.'_st') { $section=''; } |
my ($dummy,$end,$start)=split(/\_/,&unescape($value)); |
my ($dummy,$end,$start)=split(/\_/,&unescape($value)); |
my $now=time; |
my $now=time; |
if (defined($end) && ($now > $end)) { |
if (defined($end) && $end && ($now > $end)) { |
$Expired{$end}=$section; |
$Expired{$end}=$section; |
next; |
next; |
} |
} |
if (defined($start) && ($now < $start)) { |
if (defined($start) && $start && ($now < $start)) { |
$Pending{$start}=$section; |
$Pending{$start}=$section; |
next; |
next; |
} |
} |
Line 826 my $disk_caching_disabled=1;
|
Line 826 my $disk_caching_disabled=1;
|
sub devalidate_cache { |
sub devalidate_cache { |
my ($cache,$id,$name) = @_; |
my ($cache,$id,$name) = @_; |
delete $$cache{$id.'.time'}; |
delete $$cache{$id.'.time'}; |
|
delete $$cache{$id.'.file'}; |
delete $$cache{$id}; |
delete $$cache{$id}; |
if (1 || $disk_caching_disabled) { return; } |
if (1 || $disk_caching_disabled) { return; } |
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; |
my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; |
Line 864 sub is_cached {
|
Line 865 sub is_cached {
|
return (undef,undef); |
return (undef,undef); |
} else { |
} else { |
if (time-($$cache{$id.'.time'})>$time) { |
if (time-($$cache{$id.'.time'})>$time) { |
# &logthis("Devalidating $id - ".time-($$cache{$id.'.time'})); |
if (exists($$cache{$id.'.file'})) { |
&devalidate_cache($cache,$id,$name); |
foreach my $filename (@{ $$cache{$id.'.file'} }) { |
return (undef,undef); |
my $mtime=(stat($filename))[9]; |
|
#+1 is to take care of edge effects |
|
if ($mtime && (($mtime+1) < ($$cache{$id.'.time'}))) { |
|
# &logthis("Upping $mtime - ".$$cache{$id.'.time'}. |
|
# "$id because of $filename"); |
|
} else { |
|
# &logthis("Devalidating $filename $id - ".(time-($$cache{$id.'.time'}))); |
|
&devalidate_cache($cache,$id,$name); |
|
return (undef,undef); |
|
} |
|
} |
|
$$cache{$id.'.time'}=time; |
|
} else { |
|
# &logthis("Devalidating $id - ".time-($$cache{$id.'.time'})); |
|
&devalidate_cache($cache,$id,$name); |
|
return (undef,undef); |
|
} |
} |
} |
} |
} |
return ($$cache{$id},1); |
return ($$cache{$id},1); |
Line 910 sub save_cache {
|
Line 927 sub save_cache {
|
eval <<'EVALBLOCK'; |
eval <<'EVALBLOCK'; |
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
$hash{$id.'.time'}=$$cache{$id.'.time'}; |
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
$hash{$id}=freeze({'item'=>$$cache{$id}}); |
|
if (exists($$cache{$id.'.file'})) { |
|
$hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}}); |
|
} |
EVALBLOCK |
EVALBLOCK |
if ($@) { |
if ($@) { |
&logthis("<font color='red'>save_cache blew up :$@:$name</font>"); |
&logthis("<font color='red'>save_cache blew up :$@:$name</font>"); |
Line 960 sub load_cache_item {
|
Line 980 sub load_cache_item {
|
} else { |
} else { |
if (($$cache{$id.'.time'}+$time) < time) { |
if (($$cache{$id.'.time'}+$time) < time) { |
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
$$cache{$id.'.time'}=$hash{$id.'.time'}; |
my $hashref=thaw($hash{$id}); |
{ |
$$cache{$id}=$hashref->{'item'}; |
my $hashref=thaw($hash{$id}); |
|
$$cache{$id}=$hashref->{'item'}; |
|
} |
|
if (exists($hash{$id.'.file'})) { |
|
my $hashref=thaw($hash{$id.'.file'}); |
|
$$cache{$id.'.file'}=$hashref->{'item'}; |
|
} |
} |
} |
} |
} |
EVALBLOCK |
EVALBLOCK |
Line 3106 sub log_query {
|
Line 3132 sub log_query {
|
sub fetch_enrollment_query { |
sub fetch_enrollment_query { |
my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; |
my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; |
my $homeserver; |
my $homeserver; |
|
my $maxtries = 1; |
if ($context eq 'automated') { |
if ($context eq 'automated') { |
$homeserver = $perlvar{'lonHostID'}; |
$homeserver = $perlvar{'lonHostID'}; |
|
$maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout |
} else { |
} else { |
$homeserver = &homeserver($cnum,$dom); |
$homeserver = &homeserver($cnum,$dom); |
} |
} |
Line 3122 sub fetch_enrollment_query {
|
Line 3150 sub fetch_enrollment_query {
|
my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver); |
my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver); |
unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; } |
unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; } |
my $reply = &get_query_reply($queryid); |
my $reply = &get_query_reply($queryid); |
|
my $tries = 1; |
|
while (($reply=~/^timeout/) && ($tries < $maxtries)) { |
|
$reply = &get_query_reply($queryid); |
|
$tries++; |
|
} |
|
if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { |
|
&logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '. |
|
$ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '. |
|
$cnum.' maxtries: '.$maxtries.' tries: '.$tries); |
|
} |
unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { |
unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { |
my @responses = split/:/,$reply; |
my @responses = split/:/,$reply; |
if ($homeserver eq $perlvar{'lonHostID'}) { |
if ($homeserver eq $perlvar{'lonHostID'}) { |
Line 4227 sub metadata {
|
Line 4265 sub metadata {
|
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
my $metastring; |
my $metastring; |
if ($uri !~ m|^uploaded/|) { |
if ($uri !~ m|^uploaded/|) { |
$metastring=&getfile(&filelocation('',&clutter($filename))); |
my $file=&filelocation('',&clutter($filename)); |
|
push(@{$metacache{$uri.'.file'}},$file); |
|
$metastring=&getfile($file); |
} |
} |
my $parser=HTML::LCParser->new(\$metastring); |
my $parser=HTML::LCParser->new(\$metastring); |
my $token; |
my $token; |
Line 4722 sub get_rand_alg {
|
Line 4762 sub get_rand_alg {
|
return &latest_rnd_algorithm_id(); |
return &latest_rnd_algorithm_id(); |
} |
} |
|
|
|
sub validCODE { |
|
my ($CODE)=@_; |
|
if (defined($CODE) && $CODE ne '' && $CODE =~ /^\w+$/) { return 1; } |
|
return 0; |
|
} |
|
|
sub getCODE { |
sub getCODE { |
if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } |
if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } |
if (defined($Apache::lonhomework::parsing_a_problem) && |
if (defined($Apache::lonhomework::parsing_a_problem) && |
defined($Apache::lonhomework::history{'resource.CODE'})) { |
&validCODE($Apache::lonhomework::history{'resource.CODE'})) { |
return $Apache::lonhomework::history{'resource.CODE'}; |
return $Apache::lonhomework::history{'resource.CODE'}; |
} |
} |
return undef; |
return undef; |