--- loncom/lonnet/perl/lonnet.pm 2004/09/22 18:31:12 1.545.2.1 +++ loncom/lonnet/perl/lonnet.pm 2004/10/12 20:26:48 1.545.2.2 @@ -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 @@ sub logperm { # -------------------------------------------------- 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 @@ sub subreply { 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 @@ EVALBLOCK 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 @@ my $lastname; 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 is_cached_new { 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 @@ sub tmprestore { } # ----------------------------------------------------------------------- Store -my $memcache_store=0; sub store { my ($storehash,$symb,$namespace,$domain,$stuname) = @_; my $home=''; @@ -2268,8 +2270,6 @@ sub store { &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 @@ sub cstore { &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 @@ sub restore { 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 @@ sub restore { $returnhash{$_}=$returnhash{$version.':'.$_}; } } - if ($memcache_store) { - $metacache->set("store:".$symb.":".$stuname.":".$domain.':'.$namespace, - \%returnhash); - } return %returnhash; } @@ -2849,7 +2839,6 @@ sub allowed { } # Free bre to public access - if ($priv eq 'bre') { my $copyright=&metadata($uri,'copyright'); if (($copyright eq 'public') && (!$ENV{'request.course.id'})) {