--- loncom/lonnet/perl/lonnet.pm 2005/02/14 04:29:43 1.587.2.3.2.11 +++ loncom/lonnet/perl/lonnet.pm 2005/04/15 20:48:18 1.587.2.3.2.16 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.587.2.3.2.11 2005/02/14 04:29:43 albertel Exp $ +# $Id: lonnet.pm,v 1.587.2.3.2.16 2005/04/15 20:48:18 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -559,12 +559,12 @@ sub authenticate { # ---------------------- Find the homebase for a user from domain's lib servers +my %homecache; sub homeserver { my ($uname,$udom,$ignoreBadCache)=@_; my $index="$uname:$udom"; - my ($result,$cached)=&is_cached_new('home',$index); - if (defined($cached)) { return $result; } + if (exists($homecache{$index})) { return $homecache{$index}; } my $tryserver; foreach $tryserver (keys %libserv) { next if ($ignoreBadCache ne 'true' && @@ -572,7 +572,7 @@ sub homeserver { if ($hostdom{$tryserver} eq $udom) { my $answer=reply("home:$udom:$uname",$tryserver); if ($answer eq 'found') { - return &do_cache_new('home',$index,$tryserver,86400); + return $homecache{$index}=$tryserver; } elsif ($answer eq 'no_host') { $badServerCache{$tryserver}=1; } @@ -782,7 +782,7 @@ sub getsection { $courseid=~s/^(\w)/\/$1/; my $hashid="$udom:$unam:$courseid"; - my ($result,$cached)=&is_cached_new('getsection',$hashid,1); + my ($result,$cached)=&is_cached_new('getsection',$hashid); if (defined($cached)) { return $result; } my %Pending; @@ -1023,7 +1023,7 @@ EVALBLOCK # &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); } -my $to_remember=10; +my $to_remember=-1; my %remembered; my %accessed; my $kicks=0; @@ -1051,11 +1051,11 @@ sub is_cached_new { if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } return (undef,undef); } - &make_room($id,$value,$debug); if ($value eq '__undef__') { if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } - return (undef,1); + $value=undef; } + &make_room($id,$value,$debug); if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); } return ($value,1); } @@ -1067,15 +1067,19 @@ sub do_cache_new { if (!defined($setvalue)) { $setvalue='__undef__'; } + if (!defined($time)) { + $time=600; + } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $memcache->set($id,$setvalue,300); - &make_room($id,$value,$debug); + $memcache->set($id,$setvalue,$time); + #&make_room($id,$value,$debug); return $value; } sub make_room { my ($id,$value,$debug)=@_; $remembered{$id}=$value; + if ($to_remember<0) { return; } $accessed{$id}=[&gettimeofday()]; if (scalar(keys(%remembered)) <= $to_remember) { return; } my $to_kick; @@ -1095,6 +1099,7 @@ sub make_room { sub purge_remembered { &logthis("Tossing ".scalar(keys(%remembered))); + &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); undef(%remembered); undef(%accessed); } @@ -4413,7 +4418,7 @@ sub EXT { if (!defined($cached)) { my %resourcedata=&dump('resourcedata',$udom,$uname); $result=\%resourcedata; - &do_cache_new('userres',$hashid,$result); + &do_cache_new('userres',$hashid,$result,600); } my ($tmp)=keys(%$result); if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { @@ -4734,7 +4739,7 @@ sub metadata { $metaentry{':keys'}=join(',',keys %metathesekeys); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); - &do_cache_new('meta',$uri,\%metaentry); + &do_cache_new('meta',$uri,\%metaentry,6000); # this is the end of "was not already recently cached } return $metaentry{':'.$what};