Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.434 and 1.435

version 1.434, 2003/10/29 22:33:49 version 1.435, 2003/10/30 00:26:25
Line 831  sub devalidate_cache { Line 831  sub devalidate_cache {
  delete($hash{$id});   delete($hash{$id});
  delete($hash{$id.'.time'});   delete($hash{$id.'.time'});
     } else {      } else {
  &logthis("Unable to tie hash");   &logthis("Unable to tie hash (devalidate cache): $name");
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 849  sub is_cached { Line 849  sub is_cached {
  return (undef,undef);   return (undef,undef);
     } else {      } else {
  if (time-($$cache{$id.'.time'})>$time) {   if (time-($$cache{$id.'.time'})>$time) {
 #    &logthis("Devailidating $id - ".time-($$cache{$id.'.time'}));  #    &logthis("Devalidating $id - ".time-($$cache{$id.'.time'}));
     &devalidate_cache($cache,$id,$name);      &devalidate_cache($cache,$id,$name);
     return (undef,undef);      return (undef,undef);
  }   }
Line 929  sub save_cache_item { Line 929  sub save_cache_item {
  $hash{$id.'.time'}=$$cache{$id.'.time'};   $hash{$id.'.time'}=$$cache{$id.'.time'};
  $hash{$id}=freeze({'item'=>$$cache{$id}});   $hash{$id}=freeze({'item'=>$$cache{$id}});
     } else {      } else {
  &logthis("Unable to tie hash");   &logthis("Unable to tie hash (save cache item): $name");
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 964  sub load_cache_item { Line 964  sub load_cache_item {
     $$cache{$id.'.time'}=$hash{$id.'.time'};      $$cache{$id.'.time'}=$hash{$id.'.time'};
  }   }
     } else {      } else {
  &logthis("Unable to tie hash");   &logthis("Unable to tie hash (load cache item): $name");
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 2734  sub allowed { Line 2734  sub allowed {
   
 sub is_on_map {  sub is_on_map {
     my $uri=&declutter(shift);      my $uri=&declutter(shift);
       $uri=~s/\.\d+\.(\w+)$/\.$1/;
     my @uriparts=split(/\//,$uri);      my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];      my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;      my $pathname=$uri;
Line 4075  sub decode_symb { Line 4076  sub decode_symb {
 sub fixversion {  sub fixversion {
     my $fn=shift;      my $fn=shift;
     if ($fn=~/^(adm|uploaded|public)/) { return $fn; }      if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
     my ($match,$cond,$versioned)=&is_on_map($fn);      my %bighash;
     unless ($match) {      my $uri=&clutter($fn);
  $fn=$versioned;      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
          &GDBM_READER(),0640)) {
    if ($bighash{'version_'.$uri}) {
       my $version=$bighash{'version_'.$uri};
       unless ($version eq 'mostrecent') {
    $uri=~s/\.(\w+)$/\.$version\.$1/;
       }
    }
    untie %bighash;
     }      }
     return $fn;      return &declutter($uri);
 }  }
   
 # ------------------------------------------------------ Return symb list entry  # ------------------------------------------------------ Return symb list entry

Removed from v.1.434  
changed lines
  Added in v.1.435


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