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

albertel lon-capa-cvs@mail.lon-capa.org
Thu, 17 Feb 2005 22:43:28 -0000


This is a MIME encoded message

--albertel1108680208
Content-Type: text/plain

albertel		Thu Feb 17 17:43:28 2005 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - merging memcached into the mainline
  
  
--albertel1108680208
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20050217174328.txt"

Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.598 loncom/lonnet/perl/lonnet.pm:1.599
--- loncom/lonnet/perl/lonnet.pm:1.598	Thu Feb 10 17:26:38 2005
+++ loncom/lonnet/perl/lonnet.pm	Thu Feb 17 17:43:27 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.598 2005/02/10 22:26:38 albertel Exp $
+# $Id: lonnet.pm,v 1.599 2005/02/17 22:43:27 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -35,11 +35,11 @@
 use HTTP::Date;
 # use Date::Parse;
 use vars 
-qw(%perlvar %hostname %homecache %badServerCache %iphost %spareid %hostdom 
-   %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
+qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom 
+   %libserv %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash $processmarker $dumpcount 
-   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache 
-   %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
+   %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
+   %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);
 
 use IO::Socket;
@@ -50,6 +50,7 @@
 use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );
+use Cache::Memcached;
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
@@ -558,12 +559,12 @@
 
 # ---------------------- Find the homebase for a user from domain's lib servers
 
