--- loncom/lonnet/perl/lonnet.pm 2003/09/17 17:50:49 1.415 +++ loncom/lonnet/perl/lonnet.pm 2003/09/19 16:29:09 1.416 @@ -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 @@ qw(%perlvar %hostname %homecache %badSer %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 @@ sub getsection { 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 @@ sub usection { 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 @@ sub courseresdata { $courseresdatacache{$hashid}=\%dumpreply; } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; + } elsif ($tmp =~ /^(error)/) { + $courseresdatacache{$hashid.'.time'}=time; } } foreach my $item (@which) {