[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.424 and 1.425

version 1.424, 2003/09/25 20:25:04 version 1.425, 2003/10/04 02:27:02
Line 86  use HTML::LCParser; Line 86  use HTML::LCParser;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::loncoursedata;  use Apache::loncoursedata;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Storable qw(lock_store lock_nstore lock_retrieve);
   use Time::HiRes();
 my $readit;  my $readit;
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
Line 855  sub devalidate_cache { Line 856  sub devalidate_cache {
 }  }
   
 sub is_cached {  sub is_cached {
     my ($cache,$id,$time) = @_;      my ($cache,$id,$name,$time) = @_;
     if (!$time) { $time=300; }      if (!$time) { $time=300; }
     if (!exists($$cache{$id.'.time'})) {      if (!exists($$cache{$id.'.time'})) {
    &load_cache($cache,$name);
       }
       if (!exists($$cache{$id.'.time'})) {
   # &logthis("Didn't find $id");
  return (undef,undef);   return (undef,undef);
     } else {      } else {
  if (time-$$cache{$id.'.time'}>$time) {   if (time-($$cache{$id.'.time'})>$time) {
   #    &logthis("Devailidating $id");
     &devalidate_cache($cache,$id);      &devalidate_cache($cache,$id);
     return (undef,undef);      return (undef,undef);
  }   }
Line 869  sub is_cached { Line 875  sub is_cached {
 }  }
   
 sub do_cache {  sub do_cache {
     my ($cache,$id,$value) = @_;      my ($cache,$id,$value,$name) = @_;
     $$cache{$id.'.time'}=time;      $$cache{$id.'.time'}=time;
     # do_cache implictly return the set value  
     $$cache{$id}=$value;      $$cache{$id}=$value;
       &save_cache($cache,$name);
       # do_cache implictly return the set value
       $$cache{$id};
   }
   
   sub save_cache {
       my ($cache,$name)=@_;
   #    my $starttime=&Time::HiRes::time();
   #    &logthis("Saving :$name:");
       eval lock_store($cache,$perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");
       if ($@) { &logthis("lock_store threw a die ".$@); }
   #    &logthis("save_cache took ".(&Time::HiRes::time()-$starttime));
   }
   
   sub load_cache {
       my ($cache,$name)=@_;
   #    my $starttime=&Time::HiRes::time();
   #    &logthis("Before Loading $name size is ".scalar(%$cache));
       my $tmpcache;
       eval {
    $tmpcache=lock_retrieve($perlvar{'lonDaemons'}.'/tmp/'.$name.".storable");
       };
       if ($@) { &logthis("lock_retreive threw a die ".$@); return; }
       if (!%$cache) {
    my $count;
    while (my ($key,$value)=each(%$tmpcache)) { 
       $count++;
       $$cache{$key}=$value;
    }
   # &logthis("Initial load: $count");
       } else {
    my $key;
    my $count;
    while ($key=each(%$tmpcache)) {
       if ($key !~/^(.*)\.time$/) { next; }
       my $name=$1;
       if (exists($$cache{$key})) {
    if ($$tmpcache{$key} >= $$cache{$key}) {
       $$cache{$key}=$$tmpcache{$key};
       $$cache{$name}=$$tmpcache{$name};
    } else {
   #    &logthis("Would have overwritten $name with is set to expire at ".$$cache{$key}." with ".$$tmpcache{$key}." Whew!");
    }
       } else {
    $count++;
    $$cache{$key}=$$tmpcache{$key};
    $$cache{$name}=$$tmpcache{$name};
       }
    }
   # &logthis("Additional load: $count");
       }
   #    &logthis("After Loading $name size is ".scalar(%$cache));
   #    &logthis("load_cache took ".(&Time::HiRes::time()-$starttime));
 }  }
   
 sub usection {  sub usection {
     my ($udom,$unam,$courseid)=@_;      my ($udom,$unam,$courseid)=@_;
     my $hashid="$udom:$unam:$courseid";      my $hashid="$udom:$unam:$courseid";
           
     my ($result,$cached)=&is_cached(\%usectioncache,$hashid);      my ($result,$cached)=&is_cached(\%usectioncache,$hashid,'usection');
     if (defined($cached)) { return $result; }      if (defined($cached)) { return $result; }
     $courseid=~s/\_/\//g;      $courseid=~s/\_/\//g;
     $courseid=~s/^(\w)/\/$1/;      $courseid=~s/^(\w)/\/$1/;
Line 900  sub usection { Line 958  sub usection {
                 if ($now>$end) { $notactive=1; }                  if ($now>$end) { $notactive=1; }
             }               } 
             unless ($notactive) {              unless ($notactive) {
  return &do_cache(\%usectioncache,$hashid,$section);   return &do_cache(\%usectioncache,$hashid,$section,'usection');
     }      }
         }          }
     }      }
     return &do_cache(\%usectioncache,$hashid,'-1');      return &do_cache(\%usectioncache,$hashid,'-1','usection');
 }  }
   
 # ------------------------------------- Read an entry from a user's environment  # ------------------------------------- Read an entry from a user's environment
Line 3317  sub courseresdata { Line 3375  sub courseresdata {
     my ($coursenum,$coursedomain,@which)=@_;      my ($coursenum,$coursedomain,@which)=@_;
     my $coursehom=&homeserver($coursenum,$coursedomain);      my $coursehom=&homeserver($coursenum,$coursedomain);
     my $hashid=$coursenum.':'.$coursedomain;      my $hashid=$coursenum.':'.$coursedomain;
     my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid);      my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,'courseres');
     unless (defined($cached)) {      unless (defined($cached)) {
  my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);   my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
  $result=\%dumpreply;   $result=\%dumpreply;
  my ($tmp) = keys(%dumpreply);   my ($tmp) = keys(%dumpreply);
  if ($tmp !~ /^(con_lost|error|no_such_host)/i) {   if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
     &do_cache(\%courseresdatacache,$hashid,$result);      &do_cache(\%courseresdatacache,$hashid,$result,'courseres');
  } elsif ($tmp =~ /^(con_lost|no_such_host)/) {   } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
     return $tmp;      return $tmp;
  } elsif ($tmp =~ /^(error)/) {   } elsif ($tmp =~ /^(error)/) {
     $result=undef;      $result=undef;
     &do_cache(\%courseresdatacache,$hashid,$result);      &do_cache(\%courseresdatacache,$hashid,$result,'courseres');
  }   }
     }      }
     foreach my $item (@which) {      foreach my $item (@which) {
Line 3503  sub EXT { Line 3561  sub EXT {
     #most student don\'t have any data set, check if there is some data      #most student don\'t have any data set, check if there is some data
     if (! &EXT_cache_status($udom,$uname)) {      if (! &EXT_cache_status($udom,$uname)) {
  my $hashid="$udom:$uname";   my $hashid="$udom:$uname";
  my ($result,$cached)=&is_cached(\%userresdatacache,$hashid);   my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,
    'userres');
  if (!defined($cached)) {    if (!defined($cached)) { 
     my %resourcedata=&get('resourcedata',      my %resourcedata=&get('resourcedata',
   [$courselevelr,$courselevelm,    [$courselevelr,$courselevelm,
    $courselevel],$udom,$uname);     $courselevel],$udom,$uname);
     $result=\%resourcedata;      $result=\%resourcedata;
       &do_cache(\%userresdatacache,$hashid,$result,'userres');
  }   }
  my ($tmp)=keys(%$result);   my ($tmp)=keys(%$result);
  if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {   if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
     &do_cache(\%userresdatacache,$hashid,$result);  
     if ($$result{$courselevelr}) {      if ($$result{$courselevelr}) {
  return $$result{$courselevelr}; }   return $$result{$courselevelr}; }
     if ($$result{$courselevelm}) {      if ($$result{$courselevelm}) {
Line 3525  sub EXT { Line 3584  sub EXT {
  " Trying to get resource data for ".   " Trying to get resource data for ".
  $uname." at ".$udom.": ".   $uname." at ".$udom.": ".
  $tmp."</font>");   $tmp."</font>");
  &do_cache(\%userresdatacache,$hashid,undef);  
     } elsif ($tmp=~/error:No such file/) {      } elsif ($tmp=~/error:No such file/) {
                         &EXT_cache_set($udom,$uname);                          &EXT_cache_set($udom,$uname);
     } elsif ($tmp =~ /^(con_lost|no_such_host)/) {      } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
  &do_cache(\%userresdatacache,$hashid,undef);  
  return $tmp;   return $tmp;
     }      }
  }   }
Line 3829  sub gettitle { Line 3886  sub gettitle {
  unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }   unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
         return &metadata($urlsymb,'title');           return &metadata($urlsymb,'title'); 
     }      }
     my ($result,$cached)=&is_cached(\%titlecache,$symb,600);      my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);
     if (defined($cached)) { return $result; }      if (defined($cached)) { return $result; }
     my ($map,$resid,$url)=&decode_symb($symb);      my ($map,$resid,$url)=&decode_symb($symb);
     my $title='';      my $title='';
Line 3842  sub gettitle { Line 3899  sub gettitle {
     }      }
     $title=~s/\&colon\;/\:/gs;      $title=~s/\&colon\;/\:/gs;
     if ($title) {      if ($title) {
         return &do_cache(\%titlecache,$symb,$title);          return &do_cache(\%titlecache,$symb,$title,'title');
     } else {      } else {
  return &metadata($urlsymb,'title');   return &metadata($urlsymb,'title');
     }      }
Line 4245  sub mod_perl_version { Line 4302  sub mod_perl_version {
   
 sub goodbye {  sub goodbye {
    &logthis("Starting Shut down");     &logthis("Starting Shut down");
   #not converted to using infrastruture
      &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
      &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
      &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
   #converted
      &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
      &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
   #1.1 only
      &logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));
      &logthis(sprintf("%-20s is %s",'%usectioncache',scalar(%usectioncache)));
    &flushcourselogs();     &flushcourselogs();
    &logthis("Shutting down");     &logthis("Shutting down");
    return DONE;     return DONE;
Removed from v.1.424  
changed lines
  Added in v.1.425

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