--- loncom/lonnet/perl/lonnet.pm 2011/08/05 04:35:50 1.1125 +++ loncom/lonnet/perl/lonnet.pm 2011/08/09 00:54:48 1.1127 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1125 2011/08/05 04:35:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.1127 2011/08/09 00:54:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1142,43 +1142,80 @@ sub spare_can_host { sub this_host_spares { my ($dom) = @_; - my $cachetime = 60*60*24; + my ($dom_in_use,$lonhost_in_use,$result); my @hosts = ¤t_machine_ids(); foreach my $lonhost (@hosts) { if (&host_domain($lonhost) eq $dom) { - my ($result,$cached)=&is_cached_new('spares',$dom); - if (defined($cached)) { - 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); - } - } - } - } + $dom_in_use = $dom; + $lonhost_in_use = $lonhost; last; } } - my $serverhomedom = &host_domain($perlvar{'lonHostID'}); - my ($result,$cached)=&is_cached_new('spares',$serverhomedom); + 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 %homedomconfig = - &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); - if (ref($homedomconfig{'usersessions'}) eq 'HASH') { - if (ref($homedomconfig{'usersessions'}{'spares'}) eq 'HASH') { - if (ref($homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}}) eq 'HASH') { - return &do_cache_new('spares',$serverhomedom,$homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}},$cachetime); + 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 \%spareid; + return; +} + +sub internet_dom_servers { + my ($dom) = @_; + my (%uniqservers,%servers); + my $primaryserver = &hostname(&domain($dom,'primary')); + my @machinedoms = &machine_domains($primaryserver); + foreach my $mdom (@machinedoms) { + my %currservers = %servers; + my %server = &get_servers($mdom); + %servers = (%currservers,%server); + } + my %by_hostname; + foreach my $id (keys(%servers)) { + push(@{$by_hostname{$servers{$id}}},$id); + } + foreach my $hostname (sort(keys(%by_hostname))) { + if (@{$by_hostname{$hostname}} > 1) { + my $match = 0; + foreach my $id (@{$by_hostname{$hostname}}) { + if (&host_domain($id) eq $dom) { + $uniqservers{$id} = $hostname; + $match = 1; + } + } + unless ($match) { + $uniqservers{$by_hostname{$hostname}[0]} = $hostname; + } + } else { + $uniqservers{$by_hostname{$hostname}[0]} = $hostname; + } + } + return %uniqservers; } # ---------------------- Find the homebase for a user from domain's lib servers