--- loncom/lonnet/perl/lonnet.pm 2011/08/09 00:28:51 1.1126 +++ 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.1126 2011/08/09 00:28:51 raeburn Exp $ +# $Id: lonnet.pm,v 1.1127 2011/08/09 00:54:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1185,6 +1185,39 @@ sub spares_for_offload { 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 my %homecache;