File Coverage

blib/lib/Business/PxPay.pm

Criterion	Covered	Total	%
statement	21	63	33.3
branch	0	20	0.0
condition	0	28	0.0
subroutine	7	12	58.3
pod	3	5	60.0
total	31	128	24.2

package Business::PxPay;

# ABSTRACT: PX Pay Interface for www.paymentexpress.com

use warnings;
use strict;
use Carp qw/croak/;
use URI::Escape qw/uri_escape/;
use LWP::UserAgent;
use XML::Simple qw/XMLin XMLout/;
use vars qw/%TRANSACTIONS/;

our $VERSION = '0.05';

%TRANSACTIONS = (
    purchase      => 'Purchase',
    credit        => 'Refund',
    authorization => 'Auth',
    capture       => 'Complete',
    validate      => 'Validate'
);

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

    # validate
    $args->{userid} or croak 'userid is required';
    $args->{key}    or croak 'key is required';

    $args->{url} ||= 'https://sec.paymentexpress.com/pxpay/pxaccess.aspx';

    unless ( $args->{ua} ) {
        my $ua_args = delete $args->{ua_args} || {};
        $args->{ua} = LWP::UserAgent->new(%$ua_args);
    }

    bless $args, $class;
}

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

    my $xml = $self->request_xml($args);
    my $resp = $self->{ua}->post($self->{url}, Content => $xml);
    unless ($resp->is_success) {
        croak $resp->status_line;
    }
    my $rtn = XMLin($resp->content, SuppressEmpty => undef);
    return $rtn;
}

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

    # validate
    my $TxnType = $args->{TxnType} || croak 'TxnType is required';
    my $Amount = $args->{Amount} || $self->{Amount} || croak 'Amount is required';
    $Amount = sprintf ("%.2f", $Amount); # .XX format
    my $Currency   = $args->{Currency} || $self->{Currency} || croak 'Currency is required';
    my $UrlFail    = $args->{UrlFail} || $self->{UrlFail} || croak 'UrlFail is required';
    my $UrlSuccess = $args->{UrlSuccess} || $self->{UrlSuccess} || croak 'UrlSuccess is required';
    my $MerchantReference = $args->{MerchantReference} || croak 'MerchantReference is required';

    # UrlFail can't contain '?' or '&'
    if ( $UrlFail =~ /\?/ or $UrlFail =~ /\&/ ) {
        croak "UrlFail can't contain '?' or '&', please use TxnData1, TxnData2, TxnData3 or Opt\n";
    }
    if ( $UrlSuccess =~ /\?/ or $UrlSuccess =~ /\&/ ) {
        croak "UrlSuccess can't contain '?' or '&', please use TxnData1, TxnData2, TxnData3 or Opt\n";
    }

    my $request = {
        GenerateRequest => {
            PxPayUserId => [ $self->{userid} ],
            PxPayKey    => [ $self->{key} ],
            AmountInput => [ $Amount ],
            CurrencyInput => [ $Currency ],
            MerchantReference => [ $MerchantReference ],
            EmailAddress => [ $args->{EmailAddress} ],
            TxnData1     => [ $args->{TxnData1} ],
            TxnData2     => [ $args->{TxnData2} ],
            TxnData3     => [ $args->{TxnData3} ],
            TxnType      => [ $TxnType ],
            TxnId        => [ $args->{TxnId} ],
            BillingId    => [ $args->{BillingId} ],
            EnableAddBillCard => [ $args->{EnableAddBillCard} ],
            UrlSuccess   => [ $UrlSuccess ],
            UrlFail      => [ $UrlFail ],
            Opt          => [ $args->{Opt} ],
        },
    };
    return XMLout( $request, KeepRoot => 1 );
}

sub result {
    my ( $self, $ResponseCode ) = @_;

    my $xml = $self->result_xml($ResponseCode);
    my $resp = $self->{ua}->post($self->{url}, Content => $xml);
    unless ($resp->is_success) {
        croak $resp->status_line;
    }
    my $rtn = XMLin($resp->content, SuppressEmpty => undef);
    return $rtn;
}

sub result_xml {
    my ( $self, $ResponseCode ) = @_;

    my $request = {
        ProcessResponse => {
            PxPayUserId => [ $self->{userid} ],
            PxPayKey    => [ $self->{key} ],
            Response    => [ $ResponseCode ],
        },
    };
    return XMLout( $request, KeepRoot => 1 );
}

1;
__END__