File Coverage

blib/lib/Business/RealEx.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Business::RealEx;

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

use Digest::SHA1 'sha1_hex';
use LWP::UserAgent;
use Carp 'croak';
use XML::Simple;

sub new {
    my $class = shift;

    my %args = @_ % 2 ? %{$_[0]} : (@_);

    $args{merchantid} or croak 'merchantid is required.';
    $args{secret} or croak 'secret is required.';
    $args{ua} ||= LWP::UserAgent->new;

    bless \%args, $class;
}

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

    $args{edit_payer} = 1;
    $self->new_payer(%args);
}

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

    foreach my $r ('payerref', 'firstname', 'surname') {
        $args{$r} or croak "$r is required.";
    }

    $args{payertype} ||= 'Business';
    $args{title} ||= 'Mr';
    $self->{__timestamp} = __timestamp();
    my $sha1hash = $self->__sha1hash($args{orderid} || '', $args{amount} || '', $args{currency} || '', $args{payerref});

    # we omit other fields for now
    my $action = $args{edit_payer} ? 'payer-edit' : 'payer-new';
    my $xml = <

$self->{merchantid}
$args{orderid}

$args{title}
$args{firstname}
$args{surname}
XML

    $xml .= "$args{company}" if $args{company};

    $xml .= <

$sha1hash

XML

    return $self->__request($xml);
}

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

    my @r = ('ref', 'payerref', 'expdate', 'chname', 'type');
    push @r, 'number' unless $args{update_card}; # update card may not need number
    foreach my $r (@r) {
        $args{$r} or croak "$r is required.";
    }

    $self->{__timestamp} = __timestamp();
    my $sha1hash;
    if ($args{update_card}) {
        # Timestamp.merchantID.payerref.ref.expirydate.cardnumber
        $sha1hash = $self->__sha1hash($args{payerref}, $args{ref}, $args{expdate}, $args{number} || '');
    } else {
        # timestamp.merchantid.orderid.amount.currency.payerref.chname.(card)number
        $sha1hash = $self->__sha1hash($args{orderid} || '', $args{amount} || '', $args{currency} || '', $args{payerref}, $args{chname}, $args{number});
    }

    # we omit other fields for now
    my $action = $args{update_card} ? 'card-update-card' : 'card-new';
    my $xml = <

$self->{merchantid}
XML

    $xml .= "$args{orderid}" if $args{orderid};

    $xml .= <

$args{ref}
$args{payerref}
$args{number}
$args{expdate}
$args{chname}
$args{type}
XML

    $xml .= "$args{issueno}" if $args{issueno};

    $xml .= <

$sha1hash

XML

    return $self->__request($xml);
}

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

    $args{update_card} = 1;
    $self->new_card(%args);
}

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

    my @r = ('ref', 'payerref');

    $self->{__timestamp} = __timestamp();
    # Timestamp.merchantID.payerref.pmtref
    my $sha1hash = $self->__sha1hash($args{payerref}, $args{ref});

    # we omit other fields for now
    my $xml = <

$self->{merchantid}

$args{ref}
$args{payerref}

$sha1hash

XML

    return $self->__request($xml);
}

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

    my @r = ('account', 'amount', 'currency', 'payerref', 'paymentmethod');
    foreach my $r (@r) {
        $args{$r} or croak "$r is required.";
    }

    $self->{__timestamp} = __timestamp();
    # timestamp.merchantid.orderid.amount.currency.payerref
    my $sha1hash = $self->__sha1hash($args{orderid} || '', $args{amount} || '', $args{currency} || '', $args{payerref});

    $args{autosettle} = 1 unless exists $args{autosettle};

    # we omit other fields for now
    my $action = 'receipt-in';
    my $xml = <

$self->{merchantid}
$self->{account}
XML

    $xml .= "$args{orderid}" if $args{orderid};
    if ($args{cvn}) {
        $xml .= <


    $args{cvn}


XML
    }

    $xml .= <
$args{amount}
$args{payerref}
$args{paymentmethod}

XML

    $xml .= "$args{authcode}" if $args{authcode};

    $xml .= <
$sha1hash

XML

    return $self->__request($xml);
}

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

    my @r = ('account', 'amount', 'currency', 'payerref', 'paymentmethod');
    foreach my $r (@r) {
        $args{$r} or croak "$r is required.";
    }

    $args{refund_password} or $self->{refund_password} or die 'refund_password is required.';

    $self->{__timestamp} = __timestamp();
    # timestamp.merchantid.orderid.amount.currency.payerref
    my $sha1hash = $self->__sha1hash($args{orderid} || '', $args{amount} || '', $args{currency} || '', $args{payerref});
    my $refundhash = sha1_hex($args{refund_password} || $self->{refund_password});

    $args{autosettle} = 1 unless exists $args{autosettle};

    # we omit other fields for now
    my $action = 'payment-out';
    my $xml = <

$self->{merchantid}
$self->{account}
XML

    $xml .= "$args{orderid}" if $args{orderid};

    $xml .= <
$args{amount}
$args{payerref}
$args{paymentmethod}
XML

    $xml .= <
$sha1hash
$refundhash

XML

    return $self->__request($xml);
}

sub __request {
    my ($self, $xml) = @_;

    my $resp = $self->{ua}->post('https://epage.payandshop.com/epage-remote-plugins.cgi', Content => $xml);
    # use Data::Dumper; print Dumper(\$resp);
    return { error => 'Failed to talk with remote server: ' . $resp->status_line } unless $resp->is_success;
    return XMLin($resp->content, ForceArray => 0, SuppressEmpty => '');
}

sub __sha1hash {
    my $self = shift;
    return sha1_hex(join('.', sha1_hex($self->__sha_string(@_)), $self->{secret}));
}

sub __sha_string {
    my $self = shift;
    return join('.', $self->{__timestamp}, $self->{merchantid}, @_);
}

sub __timestamp {
    my @d = localtime();
    return sprintf('%04d%02d%02d%02d%02d%02d', $d[5] + 1900, $d[4] + 1, $d[3], @d[qw/2 1 0/]);
}

1;
__END__