--- loncom/lonnet/perl/lonnet.pm 2003/09/16 17:54:50 1.413 +++ loncom/lonnet/perl/lonnet.pm 2003/09/19 18:20:35 1.419 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.413 2003/09/16 17:54:50 www Exp $ +# $Id: lonnet.pm,v 1.419 2003/09/19 18:20:35 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; @@ -85,6 +85,7 @@ use Apache::Constants qw(:common :http); use HTML::LCParser; use Fcntl qw(:flock); use Apache::loncoursedata; +use Apache::lonlocal; my $readit; @@ -847,8 +848,38 @@ sub getsection { return '-1'; } +sub devalidate_cache { + my ($cache,$id) = @_; + delete $$cache{$id.'.time'}; + delete $$cache{$id}; +} + +sub is_cached { + my ($cache,$id,$time) = @_; + if (!exists($$cache{$id.'.time'})) { + return (undef,undef); + } else { + if (time-$$cache{$id.'.time'}>$time) { + &devalidate_cache($cache,$id); + return (undef,undef); + } + } + return ($$cache{$id},1); +} + +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,$cached)=&is_cached(\%usectioncache,$hashid,300); + if (defined($cached)) { return $result; } $courseid=~s/\_/\//g; $courseid=~s/^(\w)/\/$1/; foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles', @@ -867,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 @@ -2739,7 +2772,7 @@ sub userlog_query { sub plaintext { my $short=shift; - return $prp{$short}; + return &mt($prp{$short}); } # ----------------------------------------------------------------- Assign Role @@ -3262,39 +3295,29 @@ sub condval { return $result; } -# ---------------------------------------------------- Devalidate courseresdata - -sub devalidatecourseresdata { - my ($coursenum,$coursedomain)=@_; - my $hashid=$coursenum.':'.$coursedomain; - delete $courseresdatacache{$hashid.'.time'}; -} - # --------------------------------------------------- Course Resourcedata Query sub courseresdata { my ($coursenum,$coursedomain,@which)=@_; my $coursehom=&homeserver($coursenum,$coursedomain); my $hashid=$coursenum.':'.$coursedomain; - my $dodump=0; - if (!defined($courseresdatacache{$hashid.'.time'})) { - $dodump=1; - } else { - if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; } - } - if ($dodump) { + my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,300); + unless (defined($cached)) { my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum); + $result=\%dumpreply; my ($tmp) = keys(%dumpreply); if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $courseresdatacache{$hashid.'.time'}=time; - $courseresdatacache{$hashid}=\%dumpreply; + &do_cache(\%courseresdatacache,$hashid,$result); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; + } elsif ($tmp =~ /^(error)/) { + $result=undef; + &do_cache(\%courseresdatacache,$hashid,$result); } } foreach my $item (@which) { - if (defined($courseresdatacache{$hashid}->{$item})) { - return $courseresdatacache{$hashid}->{$item}; + if (defined($result->{$item})) { + return $result->{$item}; } } return undef; @@ -3783,13 +3806,8 @@ sub gettitle { unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; } return &metadata($urlsymb,'title'); } - if ($titlecache{$symb}) { - if (time < ($titlecache{$symb}[1] + 600)) { - return $titlecache{$symb}[0]; - } else { - delete($titlecache{$symb}); - } - } + my ($result,$cached)=&is_cached(\%titlecache,$symb,600); + if (defined($cached)) { return $result; } my ($map,$resid,$url)=&decode_symb($symb); my $title=''; my %bighash; @@ -3801,8 +3819,7 @@ sub gettitle { } $title=~s/\&colon\;/\:/gs; if ($title) { - $titlecache{$symb}=[$title,time]; - return $title; + return &do_cache(\%titlecache,$symb,$title); } else { return &metadata($urlsymb,'title'); } @@ -4195,6 +4212,12 @@ sub unescape { return $str; } +sub mod_perl_version { + if (defined($perlvar{'MODPERL2'})) { + return 2; + } + return 1; +} # ================================================================ Main Program sub goodbye {