--- loncom/lonnet/perl/lonnet.pm	2003/09/19 16:53:35	1.417
+++ loncom/lonnet/perl/lonnet.pm	2003/09/25 20:25:04	1.424
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.417 2003/09/19 16:53:35 albertel Exp $
+# $Id: lonnet.pm,v 1.424 2003/09/25 20:25:04 matthew 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 
-   %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
+   %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
    %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir);
 
 use IO::Socket;
@@ -856,6 +856,7 @@ sub devalidate_cache {
 
 sub is_cached {
     my ($cache,$id,$time) = @_;
+    if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {
 	return (undef,undef);
     } else {
@@ -878,7 +879,7 @@ sub usection {
     my ($udom,$unam,$courseid)=@_;
     my $hashid="$udom:$unam:$courseid";
     
-    my ($result,$cached)=&is_cached(\%usectioncache,$hashid,300);
+    my ($result,$cached)=&is_cached(\%usectioncache,$hashid);
     if (defined($cached)) { return $result; }
     $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;
@@ -2219,27 +2220,7 @@ sub currentdump {
        return if ($tmp[0] =~ /^(error:|no_such_host)/);
        my %hash = @tmp;
        @tmp=();
-       # Code ripped from lond, essentially.  The only difference
-       # here is the unescaping done by lonnet::dump().  Conceivably
-       # we might run in to problems with parameter names =~ /^v\./
-       while (my ($key,$value) = each(%hash)) {
-           my ($v,$symb,$param) = split(/:/,$key);
-           next if ($v eq 'version' || $symb eq 'keys');
-           next if (exists($returnhash{$symb}) &&
-                    exists($returnhash{$symb}->{$param}) &&
-                    $returnhash{$symb}->{'v.'.$param} > $v);
-           $returnhash{$symb}->{$param}=$value;
-           $returnhash{$symb}->{'v.'.$param}=$v;
-       }
-       #
-       # Remove all of the keys in the hashes which keep track of
-       # the version of the parameter.
-       while (my ($symb,$param_hash) = each(%returnhash)) {
-           # use a foreach because we are going to delete from the hash.
-           foreach my $key (keys(%$param_hash)) {
-               delete($param_hash->{$key}) if ($key =~ /^v\./);
-           }
-       }
+       %returnhash = %{&convert_dump_to_currentdump(\%hash)};
    } else {
        my @pairs=split(/\&/,$rep);
        foreach (@pairs) {
@@ -2252,6 +2233,33 @@ sub currentdump {
    return %returnhash;
 }
 
+sub convert_dump_to_currentdump{
+    my %hash = %{shift()};
+    my %returnhash;
+    # Code ripped from lond, essentially.  The only difference
+    # here is the unescaping done by lonnet::dump().  Conceivably
+    # we might run in to problems with parameter names =~ /^v\./
+    while (my ($key,$value) = each(%hash)) {
+        my ($v,$symb,$param) = split(/:/,$key);
+        next if ($v eq 'version' || $symb eq 'keys');
+        next if (exists($returnhash{$symb}) &&
+                 exists($returnhash{$symb}->{$param}) &&
+                 $returnhash{$symb}->{'v.'.$param} > $v);
+        $returnhash{$symb}->{$param}=$value;
+        $returnhash{$symb}->{'v.'.$param}=$v;
+    }
+    #
+    # Remove all of the keys in the hashes which keep track of
+    # the version of the parameter.
+    while (my ($symb,$param_hash) = each(%returnhash)) {
+        # use a foreach because we are going to delete from the hash.
+        foreach my $key (keys(%$param_hash)) {
+            delete($param_hash->{$key}) if ($key =~ /^v\./);
+        }
+    }
+    return \%returnhash;
+}
+
 # --------------------------------------------------------------- put interface
 
 sub put {
@@ -3300,7 +3308,7 @@ sub condval {
 sub devalidatecourseresdata {
     my ($coursenum,$coursedomain)=@_;
     my $hashid=$coursenum.':'.$coursedomain;
-    delete $courseresdatacache{$hashid.'.time'};
+    &devalidate_cache(\%courseresdatacache,$hashid);
 }
 
 # --------------------------------------------------- Course Resourcedata Query
@@ -3309,7 +3317,7 @@ sub courseresdata {
     my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;
-    my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,300);
+    my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid);
     unless (defined($cached)) {
 	my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
 	$result=\%dumpreply;
@@ -3493,28 +3501,35 @@ sub EXT {
 
 # ----------------------------------------------------------- first, check user
 	    #most student don\'t have any data set, check if there is some data
-            #every thirty minutes
 	    if (! &EXT_cache_status($udom,$uname)) {
-		my %resourcedata=&get('resourcedata',
-				      [$courselevelr,$courselevelm,$courselevel],
-				      $udom,$uname);
-		my ($tmp)=keys(%resourcedata);
+		my $hashid="$udom:$uname";
+		my ($result,$cached)=&is_cached(\%userresdatacache,$hashid);
+		if (!defined($cached)) { 
+		    my %resourcedata=&get('resourcedata',
+					  [$courselevelr,$courselevelm,
+					   $courselevel],$udom,$uname);
+		    $result=\%resourcedata;
+		}
+		my ($tmp)=keys(%$result);
 		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
-		    if ($resourcedata{$courselevelr}) {
-			return $resourcedata{$courselevelr}; }
-		    if ($resourcedata{$courselevelm}) {
-			return $resourcedata{$courselevelm}; }
-		    if ($resourcedata{$courselevel}) {
-			return $resourcedata{$courselevel}; }
+		    &do_cache(\%userresdatacache,$hashid,$result);
+		    if ($$result{$courselevelr}) {
+			return $$result{$courselevelr}; }
+		    if ($$result{$courselevelm}) {
+			return $$result{$courselevelm}; }
+		    if ($$result{$courselevel}) {
+			return $$result{$courselevel}; }
 		} else {
 		    if ($tmp!~/No such file/) {
 			&logthis("<font color=blue>WARNING:".
 				 " Trying to get resource data for ".
 				 $uname." at ".$udom.": ".
 				 $tmp."</font>");
+			&do_cache(\%userresdatacache,$hashid,undef);
 		    } elsif ($tmp=~/error:No such file/) {
                         &EXT_cache_set($udom,$uname);
 		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+			&do_cache(\%userresdatacache,$hashid,undef);
 			return $tmp;
 		    }
 		}
@@ -3621,11 +3636,11 @@ sub add_prefix_and_part {
 
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
-
     $uri=&declutter($uri);
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
-        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) {
+        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
+	($uri =~ m|home/[^/]+/public_html/|)) {
 	return '';
     }
     my $filename=$uri;
@@ -3814,13 +3829,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;
@@ -3832,8 +3842,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');
     }