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

[albertel]

albertel		Wed Sep 15 16:08:34 2004 EDT

  Modified files:              
    /loncom	loncapa_apache.conf 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - disk based caching rises from the dead, this I think it's right thanks to mattthew
     - just remeber what items are to be saved to the disk cache and save them after done with the student
     - disable devalidatation for now, it's slo and doesn't gain us much 
         (will add a cleansing pass to save_cache?)
  
  
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.94 loncom/loncapa_apache.conf:1.95
--- loncom/loncapa_apache.conf:1.94	Mon Aug 23 15:34:01 2004
+++ loncom/loncapa_apache.conf	Wed Sep 15 16:08:34 2004
@@ -1,7 +1,7 @@
 ##
 ## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
 ##
-## $Id: loncapa_apache.conf,v 1.94 2004/08/23 19:34:01 albertel Exp $
+## $Id: loncapa_apache.conf,v 1.95 2004/09/15 20:08:34 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.*">
@@ -971,7 +969,7 @@
 # -----------------------------------------------------------------------------
 # lonttpdPort is the port used by the lightweight graphics httpd server
 # not the main Apache server
-PerlSetVar       lonhttpdPort  8080
+PerlSetVar       lonhttpdPort  80
 
 
 #----------------------------------------------------------------------------
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.540 loncom/lonnet/perl/lonnet.pm:1.541
--- loncom/lonnet/perl/lonnet.pm:1.540	Thu Sep  9 04:26:46 2004
+++ loncom/lonnet/perl/lonnet.pm	Wed Sep 15 16:08:34 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.540 2004/09/09 08:26:46 albertel Exp $
+# $Id: lonnet.pm,v 1.541 2004/09/15 20:08:34 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -821,15 +821,16 @@
 }
 
 
-my $disk_caching_disabled=1;
+my $disk_caching_disabled=0;
 
 sub devalidate_cache {
     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';