--- loncom/lonnet/perl/lonnet.pm 2004/09/15 20:44:05 1.523.2.3 +++ loncom/lonnet/perl/lonnet.pm 2004/09/27 19:02:11 1.523.2.8 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.523.2.3 2004/09/15 20:44:05 albertel Exp $ +# $Id: lonnet.pm,v 1.523.2.8 2004/09/27 19:02:11 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -795,11 +795,11 @@ sub getsection { if ($key eq $courseid.'_st') { $section=''; } my ($dummy,$end,$start)=split(/\_/,&unescape($value)); my $now=time; - if (defined($end) && ($now > $end)) { + if (defined($end) && $end && ($now > $end)) { $Expired{$end}=$section; next; } - if (defined($start) && ($now < $start)) { + if (defined($start) && $start && ($now < $start)) { $Pending{$start}=$section; next; } @@ -826,6 +826,7 @@ my $disk_caching_disabled=1; sub devalidate_cache { my ($cache,$id,$name) = @_; delete $$cache{$id.'.time'}; + delete $$cache{$id.'.file'}; delete $$cache{$id}; if (1 || $disk_caching_disabled) { return; } my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db"; @@ -857,16 +858,32 @@ sub is_cached { my ($cache,$id,$name,$time) = @_; if (!$time) { $time=300; } if (!exists($$cache{$id.'.time'})) { - &load_cache_item($cache,$name,$id); + &load_cache_item($cache,$name,$id,$time); } if (!exists($$cache{$id.'.time'})) { # &logthis("Didn't find $id"); return (undef,undef); } else { if (time-($$cache{$id.'.time'})>$time) { -# &logthis("Devalidating $id - ".time-($$cache{$id.'.time'})); - &devalidate_cache($cache,$id,$name); - return (undef,undef); + if (exists($$cache{$id.'.file'})) { + foreach my $filename (@{ $$cache{$id.'.file'} }) { + 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); @@ -910,6 +927,9 @@ sub save_cache { eval <<'EVALBLOCK'; $hash{$id.'.time'}=$$cache{$id.'.time'}; $hash{$id}=freeze({'item'=>$$cache{$id}}); + if (exists($$cache{$id.'.file'})) { + $hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}}); + } EVALBLOCK if ($@) { &logthis("save_cache blew up :$@:$name"); @@ -934,7 +954,7 @@ EVALBLOCK } sub load_cache_item { - my ($cache,$name,$id)=@_; + my ($cache,$name,$id,$time)=@_; if ($disk_caching_disabled) { return; } my $starttime=&Time::HiRes::time(); # &logthis("Before Loading $name for $id size is ".scalar(%$cache)); @@ -958,9 +978,17 @@ sub load_cache_item { } # &logthis("Initial load: $count"); } else { - my $hashref=thaw($hash{$id}); - $$cache{$id}=$hashref->{'item'}; - $$cache{$id.'.time'}=$hash{$id.'.time'}; + if (($$cache{$id.'.time'}+$time) < time) { + $$cache{$id.'.time'}=$hash{$id.'.time'}; + { + 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 if ($@) { @@ -3104,8 +3132,10 @@ sub log_query { sub fetch_enrollment_query { my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; my $homeserver; + my $maxtries = 1; if ($context eq 'automated') { $homeserver = $perlvar{'lonHostID'}; + $maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout } else { $homeserver = &homeserver($cnum,$dom); } @@ -3120,6 +3150,16 @@ sub fetch_enrollment_query { my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver); unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$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/) ) { my @responses = split/:/,$reply; if ($homeserver eq $perlvar{'lonHostID'}) { @@ -4225,7 +4265,9 @@ sub metadata { unless ($filename=~/\.meta$/) { $filename.='.meta'; } my $metastring; 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 $token; @@ -4590,22 +4632,19 @@ sub deversion { sub symbread { my ($thisfn,$donotrecurse)=@_; - if (defined($ENV{'request.symbread.cached'})) { - return $ENV{'request.symbread.cached'}; - } + my $cache_str='request.symbread.cached.'.$thisfn; + if (defined($ENV{$cache_str})) { return $ENV{$cache_str}; } # no filename provided? try from environment unless ($thisfn) { if ($ENV{'request.symb'}) { - $ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'}); - return $ENV{'request.symbread.cached'}; + return $ENV{$cache_str}=&symbclean($ENV{'request.symb'}); } $thisfn=$ENV{'request.filename'}; } # is that filename actually a symb? Verify, clean, and return if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { if (&symbverify($thisfn,$1)) { - $ENV{'request.symbread.cached'}=&symbclean($thisfn); - return $ENV{'request.symbread.cached'}; + return $ENV{$cache_str}=&symbclean($thisfn); } } $thisfn=declutter($thisfn); @@ -4627,8 +4666,7 @@ sub symbread { unless ($syval=~/\_\d+$/) { unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { &appenv('request.ambiguous' => $thisfn); - $ENV{'request.symbread.cached'}=''; - return ''; + return $ENV{$cache_str}=''; } $syval.=$1; } @@ -4675,13 +4713,11 @@ sub symbread { } } if ($syval) { - $ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn); - return $ENV{'request.symbread.cached'}; + return $ENV{$cache_str}=&symbclean($syval.'___'.$thisfn); } } &appenv('request.ambiguous' => $thisfn); - $ENV{'request.symbread.cached'}=''; - return ''; + return $ENV{$cache_str}=''; } # ---------------------------------------------------------- Return random seed