--- loncom/lonnet/perl/lonnet.pm	2003/09/17 01:45:14	1.414
+++ 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.414 2003/09/17 01:45:14 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;
@@ -848,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',
@@ -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
@@ -3263,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;
@@ -3784,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;
@@ -3802,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');
     }
@@ -4196,6 +4212,12 @@ sub unescape {
     return $str;
 }
 
+sub mod_perl_version {
+    if (defined($perlvar{'MODPERL2'})) {
+	return 2;
+    }
+    return 1;
+}
 # ================================================================ Main Program
 
 sub goodbye {