version 1.587.2.3.2.7, 2005/02/14 03:11:07
|
version 1.587.2.3.2.11, 2005/02/14 04:29:43
|
Line 35 use HTTP::Headers;
|
Line 35 use HTTP::Headers;
|
use HTTP::Date; |
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 %badServerCache %hostip %iphost %spareid %hostdom |
%libserv %pr %prp $memcache %packagetab |
%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 |
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%domaindescription %domain_auth_def %domain_auth_arg_def |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); |
|
|
use IO::Socket; |
use IO::Socket; |
Line 563 sub homeserver {
|
Line 563 sub homeserver {
|
my ($uname,$udom,$ignoreBadCache)=@_; |
my ($uname,$udom,$ignoreBadCache)=@_; |
my $index="$uname:$udom"; |
my $index="$uname:$udom"; |
|
|
my ($result,$cached)=&is_cached(\%homecache,$index,'home',86400); |
my ($result,$cached)=&is_cached_new('home',$index); |
if (defined($cached)) { return $result; } |
if (defined($cached)) { return $result; } |
my $tryserver; |
my $tryserver; |
foreach $tryserver (keys %libserv) { |
foreach $tryserver (keys %libserv) { |
Line 572 sub homeserver {
|
Line 572 sub homeserver {
|
if ($hostdom{$tryserver} eq $udom) { |
if ($hostdom{$tryserver} eq $udom) { |
my $answer=reply("home:$udom:$uname",$tryserver); |
my $answer=reply("home:$udom:$uname",$tryserver); |
if ($answer eq 'found') { |
if ($answer eq 'found') { |
return &do_cache(\%homecache,$index,$tryserver,'home'); |
return &do_cache_new('home',$index,$tryserver,86400); |
} elsif ($answer eq 'no_host') { |
} elsif ($answer eq 'no_host') { |
$badServerCache{$tryserver}=1; |
$badServerCache{$tryserver}=1; |
} |
} |
Line 777 sub validate_access_key {
|
Line 777 sub validate_access_key {
|
|
|
sub getsection { |
sub getsection { |
my ($udom,$unam,$courseid)=@_; |
my ($udom,$unam,$courseid)=@_; |
|
my $cachetime=1800; |
$courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
$courseid=~s/^(\w)/\/$1/; |
$courseid=~s/^(\w)/\/$1/; |
|
|
my $hashid="$udom:$unam:$courseid"; |
my $hashid="$udom:$unam:$courseid"; |
my ($result,$cached)=&is_cached(\%getsectioncache,$hashid,'getsection'); |
my ($result,$cached)=&is_cached_new('getsection',$hashid,1); |
if (defined($cached)) { return $result; } |
if (defined($cached)) { return $result; } |
|
|
my %Pending; |
my %Pending; |
Line 816 sub getsection {
|
Line 817 sub getsection {
|
$Pending{$start}=$section; |
$Pending{$start}=$section; |
next; |
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 |
# Presumedly there will be few matching roles from the above |
# loop and the sorting time will be negligible. |
# loop and the sorting time will be negligible. |
if (scalar(keys(%Pending))) { |
if (scalar(keys(%Pending))) { |
my ($time) = sort {$a <=> $b} 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))) { |
if (scalar(keys(%Expired))) { |
my @sorted = sort {$a <=> $b} keys(%Expired); |
my @sorted = sort {$a <=> $b} keys(%Expired); |
my $time = pop(@sorted); |
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); |
} |
} |
|
|
|
|
Line 4199 sub condval {
|
Line 4200 sub condval {
|
sub devalidatecourseresdata { |
sub devalidatecourseresdata { |
my ($coursenum,$coursedomain)=@_; |
my ($coursenum,$coursedomain)=@_; |
my $hashid=$coursenum.':'.$coursedomain; |
my $hashid=$coursenum.':'.$coursedomain; |
&devalidate_cache(\%courseresdatacache,$hashid,'courseres'); |
&devalidate_cache_new('courseres',$hashid); |
} |
} |
|
|
# --------------------------------------------------- Course Resourcedata Query |
# --------------------------------------------------- Course Resourcedata Query |
Line 4208 sub courseresdata {
|
Line 4209 sub courseresdata {
|
my ($coursenum,$coursedomain,@which)=@_; |
my ($coursenum,$coursedomain,@which)=@_; |
my $coursehom=&homeserver($coursenum,$coursedomain); |
my $coursehom=&homeserver($coursenum,$coursedomain); |
my $hashid=$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)) { |
unless (defined($cached)) { |
my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); |
my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); |
$result=\%dumpreply; |
$result=\%dumpreply; |
my ($tmp) = keys(%dumpreply); |
my ($tmp) = keys(%dumpreply); |
if ($tmp !~ /^(con_lost|error|no_such_host)/i) { |
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)/) { |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
return $tmp; |
return $tmp; |
} elsif ($tmp =~ /^(error)/) { |
} elsif ($tmp =~ /^(error)/) { |
$result=undef; |
$result=undef; |
&do_cache(\%courseresdatacache,$hashid,$result,'courseres'); |
&do_cache_new('courseres',$hashid,$result,600); |
} |
} |
} |
} |
foreach my $item (@which) { |
foreach my $item (@which) { |
Line 4408 sub EXT {
|
Line 4409 sub EXT {
|
#most student don\'t have any data set, check if there is some data |
#most student don\'t have any data set, check if there is some data |
if (! &EXT_cache_status($udom,$uname)) { |
if (! &EXT_cache_status($udom,$uname)) { |
my $hashid="$udom:$uname"; |
my $hashid="$udom:$uname"; |
my ($result,$cached)=&is_cached(\%userresdatacache,$hashid, |
my ($result,$cached)=&is_cached_new('userres',$hashid); |
'userres'); |
|
if (!defined($cached)) { |
if (!defined($cached)) { |
my %resourcedata=&dump('resourcedata',$udom,$uname); |
my %resourcedata=&dump('resourcedata',$udom,$uname); |
$result=\%resourcedata; |
$result=\%resourcedata; |
&do_cache(\%userresdatacache,$hashid,$result,'userres'); |
&do_cache_new('userres',$hashid,$result); |
} |
} |
my ($tmp)=keys(%$result); |
my ($tmp)=keys(%$result); |
if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { |
if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { |
Line 5654 sub goodbye {
|
Line 5654 sub goodbye {
|
&logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache)))); |
&logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache)))); |
#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)))); |
&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)))); |