[LON-CAPA-cvs] cvs: loncom(version_1_2_X) / loncapa_apache.conf /lonnet/perl lonnet.pm

[albertel]

albertel		Wed Sep 15 16:44:06 2004 EDT

  Modified files:              (Branch: version_1_2_X)
    /loncom	loncapa_apache.conf 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - backporting the disk based caching fixes (1.541 and 1.95) but set to be disabled by default
  
  
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.90.2.1 loncom/loncapa_apache.conf:1.90.2.2
--- loncom/loncapa_apache.conf:1.90.2.1	Fri Aug 13 11:50:16 2004
+++ loncom/loncapa_apache.conf	Wed Sep 15 16:44:05 2004
@@ -1,7 +1,7 @@
 ##
 ## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
 ##
-## $Id: loncapa_apache.conf,v 1.90.2.1 2004/08/13 15:50:16 albertel Exp $
+## $Id: loncapa_apache.conf,v 1.90.2.2 2004/09/15 20:44:05 albertel Exp $
 ##
 
 #
@@ -43,9 +43,7 @@
 # ------------------------------------------------------------- Access Handlers
 
 PerlTransHandler	Apache::lontrans
-<IfDefine MODPERL2>
-PerlCleanupHandler	Apache::lonnet::cleanenv
-</IfDefine>
+PerlCleanupHandler	Apache::lonnet::save_cache
 
 #PerlWarn On
 <LocationMatch "^/+res.*">
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.523.2.2 loncom/lonnet/perl/lonnet.pm:1.523.2.3
--- loncom/lonnet/perl/lonnet.pm:1.523.2.2	Wed Sep 15 16:41:07 2004
+++ loncom/lonnet/perl/lonnet.pm	Wed Sep 15 16:44:05 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.523.2.2 2004/09/15 20:41:07 albertel Exp $
+# $Id: lonnet.pm,v 1.523.2.3 2004/09/15 20:44:05 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -827,9 +827,10 @@
     my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};
     delete $$cache{$id};
-    if ($disk_caching_disabled) { return; }
+    if (1 || $disk_caching_disabled) { return; }
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
-    open(DB,"$filename.lock");
+    if (!-e $filename) { return; }
+    open(DB,">$filename.lock");
     flock(DB,LOCK_EX);
     my %hash;
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
@@ -881,34 +882,55 @@
     $$cache{$id};
 }
 
+my %do_save_item;
+my %do_save;
 sub save_cache_item {
     my ($cache,$name,$id)=@_;
     if ($disk_caching_disabled) { return; }
-    my $starttime=&Time::HiRes::time();
-#    &logthis("Saving :$name:$id");
-    my %hash;
-    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)) {
-	eval <<'EVALBLOCK';
-	    $hash{$id.'.time'}=$$cache{$id.'.time'};
-	    $hash{$id}=freeze({'item'=>$$cache{$id}});
+    $do_save{$name}=$cache;
+    if (!exists($do_save_item{$name})) { $do_save_item{$name}={} }
+    $do_save_item{$name}->{$id}=1;
+    return;
+}
+
+sub save_cache {
+    if ($disk_caching_disabled) { return; }
+    my ($cache,$name,$id);
+    foreach $name (keys(%do_save)) {
+	$cache=$do_save{$name};
+
+	my $starttime=&Time::HiRes::time();
+	&logthis("Saving :$name:");
+	my %hash;
+	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)) {
+	    foreach $id (keys(%{ $do_save_item{$name} })) {
+		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 {
-	if (-e $filename) {
-	    &logthis("Unable to tie hash (save cache item): $name ($!)");
-	    unlink($filename);
+                if ($@) {
+		    &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
+		    unlink($filename);
+		    last;
+		}
+	    }
+	} else {
+	    if (-e $filename) {
+		&logthis("Unable to tie hash (save cache): $name ($!)");
+		unlink($filename);
+	    }
 	}
+	untie(%hash);
+	flock(DB,LOCK_UN);
+	close(DB);
+	&logthis("save_cache $name took ".(&Time::HiRes::time()-$starttime));
     }
-    untie(%hash);
-    flock(DB,LOCK_UN);
-    close(DB);
-#    &logthis("save_cache_item $name took ".(&Time::HiRes::time()-$starttime));
+    undef(%do_save);
+    undef(%do_save_item);
+
 }
 
 sub load_cache_item {
@@ -918,7 +940,8 @@
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
-    open(DB,"$filename.lock");
+    if (!-e $filename) { return; }
+    open(DB,">$filename.lock");
     flock(DB,LOCK_SH);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
 	eval <<'EVALBLOCK';