+my %homecache;
 sub homeserver {
     my ($uname,$udom,$ignoreBadCache)=@_;
     my $index="$uname:$udom";
 
-    my ($result,$cached)=&is_cached(\%homecache,$index,'home',86400);
-    if (defined($cached)) { return $result; }
+    if (exists($homecache{$index})) { return $homecache{$index}; }
     my $tryserver;
     foreach $tryserver (keys %libserv) {
         next if ($ignoreBadCache ne 'true' && 
@@ -571,7 +572,7 @@
 	if ($hostdom{$tryserver} eq $udom) {
            my $answer=reply("home:$udom:$uname",$tryserver);
            if ($answer eq 'found') { 
-	       return &do_cache(\%homecache,$index,$tryserver,'home');
+	       return $homecache{$index}=$tryserver;
            } elsif ($answer eq 'no_host') {
 	       $badServerCache{$tryserver}=1;
            }
@@ -776,11 +777,12 @@
 
 sub getsection {
     my ($udom,$unam,$courseid)=@_;
+    my $cachetime=1800;
     $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;
 
     my $hashid="$udom:$unam:$courseid";
-    my ($result,$cached)=&is_cached(\%getsectioncache,$hashid,'getsection');
+    my ($result,$cached)=&is_cached_new('getsection',$hashid);
     if (defined($cached)) { return $result; }
 
     my %Pending; 
@@ -815,211 +817,104 @@
             $Pending{$start}=$section;
             next;
         }
-        return &do_cache(\%getsectioncache,$hashid,$section,'getsection');
+        return &do_cache_new('getsection',$hashid,$section,$cachetime);
     }
     #
     # Presumedly there will be few matching roles from the above
     # loop and the sorting time will be negligible.
     if (scalar(keys(%Pending))) {
         my ($time) = sort {$a <=> $b} keys(%Pending);
-        return &do_cache(\%getsectioncache,$hashid,$Pending{$time},'getsection');
+        return &do_cache_new('getsection',$hashid,$Pending{$time},$cachetime);
     } 
     if (scalar(keys(%Expired))) {
         my @sorted = sort {$a <=> $b} keys(%Expired);
         my $time = pop(@sorted);
-        return &do_cache(\%getsectioncache,$hashid,$Expired{$time},'getsection');
+        return &do_cache_new('getsection',$hashid,$Expired{$time},$cachetime);
     }
-    return &do_cache(\%getsectioncache,$hashid,'-1','getsection');
+    return &do_cache_new('getsection',$hashid,'-1',$cachetime);
 }
 
+sub save_cache {
+    &purge_remembered();
+}
 
-my $disk_caching_disabled=1;
-
-sub devalidate_cache {
-    my ($cache,$id,$name) = @_;
-    delete $$cache{$id.'.time'};
-    delete $$cache{$id.'.file'};
-    delete $$cache{$id};
-    if (1 || $disk_caching_disabled) { return; }
-    my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
-    if (!-e $filename) { return; }
-    open(DB,">$filename.lock");
-    flock(DB,LOCK_EX);
-    my %hash;
-    if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
-	eval <<'EVALBLOCK';
-	    delete($hash{$id});
-	    delete($hash{$id.'.time'});
-EVALBLOCK
-        if ($@) {
-	    &logthis("<font color='red'>devalidate_cache blew up :$@:$name</font>");
-	    unlink($filename);
-	}
-    } else {
-	if (-e $filename) {
-	    &logthis("Unable to tie hash (devalidate cache): $name");
-	    unlink($filename);
-	}
-    }
-    untie(%hash);
-    flock(DB,LOCK_UN);
-    close(DB);
-}
-
-sub is_cached {
-    my ($cache,$id,$name,$time) = @_;
-    if (!$time) { $time=300; }
-    if (!exists($$cache{$id.'.time'})) {
-	&load_cache_item($cache,$name,$id,$time);
-    }
-    if (!exists($$cache{$id.'.time'})) {
-#	&logthis("Didn't find $id");
+my $to_remember=-1;
+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 ($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 = $memcache->get($id);
+    if (!(defined($value))) {
+	if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
 	return (undef,undef);
-    } else {
-	if (time-($$cache{$id.'.time'})>$time) {
-	    if (exists($$cache{$id.'.file'})) {
-		foreach my $filename (@{ $$cache{$id.'.file'} }) {
-		    my $mtime=(stat($filename))[9];
-		    #+1 is to take care of edge effects
-		    if ($mtime && (($mtime+1) < ($$cache{$id.'.time'}))) {
-#			&logthis("Upping $mtime - ".$$cache{$id.'.time'}.
-#				 "$id because of $filename");
-		    } else {
-			&logthis("Devalidating $filename $id - ".(time-($$cache{$id.'.time'})));
-			&devalidate_cache($cache,$id,$name);
-			return (undef,undef);
-		    }
-		}
-		$$cache{$id.'.time'}=time;
-	    } else {
-#		&logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
-		&devalidate_cache($cache,$id,$name);
-		return (undef,undef);
-	    }
-	}
     }
-    return ($$cache{$id},1);
-}
-
-sub do_cache {
-    my ($cache,$id,$value,$name) = @_;
-    $$cache{$id.'.time'}=time;
-    $$cache{$id}=$value;
-#    &logthis("Caching $id as :$value:");
-    &save_cache_item($cache,$name,$id);
-    # do_cache implictly return the set value
-    $$cache{$id};
-}
-
-my %do_save_item;
-my %do_save;
-sub save_cache_item {
-    my ($cache,$name,$id)=@_;
-    if ($disk_caching_disabled) { return; }
-    $do_save{$name}=$cache;
-    if (!exists($do_save_item{$name})) { $do_save_item{$name}={} }
-    $do_save_item{$name}->{$id}=1;
+    if ($value eq '__undef__') {
+	if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); }
+	$value=undef;
+    }
+    &make_room($id,$value,$debug);
+    if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); }
+    return ($value,1);
+}
+
+sub do_cache_new {
+    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"); }
+    $memcache->set($id,$setvalue,300);
+    &make_room($id,$value,$debug);
+    return $value;
+}
+
+sub make_room {
+    my ($id,$value,$debug)=@_;
+    $remembered{$id}=$value;
+    if ($to_remember<0) { return; }
+    $accessed{$id}=[&gettimeofday()];
+    if (scalar(keys(%remembered)) <= $to_remember) { return; }
+    my $to_kick;
+    my $max_time=0;
+    foreach my $other (keys(%accessed)) {
+	if (&tv_interval($accessed{$other}) > $max_time) {
+	    $to_kick=$other;
+	    $max_time=&tv_interval($accessed{$other});
+	}
+    }
+    delete($remembered{$to_kick});
+    delete($accessed{$to_kick});
+    $kicks++;
+    if ($debug) { &logthis("kicking $to_kick $max_time $kicks\n"); }
     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}});
