File Coverage

blib/lib/WebService/PayPal/NVP.pm

Criterion	Covered	Total	%
statement	29	105	27.6
branch	3	16	18.7
condition	0	7	0.0
subroutine	9	23	39.1
pod	10	11	90.9
total	51	162	31.4

package WebService::PayPal::NVP;

use Moo;
use DateTime;
use LWP::UserAgent ();
use MooX::Types::MooseLike::Base qw( InstanceOf );
use URI::Escape qw/uri_escape uri_escape_utf8 uri_unescape/;
use WebService::PayPal::NVP::Response;

our $VERSION = '0.004';

has 'errors' => (
    is => 'rw',
    isa => sub {
        die "errors expects an array reference!\n"
            unless ref $_[0] eq 'ARRAY';
    },
    default => sub { [] },
);

has 'ua' => (
    is      => 'ro',
    isa     => InstanceOf['LWP::UserAgent'],
    builder => '_build_ua'
);

has 'user' => ( is => 'rw', required => 1 );
has 'pwd'  => ( is => 'rw', required => 1 );
has 'sig'  => ( is => 'rw', required => 1 );
has 'url'  => ( is => 'rw' );
has 'branch' => ( is => 'rw', default => sub { 'sandbox' } );
has 'api_ver' => ( is => 'rw', default => sub { 51.0 } );

sub BUILDARGS {
    my ($class, %args) = @_;
    # detect URL if it's missing
    if (not $args{url}) {
        $args{url} = "https://api-3t.sandbox.paypal.com/nvp"
            if $args{branch} eq 'sandbox';

        $args{url} = "https://api-3t.paypal.com/nvp"
            if $args{branch} eq 'live';
    }

    return \%args;
}
sub _build_ua {
    my $self = shift;

    my $lwp = LWP::UserAgent->new;
    $lwp->agent("p-Webservice-PayPal-NVP/${VERSION}");
    return $lwp;
}

sub _do_request {
    my ($self, $args) = @_;

    my $req = HTTP::Request->new(POST => $self->url);
    $req->content_type('application/x-www-form-urlencoded');

    my $authargs = {
        user      => $self->user,
        pwd       => $self->pwd,
        signature => $self->sig,
        version   => $args->{version}||$self->api_ver,
        subject   => $args->{subject}||'',
    };

    my $allargs = { %$authargs, %$args };
    my $content = $self->_build_content( $allargs );
    $req->content($content);
    my $res = $self->ua->request($req);

    unless ($res->code == 200) {
        $self->errors(["Failure: " . $res->code . ": " . $res->message]);
        return;
    }

    my $resp = { map { uri_unescape($_) }
        map { split '=', $_, 2 }
            split '&', $res->content };

    my $res_object = WebService::PayPal::NVP::Response->new(
        branch => $self->branch
    );
;
    if ($resp->{ACK} ne 'Success') {
        $res_object->errors([]);
        my $i = 0;
        while(my $err = $resp->{"L_LONGMESSAGE${i}"}) {
            push @{$res_object->errors},
                $resp->{"L_LONGMESSAGE${i}"};
            $i += 1;
        }

        $res_object->success(0);
    }
    else {
        $res_object->success(1);
    }

    {
        no strict 'refs';
        no warnings 'redefine';
        foreach my $key (keys %$resp) {
            my $val    = $resp->{$key};
            my $lc_key = lc $key;
            if ($lc_key eq 'timestamp') {
                if ($val =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)Z/) {
                    my ($day, $month, $year, $hour, $min, $sec)
                     = ($3, $2, $1, $4, $5, $6);

                    $val = DateTime->new(
                        year    => $year,
                        month   => $month,
                        day     => $day,
                        hour    => $hour,
                        minute  => $min,
                        second  => $sec,
                    );
                }
            }
            *{"WebService::PayPal::NVP::Response::$lc_key"} = sub {
                return $val;
            };
        }
    }
    return $res_object;
}

sub _build_content {
    my ($self, $args) = @_;
    my @args;
    for my $key (keys %$args) {
        $args->{$key} = defined $args->{$key} ? $args->{$key} : '';
        push @args,
            uc(uri_escape($key)) . '=' . uri_escape_utf8($args->{$key});
    }

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

sub has_errors {
    my $self = shift;
    return scalar @{$self->errors} > 0;
}

sub set_express_checkout {
    my ($self, $args) = @_;
    $args->{method} = 'SetExpressCheckout';
    $self->_do_request($args);
}

sub do_express_checkout_payment {
    my ($self, $args) = @_;
    $args->{method} = 'DoExpressCheckoutPayment';
    $self->_do_request($args);
}

sub get_express_checkout_details {
    my ($self, $args) = @_;
    $args->{method} = 'GetExpressCheckoutDetails';
    $self->_do_request($args);
}

sub do_direct_payment {
    my ($self, $args) = @_;
    $args->{method} = 'DoDirectPayment';
    $self->_do_request($args);
}

sub create_recurring_payments_profile {
    my ($self, $args) = @_;
    $args->{method} = 'CreateRecurringPaymentsProfile';
    $self->_do_request($args);
}

sub get_recurring_payments_profile_details {
    my ($self, $args) = @_;
    $args->{method} = 'GetRecurringPaymentsProfileDetails';
    $self->_do_request($args);
}

sub manage_recurring_payments_profile_status {
    my ($self, $args) = @_;
    $args->{method} = 'ManageRecurringPaymentsProfileStatus';
    $self->_do_request($args);
}

sub mass_pay {
    my ($self, $args) = @_;
    $args->{method} = 'MassPay';
    $self->_do_request($args);
}

sub refund_transaction {
    my ($self, $args) = @_;
    $args->{method} = 'RefundTransaction';
    $self->_do_request($args);
}

1;
__END__