version 1.587.2.3.2.1, 2005/02/10 08:16:31
|
version 1.587.2.3.2.5, 2005/02/14 02:20:26
|
Line 36 use HTTP::Date;
|
Line 36 use HTTP::Date;
|
# use Date::Parse; |
# use Date::Parse; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
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 |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache |
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
Line 924 sub save_cache_item {
|
Line 924 sub save_cache_item {
|
} |
} |
|
|
sub save_cache { |
sub save_cache { |
|
&purge_remembered(); |
if ($disk_caching_disabled) { return; } |
if ($disk_caching_disabled) { return; } |
my ($cache,$name,$id); |
my ($cache,$name,$id); |
foreach $name (keys(%do_save)) { |
foreach $name (keys(%do_save)) { |
Line 1021 EVALBLOCK
|
Line 1022 EVALBLOCK
|
# &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); |
# &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); |
} |
} |
|
|
sub devalidate_cache_new { |
|
my ($cache,$name,$id) = @_; |
|
if (1) { &Apache::lonnet::logthis("deleting $name:$id"); } |
|
$cache->delete(&escape($name.':'.$id)); |
|
} |
|
|
|
my $to_remember=10; |
my $to_remember=10; |
my %remembered; |
my %remembered; |
my %accessed; |
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 { |
sub is_cached_new { |
my ($cache,$name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
$debug=0; |
$debug=0; |
$id=&escape($name.':'.$id); |
$id=&escape($name.':'.$id); |
if (exists($remembered{$id})) { |
if (exists($remembered{$id})) { |
if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } |
if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
|
$hits++; |
return ($remembered{$id},1); |
return ($remembered{$id},1); |
} |
} |
my $value = $cache->get($id); |
my $value = $memcache->get($id); |
if (!(defined($value))) { |
if (!(defined($value))) { |
if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } |
if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } |
return (undef,undef); |
return (undef,undef); |
Line 1054 sub is_cached_new {
|
Line 1061 sub is_cached_new {
|
} |
} |
|
|
sub do_cache_new { |
sub do_cache_new { |
my ($cache,$name,$id,$value,$time,$debug) = @_; |
my ($name,$id,$value,$time,$debug) = @_; |
$debug=0; |
$debug=0; |
$id=&escape($name.':'.$id); |
$id=&escape($name.':'.$id); |
my $setvalue=$value; |
my $setvalue=$value; |
Line 1062 sub do_cache_new {
|
Line 1069 sub do_cache_new {
|
$setvalue='__undef__'; |
$setvalue='__undef__'; |
} |
} |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
$cache->set($id,$setvalue,300); |
$memcache->set($id,$setvalue,300); |
|
&make_room($id,$value); |
return $value; |
return $value; |
} |
} |
|
|
my $kicks=0; |
|
sub make_room { |
sub make_room { |
my ($id,$value)=@_; |
my ($id,$value)=@_; |
my $debug=0; |
my $debug=0; |
Line 1088 sub make_room {
|
Line 1095 sub make_room {
|
return; |
return; |
} |
} |
|
|
|
sub purge_remembered { |
|
&logthis("Tossing ".scalar(keys(%remembered))); |
|
undef(%remembered); |
|
undef(%accessed); |
|
} |
# ------------------------------------- Read an entry from a user's environment |
# ------------------------------------- Read an entry from a user's environment |
|
|
sub userenvironment { |
sub userenvironment { |
Line 4552 sub metadata {
|
Line 4564 sub metadata {
|
# Everything is cached by the main uri, libraries are never directly cached |
# Everything is cached by the main uri, libraries are never directly cached |
# |
# |
if (!defined($liburi)) { |
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}; } |
if (defined($cached)) { return $result->{':'.$what}; } |
} |
} |
{ |
{ |
Line 4566 sub metadata {
|
Line 4578 sub metadata {
|
$liburi=&declutter($liburi); |
$liburi=&declutter($liburi); |
$filename=$liburi; |
$filename=$liburi; |
} else { |
} else { |
&devalidate_cache_new($metacache,'meta',$uri); |
&devalidate_cache_new('meta',$uri); |
undef(%metaentry); |
undef(%metaentry); |
} |
} |
my %metathesekeys=(); |
my %metathesekeys=(); |
Line 4725 sub metadata {
|
Line 4737 sub metadata {
|
$metaentry{':keys'}=join(',',keys %metathesekeys); |
$metaentry{':keys'}=join(',',keys %metathesekeys); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
$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 |
# this is the end of "was not already recently cached |
} |
} |
return $metaentry{':'.$what}; |
return $metaentry{':'.$what}; |
Line 4789 sub gettitle {
|
Line 4801 sub gettitle {
|
my $urlsymb=shift; |
my $urlsymb=shift; |
my $symb=&symbread($urlsymb); |
my $symb=&symbread($urlsymb); |
if ($symb) { |
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)) { |
if (defined($cached)) { |
return $result; |
return $result; |
} |
} |
Line 4804 sub gettitle {
|
Line 4817 sub gettitle {
|
} |
} |
$title=~s/\&colon\;/\:/gs; |
$title=~s/\&colon\;/\:/gs; |
if ($title) { |
if ($title) { |
return &do_cache(\%titlecache,$symb,$title,'title'); |
return &do_cache_new('title',$key,$title,600); |
} |
} |
$urlsymb=$url; |
$urlsymb=$url; |
} |
} |
Line 5647 sub goodbye {
|
Line 5660 sub goodbye {
|
#converted |
#converted |
# &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache))); |
# &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",'%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 |
#1.1 only |
&logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache)))); |
&logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache)))); |
Line 5656 sub goodbye {
|
Line 5669 sub goodbye {
|
&logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache)))); |
&logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache)))); |
&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); |
&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); |
&logthis(sprintf("%-20s is %s",'kicks',$kicks)); |
&logthis(sprintf("%-20s is %s",'kicks',$kicks)); |
|
&logthis(sprintf("%-20s is %s",'hits',$hits)); |
&flushcourselogs(); |
&flushcourselogs(); |
&logthis("Shutting down"); |
&logthis("Shutting down"); |
return DONE; |
return DONE; |
Line 5801 BEGIN {
|
Line 5815 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'}; |
$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; |
$dumpcount=0; |
$dumpcount=0; |