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

albertel lon-capa-cvs@mail.lon-capa.org
Sat, 04 Oct 2003 02:27:02 -0000


albertel		Fri Oct  3 22:27:02 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - trying to share cache data with other servers let me know if anything goes pear shaped
    (metacache is not converted because it looks like it is generally faster to parse the metadata  file, might be worthwhile to do a a metadata cache save at child exit and at child start up)
  
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.424 loncom/lonnet/perl/lonnet.pm:1.425
--- loncom/lonnet/perl/lonnet.pm:1.424	Thu Sep 25 16:25:04 2003
+++ loncom/lonnet/perl/lonnet.pm	Fri Oct  3 22:27:02 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.424 2003/09/25 20:25:04 matthew Exp $
+# $Id: lonnet.pm,v 1.425 2003/10/04 02:27:02 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -86,7 +86,8 @@
 use Fcntl qw(:flock);
 use Apache::loncoursedata;
 use Apache::lonlocal;
-
+use Storable qw(lock_store lock_nstore lock_retrieve);
+use Time::HiRes();
 my $readit;
 
 # --------------------------------------------------------------------- Logging
@@ -855,12 +856,17 @@
 }
 
 sub is_cached {
-    my ($cache,$id,$time) = @_;
+    my ($cache,$id,$name,$time) = @_;
     if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {
+	&load_cache($cache,$name);
+    }
+    if (!exists($$cache{$id.'.time'})) {
+#	&logthis("Didn't find $id");
 	return (undef,undef);
     } else {
-	if (time-$$cache{$id.'.time'}>$time) {
+	if (time-($$cache{$id.'.time'})>$time) {
+#	    &logthis("Devailidating $id");
 	    &devalidate_cache($cache,$id);
 	    return (undef,undef);
 	}
@@ -869,17 +875,69 @@
 }
 
 sub do_cache {
-    my ($cache,$id,$value) = @_;
+    my ($cache,$id,$value,$name) = @_;
     $$cache{$id.'.time'}=time;
-    # do_cache implictly return the set value
     $$cache{$id}=$value;
+    &save_cache($cache,$name);
+    # do_cache implictly return the set value
+    $$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 usection {
     my ($udom,$unam,$courseid)=@_;
     my $hashid="$udom:$unam:$courseid";
     
-    my ($result,$cached)=&is_cached(\%usectioncache,$hashid);
+    my ($result,$cached)=&is_cached(\%usectioncache,$hashid,'usection');
     if (defined($cached)) { return $result; }
     $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;
@@ -900,11 +958,11 @@
                 if ($now>$end) { $notactive=1; }
             } 
             unless ($notactive) {
-		return &do_cache(\%usectioncache,$hashid,$section);
+		return &do_cache(\%usectioncache,$hashid,$section,'usection');
 	    }
         }
     }
-    return &do_cache(\%usectioncache,$hashid,'-1');
+    return &do_cache(\%usectioncache,$hashid,'-1','usection');
 }
 
 # ------------------------------------- Read an entry from a user's environment
@@ -3317,18 +3375,18 @@
     my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;
-    my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid);
+    my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,'courseres');
     unless (defined($cached)) {
 	my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
 	$result=\%dumpreply;
 	my ($tmp) = keys(%dumpreply);
 	if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
-	    &do_cache(\%courseresdatacache,$hashid,$result);
+	    &do_cache(\%courseresdatacache,$hashid,$result,'courseres');
 	} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
 	    return $tmp;
 	} elsif ($tmp =~ /^(error)/) {
 	    $result=undef;
-	    &do_cache(\%courseresdatacache,$hashid,$result);
+	    &do_cache(\%courseresdatacache,$hashid,$result,'courseres');
 	}
     }
     foreach my $item (@which) {
@@ -3503,16 +3561,17 @@
 	    #most student don\'t have any data set, check if there is some data
 	    if (! &EXT_cache_status($udom,$uname)) {
 		my $hashid="$udom:$uname";
-		my ($result,$cached)=&is_cached(\%userresdatacache,$hashid);
+		my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,
+						'userres');
 		if (!defined($cached)) { 
 		    my %resourcedata=&get('resourcedata',
 					  [$courselevelr,$courselevelm,
 					   $courselevel],$udom,$uname);
 		    $result=\%resourcedata;
+		    &do_cache(\%userresdatacache,$hashid,$result,'userres');
 		}
 		my ($tmp)=keys(%$result);
 		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
-		    &do_cache(\%userresdatacache,$hashid,$result);
 		    if ($$result{$courselevelr}) {
 			return $$result{$courselevelr}; }
 		    if ($$result{$courselevelm}) {
@@ -3525,11 +3584,9 @@
 				 " Trying to get resource data for ".
 				 $uname." at ".$udom.": ".
 				 $tmp."</font>");
-			&do_cache(\%userresdatacache,$hashid,undef);
 		    } elsif ($tmp=~/error:No such file/) {
                         &EXT_cache_set($udom,$uname);
 		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
-			&do_cache(\%userresdatacache,$hashid,undef);
 			return $tmp;
 		    }
 		}
@@ -3829,7 +3886,7 @@
 	unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
         return &metadata($urlsymb,'title'); 
     }
-    my ($result,$cached)=&is_cached(\%titlecache,$symb,600);
+    my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
     if (defined($cached)) { return $result; }
     my ($map,$resid,$url)=&decode_symb($symb);
     my $title='';
@@ -3842,7 +3899,7 @@
     }
     $title=~s/\&colon\;/\:/gs;
     if ($title) {
-        return &do_cache(\%titlecache,$symb,$title);
+        return &do_cache(\%titlecache,$symb,$title,'title');
     } else {
 	return &metadata($urlsymb,'title');
     }
@@ -4245,6 +4302,16 @@
 
 sub goodbye {
    &logthis("Starting Shut down");
+#not converted to using infrastruture
+   &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
+   &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
+   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
+#converted
+   &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
+   &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
+#1.1 only
+   &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
+   &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache)));
    &flushcourselogs();
    &logthis("Shutting down");
    return DONE;