File Coverage

blib/lib/Business/PayPoint/MCPE.pm

Criterion	Covered	Total	%
statement	14	86	16.2
branch	0	38	0.0
condition	0	15	0.0
subroutine	5	15	33.3
pod	9	10	90.0
total	28	164	17.0

package Business::PayPoint::MCPE;

use strict;
use 5.008_005;
our $VERSION = '0.02';

use LWP::UserAgent;
use Carp 'croak';
use URI::Escape qw/uri_unescape/;

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

    $args{InstID} or croak "InstID is required.";

    $args{TestMode} ||= 0;
    $args{ua} ||= LWP::UserAgent->new();

    $args{POST_URL} ||= 'https://secure.metacharge.com/mcpe/corporate';
    $args{APIVersion} ||= '1.3';

    bless \%args, $class;
}

sub payment {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'PAYMENT',
    );
}

sub refund {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'REFUND',
    );
}

sub repeat {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'REPEAT',
    );
}

sub capture {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'CAPTURE',
    );
}

sub void {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'VOID',
    );
}

sub cancel {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'CANCEL',
    );
}

sub confirm {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'CONFIRM',
    );
}

sub nonauth {
    my $self = shift;
    my %args = @_ % 2 ? %{$_[0]} : @_;

    $self->request(
        %args,
        TransType  => 'NONAUTH',
    );
}

sub request {
    my $self = shift;
    my %params = @_ % 2 ? %{$_[0]} : @_;

    my @intFields = ('TestMode', 'InstID', 'TransID', 'AccountID', 'AuthMode', 'CountryIP', 'AVS', 'Status', 'Time', 'CV2', 'Reference', 'Recurs', 'CancelAfter', 'ScheduleID');
    my @fltFields = ('APIVersion', 'Amount', 'OriginalAmount', 'SchAmount', 'FraudScore');
    my @datFields = ('Fulfillment');

    $params{TestMode}   = $self->{TestMode} unless exists $params{TestMode};
    $params{InstID}     ||= $self->{InstID};
    $params{APIVersion} ||= $self->{APIVersion};

    my %r;
    foreach my $key (keys %params) {
        if ($key =~ /^(int|flt|str|dat)/) {
            $r{$key} = $params{$key};
        } elsif (grep { $_ eq $key } @intFields) {
            $r{'int' . $key} = $params{$key};
        } elsif (grep { $_ eq $key } @fltFields) {
            $r{'flt' . $key} = $params{$key};
        } elsif (grep { $_ eq $key } @fltFields) {
            $r{'dat' . $key} = $params{$key};
        } else {
            $r{'str' . $key} = $params{$key};
        }
    }

    my $resp = $self->{ua}->post($self->{POST_URL}, \%r);
    # use Data::Dumper; print STDERR Dumper(\$resp);
    unless ($resp->is_success) {
        return wantarray ? (error => $resp->status_line) : { error => $resp->status_line };
    }

    my @parts = split('&', $resp->decoded_content);
    my %parts;
    foreach my $p (@parts) {
        my ($a, $b) = split('=', $p, 2);
        $a =~ s/^(int|flt|str|dat)//;
        $parts{$a} = uri_unescape($b);
        $parts{$a} =~ s/\+/ /g;
    }
    return wantarray ? %parts : \%parts;
}

1;
__END__