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

[albertel]

albertel		Tue Oct 12 16:26:49 2004 EDT

  Modified files:              (Branch: memcached)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - remove the caching of store, seems to give no real performance improvment (could help with s10 load, but not clear that it would)
  - escape key names as they cannot include whitespace
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.545.2.1 loncom/lonnet/perl/lonnet.pm:1.545.2.2
--- loncom/lonnet/perl/lonnet.pm:1.545.2.1	Wed Sep 22 14:31:12 2004
+++ loncom/lonnet/perl/lonnet.pm	Tue Oct 12 16:26:48 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.545.2.1 2004/09/22 18:31:12 albertel Exp $
+# $Id: lonnet.pm,v 1.545.2.2 2004/10/12 20:26:48 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -116,6 +116,7 @@
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
+    my $t0_f=[&Time::HiRes::gettimeofday()];
     my $peerfile="$perlvar{'lonSockDir'}/$server";
     my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
                                      Type    => SOCK_STREAM,
@@ -125,6 +126,8 @@
     my $answer=<$client>;
     if (!$answer) { $answer="con_lost"; }
     chomp($answer);
+    my $td=&Time::HiRes::tv_interval($t0_f);
+    &Apache::lonnet::logthis("\n $td seconds for $cmd");
     return $answer;
 }
 
@@ -1012,7 +1015,7 @@
 sub devalidate_cache_new {
     my ($cache,$name,$id) = @_;
     if (0) { &Apache::lonnet::logthis("deleting $name:$id"); }
-    $cache->delete($name.':'.$id);
+    $cache->delete(&escape($name.':'.$id));
 }
 
 my $lastone;
@@ -1020,7 +1023,7 @@
 sub is_cached_new {
     my ($cache,$name,$id,$debug) = @_;
     $debug=0;
-    $id=$name.':'.$id;
+    $id=&escape($name.':'.$id);
     if ($lastname eq $id) {
 	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $lastone <= $lastname "); }
 	return ($lastone,1);
@@ -1045,7 +1048,7 @@
 sub do_cache_new {
     my ($cache,$name,$id,$value,$time,$debug) = @_;
     $debug=0;
-    $id=$name.':'.$id;
+    $id=&escape($name.':'.$id);
     my $setvalue=$value;
     if (!defined($setvalue)) {
 	$setvalue='__undef__';
@@ -2253,7 +2256,6 @@
 }
 
 # ----------------------------------------------------------------------- Store
-my $memcache_store=0;
 sub store {
     my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
     my $home='';
@@ -2268,8 +2270,6 @@
 
     &devalidate($symb,$stuname,$domain);
     $symb=escape($symb);
-    $memcache_store &&
-	$metacache->delete("store:".$symb.":".$stuname.":".$domain.':'.$namespace);
     if (!$namespace) { 
        unless ($namespace=$ENV{'request.course.id'}) { 
           return ''; 
@@ -2305,8 +2305,6 @@
 
     &devalidate($symb,$stuname,$domain);
     $symb=escape($symb);
-    $memcache_store &&
-	$metacache->delete("store:".$symb.":".$stuname.":".$domain.':'.$namespace);
     if (!$namespace) { 
        unless ($namespace=$ENV{'request.course.id'}) { 
           return ''; 
@@ -2348,11 +2346,7 @@
     if (!$domain) { $domain=$ENV{'user.domain'}; }
     if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }
-    if ($memcache_store) {
-	my $rethash=$metacache->get("store:".$symb.":".$stuname.":".
-				    $domain.':'.$namespace);
-	if ($rethash) { return %{$rethash}; }
-    }
+
     my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
 
     my %returnhash=();
@@ -2366,10 +2360,6 @@
           $returnhash{$_}=$returnhash{$version.':'.$_};
        }
     }
-    if ($memcache_store) {
-	$metacache->set("store:".$symb.":".$stuname.":".$domain.':'.$namespace,
-			\%returnhash);
-    }
     return %returnhash;
 }
 
@@ -2849,7 +2839,6 @@
     }
 
 # Free bre to public access
-
     if ($priv eq 'bre') {
         my $copyright=&metadata($uri,'copyright');
 	if (($copyright eq 'public') && (!$ENV{'request.course.id'})) {