File Coverage

blib/lib/Business/PayPal/NVP.pm

Criterion	Covered	Total	%
statement	34	81	41.9
branch	2	18	11.1
condition	4	20	20.0
subroutine	8	16	50.0
pod	4	6	66.6
total	52	141	36.8

package Business::PayPal::NVP;

use 5.008001;
use strict;
use warnings;

our $VERSION = '1.10';
our $AUTOLOAD;

our $Debug  = 0;
our $Branch = 'test';
our $Timeout= 0;
our $UserAgent;

use LWP::UserAgent ();
use URI::Escape ();
use Carp 'croak';

sub API_VERSION { 98 }

## NOTE: This is an inside-out object; remove members in
## NOTE: the DESTROY() sub if you add additional members.

my %errors = ();
my %test   = ();
my %live   = ();

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

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

    $Branch = $args{branch} || 'test';
    $Timeout = $args{timeout};
    $UserAgent = $args{ua} || LWP::UserAgent->new;

    if (ref $UserAgent ne 'LWP::UserAgent') {
        die "ua must be a LWP::UserAgent object\n";
    }

    $errors {$self} = [ ];
    $test   {$self} = $args{test} || { };
    $live   {$self} = $args{live} || { };

    return $self;
}

sub AUTH_CRED {
    my $self   = shift;
    my $cred   = shift;
    my $branch = shift || $Branch || 'test';

    return { testuser => $test{$self}->{user},
	     testpwd  => $test{$self}->{pwd},
	     testsig  => $test{$self}->{sig},
	     testurl  => $test{$self}->{url} || 'https://api-3t.sandbox.paypal.com/nvp',
             testsubj => $test{$self}->{subject},
	     testver  => $test{$self}->{version},

	     liveuser => $live{$self}->{user},
	     livepwd  => $live{$self}->{pwd},
	     livesig  => $live{$self}->{sig},
	     liveurl  => $live{$self}->{url} || 'https://api-3t.paypal.com/nvp',
             livesubj => $live{$self}->{subject},
	     livever  => $live{$self}->{version},
	 }->{$branch . $cred};
}

sub _do_request {
    my $self = shift;
    my %args = @_;

    my $lwp = $UserAgent;
    $lwp->timeout($Timeout) if $Timeout;
    $lwp->agent("perl-Business-PayPal-NVP/$VERSION");
    my $req = HTTP::Request->new( POST => $self->AUTH_CRED('url') );
    $req->content_type( 'application/x-www-form-urlencoded' );

    my $content = _build_content( USER      => $self->AUTH_CRED('user'),
				  PWD       => $self->AUTH_CRED('pwd'),
				  SIGNATURE => $self->AUTH_CRED('sig'),
				  VERSION   => delete $args{VERSION} || $self->AUTH_CRED('ver') || API_VERSION,
                                  SUBJECT   => $self->AUTH_CRED('subj'),
				  %args );
    $req->content( $content );

    if ($Debug) {
        require Data::Dumper;
        print STDERR "Making request: " . Data::Dumper::Dumper($req);
    }

    my $res = $lwp->request($req);

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

    return map { URI::Escape::uri_unescape($_) }
      map { split /=/, $_, 2 }
        split /&/, $res->content;
}

sub _build_content {
    my %args = @_;

    my @args = ();
    for my $key ( keys %args ) {
	$args{$key} = ( defined $args{$key} ? $args{$key} : '' );
        push @args, URI::Escape::uri_escape($key) . '=' . URI::Escape::uri_escape($args{$key});
    }

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

sub AUTOLOAD {
    my $self = shift;
    my $method = $AUTOLOAD;
    $method =~ s/^.*:://;
    return if $method eq 'DESTROY';
    croak "Undefined subroutine $method" unless $method =~ /^[A-Z]/;
    $self->_do_request(METHOD => $method, @_);
}

sub send {
    shift->_do_request(@_);
}

sub errors {
    my $self = shift;

    if( @_ ) {
        push @{ $errors{$self} }, @_;
        return;
    }

    return @{ $errors{$self} };
}

sub clear_errors {
    my $self = shift;
    $errors{$self} = [];
}

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

    delete $errors {$self};
    delete $test   {$self};
    delete $live   {$self};

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

1;
__END__