Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.587.2.3.2.12 and 1.587.2.3.2.15

version 1.587.2.3.2.12, 2005/02/14 04:31:59 version 1.587.2.3.2.15, 2005/02/23 23:28:54
Line 559  sub authenticate { Line 559  sub authenticate {
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
   
   my %homecache;
 sub homeserver {  sub homeserver {
     my ($uname,$udom,$ignoreBadCache)=@_;      my ($uname,$udom,$ignoreBadCache)=@_;
     my $index="$uname:$udom";      my $index="$uname:$udom";
   
     my ($result,$cached)=&is_cached_new('home',$index);      if (exists($homecache{$index})) { return $homecache{$index}; }
     if (defined($cached)) { return $result; }  
     my $tryserver;      my $tryserver;
     foreach $tryserver (keys %libserv) {      foreach $tryserver (keys %libserv) {
         next if ($ignoreBadCache ne 'true' &&           next if ($ignoreBadCache ne 'true' && 
Line 572  sub homeserver { Line 572  sub homeserver {
  if ($hostdom{$tryserver} eq $udom) {   if ($hostdom{$tryserver} eq $udom) {
            my $answer=reply("home:$udom:$uname",$tryserver);             my $answer=reply("home:$udom:$uname",$tryserver);
            if ($answer eq 'found') {              if ($answer eq 'found') { 
        return &do_cache_new('home',$index,$tryserver,86400);         return $homecache{$index}=$tryserver;
            } elsif ($answer eq 'no_host') {             } elsif ($answer eq 'no_host') {
        $badServerCache{$tryserver}=1;         $badServerCache{$tryserver}=1;
            }             }
Line 1023  EVALBLOCK Line 1023  EVALBLOCK
 #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));  #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
 }  }
   
 my $to_remember=20;  my $to_remember=-1;
 my %remembered;  my %remembered;
 my %accessed;  my %accessed;
 my $kicks=0;  my $kicks=0;
Line 1051  sub is_cached_new { Line 1051  sub is_cached_new {
  if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }   if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
  return (undef,undef);   return (undef,undef);
     }      }
     &make_room($id,$value,$debug);  
     if ($value eq '__undef__') {      if ($value eq '__undef__') {
  if ($debug) { &Apache::lonnet::logthis("getting $id is __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"); }      if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); }
     return ($value,1);      return ($value,1);
 }  }
Line 1068  sub do_cache_new { Line 1068  sub do_cache_new {
  $setvalue='__undef__';   $setvalue='__undef__';
     }      }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }      if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     $memcache->set($id,$setvalue,300);      $memcache->set($id,$setvalue,$time);
     &make_room($id,$value,$debug);      #&make_room($id,$value,$debug);
     return $value;      return $value;
 }  }
   
 sub make_room {  sub make_room {
     my ($id,$value,$debug)=@_;      my ($id,$value,$debug)=@_;
     $remembered{$id}=$value;      $remembered{$id}=$value;
       if ($to_remember<0) { return; }
     $accessed{$id}=[&gettimeofday()];      $accessed{$id}=[&gettimeofday()];
     if (scalar(keys(%remembered)) <= $to_remember) { return; }      if (scalar(keys(%remembered)) <= $to_remember) { return; }
     my $to_kick;      my $to_kick;
Line 1095  sub make_room { Line 1096  sub make_room {
   
 sub purge_remembered {  sub purge_remembered {
     &logthis("Tossing ".scalar(keys(%remembered)));      &logthis("Tossing ".scalar(keys(%remembered)));
       &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
     undef(%remembered);      undef(%remembered);
     undef(%accessed);      undef(%accessed);
 }  }

Removed from v.1.587.2.3.2.12  
changed lines
  Added in v.1.587.2.3.2.15


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>