774 lines
26 KiB
Perl
774 lines
26 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Payment::Direct::Moneris
|
|
# Author: Jason Rhinelander
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Moneris.pm,v 1.12 2008/09/23 23:55:26 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
# Description:
|
|
# Handle payment processing via Moneris eSelect Plus.
|
|
#
|
|
|
|
package GT::Payment::Direct::Moneris;
|
|
use strict;
|
|
use vars qw/@ISA $ERRORS $VERSION %REQUIRED %RESPONSE $AUTOLOAD %BRANDS %NAME_MAP/;
|
|
|
|
use GT::Base;
|
|
use GT::WWW;
|
|
use GT::WWW::https;
|
|
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
use constants
|
|
LIVE_SERVER => 'https://www3.moneris.com:43924/gateway2/servlet/MpgRequest',
|
|
TEST_SERVER => 'https://esqa.moneris.com:43924/gateway2/servlet/MpgRequest',
|
|
TIMEOUT => 60;
|
|
|
|
@ISA = 'GT::Base';
|
|
|
|
%REQUIRED = (
|
|
AUTHORIZE => [qw(
|
|
account_token
|
|
account_token2
|
|
credit_card_number
|
|
credit_card_expiry_month
|
|
credit_card_expiry_year
|
|
charge_total
|
|
billing_fname
|
|
billing_lname
|
|
billing_address
|
|
billing_city
|
|
billing_state
|
|
billing_postal_code
|
|
billing_country
|
|
order_id
|
|
)],
|
|
CAPTURE => [qw(
|
|
account_token
|
|
charge_total
|
|
capture_reference_id
|
|
order_id
|
|
)]
|
|
);
|
|
|
|
# The following credit card brands are supported by Moneris
|
|
%BRANDS = (
|
|
VISA => 1,
|
|
MASTERCARD => 1, # Can also be passed as 'MC'
|
|
AMERICAN_EXPRESS => 1, # Can also be passed as 'AMEX'
|
|
DISCOVER => 1, # Can also be passed as 'DISC'
|
|
NOVA => 1,
|
|
DINERS => 1,
|
|
EUROCARD => 1
|
|
);
|
|
|
|
%RESPONSE = (
|
|
0 => 'Approved, account balances included',
|
|
1 => 'Approved, account balances not included',
|
|
2 => 'Approved, country club',
|
|
3 => 'Approved, maybe more ID',
|
|
4 => 'Approved, pending ID (sign paper draft)',
|
|
5 => 'Approved, blind',
|
|
6 => 'Approved, VIP',
|
|
7 => 'Approved, administrative transaction',
|
|
8 => 'Approved, national NEG file hit OK',
|
|
9 => 'Approved, commercial',
|
|
23 => 'Amex - credit approval',
|
|
24 => 'Amex 77 - credit approval',
|
|
25 => 'Amex - credit approval ',
|
|
26 => 'Amex - credit approval ',
|
|
27 => 'Credit card approval',
|
|
28 => 'VIP Credit Approved',
|
|
29 => 'Credit Response Acknowledgement',
|
|
50 => 'Decline',
|
|
51 => 'Expired Card',
|
|
52 => 'PIN retries exceeded',
|
|
53 => 'No sharing',
|
|
54 => 'No security module',
|
|
55 => 'Invalid transaction',
|
|
56 => 'No Support',
|
|
57 => 'Lost or stolen card',
|
|
58 => 'Invalid status',
|
|
59 => 'Restricted Card',
|
|
60 => 'No Chequing account',
|
|
60 => 'No Savings account',
|
|
61 => 'No PBF',
|
|
62 => 'PBF update error',
|
|
63 => 'Invalid authorization type',
|
|
64 => 'Bad Track 2',
|
|
65 => 'Adjustment not allowed',
|
|
66 => 'Invalid credit card advance increment',
|
|
67 => 'Invalid transaction date',
|
|
68 => 'PTLF error',
|
|
69 => 'Bad message error',
|
|
70 => 'No IDF',
|
|
71 => 'Invalid route authorization',
|
|
72 => 'Card on National NEG file ',
|
|
73 => 'Invalid route service (destination)',
|
|
74 => 'Unable to authorize',
|
|
75 => 'Invalid PAN length',
|
|
76 => 'Low funds',
|
|
77 => 'Pre-auth full',
|
|
78 => 'Duplicate transaction',
|
|
79 => 'Maximum online refund reached',
|
|
80 => 'Maximum offline refund reached',
|
|
81 => 'Maximum credit per refund reached',
|
|
82 => 'Number of times used exceeded',
|
|
83 => 'Maximum refund credit reached',
|
|
84 => 'Duplicate transaction - authorization number has already been corrected by host.',
|
|
85 => 'Inquiry not allowed',
|
|
86 => 'Over floor limit ',
|
|
87 => 'Maximum number of refund credit by retailer',
|
|
88 => 'Place call ',
|
|
89 => 'CAF status inactive or closed',
|
|
90 => 'Referral file full',
|
|
91 => 'NEG file problem',
|
|
92 => 'Advance less than minimum',
|
|
93 => 'Delinquent',
|
|
94 => 'Over table limit',
|
|
95 => 'Amount over maximum',
|
|
96 => 'PIN required',
|
|
97 => 'Mod 10 check failure',
|
|
98 => 'Force Post',
|
|
99 => 'Bad PBF',
|
|
100 => 'Unable to process transaction',
|
|
101 => 'Place call',
|
|
102 => '',
|
|
103 => 'NEG file problem',
|
|
104 => 'CAF problem',
|
|
105 => 'Card not supported',
|
|
106 => 'Amount over maximum',
|
|
107 => 'Over daily limit',
|
|
108 => 'CAF Problem',
|
|
109 => 'Advance less than minimum',
|
|
110 => 'Number of times used exceeded',
|
|
111 => 'Delinquent',
|
|
112 => 'Over table limit',
|
|
113 => 'Timeout',
|
|
115 => 'PTLF error',
|
|
121 => 'Administration file problem',
|
|
122 => 'Unable to validate PIN: security module down',
|
|
150 => 'Merchant not on file',
|
|
200 => 'Invalid account',
|
|
201 => 'Incorrect PIN',
|
|
202 => 'Advance less than minimum',
|
|
203 => 'Administrative card needed',
|
|
204 => 'Amount over maximum ',
|
|
205 => 'Invalid Advance amount',
|
|
206 => 'CAF not found',
|
|
207 => 'Invalid transaction date',
|
|
208 => 'Invalid expiration date',
|
|
209 => 'Invalid transaction code',
|
|
210 => 'PIN key sync error',
|
|
212 => 'Destination not available',
|
|
251 => 'Error on cash amount',
|
|
252 => 'Debit not supported',
|
|
426 => 'AMEX - Denial 12',
|
|
427 => 'AMEX - Invalid merchant',
|
|
429 => 'AMEX - Account error',
|
|
430 => 'AMEX - Expired card',
|
|
431 => 'AMEX - Call Amex',
|
|
434 => 'AMEX - Call 03',
|
|
435 => 'AMEX - System down',
|
|
436 => 'AMEX - Call 05',
|
|
437 => 'AMEX - Declined',
|
|
438 => 'AMEX - Declined',
|
|
439 => 'AMEX - Service error',
|
|
440 => 'AMEX - Call Amex',
|
|
441 => 'AMEX - Amount error',
|
|
475 => 'CREDIT CARD - Invalid expiration date',
|
|
476 => 'CREDIT CARD - Invalid transaction, rejected',
|
|
477 => 'CREDIT CARD - Refer Call',
|
|
478 => 'CREDIT CARD - Decline, Pick up card, Call',
|
|
479 => 'CREDIT CARD - Decline, Pick up card',
|
|
480 => 'CREDIT CARD - Decline, Pick up card',
|
|
481 => 'CREDIT CARD - Decline',
|
|
482 => 'CREDIT CARD - Expired Card',
|
|
483 => 'CREDIT CARD - Refer',
|
|
484 => 'CREDIT CARD - Expired card - refer',
|
|
485 => 'CREDIT CARD - Not authorized',
|
|
486 => 'CREDIT CARD - CVV Cryptographic error',
|
|
487 => 'CREDIT CARD - Invalid CVV',
|
|
489 => 'CREDIT CARD - Invalid CVV',
|
|
490 => 'CREDIT CARD - Invalid CVV',
|
|
800 => 'Bad format',
|
|
801 => 'Bad data',
|
|
802 => 'Invalid Clerk ID',
|
|
809 => 'Bad close ',
|
|
810 => 'System timeout',
|
|
811 => 'System error',
|
|
821 => 'Bad response length',
|
|
877 => 'Invalid PIN block',
|
|
878 => 'PIN length error',
|
|
880 => 'Final packet of a multi-packet transaction',
|
|
881 => 'Intermediate packet of a multi-packet transaction',
|
|
889 => 'MAC key sync error',
|
|
898 => 'Bad MAC value',
|
|
899 => 'Bad sequence number - resend transaction',
|
|
900 => 'Capture - PIN Tries Exceeded',
|
|
901 => 'Capture - Expired Card',
|
|
902 => 'Capture - NEG Capture',
|
|
903 => 'Capture - CAF Status 3',
|
|
904 => 'Capture - Advance < Minimum',
|
|
905 => 'Capture - Num Times Used',
|
|
906 => 'Capture - Delinquent',
|
|
907 => 'Capture - Over Limit Table',
|
|
908 => 'Capture - Amount Over Maximum',
|
|
909 => 'Capture - Capture',
|
|
960 => 'Initialization failure - merchant number mismatch',
|
|
961 => 'Initialization failure -pinpad mismatch',
|
|
963 => 'No match on Poll code',
|
|
964 => 'No match on Concentrator ID',
|
|
965 => 'Invalid software version number',
|
|
966 => 'Duplicate terminal name'
|
|
);
|
|
|
|
# This contains a list of generic methods that take any value, and are handled
|
|
# via AUTOLOAD.
|
|
%NAME_MAP = (
|
|
billing_fname => 1,
|
|
billing_lname => 1,
|
|
billing_company => 1,
|
|
billing_address_1 => 1,
|
|
billing_address_2 => 1,
|
|
billing_city => 1,
|
|
billing_state => 1,
|
|
billing_postal_code => 1,
|
|
billing_country => 1,
|
|
billing_email => 1,
|
|
billing_phone => 1,
|
|
billing_fax => 1,
|
|
billing_note => 1,
|
|
order_id => 1,
|
|
account_token => 1,
|
|
account_token2 => 1
|
|
);
|
|
|
|
$ERRORS = {
|
|
CARD_NUMBER_NONE => "No credit card number entered",
|
|
CARD_NUMBER_NUMERIC => "Credit card number is not numeric",
|
|
CARD_NUMBER_LENGTH => "Invalid credit card number: Invalid length",
|
|
CARD_NUMBER_INVALID => "The credit card number entered is not valid: %s",
|
|
BRAND_NONE => "No credit card brand entered",
|
|
BRAND_INVALID => "Credit card brand '%s' is invalid or not supported%s",
|
|
EXPIRY_INVALID => "Invalid expiry date entered: %s",
|
|
EXPIRY_MONTH_NONE => "Empty expiry month entered",
|
|
EXPIRY_MONTH_NUMERIC => "Expiry month must be numeric: %s",
|
|
EXPIRY_MONTH_INVALID => "Invalid expiry month entered: %s",
|
|
EXPIRY_YEAR_NONE => "Empty expiry year entered",
|
|
EXPIRY_YEAR_NUMERIC => "Expiry year must be numeric: %s",
|
|
EXPIRY_YEAR_4_DIGIT => "Expiry year must be 4 digits: %s",
|
|
EXPIRY_YEAR_INVALID => "Invalid expiry year entered: %s",
|
|
TOTAL_NONE => "No total amount entered",
|
|
TOTAL_NUMERIC => "Total amount entered is not numeric: %s",
|
|
EMAIL_NONE => "No e-mail address entered",
|
|
EMAIL_INVALID => "Invalid e-mail address '%s' entered: %s",
|
|
GENERIC_NONE => "No value entered for %s",
|
|
GENERIC_INVALID => "Invalid value '%s' for %s: %s",
|
|
MISSING_FIELDS => "The following must be set before calling %s: %s",
|
|
|
|
TYPE_INVALID => "Invalid/unsupported transaction type: %s",
|
|
|
|
AUTHORIZE_FIRST => "You must authorize before capturing",
|
|
CAPTURE_REF_NONE => "No capture reference ID entered",
|
|
CAPTURE_REF_INVALID => "Invalid capture reference ID '%s': %s",
|
|
|
|
FIELD_MISSING => "The transaction server reported missing fields: %s",
|
|
FIELD_INVALID => "The transaction server reported invalid data: %s",
|
|
TRANSACTION_INVALID => "Setup problem: Invalid store information: %s",
|
|
TRANSACTION_PROBLEM => "A transaction server error has occurred: %s",
|
|
TRANSACTION_BAD => "You attempted to capture without authorizing first: %s",
|
|
VERSION_TOO_OLD => "The current version of the software is outdated: %s",
|
|
DECLINED => "Credit card declined: %s",
|
|
ERROR => "Credit card processing error: %s",
|
|
UNKNOWN => "The transaction server returned an unrecognized response: %s"
|
|
};
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
$class = ref $class if ref $class;
|
|
my $self = {};
|
|
bless $self, $class;
|
|
|
|
$self->debug("New $class object created") if $self->{_debug} and $self->{_debug} >= 2;
|
|
|
|
while (@_) {
|
|
my ($method, $value) = splice @_, 0, 2;
|
|
$self->debug("Found '$method' => '$value' in new() arguments - calling \$self->$method($value)") if $self->{_debug} and $self->{_debug} >= 2;
|
|
$self->$method($value);
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
AUTOLOAD {
|
|
my ($method) = $AUTOLOAD =~ /([^:]+)$/;
|
|
if (exists $NAME_MAP{$method}) {
|
|
no strict 'refs';
|
|
*$method = sub {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $value = shift;
|
|
$self->debug("Setting '$method' to '$value'") if $self->{_debug};
|
|
defined $value or $self->warn(GENERIC_NONE => $method), return undef;
|
|
$self->{$method} = $value;
|
|
return 1;
|
|
}
|
|
$self->debug("Retrieving '$method': '$self->{$method}'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $self->{$method};
|
|
};
|
|
}
|
|
else {
|
|
$method = "$ISA[0]::$method"; # Let GT::Base deal with it for now
|
|
}
|
|
goto &$method;
|
|
}
|
|
|
|
sub credit_card_number {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $ccnum = shift;
|
|
$self->debug("Setting 'credit_card_number' to '$ccnum'") if $self->{_debug};
|
|
unless (defined $ccnum and $ccnum =~ /\S/) {
|
|
$self->warn('CARD_NUMBER_NONE');
|
|
return undef;
|
|
}
|
|
$ccnum =~ y/ //d;
|
|
if ($ccnum =~ /\D/) {
|
|
$self->warn(CARD_NUMBER_NUMERIC => $ccnum);
|
|
return undef;
|
|
}
|
|
if (length($ccnum) < 13 or length($ccnum) > 20) {
|
|
$self->warn('CARD_NUMBER_LENGTH');
|
|
}
|
|
$self->{credit_card_number} = $ccnum;
|
|
return 1;
|
|
}
|
|
my $return = $self->{credit_card_number};
|
|
$self->debug("Retrieving 'credit_card_number': '$return'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $return;
|
|
}
|
|
|
|
# Takes \d\d-\d\d\d\d or \d\d/\d\d\d\d,
|
|
# passes them to credit_card_expiry_month and ..._year
|
|
# Return 1 if they were set properly, undef otherwise.
|
|
# Without arguments, returns: \d\d/\d\d\d\d if month and year are set, undef
|
|
# otherwise.
|
|
sub credit_card_expiry {
|
|
my $self = shift;
|
|
if (@_ >= 2) {
|
|
my $exp = shift;
|
|
$exp =~ y/ //d;
|
|
if (my ($m, $y) = $exp =~ m|^(\d?\d)[/-](\d\d\d\d)$|) {
|
|
$self->credit_card_expiry_month($m) or return undef;
|
|
$self->credit_card_expiry_year($y) or return undef;
|
|
return 1;
|
|
}
|
|
else {
|
|
$self->warn(EXPIRY_INVALID => $exp);
|
|
return undef;
|
|
}
|
|
}
|
|
my ($m, $y) = ($self->credit_card_expiry_month, $self->credit_card_expiry_year);
|
|
return undef unless defined $m and defined $y;
|
|
return "$m/$y";
|
|
}
|
|
|
|
sub _cc_exp {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns the credit card expiry in YYMM format, as this is how Moneris takes
|
|
# it.
|
|
#
|
|
my $self = shift;
|
|
my ($m, $y) = ($self->credit_card_expiry_month, $self->credit_card_expiry_year);
|
|
return substr($y, -2) . $m;
|
|
}
|
|
|
|
sub credit_card_expiry_month {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $expm = shift;
|
|
$expm =~ y/ //d;
|
|
defined $expm or $self->warn('EXPIRY_MONTH_NONE'), return undef;
|
|
$expm =~ /\D/ and $self->warn(EXPIRY_MONTH_NUMERIC => $expm), return undef;
|
|
$expm < 1 || $expm > 12 and $self->warn(EXPIRY_MONTH_INVALID => "Month '$expm' outside of 1-12 range"), return undef;
|
|
$expm = sprintf "%02d", $expm;
|
|
$self->debug("Setting 'credit_card_expiry_month' to '$expm'") if $self->{_debug};
|
|
$self->{credit_card_expiry_month} = $expm;
|
|
return 1;
|
|
}
|
|
my $return = $self->{credit_card_expiry_month};
|
|
$self->debug("Retrieving 'credit_card_expiry_month': '$return'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $return;
|
|
}
|
|
|
|
sub credit_card_expiry_year {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $expy = shift;
|
|
$self->debug("Setting 'credit_card_expiry_year' to '$expy'") if $self->{_debug};
|
|
$expy =~ y/ //d;
|
|
defined $expy or $self->warn('EXPIRY_YEAR_NONE'), return undef;
|
|
$expy =~ /\D/ and $self->warn(EXPIRY_YEAR_NUMERIC => $expy), return undef;
|
|
length($expy) == 4 or $self->warn(EXPIRY_YEAR_4_DIGIT => $expy), return undef;
|
|
$self->{credit_card_expiry_year} = $expy;
|
|
return 1;
|
|
}
|
|
my $return = $self->{credit_card_expiry_year};
|
|
$self->debug("Retrieving 'credit_card_expiry_year': $return") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $return;
|
|
}
|
|
|
|
sub charge_total {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $total = shift;
|
|
defined $total or $self->warn('TOTAL_NONE'), return undef;
|
|
$total =~ /^(?:\d+\.?\d*|\.\d+)$/ or $self->warn(TOTAL_NUMERIC => $total), return undef;
|
|
$total = sprintf "%.2f", $total;
|
|
$self->debug("Setting 'charge_total' to '$total'") if $self->{_debug};
|
|
$self->{charge_total} = $total;
|
|
return 1;
|
|
}
|
|
my $return = $self->{charge_total};
|
|
$self->debug("Retrieving 'charge_total': '$return'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $return;
|
|
}
|
|
|
|
sub billing_email {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $email = shift;
|
|
$self->debug("Setting 'billing_email' to '$email'") if $self->{_debug};
|
|
if (!defined $email) {
|
|
$self->warn('EMAIL_NONE');
|
|
return undef;
|
|
}
|
|
if ($email !~ /.@.+\../) {
|
|
$self->warn('EMAIL_INVALID' => $email => 'Invalid format');
|
|
return undef;
|
|
}
|
|
$self->{billing_email} = $email;
|
|
return 1;
|
|
}
|
|
my $return = $self->{billing_email};
|
|
$self->debug("Retrieving 'billing_email': '$return'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $return;
|
|
}
|
|
|
|
sub billing_address {
|
|
my $self = shift;
|
|
my ($one, $two) = ($self->billing_address_1, $self->billing_address_2);
|
|
return unless defined $one;
|
|
return $two ? $one . "\n" . $two : $one;
|
|
}
|
|
|
|
sub test_mode {
|
|
# -----------------------------------------------------------------------------
|
|
# Test mode for Moneris involves posting to a different location
|
|
#
|
|
my $self = shift;
|
|
if (@_) {
|
|
$self->{test_mode} = !!shift;
|
|
$self->debug(($self->{test_mode} ? "Enabling" : "Disabling") . " test mode") if $self->{_debug};
|
|
return 1;
|
|
}
|
|
$self->debug("Retrieving 'test_mode': '$self->{test_mode}'") if $self->{_debug} and $self->{_debug} >= 2;
|
|
return $self->{test_mode};
|
|
}
|
|
|
|
sub capture_reference_id {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $value = shift;
|
|
$self->debug("Setting 'capture_reference_id' to '$value'") if $self->{_debug};
|
|
defined $value or $self->warn('CAPTURE_REF_NONE'), return undef;
|
|
$self->{capture_reference_id} = $value;
|
|
return 1;
|
|
}
|
|
my $return;
|
|
if ($self->{preauth_capture_reference_id}) {
|
|
$return = $self->{preauth_capture_reference_id};
|
|
$self->debug("Retrieving 'capture_reference_id': '$return' (from preauth response)") if $self->{_debug} and $self->{_debug} >= 2;
|
|
}
|
|
else {
|
|
$return = $self->{capture_reference_id};
|
|
$self->debug("Retrieving 'capture_reference_id': '$return' (manually set)") if $self->{_debug} and $self->{_debug} >= 2;
|
|
}
|
|
$return;
|
|
}
|
|
|
|
sub _xml {
|
|
# -----------------------------------------------------------------------------
|
|
# Produces the XML string to post to the Moneris eSelect server
|
|
# Takes a single argument of either 'authorize', 'capture', or 'purchase'
|
|
#
|
|
my ($self, $type) = @_;
|
|
|
|
my $xml = '<?xml version="1.0"?>';
|
|
$xml .= '<request>';
|
|
$xml .= "<store_id>$self->{account_token2}</store_id>";
|
|
$xml .= "<api_token>$self->{account_token}</api_token>";
|
|
$xml .= $self->_xml_billing($type);
|
|
$xml .= '</request>';
|
|
$xml;
|
|
}
|
|
|
|
my %_Billing = (
|
|
authorize => [
|
|
order_id => 'order_id',
|
|
amount => 'charge_total',
|
|
pan => 'credit_card_number',
|
|
expdate => '_cc_exp',
|
|
crypt_type => \7, # FIXME - 6 is "SSL - SET enabled merchant", 7 is "SSL - nonSET enabled merchant" - what is SET?
|
|
],
|
|
capture => [
|
|
order_id => 'order_id',
|
|
comp_amount => 'charge_total',
|
|
txn_number => 'capture_reference_id',
|
|
crypt_type => \7, # FIXME - see above
|
|
],
|
|
txn_type => {
|
|
authorize => 'preauth',
|
|
capture => 'completion',
|
|
sale => 'purchase'
|
|
}
|
|
);
|
|
$_Billing{sale} = $_Billing{authorize};
|
|
|
|
sub _xml_billing {
|
|
# -----------------------------------------------------------------------------
|
|
# Produces the XML content for the charge portion of the transaction. This is
|
|
# credit card information, charge amount, etc. but not billing address
|
|
# information.
|
|
#
|
|
my ($self, $type) = @_;
|
|
|
|
my $xml = "<$_Billing{txn_type}->{$type}>";
|
|
for (my $i = 0; $i < @{$_Billing{$type}}; $i += 2) {
|
|
my ($key, $meth) = @{$_Billing{$type}}[$i, $i+1];
|
|
$xml .= "<$key>" . (ref $meth ? $$meth : $self->$meth()) . "</$key>";
|
|
}
|
|
|
|
$xml .= $self->_xml_custinfo($type);
|
|
$xml .= "</$_Billing{txn_type}->{$type}>";
|
|
$xml;
|
|
}
|
|
|
|
my @_Custinfo = (
|
|
first_name => 'billing_fname',
|
|
last_name => 'billing_lname',
|
|
company_name => 'billing_company',
|
|
address => 'billing_address',
|
|
city => 'billing_city',
|
|
province => 'billing_state',
|
|
postal_code => 'billing_postal_code',
|
|
country => 'billing_country',
|
|
phone_number => 'billing_phone',
|
|
fax => 'billing_fax'
|
|
);
|
|
|
|
|
|
sub _xml_custinfo {
|
|
# -----------------------------------------------------------------------------
|
|
# Produces the XML custinfo content. This is usually the billing address
|
|
# information. Although not required by eSelect, this module does require and
|
|
# pass this information.
|
|
#
|
|
my ($self, $type) = @_;
|
|
my $xml = '<cust_info>';
|
|
|
|
if (my $email = $self->billing_email) {
|
|
$xml .= "<email>$email</email>";
|
|
}
|
|
|
|
$xml .= '<billing>';
|
|
for (my $i = 0; $i < @_Custinfo; $i += 2) {
|
|
my ($key, $meth) = @_Custinfo[$i, $i+1];
|
|
my $val = $self->$meth();
|
|
if (defined $val) {
|
|
$xml .= "<$key>$val</$key>";
|
|
}
|
|
}
|
|
$xml .= '</billing>';
|
|
$xml .= '</cust_info>';
|
|
|
|
$xml;
|
|
}
|
|
|
|
sub _process {
|
|
# -----------------------------------------------------------------------------
|
|
# Processes a transaction. Takes a single argument - the type of transaction,
|
|
# which must be with 'authorize', 'capture', or 'sale'.
|
|
#
|
|
my ($self, $type) = @_;
|
|
$type eq 'authorize' or $type eq 'capture' or $type eq 'sale'
|
|
or return $self->fatal(TYPE_INVALID => $type);
|
|
|
|
$self->{response} = undef;
|
|
|
|
$self->check($type) or return undef;
|
|
|
|
my $www = GT::WWW->new(debug => $self->{_debug});
|
|
if ($self->{test_mode}) {
|
|
$www->url(TEST_SERVER);
|
|
}
|
|
else {
|
|
$www->url(LIVE_SERVER);
|
|
}
|
|
$www->connection_timeout(TIMEOUT);
|
|
$www->post_data($self->_xml('authorize'));
|
|
$www->agent("; GT::Payment::Direct::Moneris/$VERSION");
|
|
|
|
$self->debug("Posting data to @{[$self->{test_mode} ? 'test' : 'live']} server") if $self->{_debug};
|
|
my $response = $www->post
|
|
or return $self->warn(TRANSACTION_PROBLEM => $www->error);
|
|
my $status = $response->status;
|
|
|
|
$self->debug("Server responded with status " . int($status) . " $status") if $self->{_debug};
|
|
$status or return $self->warn(TRANSACTION_PROBLEM => "Webserver returned error code: " . int($status) . " $status");
|
|
|
|
return $self->_parse_response($response->content);
|
|
}
|
|
|
|
# Attempts to authorize. You'll get back three possible values:
|
|
# 1 - Authorization successful, funds guaranteed - capture should now be performed
|
|
# 0 - Authorization declined
|
|
# undef - An error occurred
|
|
sub authorize {
|
|
my $self = shift;
|
|
$self->debug("Performing authorization") if $self->{_debug};
|
|
|
|
my $ret = $self->_process('authorize');
|
|
if ($ret) { $self->{preauth_capture_reference_id} = $self->{response}->{TransID} }
|
|
elsif (defined $ret) {
|
|
my $code = $self->{response}->{ResponseCode};
|
|
$self->warn(DECLINED => ($code and $RESPONSE{int $code} or $self->{response}->{Message}));
|
|
}
|
|
else { $self->warn(ERROR => $self->{response}->{Message}) }
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub capture {
|
|
my $self = shift;
|
|
$self->debug("Performing authorization") if $self->{_debug};
|
|
|
|
my $ret = $self->_process('capture');
|
|
if (!defined $ret) { $self->warn(ERROR => $self->{response}->{Message}) }
|
|
elsif (!$ret) {
|
|
my $code = $self->{response}->{ResponseCode};
|
|
$self->warn(DECLINED => ($code and $RESPONSE{int $code} or $self->{response}->{Message}));
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub sale {
|
|
my $self = shift;
|
|
$self->debug("Performing sale") if $self->{_debug};
|
|
|
|
my $ret = $self->_process('sale');
|
|
if (!defined $ret) { $self->warn(ERROR => $self->{response}->{Message}) }
|
|
elsif (!$ret) {
|
|
my $code = $self->{response}->{ResponseCode};
|
|
$self->warn(DECLINED => ($code and $RESPONSE{int $code} or $self->{response}->{Message}));
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub _parse_response {
|
|
my ($self, $content) = @_;
|
|
|
|
my (%r, @stack);
|
|
$self->{response} = \%r;
|
|
|
|
while ($content =~ m{<(/)?([^<>]+)>|([^<>]+)}g) {
|
|
my ($slash, $tag, $value) = ($1, $2, $3);
|
|
if ($slash) {
|
|
pop @stack;
|
|
}
|
|
elsif (defined $tag) {
|
|
push @stack, $tag;
|
|
}
|
|
elsif ($value =~ /\S/) {
|
|
$value = undef if $value eq 'null';
|
|
$r{$stack[-1]} = $value;
|
|
}
|
|
}
|
|
|
|
my $ret;
|
|
if (not defined $r{ResponseCode}) {
|
|
$ret = undef;
|
|
}
|
|
elsif ($r{ResponseCode} < 50) {
|
|
$ret = 1;
|
|
}
|
|
else {
|
|
$ret = 0;
|
|
}
|
|
$ret;
|
|
}
|
|
|
|
sub check {
|
|
# -----------------------------------------------------------------------------
|
|
# Checks that all necessary data is provided for an authorize, capture, or
|
|
# sale. Takes one argument - 'authorize', 'capture', or 'sale', though 'sale'
|
|
# is really no different from 'authorize'.
|
|
#
|
|
my ($self, $type) = @_;
|
|
|
|
$type = 'authorize' if $type eq 'sale';
|
|
$type eq 'authorize' or $type eq 'capture'
|
|
or return $self->fatal(TYPE_INVALID => $type);
|
|
|
|
my @bad;
|
|
for my $field (@{$REQUIRED{uc $type}}) {
|
|
my $value = $self->$field();
|
|
if ($field eq 'charge_total') {
|
|
push @bad, $field if $value <= 0;
|
|
}
|
|
else {
|
|
push @bad, $field if !$value;
|
|
}
|
|
}
|
|
if (@bad) {
|
|
$self->warn(MISSING_FIELDS => $type => "@bad");
|
|
return undef;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub receipt {
|
|
# -----------------------------------------------------------------------------
|
|
# After a successful sale, you can call this to get a list of Key => Value
|
|
# pairs that make up a rough receipt. The keys are ordered, so reading them
|
|
# into an array probably makes more sense than a hash.
|
|
#
|
|
my $self = shift;
|
|
my $r = $self->{response} or return;
|
|
my @receipt;
|
|
my $code = $r->{ResponseCode};
|
|
push @receipt,
|
|
"Order ID" => $self->order_id,
|
|
"Amount" => $r->{TransAmount},
|
|
"Status" => ($code and $RESPONSE{int $code} or $self->{response}->{Message}),
|
|
"Transaction Type" => $r->{TransType},
|
|
"Date" => $r->{TransDate},
|
|
"Auth Code" => $r->{AuthCode},
|
|
"Response Code" => $code,
|
|
"Response Message" => $r->{Message},
|
|
"ISO Code" => $r->{ISO},
|
|
"Reference Number" => $r->{ReferenceNum},
|
|
"Cardholder Name" => $self->billing_fname . " " . $self->billing_lname;
|
|
|
|
return @receipt;
|
|
}
|
|
|
|
1;
|