--- loncom/lonnet/perl/lonnet.pm 2003/11/01 18:34:49 1.440
+++ loncom/lonnet/perl/lonnet.pm 2003/11/08 05:45:50 1.442
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.440 2003/11/01 18:34:49 www Exp $
+# $Id: lonnet.pm,v 1.442 2003/11/08 05:45:50 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -823,15 +823,24 @@ sub devalidate_cache {
my ($cache,$id,$name) = @_;
delete $$cache{$id.'.time'};
delete $$cache{$id};
- my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";
+ my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");
flock(DB,LOCK_EX);
my %hash;
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
- delete($hash{$id});
- delete($hash{$id.'.time'});
+ eval <<'EVALBLOCK';
+ delete($hash{$id});
+ delete($hash{$id.'.time'});
+EVALBLOCK
+ if ($@) {
+ &logthis("devalidate_cache blew up :$@:$name");
+ unlink($filename);
+ }
} else {
- &logthis("Unable to tie hash (devalidate cache): $name");
+ if (-e $filename) {
+ &logthis("Unable to tie hash (devalidate cache): $name");
+ unlink($filename);
+ }
}
untie(%hash);
flock(DB,LOCK_UN);
@@ -867,69 +876,28 @@ sub do_cache {
$$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 {
my ($cache,$name,$id)=@_;
my $starttime=&Time::HiRes::time();
- # &logthis("Saving :$name:$id");
+# &logthis("Saving :$name:$id");
my %hash;
- my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";
+ my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");
flock(DB,LOCK_EX);
if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
- $hash{$id.'.time'}=$$cache{$id.'.time'};
- $hash{$id}=freeze({'item'=>$$cache{$id}});
+ eval <<'EVALBLOCK';
+ $hash{$id.'.time'}=$$cache{$id.'.time'};
+ $hash{$id}=freeze({'item'=>$$cache{$id}});
+EVALBLOCK
+ if ($@) {
+ &logthis("save_cache blew up :$@:$name");
+ unlink($filename);
+ }
} 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);
flock(DB,LOCK_UN);
@@ -942,29 +910,38 @@ sub load_cache_item {
my $starttime=&Time::HiRes::time();
# &logthis("Before Loading $name for $id size is ".scalar(%$cache));
my %hash;
- my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";
+ my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
open(DB,"$filename.lock");
flock(DB,LOCK_SH);
if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
- if (!%$cache) {
- my $count;
- while (my ($key,$value)=each(%hash)) {
- $count++;
- if ($key =~ /\.time$/) {
- $$cache{$key}=$value;
- } else {
- my $hashref=thaw($value);
- $$cache{$key}=$hashref->{'item'};
+ eval <<'EVALBLOCK';
+ if (!%$cache) {
+ my $count;
+ while (my ($key,$value)=each(%hash)) {
+ $count++;
+ if ($key =~ /\.time$/) {
+ $$cache{$key}=$value;
+ } else {
+ my $hashref=thaw($value);
+ $$cache{$key}=$hashref->{'item'};
+ }
}
- }
# &logthis("Initial load: $count");
- } else {
- my $hashref=thaw($hash{$id});
- $$cache{$id}=$hashref->{'item'};
- $$cache{$id.'.time'}=$hash{$id.'.time'};
- }
+ } else {
+ my $hashref=thaw($hash{$id});
+ $$cache{$id}=$hashref->{'item'};
+ $$cache{$id.'.time'}=$hash{$id.'.time'};
+ }
+EVALBLOCK
+ if ($@) {
+ &logthis("load_cache blew up :$@:$name");
+ unlink($filename);
+ }
} 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);
flock(DB,LOCK_UN);
@@ -1090,7 +1067,7 @@ sub repcopy {
&logthis("Subscribe returned $remoteurl: $filename");
return HTTP_SERVICE_UNAVAILABLE;
} elsif ($remoteurl eq 'not_found') {
- &logthis("Subscribe returned not_found: $filename");
+ #&logthis("Subscribe returned not_found: $filename");
return HTTP_NOT_FOUND;
} elsif ($remoteurl =~ /^rejected by/) {
&logthis("Subscribe returned $remoteurl: $filename");