version 1.587.2.3.2.5, 2005/02/14 02:20:26
|
version 1.587.2.3.2.7, 2005/02/14 03:11:07
|
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 $memcache %packagetab %courseresversioncache %resversioncache |
%libserv %pr %prp $memcache %packagetab |
%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 1028 my %accessed;
|
Line 1028 my %accessed;
|
my $kicks=0; |
my $kicks=0; |
my $hits=0; |
my $hits=0; |
sub devalidate_cache_new { |
sub devalidate_cache_new { |
my ($name,$id) = @_; |
my ($name,$id,$debug) = @_; |
if (0) { &Apache::lonnet::logthis("deleting $name:$id"); } |
if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } |
$id=&escape($name.':'.$id); |
$id=&escape($name.':'.$id); |
$memcache->delete($id); |
$memcache->delete($id); |
delete($remembered{$id}); |
delete($remembered{$id}); |
Line 1038 sub devalidate_cache_new {
|
Line 1038 sub devalidate_cache_new {
|
|
|
sub is_cached_new { |
sub is_cached_new { |
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
$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} "); } |
Line 1051 sub is_cached_new {
|
Line 1050 sub is_cached_new {
|
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); |
} |
} |
&make_room($id,$value); |
&make_room($id,$value,$debug); |
if ($value eq '__undef__') { |
if ($value eq '__undef__') { |
if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } |
if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } |
return (undef,1); |
return (undef,1); |
Line 1062 sub is_cached_new {
|
Line 1061 sub is_cached_new {
|
|
|
sub do_cache_new { |
sub do_cache_new { |
my ($name,$id,$value,$time,$debug) = @_; |
my ($name,$id,$value,$time,$debug) = @_; |
$debug=0; |
|
$id=&escape($name.':'.$id); |
$id=&escape($name.':'.$id); |
my $setvalue=$value; |
my $setvalue=$value; |
if (!defined($setvalue)) { |
if (!defined($setvalue)) { |
Line 1070 sub do_cache_new {
|
Line 1068 sub do_cache_new {
|
} |
} |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } |
$memcache->set($id,$setvalue,300); |
$memcache->set($id,$setvalue,300); |
&make_room($id,$value); |
&make_room($id,$value,$debug); |
return $value; |
return $value; |
} |
} |
|
|
sub make_room { |
sub make_room { |
my ($id,$value)=@_; |
my ($id,$value,$debug)=@_; |
my $debug=0; |
|
$remembered{$id}=$value; |
$remembered{$id}=$value; |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
Line 1137 sub getversion {
|
Line 1134 sub getversion {
|
|
|
sub currentversion { |
sub currentversion { |
my $fname=shift; |
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; } |
if (defined($cached)) { return $result; } |
my $author=$fname; |
my $author=$fname; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
Line 1150 sub currentversion {
|
Line 1147 sub currentversion {
|
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
return -1; |
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 |
# ----------------------------- Subscribe to a resource, return URL if possible |
Line 4931 sub fixversion {
|
Line 4928 sub fixversion {
|
my $uri=&clutter($fn); |
my $uri=&clutter($fn); |
my $key=$ENV{'request.course.id'}.'_'.$uri; |
my $key=$ENV{'request.course.id'}.'_'.$uri; |
# is this cached? |
# is this cached? |
my ($result,$cached)=&is_cached(\%courseresversioncache,$key, |
my ($result,$cached)=&is_cached_new('courseresversion',$key); |
'courseresversion',600); |
|
if (defined($cached)) { return $result; } |
if (defined($cached)) { return $result; } |
# unfortunately not cached, or expired |
# unfortunately not cached, or expired |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
Line 4946 sub fixversion {
|
Line 4942 sub fixversion {
|
} |
} |
untie %bighash; |
untie %bighash; |
} |
} |
return &do_cache |
return &do_cache_new('courseresversion',$key,&declutter($uri),600); |
(\%courseresversioncache,$key,&declutter($uri),'courseresversion'); |
|
} |
} |
|
|
sub deversion { |
sub deversion { |
Line 5665 sub goodbye {
|
Line 5660 sub goodbye {
|
#1.1 only |
#1.1 only |
&logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache)))); |
&logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache)))); |
&logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache)))); |
&logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache)))); |
&logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache)))); |
# &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache)))); |
&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)); |
&logthis(sprintf("%-20s is %s",'hits',$hits)); |