First pass at adding key files
This commit is contained in:
@ -0,0 +1,773 @@
|
||||
# ====================================================================
|
||||
# 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;
|
Reference in New Issue
Block a user