Perl Add Pool Member

Problem this snippet solves:

This sample perl application will illustrate how to add a member to a pool.

Code :

#use SOAP::Lite + trace => qw(method debug);
use SOAP::Lite;
#----------------------------------------------------------------------------
# Validate Arguments
#----------------------------------------------------------------------------
my $sHost = $ARGV[0];
my $sUID = $ARGV[1];
my $sPWD = $ARGV[2];
my $sPool = $ARGV[3];
my $sMember = $ARGV[4];

sub usage()
{
  die ("Usage: add PoolMember.pl host uid pwd [pool member_ip:port]\n");
}

if ( ($sHost eq "") or ($sUID eq "") or ($sPWD eq "") )
{
  usage();
}

#----------------------------------------------------------------------------
# Transport Information
#----------------------------------------------------------------------------
sub SOAP::Transport::HTTP::Client::get_basic_credentials-->
{
  return "$sUID" => "$sPWD";
}

$Pool = SOAP::Lite
  -> uri('urn
  -> readable(1)
  -> proxy("https://$sHost/iControl/iControlPortal.cgi");
$PoolMember = SOAP::Lite
  -> uri('urn
  -> readable(1)
  -> proxy("https://$sHost/iControl/iControlPortal.cgi");

#----------------------------------------------------------------------------
# Attempt to add auth headers to avoid dual-round trip
#----------------------------------------------------------------------------
eval { $Pool->transport->http_request->header
(
  'Authorization' =>
  'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')-->
); };
eval { $Pool->transport->http_request->header
(
  'Authorization' =>
  'Basic ' . MIME::Base64::encode("$sUID:$sPWD", '')-->
); };

#----------------------------------------------------------------------------
# support for custom enum types
#----------------------------------------------------------------------------
sub SOAP::Deserializer::typecast-->
{
  my ($self, $value, $name, $attrs, $children, $type) = @_;
  my $retval = undef;
  if ( "{urn:iControl}Common.EnabledState" == $type )
  {
    $retval = $value;
  }
  return $retval;
}

#----------------------------------------------------------------------------
# Main logic
#----------------------------------------------------------------------------
if ( "" eq $sPool )
{
  #------------------------------------------------------------------------
  # No pool supplied.  Query pool list and display members for given pool
  #------------------------------------------------------------------------
  $soapResponse = $Pool->get_list();
  &checkResponse($soapResponse);
  @pool_list = @{$soapResponse->result};
  &showPoolMembers(@pool_list);
}
elsif ( "" eq $sMember )
{
  &showPoolMembers($sPool);
}
elsif ( "" ne $sMember )
{
  ($addr, $port) = split(/:/, $sMember, 2);
  
  $member = 
  {
    address => $addr,
    port => $port
  };
  
  # memberA is the 1st dimension of the array, we need one for each pool
  push @memberA, $member;
  
  # memberAofA is the 2nd dimension. push pool members for each pool here.
  push @memberAofA, [@memberA];
  
  $soapResponse = $Pool->add_member(
    SOAP::Data->name(pool_names => [$sPool]),
    SOAP::Data->name(members => [@memberAofA])
  );
  &checkResponse($soapResponse);
  
  &showPoolMembers($sPool);
}
else
{
  &usage();
}

#----------------------------------------------------------------------------
# Show list of pools and members
#----------------------------------------------------------------------------
sub showPoolMembers()
{
  my (@pool_list) = @_;
  
  $soapResponse = $Pool->get_member(
    SOAP::Data->name(pool_names => [@pool_list])
  );
  &checkResponse($soapResponse);
  @memberAofA = @{$soapResponse->result};
  
  $i = 0;
  foreach $pool (@pool_list)
  {
    print "POOL : $pool\n";
    @memberA = @{$memberAofA[$i]};
    foreach $member (@memberA)
    {
      $addr = $member->{"address"};
      $port = $member->{"port"};
      print "   MEMBER : ${addr}:${port}\n";
    }
    $i++;
  }
}

#----------------------------------------------------------------------------
# checkResponse makes sure the error isn't a SOAP error
#----------------------------------------------------------------------------
sub checkResponse()
{
  my ($soapResponse) = (@_);
  if ( $soapResponse->fault )
  {
    print $soapResponse->faultcode, " ", $soapResponse->faultstring, "\n";
    exit();
  }
}