-		if (exists($$cache{$id.'.file'})) {
-		    $hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}});
-		}
-EVALBLOCK
-                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));
-    }
-    undef(%do_save);
-    undef(%do_save_item);
-
-}
-
-sub load_cache_item {
-    my ($cache,$name,$id,$time)=@_;
-    if ($disk_caching_disabled) { return; }
-    my $starttime=&Time::HiRes::time();
-#    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
-    my %hash;
-    my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
-    if (!-e $filename) { return; }
-    open(DB,">$filename.lock");
-    flock(DB,LOCK_SH);
-    if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
-	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 {
-		if (($$cache{$id.'.time'}+$time) < time) {
-		    $$cache{$id.'.time'}=$hash{$id.'.time'};
-		    {
-			my $hashref=thaw($hash{$id});
-			$$cache{$id}=$hashref->{'item'};
-		    }
-		    if (exists($hash{$id.'.file'})) {
-			my $hashref=thaw($hash{$id.'.file'});
-			$$cache{$id.'.file'}=$hashref->{'item'};
-		    }
-		}
-	    }
-EVALBLOCK
-        if ($@) {
-	    &logthis("<font color='red'>load_cache blew up :$@:$name</font>");
-	    unlink($filename);
-	}        
-    } else {
-	if (-e $filename) {
-	    &logthis("Unable to tie hash (load cache item): $name ($!)");
-	    unlink($filename);
-	}
-    }
-    untie(%hash);
-    flock(DB,LOCK_UN);
-    close(DB);
-#    &logthis("After Loading $name size is ".scalar(%$cache));
-#    &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
+sub purge_remembered {
+    &logthis("Tossing ".scalar(keys(%remembered)));
+    &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
+    undef(%remembered);
+    undef(%accessed);
 }
-
 # ------------------------------------- Read an entry from a user's environment
 
 sub userenvironment {
@@ -1057,7 +952,7 @@
 
 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/;
@@ -1070,7 +965,7 @@
     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
@@ -4139,7 +4034,7 @@
 sub devalidatecourseresdata {
     my ($coursenum,$coursedomain)=@_;
     my $hashid=$coursenum.':'.$coursedomain;
-    &devalidate_cache(\%courseresdatacache,$hashid,'courseres');
+    &devalidate_cache_new('courseres',$hashid);
 }
 
 # --------------------------------------------------- Course Resourcedata Query
@@ -4148,18 +4043,18 @@
     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) {
@@ -4349,12 +4244,11 @@
 	    #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,
-						'userres');
+		my ($result,$cached)=&is_cached_new('userres',$hashid);
 		if (!defined($cached)) {
 		    my %resourcedata=&dump('resourcedata',$udom,$uname);
 		    $result=\%resourcedata;
-		    &do_cache(\%userresdatacache,$hashid,$result,'userres');
+		    &do_cache_new('userres',$hashid,$result);
 		}
 		my ($tmp)=keys(%$result);
 		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
@@ -4489,6 +4383,7 @@
 
 # ---------------------------------------------------------------- Get metadata
 
