version 1.439, 2003/11/01 16:37:21
|
version 1.440, 2003/11/01 18:34:49
|
Line 35 use LWP::UserAgent();
|
Line 35 use LWP::UserAgent();
|
use HTTP::Headers; |
use HTTP::Headers; |
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 |
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache |
%userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
Line 1042 sub getversion {
|
Line 1042 sub getversion {
|
|
|
sub currentversion { |
sub currentversion { |
my $fname=shift; |
my $fname=shift; |
|
my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600); |
|
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/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
Line 1053 sub currentversion {
|
Line 1055 sub currentversion {
|
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
if (($answer eq 'con_lost') || ($answer eq 'rejected')) { |
return -1; |
return -1; |
} |
} |
return $answer; |
return &do_cache(\%resversioncache,$fname,$answer,'resversion'); |
} |
} |
|
|
# ----------------------------- Subscribe to a resource, return URL if possible |
# ----------------------------- Subscribe to a resource, return URL if possible |
Line 4080 sub fixversion {
|
Line 4082 sub fixversion {
|
if ($fn=~/^(adm|uploaded|public)/) { return $fn; } |
if ($fn=~/^(adm|uploaded|public)/) { return $fn; } |
my %bighash; |
my %bighash; |
my $uri=&clutter($fn); |
my $uri=&clutter($fn); |
|
my $key=$ENV{'request.course.id'}.'_'.$uri; |
|
# is this cached? |
|
my ($result,$cached)=&is_cached(\%courseresversioncache,$key, |
|
'courseresversion',600); |
|
if (defined($cached)) { return $result; } |
|
# 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', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
if ($bighash{'version_'.$uri}) { |
if ($bighash{'version_'.$uri}) { |
my $version=$bighash{'version_'.$uri}; |
my $version=$bighash{'version_'.$uri}; |
unless ($version eq 'mostrecent') { |
unless ($version eq 'mostrecent') { |
$uri=~s/\.(\w+)$/\.$version\.$1/; |
$uri=~s/\.(\w+)$/\.$version\.$1/; |
} |
} |
} |
} |
untie %bighash; |
untie %bighash; |
} |
} |
return &declutter($uri); |
return &do_cache |
|
(\%courseresversioncache,$key,&declutter($uri),'courseresversion'); |
} |
} |
|
|
sub deversion { |
sub deversion { |
Line 4425 sub goodbye {
|
Line 4434 sub goodbye {
|
#1.1 only |
#1.1 only |
&logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); |
&logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); |
&logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache))); |
&logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache))); |
|
&logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache))); |
|
&logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache))); |
&flushcourselogs(); |
&flushcourselogs(); |
&logthis("Shutting down"); |
&logthis("Shutting down"); |
return DONE; |
return DONE; |