[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 19 Sep 2003 16:29:09 -0000
albertel Fri Sep 19 12:29:09 2003 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- cache usection, it was about 50% of the time for rendering a problem set for grade
- make reusable caching infrastructure
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.415 loncom/lonnet/perl/lonnet.pm:1.416
--- loncom/lonnet/perl/lonnet.pm:1.415 Wed Sep 17 13:50:49 2003
+++ loncom/lonnet/perl/lonnet.pm Fri Sep 19 12:29:09 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.415 2003/09/17 17:50:49 albertel Exp $
+# $Id: lonnet.pm,v 1.416 2003/09/19 16:29:09 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -76,7 +76,7 @@
%libserv %pr %prp %metacache %packagetab %titlecache
%courselogs %accesshash %userrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache
- %domaindescription %domain_auth_def %domain_auth_arg_def
+ %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);
use IO::Socket;
@@ -848,8 +848,38 @@
return '-1';
}
+sub devalidate_cache {
+ my ($cache,$id) = @_;
+ delete $courseresdatacache{$id.'.time'};
+ delete $courseresdatacache{$id};
+}
+
+sub is_cached {
+ my ($cache,$id,$time) = @_;
+ if (!exists($$cache{$id.'.time'})) {
+ return undef;
+ } else {
+ if (time-$$cache{$id.'.time'}>300) {
+ &devaidate_cache($cache,$id);
+ return undef;
+ }
+ }
+ return $$cache{$id};
+}
+
+sub do_cache {
+ my ($cache,$id,$value) = @_;
+ $$cache{$id.'.time'}=time;
+ # do_cache implictly return the set value
+ $$cache{$id}=$value;
+}
+
sub usection {
my ($udom,$unam,$courseid)=@_;
+ my $hashid="$udom:$unam:$courseid";
+
+ my $result;
+ if ($result=&is_cached(\%usectioncache,$hashid,300)) { return $result; }
$courseid=~s/\_/\//g;
$courseid=~s/^(\w)/\/$1/;
foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
@@ -868,10 +898,12 @@
if ($end) {
if ($now>$end) { $notactive=1; }
}
- unless ($notactive) { return $section; }
+ unless ($notactive) {
+ return &do_cache(\%usectioncache,$hashid,$section);
+ }
}
}
- return '-1';
+ return &do_cache(\%usectioncache,$hashid,'-1');
}
# ------------------------------------- Read an entry from a user's environment
@@ -3291,6 +3323,8 @@
$courseresdatacache{$hashid}=\%dumpreply;
} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
return $tmp;
+ } elsif ($tmp =~ /^(error)/) {
+ $courseresdatacache{$hashid.'.time'}=time;
}
}
foreach my $item (@which) {