[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.441 and 1.444

version 1.441, 2003/11/04 18:44:17 version 1.444, 2003/11/10 21:50:21
Line 823  sub devalidate_cache { Line 823  sub devalidate_cache {
     my ($cache,$id,$name) = @_;      my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};      delete $$cache{$id.'.time'};
     delete $$cache{$id};      delete $$cache{$id};
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
  delete($hash{$id});   eval <<'EVALBLOCK';
  delete($hash{$id.'.time'});      delete($hash{$id});
       delete($hash{$id.'.time'});
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>devalidate_cache blew up :$@:$name</font>");
       unlink($filename);
    }
     } else {      } else {
  &logthis("Unable to tie hash (devalidate cache): $name");   if (-e $filename) {
       &logthis("Unable to tie hash (devalidate cache): $name");
       unlink($filename);
    }
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 867  sub do_cache { Line 876  sub do_cache {
     $$cache{$id};      $$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 save_cache_item {  sub save_cache_item {
     my ($cache,$name,$id)=@_;      my ($cache,$name,$id)=@_;
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
  #   &logthis("Saving :$name:$id");  #    &logthis("Saving :$name:$id");
     my %hash;      my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_EX);      flock(DB,LOCK_EX);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_WRCREAT(),0640)) {
  $hash{$id.'.time'}=$$cache{$id.'.time'};   eval <<'EVALBLOCK';
  $hash{$id}=freeze({'item'=>$$cache{$id}});      $hash{$id.'.time'}=$$cache{$id.'.time'};
       $hash{$id}=freeze({'item'=>$$cache{$id}});
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>save_cache blew up :$@:$name</font>");
       unlink($filename);
    }
     } else {      } else {
  &logthis("Unable to tie hash (save cache item): $name");   if (-e $filename) {
       &logthis("Unable to tie hash (save cache item): $name");
       unlink($filename);
    }
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 942  sub load_cache_item { Line 910  sub load_cache_item {
     my $starttime=&Time::HiRes::time();      my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));  #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;      my %hash;
     my $filename=$perlvar{'lonDaemons'}.'/tmp/'.$name.".db";      my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");      open(DB,"$filename.lock");
     flock(DB,LOCK_SH);      flock(DB,LOCK_SH);
     if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {      if (tie(%hash,'GDBM_File',$filename,&GDBM_READER(),0640)) {
  if (!%$cache) {   eval <<'EVALBLOCK';
     my $count;      if (!%$cache) {
     while (my ($key,$value)=each(%hash)) {    my $count;
  $count++;   while (my ($key,$value)=each(%hash)) { 
  if ($key =~ /\.time$/) {      $count++;
     $$cache{$key}=$value;      if ($key =~ /\.time$/) {
  } else {   $$cache{$key}=$value;
     my $hashref=thaw($value);      } else {
     $$cache{$key}=$hashref->{'item'};   my $hashref=thaw($value);
    $$cache{$key}=$hashref->{'item'};
       }
  }   }
     }  
 #    &logthis("Initial load: $count");  #    &logthis("Initial load: $count");
  } else {      } else {
     my $hashref=thaw($hash{$id});   my $hashref=thaw($hash{$id});
     $$cache{$id}=$hashref->{'item'};   $$cache{$id}=$hashref->{'item'};
     $$cache{$id.'.time'}=$hash{$id.'.time'};   $$cache{$id.'.time'}=$hash{$id.'.time'};
       }
   EVALBLOCK
           if ($@) {
       &logthis("<font color='red'>load_cache blew up :$@:$name</font>");
       unlink($filename);
    }        
       } else {
    if (-e $filename) {
       &logthis("Unable to tie hash (load cache item): $name");
       unlink($filename);
  }   }
     } else {  
  &logthis("Unable to tie hash (load cache item): $name");  
     }      }
     untie(%hash);      untie(%hash);
     flock(DB,LOCK_UN);      flock(DB,LOCK_UN);
Line 4092  sub fixversion { Line 4069  sub fixversion {
     &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') || 
       ($version==&getversion($uri))) {
   $uri=~s/\.(\w+)$/\.$version\.$1/;    $uri=~s/\.(\w+)$/\.$version\.$1/;
      }       }
   }    }
Line 4205  sub numval { Line 4183  sub numval {
 }  }
   
 sub latest_rnd_algorithm_id {  sub latest_rnd_algorithm_id {
     return '64bit';      return '64bit2';
 }  }
   
 sub rndseed {  sub rndseed {
Line 4222  sub rndseed { Line 4200  sub rndseed {
     my $CODE=$ENV{'scantron.CODE'};      my $CODE=$ENV{'scantron.CODE'};
     if (defined($CODE)) {      if (defined($CODE)) {
  &rndseed_CODE_64bit($symb,$courseid,$domain,$username);   &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
       } elsif ($which eq '64bit2') {
    return &rndseed_64bit2($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit') {      } elsif ($which eq '64bit') {
  return &rndseed_64bit($symb,$courseid,$domain,$username);   return &rndseed_64bit($symb,$courseid,$domain,$username);
     }      }
Line 4265  sub rndseed_64bit { Line 4245  sub rndseed_64bit {
     }      }
 }  }
   
   sub rndseed_64bit2 {
       my ($symb,$courseid,$domain,$username)=@_;
       {
    use integer;
    # strings need to be an even # of cahracters long, it it is odd the
           # last characters gets thrown away
    my $symbchck=unpack("%32S*",$symb.' ') << 21;
    my $symbseed=numval($symb) << 10;
    my $namechck=unpack("%32S*",$username.' ');
   
    my $nameseed=numval($username) << 21;
    my $domainseed=unpack("%32S*",$domain.' ') << 10;
    my $courseseed=unpack("%32S*",$courseid.' ');
   
    my $num1=$symbchck+$symbseed+$namechck;
    my $num2=$nameseed+$domainseed+$courseseed;
    #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
    #&Apache::lonxml::debug("rndseed :$num:$symb");
    return "$num1,$num2";
       }
   }
   
 sub rndseed_CODE_64bit {  sub rndseed_CODE_64bit {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
     {      {
  use integer;   use integer;
  my $symbchck=unpack("%32S*",$symb) << 16;   my $symbchck=unpack("%32S*",$symb.' ') << 16;
  my $symbseed=numval($symb);   my $symbseed=numval($symb);
  my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;   my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
  my $courseseed=unpack("%32S*",$courseid);   my $courseseed=unpack("%32S*",$courseid.' ');
  my $num1=$symbseed+$CODEseed;   my $num1=$symbseed+$CODEseed;
  my $num2=$courseseed+$symbchck;   my $num2=$courseseed+$symbchck;
  #&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");   #&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
Line 4416  sub mod_perl_version { Line 4418  sub mod_perl_version {
   
 sub correct_line_ends {  sub correct_line_ends {
     my ($result)=@_;      my ($result)=@_;
     &logthis("Wha $result");  
     $$result =~s/\r\n/\n/mg;      $$result =~s/\r\n/\n/mg;
     $$result =~s/\r/\n/mg;      $$result =~s/\r/\n/mg;
 }  }
Line 4424  sub correct_line_ends { Line 4425  sub correct_line_ends {
   
 sub goodbye {  sub goodbye {
    &logthis("Starting Shut down");     &logthis("Starting Shut down");
 #not converted to using infrastruture  #not converted to using infrastruture and probably shouldn't be
    &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));  
    &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));     &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
    &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));  
 #converted  #converted
      &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
      &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
    &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));     &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
    &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));     &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
 #1.1 only  #1.1 only
Removed from v.1.441  
changed lines
  Added in v.1.444

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