Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.543 and 1.546

version 1.543, 2004/09/20 19:54:47 version 1.546, 2004/09/22 20:43:20
Line 821  sub getsection { Line 821  sub getsection {
 }  }
   
   
 my $disk_caching_disabled=1;  my $disk_caching_disabled=0;
   
 sub devalidate_cache {  sub devalidate_cache {
     my ($cache,$id,$name) = @_;      my ($cache,$id,$name) = @_;
Line 927  sub save_cache { Line 927  sub save_cache {
  eval <<'EVALBLOCK';   eval <<'EVALBLOCK';
  $hash{$id.'.time'}=$$cache{$id.'.time'};   $hash{$id.'.time'}=$$cache{$id.'.time'};
  $hash{$id}=freeze({'item'=>$$cache{$id}});   $hash{$id}=freeze({'item'=>$$cache{$id}});
    if (exists($$cache{$id.'.file'})) {
       $hash{$id.'.file'}=freeze({'item'=>$$cache{$id.'.file'}});
    }
 EVALBLOCK  EVALBLOCK
                 if ($@) {                  if ($@) {
     &logthis("<font color='red'>save_cache blew up :$@:$name</font>");      &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
Line 977  sub load_cache_item { Line 980  sub load_cache_item {
     } else {      } else {
  if (($$cache{$id.'.time'}+$time) < time) {   if (($$cache{$id.'.time'}+$time) < time) {
     $$cache{$id.'.time'}=$hash{$id.'.time'};      $$cache{$id.'.time'}=$hash{$id.'.time'};
     my $hashref=thaw($hash{$id});      {
     $$cache{$id}=$hashref->{'item'};   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  EVALBLOCK
Line 2765  sub allowed { Line 2774  sub allowed {
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
       
       
       
     if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }      if (defined($ENV{'allowed.'.$priv})) { return $ENV{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|))       if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
Line 2773  sub allowed { Line 2784  sub allowed {
  return 'F';   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  # Free bre to public access
   
     if ($priv eq 'bre') {      if ($priv eq 'bre') {

Removed from v.1.543  
changed lines
  Added in v.1.546


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>