--- loncom/lonnet/perl/lonnet.pm 2005/02/13 23:09:03 1.587.2.3.2.3 +++ loncom/lonnet/perl/lonnet.pm 2005/02/14 02:22:25 1.587.2.3.2.6 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.587.2.3.2.3 2005/02/13 23:09:03 albertel Exp $ +# $Id: lonnet.pm,v 1.587.2.3.2.6 2005/02/14 02:22:25 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 $memcache %packagetab %courseresversioncache %resversioncache + %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 @@ -1022,17 +1022,20 @@ EVALBLOCK # &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); } -sub devalidate_cache_new { - my ($name,$id) = @_; - if (1) { &Apache::lonnet::logthis("deleting $name:$id"); } - $memcache->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) = @_; + if (0) { &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) = @_; $debug=0; @@ -1067,6 +1070,7 @@ sub do_cache_new { } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } $memcache->set($id,$setvalue,300); + &make_room($id,$value); return $value; } @@ -1133,7 +1137,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/; @@ -1146,7 +1150,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 @@ -4797,7 +4801,8 @@ sub gettitle { my $urlsymb=shift; my $symb=&symbread($urlsymb); if ($symb) { - my ($result,$cached)=&is_cached_new('title',$symb); + my $key=$ENV{'request.course.id'}."\0".$symb; + my ($result,$cached)=&is_cached_new('title',$key); if (defined($cached)) { return $result; } @@ -4812,7 +4817,7 @@ sub gettitle { } $title=~s/\&colon\;/\:/gs; if ($title) { - return &do_cache_new('title',$symb,$title,600); + return &do_cache_new('title',$key,$title,600); } $urlsymb=$url; } @@ -4926,8 +4931,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', @@ -4941,8 +4945,7 @@ sub fixversion { } untie %bighash; } - return &do_cache - (\%courseresversioncache,$key,&declutter($uri),'courseresversion'); + return &do_cache_new('courseresversion',$key,&declutter($uri),600); } sub deversion { @@ -5660,8 +5663,8 @@ sub goodbye { #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));