File Coverage

blib/lib/WWW/Vonage/API.pm

Criterion	Covered	Total	%
statement	116	124	93.5
branch	30	42	71.4
condition	15	21	71.4
subroutine	23	23	100.0
pod	8	8	100.0
total	192	218	88.0

package WWW::Vonage::API;

use 5.010001;
use strict;
use warnings;

our $VERSION = '0.001';
our $Debug   = 0;
our $Test    = 0;
use LWP::UserAgent ();
use URI::Escape qw(uri_escape uri_escape_utf8);
use JSON;
use Carp 'croak';
use List::Util '1.29', 'pairs';
use Data::Dumper;
sub API_Domain  { 'nexmo.com' }
sub API_Version { 'v1' }
sub API_Region  { 'api' }

my %account_sid  = ();
my %auth_token   = ();
my %api_version  = ();
my %api_region   = ();
my %api_domain   = ();
my %lwp_callback = ();    #not used yet
my %utf8         = ();    #not documented

sub new {
    my $class = shift;
    my %args  = @_;

    my $self = bless \( my $ref ), $class;

    for my $argument (qw ( API_Key API_Secret )) {
        exists $args{$argument}
          or croak $class . "->new requires $argument argument";
    }

    $account_sid{$self} = $args{API_Key}    || '';
    $auth_token{$self}  = $args{API_Secret} || '';
    $api_version{$self} =
      defined $args{API_Version} ? lc( $args{API_Version} ) : API_Version();
    $api_region{$self} =
      defined $args{API_Region} ? lc( $args{API_Region} ) : API_Region();
    $api_domain{$self} =
      defined $args{API_Domain} ? lc( $args{API_Domain} ) : API_Domain();
    $Test = defined $args{_test} ? 1 : $Test;

    $lwp_callback{$self} = $args{LWP_Callback} || undef;
    $utf8{$self}         = $args{utf8}         || undef;

    return $self;
}

sub GET {
    _do_request( shift, METHOD => 'GET', Path => shift, PAYLOAD => shift, @_ );
}

sub POST {
    _do_request( shift, METHOD => 'POST', Path => shift, PAYLOAD => shift, @_ );
}

sub PUT {
    _do_request( shift, METHOD => 'PUT', Path => shift, PAYLOAD => shift, @_ );
}

sub PATCH {
    _do_request(
        shift,
        METHOD  => 'PATCH',
        Path    => shift,
        PAYLOAD => shift,
        @_
    );
}

sub DELETE {
    _do_request(
        shift,
        METHOD  => 'DELETE',
        Path    => shift,
        PAYLOAD => shift,
        @_
    );
}

## METHOD => GET|POST|PUT|DELETE|PATCH
## API    => Messages
##           Recordings|Notifications|etc.
sub _do_request {
    my $self = shift;

    my %args = @_;

    my $lwp = LWP::UserAgent->new;
    $lwp_callback{$self}->($lwp)
      if ref( $lwp_callback{$self} ) eq 'CODE';

    $lwp->agent("perl-WWW-Vonage-API/$VERSION");

    my $method  = delete $args{METHOD};
    my $payload = delete $args{PAYLOAD};
    my $path    = lc( delete( $args{Path} ) );

    print STDERR "Raw payload: " . Dumper($payload) . "\n"
      if $Debug;

    my $domain = $self->_build_domain(%args);

    print STDERR "Raw domain  " . $domain . "\n"
      if $Debug;

    my $url = $self->_build_url( $method, $domain, $path, $payload, %args );

    print STDERR "Request URL " . $url . "\n"
      if $Debug;

    my $request = HTTP::Request->new( $method => $url );
    my $content = undef;
    if ( ( $method eq 'POST' or $method eq 'PATCH' or $method eq 'PUT' )
        and ref($payload) eq "HASH" )
    {

        my $json = JSON->new->canonical(1);

        $content = $json->encode($payload);
        $request->content($content);
    }

    if ($Test) {    #used only for testing
        return {
            url     => $url,
            payload => $content
        };
    }
    $request->header( 'Content-Type' => 'application/json' );
    $request->header( 'Accept'       => 'application/json' );

    $request->authorization_basic( $account_sid{$self}, $auth_token{$self} );

    local $ENV{HTTPS_DEBUG} = $Debug;

    my $response = $lwp->request($request);

    print STDERR "Request sent: " . $request->as_string . "\n"
      if $Debug;

    print STDERR "Raw Response received: " . Dumper($response) . "\n"
      if $Debug;

    return {
        code    => $response->code,
        message => $response->message,
        content => $response->content
    };
}

sub _build_url {    #did it this way so they can be tested
    my $self      = shift;
    my ($method)  = shift;
    my ($domain)  = shift;
    my ($path)    = shift;
    my ($payload) = shift;
    my %args      = @_;

    my $url = sprintf( 'https://%s/%s', $domain, $path );

    if ( $method eq 'GET' and ref($payload) eq "HASH" ) {
        my $query_string = $self->_build_query_string($payload);

        print STDERR "Encoded query_string: " . $query_string . "\n"
          if $Debug;

        $url .= '?' . $query_string;
    }

    return $url;

}

## builds a string suitable for LWP's content() method
sub _build_query_string {
    my $self = shift;
    my ($payload) = @_;

    my $escape_method = $utf8{$self} ? \&uri_escape_utf8 : \&uri_escape;
    my @arguments;
    foreach my $key ( sort( keys( %{$payload} ) ) ) {
        push( @arguments,
                &$escape_method($key) . '='
              . &$escape_method( $payload->{$key} // '' ) );
    }

    return join( '&', @arguments ) || '';
}

sub _build_domain {
    my $self = shift;

    my %args    = @_;
    my $api_ver = $api_version{$self};
    my $region  = $api_region{$self};
    my $domain  = $api_domain{$self};

    if ( $args{API_Version} ) {
        $api_ver = lc( $args{API_Version} );
        $api_version{$self} = $api_ver;
    }

    $api_ver = "/" . $api_ver;

    $api_ver = ''
      if ($api_ver) eq '/none';

    if ( $args{API_Region} ) {
        $region = lc( $args{API_Region} );
        $api_region{$self} = $region;
    }

    if ( $args{API_Domain} ) {
        $domain = lc( $args{API_Domain} );
        $api_domain{$self} = $domain;
    }

    return $region . "." . $domain . $api_ver

}

sub DESTROY {
    my $self = $_[0];

    delete( $account_sid{$self} );
    delete( $auth_token{$self} );
    delete( $api_version{$self} );
    delete( $api_region{$self} );
    delete( $api_domain{$self} );
    delete( $lwp_callback{$self} );
    delete( $utf8{$self} );

    my $super = $self->can("SUPER::DESTROY");
    goto &$super if $super;
}

1;

__END__