#!/usr/bin/perl -w 
use SOAP::Lite;
use CGI; 
use SoapAccess;
use strict;
use Data::Dumper;
main();
exit 0;

sub main {

    my ($soap_res, $res);
    my ($element, $key, $count);
    my ($reqrv, $reqres, $rv, $result, $function, %resultH, @params);
    my $type = 1;

# **********************************
#    URI = "urn:adminTool"
# *********************************
#    my $SOAP_SERVER = "partnertest.hk1.outblaze.com";
    my $SOAP_SERVER = "stagerm.outblaze.com";
#   my $SOAP_SERVER = "resellertool1.hk1.outblaze.com";
#   my $SOAP_SERVER = "rm.cl.outblaze.com";
#   my $SOAP_SERVER = "devrm.outblaze.com";
#    my $SOAP_SERVER = "reseller3.us4.outblaze.com";
#    my $SOAP_SERVER = "rm.hk2.outblaze.com";
#    my $SOAP_SERVER = "rm.us4.outblaze.com";
   my $SOAP_PROXY = "http://$SOAP_SERVER/ob/servlet/rpcrouter";
   my $URI = "urn:adminTool";

    $function = "getCobrandServerInterface";
    push @params, "namespace";
    push @params, "gusv5test14.outblaze.com";
    push @params, "5";
  unless ($function) {
        print "No function given";
        exit 0;
    } 

    my $soap = new SoapAccess($URI, $SOAP_PROXY);
    ($type == 1)
        and ($reqrv, $reqres, $rv, $res, $result) = $soap->request($function, \@params);
    ($type == 2)
        and ($reqrv, $reqres, $rv, $res, %resultH) = $soap->request($function, \@params);

    print "SOAP_SERVER = $SOAP_SERVER\n";
    print "function = $function\n";
    print Dumper(\@params);

    print "========Result============\n";
    print "reqrv: $reqrv\n";
    print "reqres: $reqres\n";
    print "rv: $rv\n";


#use MIME::Base64 qw(encode_base64 decode_base64);
#my $a = $$rv{3711637}->{comment};
#print decode_base64($a);
#print $a;
    print "rv(Dumper): ".Dumper($rv);
    print "res: ".Dumper($res)."\n";
    ($type == 1)
        and print "result: ".Dumper($result)."\n";
    if ($type == 2) {
        print "result: ".Dumper(\%resultH)."\n";
        foreach my $key (keys %resultH) {
            print "$key -- " . CGI::unescape($resultH{$key}) . "\n";
        }
    }
    return 1;
}



##
###
### the definition of the package
####
###
###

#
# Class stored function simplifing access to SOAP
#
package SoapAccess;
use strict;
use SOAP::Lite;
use HTTP::Cookies;
use Data::Dumper;

#
# Constructor
#
# **********************
# Parameters : $uri, string, soap uri to the remote machine
#              $proxy, string, url to call the soap request
#              $timeout, integer, number of second for the soap transport timeout (Default : 30)
#              $retry, integer, number of of times to retries for soap call failure (Default : 3)
# Return : the object
#
sub new {
    my ($class, $uri, $proxy,$proxy_second, $timeout, $retry) = @_;
    print "uri = $uri \n";
    print "proxy = $proxy \n";
    print "$SOAP::soapretry\n";
    my $self = {
                "uri" => $uri,
                "proxy" => $proxy,
                "timeout" => $timeout || 40, # default timout 30 seconds
                "retry" => $retry || 1 ,      # default retry 3 times
                "proxy_second" => $proxy_second ,
        };

    # Init the soap object
    eval {
        $self->{soapobj} = SOAP::Lite
                           ->uri($self->{uri})
                           ->proxy($self->{proxy}, cookie_jar => HTTP::Cookies->new(), timeout=>($self->{timeout}))
    };
    if ($@) {
        warn "Error initializing $proxy object: $@\n";
        return undef;
    }
    unless ($self->{soapobj}) {
        warn "Error initalizing soap object\n";
        return undef; #If soap obj creation failed, return error
    }
    bless  $self, $class;
}

#
# submite the request
#
# *********************
# Parameters : $function, string, name of the function you would call
#              @params, array, list of data you would pass to the function
# Return : boolean, indicate if the call completed ok
#          string, description of what happened
#          array, list of data returned from the call
#
sub request {
    my ($self, $function, $params) = @_;
    my ($result);

    # setup init values
    my $soapobj = $self->{soapobj};
    my $retry = $self->{retry};
    while ($retry) {
       eval {
           $result = $soapobj->$function(@$params);
       };
       # If result is good, terminate the call, otherwise, do another try
       $retry = ((defined $result) && (!$result->fault))?0:$retry-1;
    };
    if ($@ || (!defined $result) || $result->fault) {
        eval {
            $self->{soapobj_second} = SOAP::Lite
                           ->uri($self->{uri})
                           ->proxy($self->{proxy_second}, cookie_jar => HTTP::Cookies->new(), timeout=>($self->{timeout}))
            };
        if ($@) {
            warn "Error initalizing proxy_second object: $@\n";
            return undef;
        }
        $soapobj = $self->{soapobj_second} ;
        $retry = $self->{retry};
        while ($retry) {
           eval {
               $result = $soapobj->$function(@$params);
           };
           $retry = ((defined $result) && (!$result->fault))?0:$retry-1;
        } ;

        if ($@ || (!defined $result) || $result->fault) {

            if ($@) {
                return (0, "failed: $@\n");
            } elsif (defined $result && $result->fault) {
                return (0, "request failed : " . $result->faultcode . "." . $result->faultstring);
            } else {
                return (0, "unknown error, no result returned");
  } else {
                return (0, "unknown error, no result returned");
            }
        }
    }
    if (defined $result->fault) {
        return (0, "SOAP exception found: " . $result->faultcode . "." . $result->faultstring);
    }
    return (1, "ok", $result->result, $result->paramsout);
}


1;
~

Soap test in Outblaze

Perl