+my %metaentry;
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
@@ -4508,28 +4403,29 @@
 # Everything is cached by the main uri, libraries are never directly cached
 #
     if (!defined($liburi)) {
-	my ($result,$cached)=&is_cached(\%metacache,$uri,'meta');
+	my ($result,$cached)=&is_cached_new('meta',$uri);
 	if (defined($cached)) { return $result->{':'.$what}; }
     }
     {
 #
 # Is this a recursive call for a library?
 #
-	if (! exists($metacache{$uri})) {
-	    $metacache{$uri}={};
-	}
+#	if (! exists($metacache{$uri})) {
+#	    $metacache{$uri}={};
+#	}
         if ($liburi) {
 	    $liburi=&declutter($liburi);
             $filename=$liburi;
         } else {
-	    &devalidate_cache(\%metacache,$uri,'meta');
+	    &devalidate_cache_new('meta',$uri);
+	    undef(%metaentry);
 	}
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
 	if ($uri !~ m|^uploaded/|) {
 	    my $file=&filelocation('',&clutter($filename));
-	    push(@{$metacache{$uri.'.file'}},$file);
+	    #push(@{$metaentry{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
 	}
         my $parser=HTML::LCParser->new(\$metastring);
@@ -4546,10 +4442,10 @@
 		    if (defined($token->[2]->{'id'})) { 
 			$keyroot.='_'.$token->[2]->{'id'}; 
 		    }
-		    if ($metacache{$uri}->{':packages'}) {
-			$metacache{$uri}->{':packages'}.=','.$package.$keyroot;
+		    if ($metaentry{':packages'}) {
+			$metaentry{':packages'}.=','.$package.$keyroot;
 		    } else {
-			$metacache{$uri}->{':packages'}=$package.$keyroot;
+			$metaentry{':packages'}=$package.$keyroot;
 		    }
 		    foreach (keys %packagetab) {
 			my $part=$keyroot;
@@ -4571,14 +4467,14 @@
 			    if ($subp eq 'display') {
 				$value.=' [Part: '.$part.']';
 			    }
-			    $metacache{$uri}->{':'.$unikey.'.part'}=$part;
+			    $metaentry{':'.$unikey.'.part'}=$part;
 			    $metathesekeys{$unikey}=1;
-			    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
-				$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
+			    unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
+				$metaentry{':'.$unikey.'.'.$subp}=$value;
 			    }
-			    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
-				$metacache{$uri}->{':'.$unikey}=
-				    $metacache{$uri}->{':'.$unikey.'.default'};
+			    if (defined($metaentry{':'.$unikey.'.default'})) {
+				$metaentry{':'.$unikey}=
+				    $metaentry{':'.$unikey.'.default'};
 			    }
 			}
 		    }
@@ -4611,7 +4507,7 @@
 			    foreach (sort(split(/\,/,&metadata($uri,'keys',
 							       $location,$unikey,
 							       $depthcount+1)))) {
-				$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
+				$metaentry{':'.$_}=$metaentry{':'.$_};
 				$metathesekeys{$_}=1;
 			    }
 			}
@@ -4622,18 +4518,18 @@
 			}
 			$metathesekeys{$unikey}=1;
 			foreach (@{$token->[3]}) {
-			    $metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};
+			    $metaentry{':'.$unikey.'.'.$_}=$token->[2]->{$_};
 			}
 			my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
-			my $default=$metacache{$uri}->{':'.$unikey.'.default'};
+			my $default=$metaentry{':'.$unikey.'.default'};
 			if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
 		 # only ws inside the tag, and not in default, so use default
 		 # as value
-			    $metacache{$uri}->{':'.$unikey}=$default;
+			    $metaentry{':'.$unikey}=$default;
 			} else {
 		  # either something interesting inside the tag or default
                   # uninteresting
-			    $metacache{$uri}->{':'.$unikey}=$internaltext;
+			    $metaentry{':'.$unikey}=$internaltext;
 			}
 # end of not-a-package not-a-library import
 		    }
@@ -4650,7 +4546,7 @@
 	    &metadata_create_package_def($uri,$key,'extension_'.$extension,
 					 \%metathesekeys);
 	}
