|
version 1.587.2.3.2.9, 2005/02/14 04:22:13
|
version 1.587.2.3.2.12, 2005/02/14 04:31:59
|
|
Line 39 qw(%perlvar %hostname %badServerCache %h
|
Line 39 qw(%perlvar %hostname %badServerCache %h
|
| %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 |
%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 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); |
| 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 1022 EVALBLOCK
|
Line 1023 EVALBLOCK
|
| # &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); |
# &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime)); |
| } |
} |
| |
|
| my $to_remember=10; |
my $to_remember=20; |
| my %remembered; |
my %remembered; |
| my %accessed; |
my %accessed; |
| my $kicks=0; |
my $kicks=0; |
|
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 5658 sub goodbye {
|
Line 5658 sub goodbye {
|
| # &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)))); |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lonnet / perl