[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Tue Sep 25 23:15:26 2012 EDT

  Modified files:              (Branch: version_2_11_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - For 2.11.
    - Backport 1.1191.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1172.2.11 loncom/lonnet/perl/lonnet.pm:1.1172.2.12
--- loncom/lonnet/perl/lonnet.pm:1.1172.2.11	Tue Sep 25 23:06:07 2012
+++ loncom/lonnet/perl/lonnet.pm	Tue Sep 25 23:15:25 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.11 2012/09/25 23:06:07 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.12 2012/09/25 23:15:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1235,8 +1235,8 @@
 
 sub check_loadbalancing {
     my ($uname,$udom) = @_;
-    my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect,
-        $offloadto,$otherserver);
+    my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom,
+        $rule_in_effect,$offloadto,$otherserver);
     my $lonhost = $perlvar{'lonHostID'};
     my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1261,14 +1261,8 @@
         }
     }
     if (ref($result) eq 'HASH') {
-        my $currbalancer = $result->{'lonhost'};
-        my $currtargets = $result->{'targets'};
-        my $currrules = $result->{'rules'};
-        if ($currbalancer ne '') {
-            if (grep(/^\Q$currbalancer\E$/, at hosts)) {
-                $is_balancer = 1;
-            }
-        }
+        ($is_balancer,$currtargets,$currrules) =
+            &check_balancer_result($result, at hosts);
         if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {
                 if ($homeintdom) {
@@ -1326,12 +1320,9 @@
             }
         }
         if (ref($result) eq 'HASH') {
-            my $currbalancer = $result->{'lonhost'};
-            my $currtargets = $result->{'targets'};
-            my $currrules = $result->{'rules'};
-
-            if ($currbalancer eq $lonhost) {
-                $is_balancer = 1;
+            ($is_balancer,$currtargets,$currrules) =
+                &check_balancer_result($result, at hosts);
+            if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {
                     if ($currrules->{'_LC_internetdom'} ne '') {
                         $rule_in_effect = $currrules->{'_LC_internetdom'};
@@ -1395,6 +1386,32 @@
     return ($is_balancer,$otherserver);
 }
 
+sub check_balancer_result {
+    my ($result, at hosts) = @_;
+    my ($is_balancer,$currtargets,$currrules);
+    if (ref($result) eq 'HASH') {
+        if ($result->{'lonhost'} ne '') {
+            my $currbalancer = $result->{'lonhost'};
+            if (grep(/^\Q$currbalancer\E$/, at hosts)) {
+                $is_balancer = 1;
+                $currtargets = $result->{'targets'};
+                $currrules = $result->{'rules'};
+            }
+        } else {
+            foreach my $key (keys(%{$result})) {
+                if (($key ne '') && (grep(/^\Q$key\E$/, at hosts)) &&
+                    (ref($result->{$key}) eq 'HASH')) {
+                    $is_balancer = 1;
+                    $currrules = $result->{$key}{'rules'};
+                    $currtargets = $result->{$key}{'targets'};
+                    last;
+                }
+            }
+        }
+    }
+    return ($is_balancer,$currtargets,$currrules);
+}
+
 sub get_loadbalancer_targets {
     my ($rule_in_effect,$currtargets,$uname,$udom) = @_;
     my $offloadto;