--- loncom/lonnet/perl/lonnet.pm 2003/11/01 16:37:21 1.439 +++ loncom/lonnet/perl/lonnet.pm 2003/11/01 18:34:49 1.440 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.439 2003/11/01 16:37:21 www Exp $ +# $Id: lonnet.pm,v 1.440 2003/11/01 18:34:49 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,7 +35,7 @@ use LWP::UserAgent(); use HTTP::Headers; use vars 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 %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def @@ -1042,6 +1042,8 @@ sub getversion { sub currentversion { my $fname=shift; + my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600); + if (defined($cached)) { return $result; } my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -1053,7 +1055,7 @@ sub currentversion { if (($answer eq 'con_lost') || ($answer eq 'rejected')) { return -1; } - return $answer; + return &do_cache(\%resversioncache,$fname,$answer,'resversion'); } # ----------------------------- Subscribe to a resource, return URL if possible @@ -4080,17 +4082,24 @@ sub fixversion { if ($fn=~/^(adm|uploaded|public)/) { return $fn; } my %bighash; 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', - &GDBM_READER(),0640)) { - if ($bighash{'version_'.$uri}) { - my $version=$bighash{'version_'.$uri}; - unless ($version eq 'mostrecent') { - $uri=~s/\.(\w+)$/\.$version\.$1/; - } - } - untie %bighash; + &GDBM_READER(),0640)) { + if ($bighash{'version_'.$uri}) { + my $version=$bighash{'version_'.$uri}; + unless ($version eq 'mostrecent') { + $uri=~s/\.(\w+)$/\.$version\.$1/; + } + } + untie %bighash; } - return &declutter($uri); + return &do_cache + (\%courseresversioncache,$key,&declutter($uri),'courseresversion'); } sub deversion { @@ -4425,6 +4434,8 @@ sub goodbye { #1.1 only &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache))); &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(); &logthis("Shutting down"); return DONE;