Compatibility issue

Test case below. Call it with:

script

My test gear runs 9.0.5. Pointing this at a 4.6 box will dump something like this:

Pool: GSKiisT2TST 1.2.3.4:80 5.6.7.8:80

Pool: GSKiisT2TST-s 11.12.13.14:80 15.16.17.18:80

The test gear:

Pool: GSKSSOIISTest 1972258726:80 1989035942:80

Pool: GSKSSOIISTest8080 1972258726:80 1989035942:80

 
 !/usr/bin/perl 
  
 require "dumpvar.pl"; 
 use strict; 
 use SOAP::Lite; 
  
 my ($user, $pwd); 
  
 sub SOAP::Transport::HTTP::Client::get_basic_credentials { 
     return $user => $pwd; 
 } 
  
 sub getF5Pools { 
     my $url = shift; 
     my($soap, $soapResponse, $result); 
      
     $soap = SOAP::Lite 
           ->uri('urn:iControl:ITCMLocalLB/Pool') 
           ->proxy($url) || die "Can't connect\n"; 
     $soapResponse = $soap->get_list(); 
     if ( $soapResponse->fault ) { 
         return [] if $soapResponse->faultstring =~  
           /The requested item does not exist/i; 
         return "Error getting Pools: " . 
           $soapResponse->faultcode . " " . 
           $soapResponse->faultstring; 
     } 
     return $soapResponse->result; 
 } 
  
 sub getF5PoolsMembers { 
     my $url = shift; 
     my $pools = shift; 
     my($p, $soap, $soapResponse, $r); 
     $soap = SOAP::Lite 
           ->uri('urn:iControl:ITCMLocalLB/Pool') 
           ->proxy($url) || die "Can't connect\n"; 
     $r = []; 
     for $p ( @$pools ) { 
         $soapResponse = $soap->get_member_list( 
             SOAP::Data->name('pool_name' => $p) 
         ); 
         if ( ! $soapResponse->fault ) { 
             push @$r, [ $p, $soapResponse->result]; 
         } 
     } 
     return $r; 
 } 
  
  
 sub main { 
     my ($ip, $url, $r, $p, $m); 
     $ip = $ARGV[0]; 
     $user = $ARGV[1]; 
     $pwd = $ARGV[2]; 
     $url = "https://$ip/iControl/iControlPortal.cgi";     
      
     $r = getF5Pools($url); 
     $r = getF5PoolsMembers($url, $r); 
     for $p ( @$r ) { 
         print "Pool: " . 
           $p->[0] . " "; 
         for $m ( @{$p->[1]} ) { 
             print $m->{'address'} . ":" . $m->{'port'} . " ";        
         } 
         print "\n"; 
     } 
 } 
  
 main; 
  
 1;