--- loncom/lonnet/perl/lonnet.pm	2004/09/15 20:08:34	1.541
+++ loncom/lonnet/perl/lonnet.pm	2004/09/21 22:38:10	1.545
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.541 2004/09/15 20:08:34 albertel Exp $
+# $Id: lonnet.pm,v 1.545 2004/09/21 22:38:10 banghart Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -826,6 +826,7 @@ my $disk_caching_disabled=0;
 sub devalidate_cache {
     my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};
+    delete $$cache{$id.'.file'};
     delete $$cache{$id};
     if (1 || $disk_caching_disabled) { return; }
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
@@ -857,16 +858,32 @@ sub is_cached {
     my ($cache,$id,$name,$time) = @_;
     if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {
-	&load_cache_item($cache,$name,$id);
+	&load_cache_item($cache,$name,$id,$time);
     }
     if (!exists($$cache{$id.'.time'})) {
 #	&logthis("Didn't find $id");
 	return (undef,undef);
     } else {
 	if (time-($$cache{$id.'.time'})>$time) {
-#	    &logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
-	    &devalidate_cache($cache,$id,$name);
-	    return (undef,undef);
+	    if (exists($$cache{$id.'.file'})) {
+		foreach my $filename (@{ $$cache{$id.'.file'} }) {
+		    my $mtime=(stat($filename))[9];
+		    #+1 is to take care of edge effects
+		    if ($mtime && (($mtime+1) < ($$cache{$id.'.time'}))) {
+#			&logthis("Upping $mtime - ".$$cache{$id.'.time'}.
+#				 "$id because of $filename");
+		    } else {
+			&logthis("Devalidating $filename $id - ".(time-($$cache{$id.'.time'})));
+			&devalidate_cache($cache,$id,$name);
+			return (undef,undef);
+		    }
+		}
+		$$cache{$id.'.time'}=time;
+	    } else {
+#		&logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
+		&devalidate_cache($cache,$id,$name);
+		return (undef,undef);
+	    }
 	}
     }
     return ($$cache{$id},1);
@@ -910,6 +927,9 @@ sub save_cache {
 		eval <<'EVALBLOCK';
 		$hash{$id.'.time'}=$$cache{$id.'.time'};
 		$hash{$id}=freeze({'item'=>$$cache{$id}});
+		if (exists($$cache{$id.'.file'})) {
+		    $hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}});
+		}
 EVALBLOCK
                 if ($@) {
 		    &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
@@ -934,7 +954,7 @@ EVALBLOCK
 }
 
 sub load_cache_item {
-    my ($cache,$name,$id)=@_;
+    my ($cache,$name,$id,$time)=@_;
     if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
@@ -958,9 +978,17 @@ sub load_cache_item {
 		}
 #	    &logthis("Initial load: $count");
 	    } else {
-		my $hashref=thaw($hash{$id});
-		$$cache{$id}=$hashref->{'item'};
-		$$cache{$id.'.time'}=$hash{$id.'.time'};
+		if (($$cache{$id.'.time'}+$time) < time) {
+		    $$cache{$id.'.time'}=$hash{$id.'.time'};
+		    {
+			my $hashref=thaw($hash{$id});
+			$$cache{$id}=$hashref->{'item'};
+		    }
+		    if (exists($hash{$id.'.file'})) {
+			my $hashref=thaw($hash{$id.'.file'});
+			$$cache{$id.'.file'}=$hashref->{'item'};
+		    }
+		}
 	    }
 EVALBLOCK
         if ($@) {
@@ -2746,7 +2774,9 @@ sub allowed {
     $uri=&deversion($uri);
     my $orguri=$uri;
     $uri=&declutter($uri);
-
+    
+    
+    
     if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
@@ -2754,6 +2784,12 @@ sub allowed {
 	return 'F';
     }
 
+# Free bre access to user's own portfolio contents
+    $uri=~m:([^/]+)/([^/]+)/([^/]+)/([^/]+)/:;
+    if (('uploaded' eq $1)&&($ENV{'user.name'} eq $3) && ($ENV{'user.domain'} eq $2) && ('portfolio' eq $4)) {
+        return 'F';
+    }
+
 # Free bre to public access
 
     if ($priv eq 'bre') {
@@ -4260,7 +4296,9 @@ sub metadata {
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
 	if ($uri !~ m|^uploaded/|) {
-	    $metastring=&getfile(&filelocation('',&clutter($filename)));
+	    my $file=&filelocation('',&clutter($filename));
+	    push(@{$metacache{$uri.'.file'}},$file);
+	    $metastring=&getfile($file);
 	}
         my $parser=HTML::LCParser->new(\$metastring);
         my $token;
@@ -4625,22 +4663,19 @@ sub deversion {
 
 sub symbread {
     my ($thisfn,$donotrecurse)=@_;
-    if (defined($ENV{'request.symbread.cached'})) {
-	return $ENV{'request.symbread.cached'};
-    }
+    my $cache_str='request.symbread.cached.'.$thisfn;
+    if (defined($ENV{$cache_str})) { return $ENV{$cache_str}; }
 # no filename provided? try from environment
     unless ($thisfn) {
         if ($ENV{'request.symb'}) {
-	    $ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'});
-	    return $ENV{'request.symbread.cached'};
+	    return $ENV{$cache_str}=&symbclean($ENV{'request.symb'});
 	}
 	$thisfn=$ENV{'request.filename'};
     }
 # is that filename actually a symb? Verify, clean, and return
     if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
 	if (&symbverify($thisfn,$1)) {
-	    $ENV{'request.symbread.cached'}=&symbclean($thisfn);
-	    return $ENV{'request.symbread.cached'};
+	    return $ENV{$cache_str}=&symbclean($thisfn);
 	}
     }
     $thisfn=declutter($thisfn);
@@ -4662,8 +4697,7 @@ sub symbread {
            unless ($syval=~/\_\d+$/) {
 	       unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) {
                   &appenv('request.ambiguous' => $thisfn);
-		  $ENV{'request.symbread.cached'}='';
-                  return '';
+		  return $ENV{$cache_str}='';
                }    
                $syval.=$1;
 	   }
@@ -4710,13 +4744,11 @@ sub symbread {
            }
         }
         if ($syval) {
-	    $ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn);
-	    return $ENV{'request.symbread.cached'};
+	    return $ENV{$cache_str}=&symbclean($syval.'___'.$thisfn);
         }
     }
     &appenv('request.ambiguous' => $thisfn);
-    $ENV{'request.symbread.cached'}='';
-    return '';
+    return $ENV{$cache_str}='';
 }
 
 # ---------------------------------------------------------- Return random seed