File Coverage

blib/lib/WebService/IPRental.pm

Criterion	Covered	Total	%
statement	8	10	80.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	12	14	85.7

package WebService::IPRental;

BEGIN {
    $WebService::IPRental::VERSION = '0.02';
}

# ABSTRACT: IP Rental API

use strict;
use warnings;
use SOAP::Lite;

#use SOAP::Lite +trace => 'all';
use Carp 'croak';
use XML::Simple 'XMLin';

$SOAP::Constants::PREFIX_ENC = 'SOAP-ENC';

sub new {
    my $class = shift;
    my $args = scalar @_ % 2 ? shift : {@_};

    $args->{APIkey}   or croak 'APIkey is required';
    $args->{APIpass}  or croak 'APIpass is required';
    $args->{Username} or croak 'Username is required';
    $args->{Password} or croak 'Password is required';

    $args->{TTL} ||= 780;
    $args->{soap} =
      SOAP::Lite->envprefix('SOAP-ENV')
      ->on_fault( sub { print( Dumper( $_[1]->fault ), "\n" ); } )
      ->on_action( sub { 'urn:IPRentalSoapAPIAction' } )
      ->proxy( 'https://secure.iprental.com/api/', timeout => 5 )
      ->ns( 'urn:IPRentalSoapAPI', 'ns1' )->outputxml(1)->autotype(0);

    bless $args, $class;
}

sub doIpLease {
    my ($self) = @_;

    my @search_request_params;
    foreach my $arg (qw(APIkey APIpass username password )) {
        push @search_request_params,
          SOAP::Data->name($arg)->value( $self->{ ucfirst $arg } )
          ->attr( { 'xsi:type' => "xsd:string" } );
    }
    foreach my $arg ( 'TTL', 'Location' ) {
        push @search_request_params,
          SOAP::Data->name($arg)->value( $self->{$arg} || 0 )
          ->attr( { 'xsi:type' => "xsd:int" } );
    }

    my $request_params =
      SOAP::Data->name('return')->value( [@search_request_params] )
      ->attr( { 'xsi:type' => 'ns1:IPRargs' } );

    my $xml =
      $self->{soap}->call( SOAP::Data->name('ns1:doIpLease'), $request_params );

    my $data = XMLin( $xml, NoAttr => 1 );
    my $response =
      $data->{'SOAP-ENV:Body'}->{'ns1:doIpLeaseResponse'}->{return};

    return $response;
}

sub verboseReponseCode {
    my ( $self, $r ) = @_;

    return "Good, Fresh IP"                     if $r == 202;
    return "Good, Duplicate IP"                 if $r == 203;
    return "Internal Error, Unable to serve IP" if $r == 402;
    return "Unknown User Authentication"        if $r == 403;
    return "Unknown API Authentication"         if $r == 404;
    return "0 IP leases left in your pool"      if $r == 405;
    return "Impermissible network type"         if $r == 406;
    return "Unknown";
}

1;

__END__