Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1123 and 1.1126

version 1.1123, 2011/08/01 22:13:49 version 1.1126, 2011/08/09 00:28:51
Line 308  sub get_server_homeID { Line 308  sub get_server_homeID {
   
 sub get_remote_globals {  sub get_remote_globals {
     my ($lonhost,$whathash,$ignore_cache) = @_;      my ($lonhost,$whathash,$ignore_cache) = @_;
     my (%returnhash,%whatneeded);      my ($result,%returnhash,%whatneeded);
     if (ref($whathash) eq 'ARRAY') {      if (ref($whathash) eq 'HASH') {
         foreach my $what (sort(keys(%{$whathash}))) {          foreach my $what (sort(keys(%{$whathash}))) {
             my $type = $whathash->{$what};  
             my $hashid = $lonhost.'-'.$what;              my $hashid = $lonhost.'-'.$what;
             my ($result,$cached);               my ($response,$cached);
             unless ($ignore_cache) {              unless ($ignore_cache) {
                 ($result,$cached)=&is_cached_new('lonnetglobal',$hashid);                  ($response,$cached)=&is_cached_new('lonnetglobal',$hashid);
                 $returnhash{$what} = $result;  
             }              }
             if (defined($cached)) {              if (defined($cached)) {
                 $returnhash{$what} = $result;                  $returnhash{$what} = $response;
             } else {              } else {
                 $whatneeded{$what} = $type;                  $whatneeded{$what} = 1;
             }              }
         }          }
         if (keys(%whatneeded) > 0) {          if (keys(%whatneeded) == 0) {
               $result = 'ok';
           } else {
             my $requested = &freeze_escape(\%whatneeded);              my $requested = &freeze_escape(\%whatneeded);
             my $rep=&reply('readlonnetglobal:'.$requested,$lonhost);              my $rep=&reply('readlonnetglobal:'.$requested,$lonhost);
             unless (($rep=~/^refused/) || ($rep=~/^rejected/) || ($rep eq 'con_lost')) {              if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
                   ($rep eq 'unknown_cmd')) {
                   $result = $rep;
               } else {
                   $result = 'ok';
                 my @pairs=split(/\&/,$rep);                  my @pairs=split(/\&/,$rep);
                 if ($rep !~ /^error/) {                  foreach my $item (@pairs) {
                     foreach my $item (@pairs) {                      my ($key,$value)=split(/=/,$item,2);
                         my ($key,$value)=split(/=/,$item,2);                      my $what = &unescape($key);
                         my $what = &unescape($key);                      my $hashid = $lonhost.'-'.$what;
                         my $hashid = $lonhost.'-'.$what;                      $returnhash{$what}=&thaw_unescape($value);
                         $returnhash{$what}=&thaw_unescape($value);                      &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600);
                         &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600);  
                     }  
                 }                  }
             }              }
         }          }
     }      }
     return %returnhash;      return ($result,\%returnhash);
   }
   
   sub remote_devalidate_cache {
       my ($lonhost,$name,$id) = @_;
       my $response = &reply('devalidatecache',&escape($name).':'.&escape($id),$lonhost);
       return $response;
 }  }
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
Line 1134  sub spare_can_host { Line 1142  sub spare_can_host {
   
 sub this_host_spares {  sub this_host_spares {
     my ($dom) = @_;      my ($dom) = @_;
     my $cachetime = 60*60*24;      my ($dom_in_use,$lonhost_in_use,$result);
     my @hosts = &current_machine_ids();      my @hosts = &current_machine_ids();
     foreach my $lonhost (@hosts) {      foreach my $lonhost (@hosts) {
         if (&host_domain($lonhost) eq $dom) {          if (&host_domain($lonhost) eq $dom) {
             my ($result,$cached)=&is_cached_new('spares',$dom);              $dom_in_use = $dom;
             if (defined($cached)) {              $lonhost_in_use = $lonhost;
                 return $result;  
             } else {  
                 my %domconfig =  
                     &Apache::lonnet::get_dom('configuration',['usersessions'],$dom);  
                 if (ref($domconfig{'usersessions'}) eq 'HASH') {  
                     if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {  
                         if (ref($domconfig{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') {  
                             return &do_cache_new('spares',$dom,$domconfig{'usersessions'}{'spares'}{$lonhost},$cachetime);  
                         }  
                     }  
                 }  
             }  
             last;              last;
         }          }
     }      }
     my $serverhomedom = &host_domain($perlvar{'lonHostID'});      if ($dom_in_use ne '') {
     my ($result,$cached)=&is_cached_new('spares',$serverhomedom);          $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
       }
       if (ref($result) ne 'HASH') {
           $lonhost_in_use = $perlvar{'lonHostID'};
           $dom_in_use = &host_domain($lonhost_in_use);
           $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
           if (ref($result) ne 'HASH') {
               $result = \%spareid;
           }
       }
       return $result;
   }
   
   sub spares_for_offload  {
       my ($dom_in_use,$lonhost_in_use) = @_;
       my ($result,$cached)=&is_cached_new('spares',$dom_in_use);
     if (defined($cached)) {      if (defined($cached)) {
         return $result;          return $result;
     } else {      } else {
         my %homedomconfig =          my $cachetime = 60*60*24;
             &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom);          my %domconfig =
         if (ref($homedomconfig{'usersessions'}) eq 'HASH') {              &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
             if (ref($homedomconfig{'usersessions'}{'spares'}) eq 'HASH') {          if (ref($domconfig{'usersessions'}) eq 'HASH') {
                 if (ref($homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}}) eq 'HASH') {              if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
                     return &do_cache_new('spares',$serverhomedom,$homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}},$cachetime);                  if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
                       return &do_cache_new('spares',$dom_in_use,$domconfig{'usersessions'}{'spares'}{$lonhost_in_use},$cachetime);
                 }                  }
             }              }
         }          }
     }      }
     return \%spareid;      return;
 }  }
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers

Removed from v.1.1123  
changed lines
  Added in v.1.1126


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