[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.846 and 1.851

version 1.846, 2007/03/08 01:58:41 version 1.851, 2007/03/28 00:05:45
Line 35  use HTTP::Headers; Line 35  use HTTP::Headers;
 use HTTP::Date;  use HTTP::Date;
 # use Date::Parse;  # use Date::Parse;
 use vars   use vars 
 qw(%perlvar %badServerCache %iphost %spareid   qw(%perlvar %badServerCache %spareid 
    %pr %prp $memcache %packagetab      %pr %prp $memcache %packagetab 
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount      %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf     %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
Line 144  sub logperm { Line 144  sub logperm {
     return 1;      return 1;
 }  }
   
   sub create_connection {
       my ($server) = @_;
       my $client=IO::Socket::UNIX->new(Peer    => $perlvar{'lonSockCreate'},
        Type    => SOCK_STREAM,
        Timeout => 10);
       return 0 if (!$client);
       print $client ("$server\n");
       my $result = <$client>;
       chomp($result);
       return 1 if ($result eq 'done');
       return 0;
   }
   
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
Line 170  sub subreply { Line 184  sub subreply {
       Timeout => 10);        Timeout => 10);
  if($client) {   if($client) {
     last; # Connected!      last; # Connected!
    } else {
       &create_connection(&hostname($server));
  }   }
  sleep(1); # Try again later if failed connection.          sleep(1); # Try again later if failed connection.
     }      }
     my $answer;      my $answer;
     if ($client) {      if ($client) {
Line 1010  my %remembered; Line 1026  my %remembered;
 my %accessed;  my %accessed;
 my $kicks=0;  my $kicks=0;
 my $hits=0;  my $hits=0;
   sub make_key {
       my ($name,$id) = @_;
       if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); }
       return &escape($name.':'.$id);
   }
   
 sub devalidate_cache_new {  sub devalidate_cache_new {
     my ($name,$id,$debug) = @_;      my ($name,$id,$debug) = @_;
     if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }      if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
     $id=&escape($name.':'.$id);      $id=&make_key($name,$id);
     $memcache->delete($id);      $memcache->delete($id);
     delete($remembered{$id});      delete($remembered{$id});
     delete($accessed{$id});      delete($accessed{$id});
Line 1021  sub devalidate_cache_new { Line 1043  sub devalidate_cache_new {
   
 sub is_cached_new {  sub is_cached_new {
     my ($name,$id,$debug) = @_;      my ($name,$id,$debug) = @_;
     $id=&escape($name.':'.$id);      $id=&make_key($name,$id);
     if (exists($remembered{$id})) {      if (exists($remembered{$id})) {
  if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }   if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
  $accessed{$id}=[&gettimeofday()];   $accessed{$id}=[&gettimeofday()];
Line 1044  sub is_cached_new { Line 1066  sub is_cached_new {
   
 sub do_cache_new {  sub do_cache_new {
     my ($name,$id,$value,$time,$debug) = @_;      my ($name,$id,$value,$time,$debug) = @_;
     $id=&escape($name.':'.$id);      $id=&make_key($name,$id);
     my $setvalue=$value;      my $setvalue=$value;
     if (!defined($setvalue)) {      if (!defined($setvalue)) {
  $setvalue='__undef__';   $setvalue='__undef__';
Line 6176  sub packages_tab_default { Line 6198  sub packages_tab_default {
     $do_default=1;      $do_default=1;
  } elsif ($pack_type eq 'extension') {   } elsif ($pack_type eq 'extension') {
     push(@extension,[$package,$pack_type,$pack_part]);      push(@extension,[$package,$pack_type,$pack_part]);
  } else {   } elsif ($pack_part eq $part) {
       # only look at packages defaults for packages that this id is
     push(@specifics,[$package,$pack_type,$pack_part]);      push(@specifics,[$package,$pack_type,$pack_part]);
  }   }
     }      }
Line 7671  BEGIN { Line 7694  BEGIN {
     }      }
 }  }
   
 sub get_hosts_from_ip {  { 
     my ($ip) = @_;      my %iphost;
     my %iphosts = &get_iphost();      sub get_hosts_from_ip {
     if (ref($iphosts{$ip})) {   my ($ip) = @_;
  return @{$iphosts{$ip}};   my %iphosts = &get_iphost();
    if (ref($iphosts{$ip})) {
       return @{$iphosts{$ip}};
    }
    return;
     }      }
     return;      
 }      sub get_iphost {
    if (%iphost) { return %iphost; }
 sub get_iphost {   my %name_to_ip;
     if (%iphost) { return %iphost; }   my %hostname = &all_hostnames();
     my %name_to_ip;   foreach my $id (keys(%hostname)) {
     my %hostname = &all_hostnames();      my $name=$hostname{$id};
     foreach my $id (keys(%hostname)) {      my $ip;
  my $name=$hostname{$id};      if (!exists($name_to_ip{$name})) {
  my $ip;   $ip = gethostbyname($name);
  if (!exists($name_to_ip{$name})) {   if (!$ip || length($ip) ne 4) {
     $ip = gethostbyname($name);      &logthis("Skipping host $id name $name no IP found");
     if (!$ip || length($ip) ne 4) {      next;
  &logthis("Skipping host $id name $name no IP found");   }
  next;   $ip=inet_ntoa($ip);
    $name_to_ip{$name} = $ip;
       } else {
    $ip = $name_to_ip{$name};
     }      }
     $ip=inet_ntoa($ip);      push(@{$iphost{$ip}},$id);
     $name_to_ip{$name} = $ip;  
  } else {  
     $ip = $name_to_ip{$name};  
  }   }
  push(@{$iphost{$ip}},$id);   return %iphost;
     }      }
     return %iphost;  
 }  }
   
 # ------------------------------------------------------ Read spare server file  # ------------------------------------------------------ Read spare server file
Removed from v.1.846  
changed lines
  Added in v.1.851

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