--- loncom/lonnet/perl/lonnet.pm 2005/02/14 02:22:25 1.587.2.3.2.6 +++ loncom/lonnet/perl/lonnet.pm 2005/04/15 20:48:18 1.587.2.3.2.16 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.587.2.3.2.6 2005/02/14 02:22:25 albertel Exp $ +# $Id: lonnet.pm,v 1.587.2.3.2.16 2005/04/15 20:48:18 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,11 +35,11 @@ use HTTP::Headers; use HTTP::Date; # use Date::Parse; use vars -qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom +qw(%perlvar %hostname %badServerCache %hostip %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; @@ -559,12 +559,12 @@ sub authenticate { # ---------------------- 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' && @@ -572,7 +572,7 @@ sub homeserver { 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; } @@ -777,11 +777,12 @@ sub validate_access_key { 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; @@ -816,21 +817,21 @@ sub getsection { $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); } @@ -1022,14 +1023,14 @@ EVALBLOCK # &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); } -my $to_remember=10; +my $to_remember=-1; 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"); } + my ($name,$id,$debug) = @_; + if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } $id=&escape($name.':'.$id); $memcache->delete($id); delete($remembered{$id}); @@ -1038,7 +1039,6 @@ sub devalidate_cache_new { sub is_cached_new { 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} "); } @@ -1051,33 +1051,35 @@ sub is_cached_new { if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } return (undef,undef); } - &make_room($id,$value); if ($value eq '__undef__') { if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } - return (undef,1); + $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) = @_; - $debug=0; $id=&escape($name.':'.$id); my $setvalue=$value; if (!defined($setvalue)) { $setvalue='__undef__'; } + if (!defined($time)) { + $time=600; + } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $memcache->set($id,$setvalue,300); - &make_room($id,$value); + $memcache->set($id,$setvalue,$time); + #&make_room($id,$value,$debug); return $value; } sub make_room { - my ($id,$value)=@_; - my $debug=0; + 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; @@ -1097,6 +1099,7 @@ sub make_room { sub purge_remembered { &logthis("Tossing ".scalar(keys(%remembered))); + &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); undef(%remembered); undef(%accessed); } @@ -4202,7 +4205,7 @@ sub condval { sub devalidatecourseresdata { my ($coursenum,$coursedomain)=@_; my $hashid=$coursenum.':'.$coursedomain; - &devalidate_cache(\%courseresdatacache,$hashid,'courseres'); + &devalidate_cache_new('courseres',$hashid); } # --------------------------------------------------- Course Resourcedata Query @@ -4211,18 +4214,18 @@ sub courseresdata { 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) { @@ -4411,12 +4414,11 @@ sub EXT { #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,600); } my ($tmp)=keys(%$result); if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { @@ -4737,7 +4739,7 @@ sub metadata { $metaentry{':keys'}=join(',',keys %metathesekeys); &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); - &do_cache_new('meta',$uri,\%metaentry); + &do_cache_new('meta',$uri,\%metaentry,6000); # this is the end of "was not already recently cached } return $metaentry{':'.$what}; @@ -5657,12 +5659,12 @@ sub goodbye { &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache)))); #converted # &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache))); - &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache)))); +# &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)))); +# &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache)))); #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",'%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))));