[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.587.2.3.2.2 and 1.587.2.3.2.3

version 1.587.2.3.2.2, 2005/02/13 22:12:34 version 1.587.2.3.2.3, 2005/02/13 23:09:03
Line 36  use HTTP::Date; Line 36  use HTTP::Date;
 # use Date::Parse;  # use Date::Parse;
 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 %courseresversioncache %resversioncache     %libserv %pr %prp $memcache %packagetab %courseresversioncache %resversioncache
    %courselogs %accesshash %userrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache      %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache 
    %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def      %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def 
Line 1023  EVALBLOCK Line 1023  EVALBLOCK
 }  }
   
 sub devalidate_cache_new {  sub devalidate_cache_new {
     my ($cache,$name,$id) = @_;      my ($name,$id) = @_;
     if (1) { &Apache::lonnet::logthis("deleting $name:$id"); }      if (1) { &Apache::lonnet::logthis("deleting $name:$id"); }
     $cache->delete(&escape($name.':'.$id));      $memcache->delete(&escape($name.':'.$id));
 }  }
   
 my $to_remember=10;  my $to_remember=10;
Line 1034  my %accessed; Line 1034  my %accessed;
 my $kicks=0;  my $kicks=0;
 my $hits=0;  my $hits=0;
 sub is_cached_new {  sub is_cached_new {
     my ($cache,$name,$id,$debug) = @_;      my ($name,$id,$debug) = @_;
     $debug=0;      $debug=0;
     $id=&escape($name.':'.$id);      $id=&escape($name.':'.$id);
     if (exists($remembered{$id})) {      if (exists($remembered{$id})) {
Line 1043  sub is_cached_new { Line 1043  sub is_cached_new {
  $hits++;   $hits++;
  return ($remembered{$id},1);   return ($remembered{$id},1);
     }      }
     my $value = $cache->get($id);      my $value = $memcache->get($id);
     if (!(defined($value))) {      if (!(defined($value))) {
  if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }   if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
  return (undef,undef);   return (undef,undef);
Line 1058  sub is_cached_new { Line 1058  sub is_cached_new {
 }  }
   
 sub do_cache_new {  sub do_cache_new {
     my ($cache,$name,$id,$value,$time,$debug) = @_;      my ($name,$id,$value,$time,$debug) = @_;
     $debug=0;      $debug=0;
     $id=&escape($name.':'.$id);      $id=&escape($name.':'.$id);
     my $setvalue=$value;      my $setvalue=$value;
Line 1066  sub do_cache_new { Line 1066  sub do_cache_new {
  $setvalue='__undef__';   $setvalue='__undef__';
     }      }
     if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }      if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
     $cache->set($id,$setvalue,300);      $memcache->set($id,$setvalue,300);
     return $value;      return $value;
 }  }
   
Line 4560  sub metadata { Line 4560  sub metadata {
 # Everything is cached by the main uri, libraries are never directly cached  # Everything is cached by the main uri, libraries are never directly cached
 #  #
     if (!defined($liburi)) {      if (!defined($liburi)) {
  my ($result,$cached)=&is_cached_new($metacache,'meta',$uri);   my ($result,$cached)=&is_cached_new('meta',$uri);
  if (defined($cached)) { return $result->{':'.$what}; }   if (defined($cached)) { return $result->{':'.$what}; }
     }      }
     {      {
Line 4574  sub metadata { Line 4574  sub metadata {
     $liburi=&declutter($liburi);      $liburi=&declutter($liburi);
             $filename=$liburi;              $filename=$liburi;
         } else {          } else {
     &devalidate_cache_new($metacache,'meta',$uri);      &devalidate_cache_new('meta',$uri);
     undef(%metaentry);      undef(%metaentry);
  }   }
         my %metathesekeys=();          my %metathesekeys=();
Line 4733  sub metadata { Line 4733  sub metadata {
  $metaentry{':keys'}=join(',',keys %metathesekeys);   $metaentry{':keys'}=join(',',keys %metathesekeys);
  &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);   &metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
  $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);   $metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
  &do_cache_new($metacache,'meta',$uri,\%metaentry);   &do_cache_new('meta',$uri,\%metaentry);
 # this is the end of "was not already recently cached  # this is the end of "was not already recently cached
     }      }
     return $metaentry{':'.$what};      return $metaentry{':'.$what};
Line 4797  sub gettitle { Line 4797  sub gettitle {
     my $urlsymb=shift;      my $urlsymb=shift;
     my $symb=&symbread($urlsymb);      my $symb=&symbread($urlsymb);
     if ($symb) {      if ($symb) {
  my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);   my ($result,$cached)=&is_cached_new('title',$symb);
  if (defined($cached)) {    if (defined($cached)) { 
     return $result;      return $result;
  }   }
Line 4812  sub gettitle { Line 4812  sub gettitle {
  }   }
  $title=~s/\&colon\;/\:/gs;   $title=~s/\&colon\;/\:/gs;
  if ($title) {   if ($title) {
     return &do_cache(\%titlecache,$symb,$title,'title');      return &do_cache_new('title',$symb,$title,600);
  }   }
  $urlsymb=$url;   $urlsymb=$url;
     }      }
Line 5655  sub goodbye { Line 5655  sub goodbye {
 #converted  #converted
 #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));  #   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
    &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));     &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));
    &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));  #   &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
    &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));     &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
 #1.1 only  #1.1 only
    &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));     &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));
Line 5810  BEGIN { Line 5810  BEGIN {
   
 }  }
   
 $metacache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});  $memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
   
 $processmarker='_'.time.'_'.$perlvar{'lonHostID'};  $processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;  $dumpcount=0;
Removed from v.1.587.2.3.2.2  
changed lines
  Added in v.1.587.2.3.2.3

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