[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.1121 and 1.1126

version 1.1121, 2011/07/31 22:55:53 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 811  sub spareserver { Line 819  sub spareserver {
         my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);          my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
         $remotesessions = $udomdefaults{'remotesessions'};          $remotesessions = $udomdefaults{'remotesessions'};
     }      }
     foreach my $try_server (@{ $spareid{'primary'} }) {      my $spareshash = &this_host_spares($udom);
         if ($uint_dom) {      if (ref($spareshash) eq 'HASH') {
              next unless (&spare_can_host($udom,$uint_dom,$remotesessions,          if (ref($spareshash->{'primary'}) eq 'ARRAY') {
                                           $try_server));              foreach my $try_server (@{ $spareshash->{'primary'} }) {
                   if ($uint_dom) {
                       next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
                                                    $try_server));
                   }
           ($spare_server, $lowest_load) =
               &compare_server_load($try_server, $spare_server, $lowest_load);
               }
         }          }
  ($spare_server, $lowest_load) =  
     &compare_server_load($try_server, $spare_server, $lowest_load);  
     }  
   
     my $found_server = ($spare_server ne '' && $lowest_load < 100);          my $found_server = ($spare_server ne '' && $lowest_load < 100);
   
     if (!$found_server) {          if (!$found_server) {
  foreach my $try_server (@{ $spareid{'default'} }) {              if (ref($spareshash->{'default'}) eq 'ARRAY') { 
             if ($uint_dom) {          foreach my $try_server (@{ $spareshash->{'default'} }) {
                 next unless (&spare_can_host($udom,$uint_dom,$remotesessions,                      if ($uint_dom) {
                                              $try_server));                          next unless (&spare_can_host($udom,$uint_dom,
             }                                                       $remotesessions,$try_server));
     ($spare_server, $lowest_load) =                      }
  &compare_server_load($try_server, $spare_server, $lowest_load);              ($spare_server, $lowest_load) =
  }          &compare_server_load($try_server, $spare_server, $lowest_load);
                   }
       }
           }
     }      }
   
     if (!$want_server_name) {      if (!$want_server_name) {
Line 881  sub compare_server_load { Line 896  sub compare_server_load {
 # --------------------------- ask offload servers if user already has a session  # --------------------------- ask offload servers if user already has a session
 sub find_existing_session {  sub find_existing_session {
     my ($udom,$uname) = @_;      my ($udom,$uname) = @_;
     foreach my $try_server (@{ $spareid{'primary'} },      my $spareshash = &this_host_spares($udom);
     @{ $spareid{'default'} }) {      if (ref($spareshash) eq 'HASH') {
  return $try_server if (&has_user_session($try_server, $udom, $uname));          if (ref($spareshash->{'primary'}) eq 'ARRAY') {
               foreach my $try_server (@{ $spareshash->{'primary'} }) {
                   return $try_server if (&has_user_session($try_server, $udom, $uname));
               }
           }
           if (ref($spareshash->{'default'}) eq 'ARRAY') {
               foreach my $try_server (@{ $spareshash->{'default'} }) {
                   return $try_server if (&has_user_session($try_server, $udom, $uname));
               }
           }
     }      }
     return;      return;
 }  }
Line 1116  sub spare_can_host { Line 1140  sub spare_can_host {
     return $canhost;      return $canhost;
 }  }
   
   sub this_host_spares {
       my ($dom) = @_;
       my ($dom_in_use,$lonhost_in_use,$result);
       my @hosts = &current_machine_ids();
       foreach my $lonhost (@hosts) {
           if (&host_domain($lonhost) eq $dom) {
               $dom_in_use = $dom;
               $lonhost_in_use = $lonhost;
               last;
           }
       }
       if ($dom_in_use ne '') {
           $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)) {
           return $result;
       } else {
           my $cachetime = 60*60*24;
           my %domconfig =
               &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
           if (ref($domconfig{'usersessions'}) eq 'HASH') {
               if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
                   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;
   }
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
   
 my %homecache;  my %homecache;
Removed from v.1.1121  
changed lines
  Added in v.1.1126

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