--- loncom/lonnet/perl/lonnet.pm	2005/02/10 08:16:31	1.587.2.3.2.1
+++ loncom/lonnet/perl/lonnet.pm	2005/02/14 03:12:06	1.587.2.3.2.8
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.587.2.3.2.1 2005/02/10 08:16:31 albertel Exp $
+# $Id: lonnet.pm,v 1.587.2.3.2.8 2005/02/14 03:12:06 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -36,9 +36,9 @@ use HTTP::Date;
 # use Date::Parse;
 use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
-   %libserv %pr %prp $metacache %packagetab %titlecache %courseresversioncache %resversioncache
+   %libserv %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash $processmarker $dumpcount 
-   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache 
+   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
 
@@ -924,6 +924,7 @@ sub save_cache_item {
 }
 
 sub save_cache {
+    &purge_remembered();
     if ($disk_caching_disabled) { return; }
     my ($cache,$name,$id);
     foreach $name (keys(%do_save)) {
@@ -1021,30 +1022,35 @@ EVALBLOCK
 #    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
 }
 
-sub devalidate_cache_new {
-    my ($cache,$name,$id) = @_;
-    if (1) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $cache->delete(&escape($name.':'.$id));
-}
-
 my $to_remember=10;
 my %remembered;
 my %accessed;
+my $kicks=0;
+my $hits=0;
+sub devalidate_cache_new {
+    my ($name,$id,$debug) = @_;
+    if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
+    $id=&escape($name.':'.$id);
+    $memcache->delete($id);
+    delete($remembered{$id});
+    delete($accessed{$id});
+}
+
 sub is_cached_new {
-    my ($cache,$name,$id,$debug) = @_;
-    $debug=0;
+    my ($name,$id,$debug) = @_;
     $id=&escape($name.':'.$id);
     if (exists($remembered{$id})) {
 	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
 	$accessed{$id}=[&gettimeofday()];
+	$hits++;
 	return ($remembered{$id},1);
     }
-    my $value = $cache->get($id);
+    my $value = $memcache->get($id);
     if (!(defined($value))) {
 	if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
 	return (undef,undef);
     }
-    &make_room($id,$value);
+    &make_room($id,$value,$debug);
     if ($value eq '__undef__') {
 	if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); }
 	return (undef,1);
@@ -1054,22 +1060,20 @@ sub is_cached_new {
 }
 
 sub do_cache_new {
-    my ($cache,$name,$id,$value,$time,$debug) = @_;
-    $debug=0;
+    my ($name,$id,$value,$time,$debug) = @_;
     $id=&escape($name.':'.$id);
     my $setvalue=$value;
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
     }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
-    $cache->set($id,$setvalue,300);
+    $memcache->set($id,$setvalue,300);
+    &make_room($id,$value,$debug);
     return $value;
 }
 
