[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.441 and 1.442

version 1.441, 2003/11/04 18:44:17 version 1.442, 2003/11/08 05:45:50
Line 823  sub devalidate_cache { Line 823  sub devalidate_cache {
     my ($cache,$id,$name) = @_;      my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};      delete $$cache{$id.'.time'};
     delete $$cache{$id};      delete $$cache{$id};
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
  delete($hash{$id});   eval <<'EVALBLOCK';
  delete($hash{$id.'.time'});      delete($hash{$id});
       delete($hash{$id.'.time'});
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>devalidate_cache blew up :$@:$name</font>");
       unlink($filename);
    }
     } else {      } else {
  &logthis("Unable to tie hash (devalidate cache): $name");   if (-e $filename) {
       &logthis("Unable to tie hash (devalidate cache): $name");
       unlink($filename);
    }
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 867  sub do_cache { Line 876  sub do_cache {
     $$cache{$id};      $$cache{$id};
 }  }
   
 sub save_cache {  
     my ($cache,$name)=@_;  
     my $starttime=&Time::HiRes::time();  
 #    &logthis("Saving :$name:");  
     eval lock_store($cache,$perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");  
     if ($@) { &logthis("lock_store threw a die ".$@); }  
 #    &logthis("save_cache took ".(&Time::HiRes::time()-$starttime));  
 }  
   
 sub load_cache {  
     my ($cache,$name)=@_;  
     my $starttime=&Time::HiRes::time();  
 #    &logthis("Before Loading $name size is ".scalar(%$cache));  
     my $tmpcache;  
     eval {  
  $tmpcache=lock_retrieve($perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");  
     };  
     if ($@) { &logthis("lock_retreive threw a die ".$@); return; }  
     if (!%$cache) {  
  my $count;  
  while (my ($key,$value)=each(%$tmpcache)) {   
     $count++;  
     $$cache{$key}=$value;  
  }  
 # &logthis("Initial load: $count");  
     } else {  
  my $key;  
  my $count;  
  while ($key=each(%$tmpcache)) {  
     if ($key !~/^(.*)\.time$/) { next; }  
     my $name=$1;  
     if (exists($$cache{$key})) {  
  if ($$tmpcache{$key} >= $$cache{$key}) {  
     $$cache{$key}=$$tmpcache{$key};  
     $$cache{$name}=$$tmpcache{$name};  
  } else {  
 #    &logthis("Would have overwritten $name with is set to expire at ".$$cache{$key}." with ".$$tmpcache{$key}." Whew!");  
  }  
     } else {  
  $count++;  
  $$cache{$key}=$$tmpcache{$key};  
  $$cache{$name}=$$tmpcache{$name};  
     }  
  }  
 # &logthis("Additional load: $count");  
     }  
 #    &logthis("After Loading $name size is ".scalar(%$cache));  
 #    &logthis("load_cache took ".(&Time::HiRes::time()-$starttime));  
 }  
   
 sub save_cache_item {  sub save_cache_item {
     my ($cache,$name,$id)=@_;      my ($cache,$name,$id)=@_;
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
  #   &logthis("Saving :$name:$id");  #    &logthis("Saving :$name:$id");
     my %hash;      my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
  $hash{$id.'.time'}=$$cache{$id.'.time'};   eval <<'EVALBLOCK';
  $hash{$id}=freeze({'item'=>$$cache{$id}});      $hash{$id.'.time'}=$$cache{$id.'.time'};
       $hash{$id}=freeze({'item'=>$$cache{$id}});
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
       unlink($filename);
    }
     } else {      } else {
  &logthis("Unable to tie hash (save cache item): $name");   if (-e $filename) {
       &logthis("Unable to tie hash (save cache item): $name");
       unlink($filename);
    }
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 942  sub load_cache_item { Line 910  sub load_cache_item {
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));  #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;      my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_SH);      flock(DB,LOCK_SH);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
  if (!%$cache) {   eval <<'EVALBLOCK';
     my $count;      if (!%$cache) {
     while (my ($key,$value)=each(%hash)) {    my $count;
  $count++;   while (my ($key,$value)=each(%hash)) { 
  if ($key =~ /\.time$/) {      $count++;
     $$cache{$key}=$value;      if ($key =~ /\.time$/) {
  } else {   $$cache{$key}=$value;
     my $hashref=thaw($value);      } else {
     $$cache{$key}=$hashref->{'item'};   my $hashref=thaw($value);
    $$cache{$key}=$hashref->{'item'};
       }
  }   }
     }  
 #    &logthis("Initial load: $count");  #    &logthis("Initial load: $count");
  } else {      } else {
     my $hashref=thaw($hash{$id});   my $hashref=thaw($hash{$id});
     $$cache{$id}=$hashref->{'item'};   $$cache{$id}=$hashref->{'item'};
     $$cache{$id.'.time'}=$hash{$id.'.time'};   $$cache{$id.'.time'}=$hash{$id.'.time'};
  }      }
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>load_cache blew up :$@:$name</font>");
       unlink($filename);
    }        
     } else {      } else {
  &logthis("Unable to tie hash (load cache item): $name");   if (-e $filename) {
       &logthis("Unable to tie hash (load cache item): $name");
       unlink($filename);
    }
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Removed from v.1.441  
changed lines
  Added in v.1.442

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