--- loncom/lonnet/perl/lonnet.pm 2005/02/15 17:13:54 1.598.2.2 +++ loncom/lonnet/perl/lonnet.pm 2005/02/16 20:16:44 1.598.2.3 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.598.2.2 2005/02/15 17:13:54 albertel Exp $ +# $Id: lonnet.pm,v 1.598.2.3 2005/02/16 20:16:44 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; } @@ -838,7 +838,7 @@ sub save_cache { &purge_remembered(); } -my $to_remember=20; +my $to_remember=-1; my %remembered; my %accessed; my $kicks=0; @@ -891,6 +891,7 @@ sub do_cache_new { 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; @@ -910,6 +911,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); }