--- 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 02:17:51 1.587.2.3.2.4 @@ -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.4 2005/02/14 02:17:51 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -36,7 +36,7 @@ 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 %courseresversioncache %resversioncache %courselogs %accesshash %userrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def @@ -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)) { @@ -1022,24 +1023,27 @@ EVALBLOCK } sub devalidate_cache_new { - my ($cache,$name,$id) = @_; + my ($name,$id) = @_; if (1) { &Apache::lonnet::logthis("deleting $name:$id"); } - $cache->delete(&escape($name.':'.$id)); + $memcache->delete(&escape($name.':'.$id)); } my $to_remember=10; my %remembered; my %accessed; +my $kicks=0; +my $hits=0; sub is_cached_new { - my ($cache,$name,$id,$debug) = @_; + my ($name,$id,$debug) = @_; $debug=0; $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); @@ -1054,7 +1058,7 @@ sub is_cached_new { } sub do_cache_new { - my ($cache,$name,$id,$value,$time,$debug) = @_; + my ($name,$id,$value,$time,$debug) = @_; $debug=0; $id=&escape($name.':'.$id); my $setvalue=$value; @@ -1062,11 +1066,10 @@ sub do_cache_new { $setvalue='__undef__'; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $cache->set($id,$setvalue,300); + $memcache->set($id,$setvalue,300); return $value; } -my $kicks=0; sub make_room { my ($id,$value)=@_; my $debug=0; @@ -1088,6 +1091,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 { @@ -4552,7 +4560,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 +4574,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 +4733,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 +4797,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 +4813,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; } @@ -5647,7 +5656,7 @@ 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",'%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)))); @@ -5656,6 +5665,7 @@ sub goodbye { &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 +5811,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;