Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.433 and 1.436

version 1.433, 2003/10/27 21:59:34 version 1.436, 2003/10/30 20:22:00
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,  
 # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,  
 # 11/8,11/16,11/18,11/22,11/23,12/22,  
 # 01/06,01/13,02/24,02/28,02/29,  
 # 03/01,03/02,03/06,03/07,03/13,  
 # 04/05,05/29,05/31,06/01,  
 # 06/05,06/26 Gerd Kortemeyer  
 # 06/26 Ben Tyszka  
 # 06/30,07/15,07/17,07/18,07/20,07/21,07/22,07/25 Gerd Kortemeyer  
 # 08/14 Ben Tyszka  
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer  
 # 10/04 Gerd Kortemeyer  
 # 10/04 Guy Albertelli  
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29,   
 # 10/30,10/31,  
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,  
 # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer  
 # 05/01/01 Guy Albertelli  
 # 05/01,06/01,09/01 Gerd Kortemeyer  
 # 09/01 Guy Albertelli  
 # 09/01,10/01,11/01 Gerd Kortemeyer  
 # YEAR=2001  
 # 3/2 Gerd Kortemeyer  
 # 3/19,3/20 Gerd Kortemeyer  
 # 5/26,5/28 Gerd Kortemeyer  
 # 5/30 H. K. Ng  
 # 6/1 Gerd Kortemeyer  
 # July Guy Albertelli  
 # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,  
 # 10/2 Gerd Kortemeyer  
 # 11/17,11/20,11/22,11/29 Gerd Kortemeyer  
 # 12/5 Matthew Hall  
 # 12/5 Guy Albertelli  
 # 12/6,12/7,12/12 Gerd Kortemeyer  
 # 12/21,12/22,12/27,12/28 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/4,2/4,2/7 Gerd Kortemeyer  
 #  
 ###  ###
   
 package Apache::lonnet;  package Apache::lonnet;
Line 869  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 887  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 967  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 1002  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 2772  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 2783  sub is_on_map { Line 2746  sub is_on_map {
     if ($match) {      if ($match) {
  return (1,$1);   return (1,$1);
     } else {      } else {
  my ($name,$ext)=($filename=~/^(.+)\.(\w+)$/);   return (0,0);
         $ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~  
        /\&(\Q$name\E\.\d+\.$ext)\:([\d\|]+)\&/;  
  return (0,$2,$pathname.'/'.$1);  
     }      }
 }  }
   
Line 4116  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
Line 4428  sub mod_perl_version { Line 4396  sub mod_perl_version {
     }      }
     return 1;      return 1;
 }  }
   
   sub correct_line_ends {
       my ($result)=@_;
       &logthis("Wha $result");
       $$result =~s/\r\n/\n/mg;
       $$result =~s/\r/\n/mg;
   }
 # ================================================================ Main Program  # ================================================================ Main Program
   
 sub goodbye {  sub goodbye {

Removed from v.1.433  
changed lines
  Added in v.1.436


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