[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

albertel lon-capa-cvs@mail.lon-capa.org
Sat, 08 Nov 2003 05:45:51 -0000


albertel		Sat Nov  8 00:45:51 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - removed some dead code
  - gave the internal caches better names
  - Now more defensive, I don't know how it happened, but Gerd claims that one of the DB files became corrputed (BUG#2360), now it does the DB walking in an eval and deletes the cache if it blows up on us
  - Fewer 'unable to tie hash' messages (if doesn't even exist don't complain)
    (I am personally still seeing 'unalbe to tie hash: load item : home' messages on server shutdown, but can't trace down what is causing it.
  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.441 loncom/lonnet/perl/lonnet.pm:1.442
--- loncom/lonnet/perl/lonnet.pm:1.441	Tue Nov  4 13:44:17 2003
+++ loncom/lonnet/perl/lonnet.pm	Sat Nov  8 00:45:50 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.441 2003/11/04 18:44:17 albertel 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 @@
     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("<font color='red'>devalidate_cache blew up :$@:$name</font>");
+	    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 @@
     $$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("<font color='red'>save_cache blew up :$@:$name</font>");
+	    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 @@
     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("<font color='red'>load_cache blew up :$@:$name</font>");
+	    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);