-	if (!exists($metacache{$uri}->{':packages'})) {
+	if (!exists($metaentry{':packages'})) {
 	    foreach my $key (sort(keys(%packagetab))) {
 		#no specific packages well let's get default then
 		if ($key!~/^default&/) { next; }
@@ -4659,31 +4555,31 @@
 	    }
 	}
 # are there custom rights to evaluate
-	if ($metacache{$uri}->{':copyright'} eq 'custom') {
+	if ($metaentry{':copyright'} eq 'custom') {
 
     #
     # Importing a rights file here
     #
 	    unless ($depthcount) {
-		my $location=$metacache{$uri}->{':customdistributionfile'};
+		my $location=$metaentry{':customdistributionfile'};
 		my $dir=$filename;
 		$dir=~s|[^/]*$||;
 		$location=&filelocation($dir,$location);
 		foreach (sort(split(/\,/,&metadata($uri,'keys',
 						   $location,'_rights',
 						   $depthcount+1)))) {
-		    $metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};
+		    #$metaentry{':'.$_}=$metacache{$uri}->{':'.$_};
 		    $metathesekeys{$_}=1;
 		}
 	    }
 	}
-	$metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);
-	&metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);
-	$metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);
-	&do_cache(\%metacache,$uri,$metacache{$uri},'meta');
+	$metaentry{':keys'}=join(',',keys %metathesekeys);
+	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
+	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
+	&do_cache_new('meta',$uri,\%metaentry);
 # this is the end of "was not already recently cached
     }
-    return $metacache{$uri}->{':'.$what};
+    return $metaentry{':'.$what};
 }
 
 sub metadata_create_package_def {
@@ -4691,22 +4587,22 @@
     my ($pack,$name,$subp)=split(/\&/,$key);
     if ($subp eq 'default') { next; }
     
-    if (defined($metacache{$uri}->{':packages'})) {
-	$metacache{$uri}->{':packages'}.=','.$package;
+    if (defined($metaentry{':packages'})) {
+	$metaentry{':packages'}.=','.$package;
     } else {
-	$metacache{$uri}->{':packages'}=$package;
+	$metaentry{':packages'}=$package;
     }
     my $value=$packagetab{$key};
     my $unikey;
     $unikey='parameter_0_'.$name;
-    $metacache{$uri}->{':'.$unikey.'.part'}=0;
+    $metaentry{':'.$unikey.'.part'}=0;
     $$metathesekeys{$unikey}=1;
-    unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {
-	$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;
+    unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
+	$metaentry{':'.$unikey.'.'.$subp}=$value;
     }
-    if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {
-	$metacache{$uri}->{':'.$unikey}=
-	    $metacache{$uri}->{':'.$unikey.'.default'};
+    if (defined($metaentry{':'.$unikey.'.default'})) {
+	$metaentry{':'.$unikey}=
+	    $metaentry{':'.$unikey.'.default'};
     }
 }
 
@@ -4744,7 +4640,8 @@
     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;
 	}
@@ -4759,7 +4656,7 @@
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
-	    return &do_cache(\%titlecache,$symb,$title,'title');
+	    return &do_cache_new('title',$key,$title,600);
 	}
 	$urlsymb=$url;
     }
@@ -4873,8 +4770,7 @@
     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',
@@ -4888,8 +4784,7 @@
  	}
  	untie %bighash;
     }
-    return &do_cache
-	(\%courseresversioncache,$key,&declutter($uri),'courseresversion');
+    return &do_cache_new('courseresversion',$key,&declutter($uri),600);
 }
 
 sub deversion {
@@ -5601,17 +5496,20 @@
 sub goodbye {
    &logthis("Starting Shut down");
 #not converted to using infrastruture and probably shouldn't be
-   &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
+   &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache))));
 #converted
-   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
-   &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
-   &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
-   &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
+#   &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))));
 #1.1 only
-   &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
-   &logthis(sprintf("%-20s is %s",'%getsectioncache',scalar(%getsectioncache)));
-   &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));
-   &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));
+#   &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",'%remembered',length(&freeze(\%remembered))));
+   &logthis(sprintf("%-20s is %s",'kicks',$kicks));
+   &logthis(sprintf("%-20s is %s",'hits',$hits));
    &flushcourselogs();
    &logthis("Shutting down");
    return DONE;
@@ -5771,7 +5669,7 @@
 
 }
 
-%metacache=();
+$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
 
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;

--albertel1108680208--