-my $kicks=0;
 sub make_room {
-    my ($id,$value)=@_;
-    my $debug=0;
+    my ($id,$value,$debug)=@_;
     $remembered{$id}=$value;
     $accessed{$id}=[&gettimeofday()];
     if (scalar(keys(%remembered)) <= $to_remember) { return; }
@@ -1088,6 +1092,11 @@ sub make_room {
     return;
 }
 
+sub purge_remembered {
+    &logthis("Tossing ".scalar(keys(%remembered)));
+    undef(%remembered);
+    undef(%accessed);
+}
 # ------------------------------------- Read an entry from a user's environment
 
 sub userenvironment {
@@ -1125,7 +1134,7 @@ sub getversion {
 
 sub currentversion {
     my $fname=shift;
-    my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600);
+    my ($result,$cached)=&is_cached_new('resversion',$fname);
     if (defined($cached)) { return $result; }
     my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -1138,7 +1147,7 @@ sub currentversion {
     if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
 	return -1;
     }
-    return &do_cache(\%resversioncache,$fname,$answer,'resversion');
+    return &do_cache_new('resversion',$fname,$answer,600);
 }
 
 # ----------------------------- Subscribe to a resource, return URL if possible
@@ -4190,7 +4199,7 @@ sub condval {
 sub devalidatecourseresdata {
     my ($coursenum,$coursedomain)=@_;
     my $hashid=$coursenum.':'.$coursedomain;
-    &devalidate_cache(\%courseresdatacache,$hashid,'courseres');
+    &devalidate_cache_new('courseres',$hashid);
 }
 
 # --------------------------------------------------- Course Resourcedata Query
@@ -4199,18 +4208,18 @@ sub courseresdata {
     my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;
-    my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,'courseres');
+    my ($result,$cached)=&is_cached_new('courseres',$hashid);
     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,'courseres');
+	    &do_cache_new('courseres',$hashid,$result,600);
 	} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
 	    return $tmp;
 	} elsif ($tmp =~ /^(error)/) {
 	    $result=undef;
-	    &do_cache(\%courseresdatacache,$hashid,$result,'courseres');
+	    &do_cache_new('courseres',$hashid,$result,600);
 	}
     }
     foreach my $item (@which) {
@@ -4552,7 +4561,7 @@ sub metadata {
 # Everything is cached by the main uri, libraries are never directly cached
 #
     if (!defined($liburi)) {
-	my ($result,$cached)=&is_cached_new($metacache,'meta',$uri);
+	my ($result,$cached)=&is_cached_new('meta',$uri);
 	if (defined($cached)) { return $result->{':'.$what}; }
     }
     {
@@ -4566,7 +4575,7 @@ sub metadata {
 	    $liburi=&declutter($liburi);
             $filename=$liburi;
         } else {
-	    &devalidate_cache_new($metacache,'meta',$uri);
+	    &devalidate_cache_new('meta',$uri);
 	    undef(%metaentry);
 	}
         my %metathesekeys=();
@@ -4725,7 +4734,7 @@ sub metadata {
 	$metaentry{':keys'}=join(',',keys %metathesekeys);
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache_new($metacache,'meta',$uri,\%metaentry);
+	&do_cache_new('meta',$uri,\%metaentry);
 # this is the end of "was not already recently cached
     }
     return $metaentry{':'.$what};
@@ -4789,7 +4798,8 @@ sub gettitle {
     my $urlsymb=shift;
     my $symb=&symbread($urlsymb);
     if ($symb) {
-	my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
+	my $key=$ENV{'request.course.id'}."\0".$symb;
+	my ($result,$cached)=&is_cached_new('title',$key);
 	if (defined($cached)) { 
 	    return $result;
 	}
@@ -4804,7 +4814,7 @@ sub gettitle {
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
-	    return &do_cache(\%titlecache,$symb,$title,'title');
+	    return &do_cache_new('title',$key,$title,600);
 	}
 	$urlsymb=$url;
     }
@@ -4918,8 +4928,7 @@ sub fixversion {
     my $uri=&clutter($fn);
     my $key=$ENV{'request.course.id'}.'_'.$uri;
 # is this cached?
-    my ($result,$cached)=&is_cached(\%courseresversioncache,$key,
-				    'courseresversion',600);
+    my ($result,$cached)=&is_cached_new('courseresversion',$key);
     if (defined($cached)) { return $result; }
 # unfortunately not cached, or expired
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
@@ -4933,8 +4942,7 @@ sub fixversion {
  	}
  	untie %bighash;
     }
-    return &do_cache
-	(\%courseresversioncache,$key,&declutter($uri),'courseresversion');
+    return &do_cache_new('courseresversion',$key,&declutter($uri),600);
 }
 
 sub deversion {
@@ -5647,15 +5655,16 @@ sub goodbye {
 #converted
 #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
    &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));
-   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
-   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
+#   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
+#   &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
 #1.1 only
    &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));
    &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache))));
-   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));
-   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));
+#   &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));
+#   &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));
    &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
    &logthis(sprintf("%-20s is %s",'kicks',$kicks));
+   &logthis(sprintf("%-20s is %s",'hits',$hits));
    &flushcourselogs();
    &logthis("Shutting down");
    return DONE;
@@ -5801,7 +5810,7 @@ BEGIN {
 
 }
 
-$metacache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;