--- loncom/lonnet/perl/lonnet.pm 2004/09/15 20:08:34 1.541
+++ loncom/lonnet/perl/lonnet.pm 2004/09/22 20:43:20 1.546
@@ -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.546 2004/09/22 20:43:20 albertel 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,13 @@ sub allowed {
return 'F';
}
+# Free bre access to user's own portfolio contents
+ my ($space,$domain,$name,$dir)=split('/',$uri);
+ if (('uploaded' eq $space) && ($ENV{'user.name'} eq $name) &&
+ ($ENV{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
+ return 'F';
+ }
+
# Free bre to public access
if ($priv eq 'bre') {
@@ -4260,7 +4297,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 +4664,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 +4698,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 +4745,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