Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.439 and 1.440

version 1.439, 2003/11/01 16:37:21 version 1.440, 2003/11/01 18:34:49
Line 35  use LWP::UserAgent(); Line 35  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom   qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab %titlecache      %libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache      %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseresdatacache 
    %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def      %userresdatacache %usectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
Line 1042  sub getversion { Line 1042  sub getversion {
   
 sub currentversion {  sub currentversion {
     my $fname=shift;      my $fname=shift;
       my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600);
       if (defined($cached)) { return $result; }
     my $author=$fname;      my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
Line 1053  sub currentversion { Line 1055  sub currentversion {
     if (($answer eq 'con_lost') || ($answer eq 'rejected')) {      if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
  return -1;   return -1;
     }      }
     return $answer;      return &do_cache(\%resversioncache,$fname,$answer,'resversion');
 }  }
   
 # ----------------------------- Subscribe to a resource, return URL if possible  # ----------------------------- Subscribe to a resource, return URL if possible
Line 4080  sub fixversion { Line 4082  sub fixversion {
     if ($fn=~/^(adm|uploaded|public)/) { return $fn; }      if ($fn=~/^(adm|uploaded|public)/) { return $fn; }
     my %bighash;      my %bighash;
     my $uri=&clutter($fn);      my $uri=&clutter($fn);
       my $key=$ENV{'request.course.id'}.'_'.$uri;
   # is this cached?
       my ($result,$cached)=&is_cached(\%courseresversioncache,$key,
       'courseresversion',600);
       if (defined($cached)) { return $result; }
   # unfortunately not cached, or expired
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',      if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
        &GDBM_READER(),0640)) {      &GDBM_READER(),0640)) {
  if ($bighash{'version_'.$uri}) {    if ($bighash{'version_'.$uri}) {
     my $version=$bighash{'version_'.$uri};       my $version=$bighash{'version_'.$uri};
     unless ($version eq 'mostrecent') {       unless ($version eq 'mostrecent') {
  $uri=~s/\.(\w+)$/\.$version\.$1/;    $uri=~s/\.(\w+)$/\.$version\.$1/;
     }       }
  }    }
  untie %bighash;    untie %bighash;
     }      }
     return &declutter($uri);      return &do_cache
    (\%courseresversioncache,$key,&declutter($uri),'courseresversion');
 }  }
   
 sub deversion {  sub deversion {
Line 4425  sub goodbye { Line 4434  sub goodbye {
 #1.1 only  #1.1 only
    &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));     &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
    &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache)));     &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache)));
      &logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));
      &logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));
    &flushcourselogs();     &flushcourselogs();
    &logthis("Shutting down");     &logthis("Shutting down");
    return DONE;     return DONE;

Removed from v.1.439  
changed lines
  Added in v.1.440


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