saint/discourse-legacysite-perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

First pass at adding key files

Browse Source
This commit is contained in:
dsainty
2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

787
site/slowtwitch.com/cgi-bin/articles/admin/GT/Payment/Direct/AuthorizeDotNet.pm Normal file
View File

@ -0,0 +1,787 @@
# ====================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
# GT::Payment::AuthorizeDotNet
# Author: Jason Rhinelander
# CVS Info : 087,071,086,086,085
# $Id: AuthorizeDotNet.pm,v 1.8 2008/09/23 23:55:26 brewt Exp $
#
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
# ====================================================================
#
# Description:
# Enter description here.
#
package GT::Payment::Direct::AuthorizeDotNet;
use strict;
use vars qw/%REQUIRED %ERRORS %PARAM $AUTOLOAD %VALID %CURRENCY/;
use Carp;
use Net::SSLeay; # Just to make sure it's available, since GT::WWW doesn't load
use GT::WWW; # Net::SSLeay until attempting to establish the connection.
use Net::hostent;
%ERRORS = (
INVALID => "Invalid value entered for %s: '%s'",
INVALID_PIPE => "Invalid value entered for %s: '%s' ('|' is not permitted)",
INVALID_CURRENCY => "Invalid currency specified for %s: '%s'",
MISSING_FIELDS => 'The following must be set before calling %s: %s',
CHECK_INVALID => 'Invalid type to check: %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",
HTTP_CONNECTING => 'An error occurred while connecting to the Authorize.net gateway: %s',
HTTP_COMMUNICATING => 'An error occurred while communicating with the Authorize.net gateway: %s',
TEST_CONN_RESOLVE => 'Unable to resolve gateway host: %s',
TEST_CONNECTION => 'Unable to establish a SSL test connection: %s',
DECLINED => 'Credit card declined: %s',
);
# Also required in addition to this list that is set automatically:
# x_Version (3.1), x_Delim_Data (TRUE), x_Type (AUTH_CAPTURE, AUTH_ONLY, etc.),
# x_Method (CC)
%REQUIRED = (
AUTHORIZE => [
'account_username', # x_Login
'account_key', # x_Trans_Key
'credit_card_number', # x_Card_Num
'credit_card_expiry_month', # x_Exp_Date (part 1, month)
'credit_card_expiry_year', # x_Exp_Date (part 2, year)
'charge_total', # x_Amount
'billing_fname',
'billing_lname',
'billing_address_1',
'billing_city',
'billing_state',
'billing_postal_code',
'billing_country',
'billing_phone',
'order_id'
],
CAPTURE => [qw(
account_username
charge_total
capture_reference_id
)],
# Can be used to refund an already settled payment partially or completely
CREDIT => [qw(
account_username
charge_total
capture_reference_id
)],
# Can be used to cancel a previously made payment. This can apply to an authorization,
# capture, or sale - provided, with the latter two, that the payment has not already
# been settled.
VOID => [qw(
account_username
charge_total
capture_reference_id
)]
);
# Scalar ref = use this value,
# Scalar = call this method, use the return value
# undef = the method (auth, capture, etc.) will set it
%PARAM = (
x_Delim_Char => \'|',
x_Delim_Data => \'TRUE',
x_Encap_Char => \'',
# x_ADC_URL => \'FALSE',
x_Test_Request => 'test_mode', # this means nothing real actually happens. Values are 'TRUE' or 'FALSE'.
x_Login => 'account_username', # required
x_Tran_Key => 'account_key', # supposedly required
x_Password => 'account_password', # Optional under AIM (a merchant option)
x_Version => \'3.1', # Authorize.net protocol and response version.
x_Method => \'CC', # Authorize.Net also supports 'ECHECK', but it has different requirements and so should probably be a subclass
# x_Auth_Code => ???, # ???
x_Trans_ID => 'capture_reference_id', # Required for CREDIT, VOID, and PRIOR_AUTH_CAPTURE
x_Card_Num => 'credit_card_number', # required
x_Card_Code => 'credit_card_code', # optional
x_Exp_Date => 'credit_card_expiry', # required - mmyy, mm/yy, or mm/yyyy
x_Amount => 'charge_total', # required
x_Currency_Code => 'currency', # optional - default is 'USD'
x_Invoice_Num => 'order_id', # not strictly required by Authorize.Net, but we require it anyway
x_Description => 'charge_description', # optional
x_Freight => 'charge_freight', # optional
x_Tax => 'charge_tax', # optional
x_Tax_Exempt => 'charge_tax_exempt', # optional - 'TRUE' or 'FALSE' (default)
x_Description => 'charge_description', # optional
x_Duty => 'charge_duty', # optional - valid is "any valid amount"
x_First_Name => 'billing_fname', # required
x_Last_Name => 'billing_lname', # required
x_Company => 'billing_company', # optional
x_Address => 'billing_address', # required - equivelant to a combination of Moneris' billing_address_1 and ..._2
x_City => 'billing_city', # required
x_State => 'billing_state', # required
x_Country => 'billing_country', # required
x_Zip => 'billing_postal_code', # required
x_Phone => 'billing_phone', # required
x_Fax => 'billing_fax', # optional
x_Customer_IP => 'billing_ip', # required; Moneris doesn't have this. It is the IP of whoever placed the order
x_Email => 'confirmation_email', # optional
x_Email_Customer => 'confirmation_confirm', # optional - Whether a confirmation e-mail should be sent to the customer. 'TRUE' or 'FALSE'. Default is configurable through Merchant interface
x_Merchant_Email => 'confirmation_merchant', # optional - if set, an e-mail will be sent here in addition to the normal merchant e-mail address
# x_Recurring_Billing => ???, # optional - TRUE or FALSE (FALSE is default)
# All optional:
x_Ship_To_First_Name => 'shipping_fname',
x_Ship_To_Last_Name => 'shipping_lname',
x_Ship_To_Company => 'shipping_company',
x_Ship_To_Address => 'shipping_address',
x_Ship_To_City => 'shipping_city',
x_Ship_To_State => 'shipping_state',
x_Ship_To_Country => 'shipping_country',
x_Ship_To_Zip => 'shipping_postal_code',
x_Type => undef, # This has to be set by auth(), or capture() to one of:
#
# AUTH_CAPTURE: Auth-Capture is the normal transaction method; a transaction is
# sent to the system for approval, the transaction is approved, the merchant is
# notified of the approval, and the transaction automatically settles at the
# end of the business day without any further action by the merchant.
#
# AUTH_ONLY: Auth-Only stands for Authorization-Only and means obtaining an
# authorization for a certain amount on a customer's credit card without
# actually charging the card. If the money is not captured within 30 days, the
# transaction will expire.
#
# PRIOR_AUTH_CAPTURE: A Prior-Auth-Capture transaction is used to capture funds
# authorized previously using an Auth-Only transaction. Prior-Auth-Capture is
# really just an operation on an already existing transaction.
# Prior-Auth-Capture should only be used on Auth-Only transactions processed
# using the system.
#
# CAPTURE_ONLY: Capture-Only transactions are used when an authorization-only is
# obtained through any means other than the system.
#
# CREDIT: Credits are not processed in real time, but are submitted at
# settlement time with other transactions.
#
# VOID: Voiding a transaction prevents a charge to a credit card/bank account
# from occurring. Voids are performed on existing transactions that have yet to
# be settled.
#
#x_Use_Fraudscreen => ???, # "Not yet supported"
);
my $monetary = '^(?:\d+\.?\d*|\.\d+)$';
# A series of regex for field assignment. References are special values, as follows:
# BOOL => accept a boolean (1 or undef)
# CURRENCY => accept a key of the %CURRENCY hash
#
# undef means any string can be assigned. Note that anything NOT in here CANNOT
# be called as a method.
%VALID = (
account_username => undef,
account_key => undef,
account_password => undef,
capture_reference_id => undef,
credit_card_number => '^\d{13,19}$',
credit_card_expiry_month => '^(?:0?[1-9]|1[012])$',
credit_card_expiry_year => '^\d\d(?:\d\d)?$',
#credit_card_expiry => '^(?:0?[1-9]|1[12])(?:[-/]?\d\d(?:\d\d)?)$', # mmyy, mm/yy, mm-yy, mmyyyy, mm/yyyy, or mm-yyyy
credit_card_code => '^\d{3,4}$', # The 3 or 4 digit code on the back of the credit card (or front of Amer. Exp.)
currency => \'CURRENCY',
charge_total => $monetary,
charge_freight => $monetary,
charge_tax => $monetary,
charge_tax_exempt => \'BOOL',
charge_duty => $monetary,
charge_description => undef,
charge_duty => $monetary,
billing_fname => undef,
billing_lname => undef,
billing_company => undef,
billing_address_1 => undef,
billing_address_2 => undef,
billing_city => undef,
billing_state => undef,
billing_country => undef,
billing_postal_code => undef,
billing_phone => undef,
billing_fax => undef,
billing_ip => '^(?:(?:1?\d?\d|2(?:[0-4]\d|5[0-5]))\.){3}(?:1?\d?\d|2(?:[0-4]\d|5[0-5]))$',
confirmation_email => '^\S+@([a-zA-Z0-9-]+\.)+[a-zA-Z0-9-]+$',
confirmation_confirm => \'BOOL',
confirmation_merchant => '^\S+@([a-zA-Z0-9-]+\.)+[a-zA-Z0-9-]+$',
shipping_fname => undef,
shipping_lname => undef,
shipping_company => undef,
shipping_address => undef,
shipping_city => undef,
shipping_state => undef,
shipping_country => undef,
shipping_postal_code => undef,
order_id => '^.{1,20}$',
test_mode => \'BOOL'
);
# The official list of supported currencies:
%CURRENCY = (
AFA => 'Afghani (Afghanistan)',
DZD => 'Algerian Dinar (Algeria)',
ADP => 'Andorran Peseta (Andorra)',
ARS => 'Argentine Peso (Argentina)',
AMD => 'Armenian Dram (Armenia)',
AWG => 'Aruban Guilder (Aruba)',
AUD => 'Australian Dollar (Australia)',
AZM => 'Azerbaijanian Manat (Azerbaijan)',
BSD => 'Bahamian Dollar (Bahamas)',
BHD => 'Bahraini Dinar (Bahrain)',
THB => 'Baht (Thailand)',
PAB => 'Balboa (Panama)',
BBD => 'Barbados Dollar (Barbados)',
BYB => 'Belarussian Ruble (Belarus)',
BEF => 'Belgian Franc (Belgium)',
BZD => 'Belize Dollar (Belize)',
BMD => 'Bermudian Dollar (Bermuda)',
VEB => 'Bolivar (Venezuela)',
BOB => 'Boliviano (Bolivia)',
BRL => 'Brazilian Real (Brazil)',
BND => 'Brunei Dollar (Brunei Darussalam)',
BGN => 'Bulgarian Lev (Bulgaria)',
BIF => 'Burundi Franc (Burundi)',
CAD => 'Canadian Dollar (Canada)',
CVE => 'Cape Verde Escudo (Cape Verde)',
KYD => 'Cayman Islands Dollar (Cayman Islands)',
GHC => 'Cedi (Ghana)',
XOF => 'CFA Franc BCEAO (Guinea-Bissau)',
XAF => 'CFA Franc BEAC (Central African Republic)',
XPF => 'CFP Franc (New Caledonia)',
CLP => 'Chilean Peso (Chile)',
COP => 'Colombian Peso (Colombia)',
KMF => 'Comoro Franc (Comoros)',
BAM => 'Convertible Marks (Bosnia And Herzegovina)',
NIO => 'Cordoba Oro (Nicaragua)',
CRC => 'Costa Rican Colon (Costa Rica)',
CUP => 'Cuban Peso (Cuba)',
CYP => 'Cyprus Pound (Cyprus)',
CZK => 'Czech Koruna (Czech Republic)',
GMD => 'Dalasi (Gambia)',
DKK => 'Danish Krone (Denmark)',
MKD => 'Denar (The Former Yugoslav Republic Of Macedonia)',
DEM => 'Deutsche Mark (Germany)',
AED => 'Dirham (United Arab Emirates)',
DJF => 'Djibouti Franc (Djibouti)',
STD => 'Dobra (Sao Tome And Principe)',
DOP => 'Dominican Peso (Dominican Republic)',
VND => 'Dong (Vietnam)',
GRD => 'Drachma (Greece)',
XCD => 'East Caribbean Dollar (Grenada)',
EGP => 'Egyptian Pound (Egypt)',
SVC => 'El Salvador Colon (El Salvador)',
ETB => 'Ethiopian Birr (Ethiopia)',
EUR => 'Euro (Europe)',
FKP => 'Falkland Islands Pound (Falkland Islands)',
FJD => 'Fiji Dollar (Fiji)',
HUF => 'Forint (Hungary)',
CDF => 'Franc Congolais (The Democratic Republic Of Congo)',
FRF => 'French Franc (France)',
GIP => 'Gibraltar Pound (Gibraltar)',
XAU => 'Gold',
HTG => 'Gourde (Haiti)',
PYG => 'Guarani (Paraguay)',
GNF => 'Guinea Franc (Guinea)',
GWP => 'Guinea-Bissau Peso (Guinea-Bissau)',
GYD => 'Guyana Dollar (Guyana)',
HKD => 'Hong Kong Dollar (Hong Kong)',
UAH => 'Hryvnia (Ukraine)',
ISK => 'Iceland Krona (Iceland)',
INR => 'Indian Rupee (India)',
IRR => 'Iranian Rial (Islamic Republic Of Iran)',
IQD => 'Iraqi Dinar (Iraq)',
IEP => 'Irish Pound (Ireland)',
ITL => 'Italian Lira (Italy)',
JMD => 'Jamaican Dollar (Jamaica)',
JOD => 'Jordanian Dinar (Jordan)',
KES => 'Kenyan Shilling (Kenya)',
PGK => 'Kina (Papua New Guinea)',
LAK => 'Kip (Lao People\'s Democratic Republic)',
EEK => 'Kroon (Estonia)',
HRK => 'Kuna (Croatia)',
KWD => 'Kuwaiti Dinar (Kuwait)',
MWK => 'Kwacha (Malawi)',
ZMK => 'Kwacha (Zambia)',
AOR => 'Kwanza Reajustado (Angola)',
MMK => 'Kyat (Myanmar)',
GEL => 'Lari (Georgia)',
LVL => 'Latvian Lats (Latvia)',
LBP => 'Lebanese Pound (Lebanon)',
ALL => 'Lek (Albania)',
HNL => 'Lempira (Honduras)',
SLL => 'Leone (Sierra Leone)',
ROL => 'Leu (Romania)',
BGL => 'Lev (Bulgaria)',
LRD => 'Liberian Dollar (Liberia)',
LYD => 'Libyan Dinar (Libyan Arab Jamahiriya)',
SZL => 'Lilangeni (Swaziland)',
LTL => 'Lithuanian Litas (Lithuania)',
LSL => 'Loti (Lesotho)',
LUF => 'Luxembourg Franc (Luxembourg)',
MGF => 'Malagasy Franc (Madagascar)',
MYR => 'Malaysian Ringgit (Malaysia)',
MTL => 'Maltese Lira (Malta)',
TMM => 'Manat (Turkmenistan)',
FIM => 'Markka (Finland)',
MUR => 'Mauritius Rupee (Mauritius)',
MZM => 'Metical (Mozambique)',
MXN => 'Mexican Peso (Mexico)',
MXV => 'Mexican Unidad de Inversion (Mexico)',
MDL => 'Moldovan Leu (Republic Of Moldova)',
MAD => 'Moroccan Dirham (Morocco)',
BOV => 'Mvdol (Bolivia)',
NGN => 'Naira (Nigeria)',
ERN => 'Nakfa (Eritrea)',
NAD => 'Namibia Dollar (Namibia)',
NPR => 'Nepalese Rupee (Nepal)',
ANG => 'Netherlands (Netherlands)',
NLG => 'Netherlands Guilder (Netherlands)',
YUM => 'New Dinar (Yugoslavia)',
ILS => 'New Israeli Sheqel (Israel)',
AON => 'New Kwanza (Angola)',
TWD => 'New Taiwan Dollar (Province Of China Taiwan)',
ZRN => 'New Zaire (Zaire)',
NZD => 'New Zealand Dollar (New Zealand)',
BTN => 'Ngultrum (Bhutan)',
KPW => 'North Korean Won (Democratic People\'s Republic Of Korea)',
NOK => 'Norwegian Krone (Norway)',
PEN => 'Nuevo Sol (Peru)',
MRO => 'Ouguiya (Mauritania)',
TOP => 'Pa\'anga (Tonga)',
PKR => 'Pakistan Rupee (Pakistan)',
XPD => 'Palladium',
MOP => 'Pataca (Macau)',
UYU => 'Peso Uruguayo (Uruguay)',
PHP => 'Philippine Peso (Philippines)',
XPT => 'Platinum',
PTE => 'Portuguese Escudo (Portugal)',
GBP => 'Pound Sterling (United Kingdom)',
BWP => 'Pula (Botswana)',
QAR => 'Qatari Rial (Qatar)',
GTQ => 'Quetzal (Guatemala)',
ZAL => 'Rand (Financial) (Lesotho)',
ZAR => 'Rand (South Africa)',
OMR => 'Rial Omani (Oman)',
KHR => 'Riel (Cambodia)',
MVR => 'Rufiyaa (Maldives)',
IDR => 'Rupiah (Indonesia)',
RUB => 'Russian Ruble (Russian Federation)',
RUR => 'Russian Ruble (Russian Federation)',
RWF => 'Rwanda Franc (Rwanda)',
SAR => 'Saudi Riyal (Saudi Arabia)',
ATS => 'Schilling (Austria)',
SCR => 'Seychelles Rupee (Seychelles)',
XAG => 'Silver',
SGD => 'Singapore Dollar (Singapore)',
SKK => 'Slovak Koruna (Slovakia)',
SBD => 'Solomon Islands Dollar (Solomon Islands)',
KGS => 'Som (Kyrgyzstan)',
SOS => 'Somali Shilling (Somalia)',
ESP => 'Spanish Peseta (Spain)',
LKR => 'Sri Lanka Rupee (Sri Lanka)',
SHP => 'St Helena Pound (St Helena)',
ECS => 'Sucre (Ecuador)',
SDD => 'Sudanese Dinar (Sudan)',
SRG => 'Surinam Guilder (Suriname)',
SEK => 'Swedish Krona (Sweden)',
CHF => 'Swiss Franc (Switzerland)',
SYP => 'Syrian Pound (Syrian Arab Republic)',
TJR => 'Tajik Ruble (Tajikistan)',
BDT => 'Taka (Bangladesh)',
WST => 'Tala (Samoa)',
TZS => 'Tanzanian Shilling (United Republic Of Tanzania)',
KZT => 'Tenge (Kazakhstan)',
TPE => 'Timor Escudo (East Timor)',
SIT => 'Tolar (Slovenia)',
TTD => 'Trinidad and Tobago Dollar (Trinidad And Tobago)',
MNT => 'Tugrik (Mongolia)',
TND => 'Tunisian Dinar (Tunisia)',
TRL => 'Turkish Lira (Turkey)',
UGX => 'Uganda Shilling (Uganda)',
ECV => 'Unidad de Valor Constante (Ecuador)',
CLF => 'Unidades de fomento (Chile)',
USN => 'US Dollar (Next day) (United States)',
USS => 'US Dollar (Same day) (United States)',
USD => 'US Dollar (United States)',
UZS => 'Uzbekistan Sum (Uzbekistan)',
VUV => 'Vatu (Vanuatu)',
KRW => 'Won (Republic Of Korea)',
YER => 'Yemeni Rial (Yemen)',
JPY => 'Yen (Japan)',
CNY => 'Yuan Renminbi (China)',
ZWD => 'Zimbabwe Dollar (Zimbabwe)',
PLN => 'Zloty (Poland)'
);
use constants
POST_HOST => 'secure.authorize.net',
POST_PATH => '/gateway/transact.dll';
sub new {
# -----------------------------------------------------------------------------
my $class = shift;
$class = ref $class if ref $class;
my $self = { debug => 0 };
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;
}
DESTROY { }
sub errcode {
# -----------------------------------------------------------------------------
my $self = shift;
$self->{errcode};
}
sub error {
# -----------------------------------------------------------------------------
my $self = shift;
if (@_) {
my $code = shift;
$self->{errcode} = $code;
my $error = sprintf($ERRORS{$code} || $code, @_);
$self->debug($error) if $self->{debug};
$self->{error} = $error;
return undef;
}
$self->{error};
}
sub clear_error {
my $self = shift;
$self->{error} = $self->{errcode} = undef;
$self->debug("Clearing error code") if $self->{debug} >= 2;
}
sub fatal {
# -----------------------------------------------------------------------------
my ($self, $code) = splice @_, 0, 2;
my $error = sprintf($ERRORS{$code} || $code, @_);
my $me = ref $self || $self;
croak "$me: @_";
}
sub debug {
# -----------------------------------------------------------------------------
my $self = @_ > 1 ? shift : __PACKAGE__;
$self = ref $self if ref $self;
carp "$self: @_";
}
sub debug_level {
# -----------------------------------------------------------------------------
my $self = shift;
if (@_) {
$self->{debug} = int shift;
}
$self->{debug};
}
AUTOLOAD {
my ($method) = $AUTOLOAD =~ /([^:]+)$/;
if (exists $VALID{$method}) {
no strict 'refs';
my $validation = $VALID{$method};
*$method = sub {
my $self = shift;
if (@_) {
$self->{error} = undef;
if (ref $validation) {
if ($$validation eq 'BOOL') {
if (shift) {
$self->debug("Setting '$method' option to true") if $self->{debug};
$self->{$method} = 'TRUE';
}
else {
$self->debug("Setting '$method' option to false") if $self->{debug};
$self->{$method} = 'FALSE';
}
}
elsif ($$validation eq 'CURRENCY') {
my $value = uc shift;
unless (exists $CURRENCY{$value}) {
$self->debug("Not setting '$method' to '$value' (Invalid currency code)") if $self->{debug};
return $self->error(INVALID_CURRENCY => $method, $value);
}
$self->debug("Setting '$method' to '$value' (Currency code accepted)") if $self->{debug};
$self->{$method} = $value;
}
}
elsif (defined $validation) {
my $value = shift;
$value =~ s/\s+//g if $method eq 'credit_card_number';
if ($value =~ /$validation/) {
if (index($value, '|') >= 0) {
$self->debug("Not setting '$method' to '$value' (Value contains illegal character '|')") if $self->{debug};
return $self->error(INVALID_PIPE => $method, $value);
}
$self->debug("Setting '$method' to '$value' (Validation regex: $validation passed)") if $self->{debug};
$self->{$method} = $value;
}
else {
$self->debug("Not setting '$method' to '$value' (Validation regex: $validation failed)") if $self->{debug};
return $self->error(INVALID => $method, $value);
}
}
else {
my $value = shift;
if (index($value, '|') >= 0) {
$self->debug("Not setting '$method' to '$value' (Value contains illegal character '|')") if $self->{debug};
return $self->error(INVALID_PIPE => $method, $value);
}
$self->debug("Setting '$method' to '$value' (No validation regex)") if $self->{debug};
$self->{$method} = $value;
}
return 1;
}
my $value = $self->{$method};
$self->debug("Retrieving '$method': '$value'") if $self->{debug} and $self->{debug} >= 2;
return $value;
};
}
else {
croak qq|Can't locate object method "$method" via package "| . (ref $_[0] or $_[0] or __PACKAGE__) . qq|"|;
}
goto &$method;
}
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 credit_card_expiry {
my $self = shift;
my ($month, $year) = ($self->credit_card_expiry_month, $self->credit_card_expiry_year);
return unless defined $month and defined $year;
return $month . '/' . $year;
}
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) = @_;
$self->clear_error();
$self->fatal(CHECK_INVALID => $type) unless $type =~ /^(?:authorize|capture|sale)$/i;
my @bad;
for my $field (@{$REQUIRED{uc(lc $type eq 'sale' ? 'authorize' : $type)}}) {
my $value = $self->$field();
if ($field eq 'charge_total') {
push @bad, $field if $value <= 0;
}
else {
push @bad, $field if not defined $value or not length $value;
}
}
if (@bad) {
$self->error(MISSING_FIELDS => $type => "@bad");
return undef;
}
return 1;
}
sub response {
# -----------------------------------------------------------------------------
my $self = shift;
$self->{response};
}
sub _init_www {
# -----------------------------------------------------------------------------
my ($self, $type) = @_;
my $www = $self->{www} ||= GT::WWW->new(debug => $self->{debug});
$www->url('https://' . POST_HOST . POST_PATH);
my @param;
while (my ($key, $value) = each %PARAM) {
if (ref $value) {
push @param, $key, $$value;
}
elsif ($key eq 'x_Type') {
push @param, 'x_Type', $type;
}
else {
my $val = $self->$value();
push @param, $key, $val if defined $val;
}
}
$www->header(Connection => 'close');
$www->parameters(@param);
return $www;
}
sub post_payment_request {
# -----------------------------------------------------------------------------
my ($self, $type) = @_;
my $www = $self->_init_www($type);
my $response = $www->post;
unless ($response) {
return $self->error(HTTP_CONNECTING => $www->error);
}
unless ($response->status) {
return $self->error(HTTP_COMMUNICATING => int($response->status()) . ' ' . $response->status());
}
my @fields = split /\|/, "$response";
$self->{response} = { fields => \@fields };
$self->{response}->{code} = $fields[0]; # 1 = Approved, 2 = Denied, 3 = Error
$self->{response}->{reason_code} = $fields[2];
$self->{response}->{reason_text} = $fields[3];
$self->{response}->{approval_code} = $fields[4]; # The six-digit alphanumeric authorization or approval code
$self->{response}->{avs_code} = $fields[5]; # See the AIM Implementation Guide
# "This number identifies the transaction in the system and can be used to
# submit a modification of this transaction at a later time, such as voiding,
# crediting or capturing the transaction."
$self->{response}->{trans_id} = $fields[6];
# The 8th through 37th fields are just the form input echoed back.
# 38 is a "system-generated MD5 hash that may be validated by the merchant to
# authenticate a transaction response received from the gateway"
$self->{response}->{md5_hash} = $fields[37];
# 39 "indicates the results of Card Code verification" - see the AIM Implementation Guide
$self->{response}->{card_code_response} = $fields[38];
$self->{transaction_error_code} = $self->{response}->{reason_code};
# What we return is:
# 1 - Payment request successful
# 0 - Payment request declined
# -1 - An error occurred
if ($self->{response}->{code} == 1) {
my @receipt;
push @receipt, 'Approval Code', $self->{response}->{approval_code};
push @receipt, 'AVS Code', $self->{response}->{avs_code} if $self->{response}->{avs_code};
push @receipt, 'Transaction ID', $self->{response}->{trans_id};
push @receipt, 'Card Code Response', $self->{response}->{card_code_response} if $self->{response}->{card_code_response};
$self->{response}->{receipt} = \@receipt;
}
return $self->{response}->{code} == 1 ? 1 : $self->{response}->{code} == 2 ? 0 : -1;
}
sub authorize {
# -----------------------------------------------------------------------------
my $self = shift;
$self->debug("Performing authorization") if $self->{debug};
$self->{type} = 'AUTH_ONLY';
$self->check('authorize') or return undef;
my $ret = $self->post_payment_request('AUTH_ONLY');
# Set the transaction ID as our 'capture_reference_id', so that this object can
# capture() immediately after authorize()ing.
$self->{capture_reference_id} = $self->{response}->{trans_id};
return $ret;
}
sub capture {
# -----------------------------------------------------------------------------
my $self = shift;
$self->debug("Performing prior-auth capture") if $self->{debug};
$self->{type} = 'PRIOR_AUTH_CAPTURE';
$self->check('capture') or return undef;
return $self->post_payment_request('PRIOR_AUTH_CAPTURE');
}
sub sale {
# -----------------------------------------------------------------------------
my $self = shift;
$self->debug("Performing auth-capture (sale)") if $self->{debug};
$self->{type} = 'AUTH_CAPTURE';
$self->check('sale') or return undef;
return $self->post_payment_request('AUTH_CAPTURE');
}
sub test_connection {
# -----------------------------------------------------------------------------
# Call this on your object when setting up a payment system to verify that the
# payment gateway is reachable. This does a simple HEAD request of
# http://secure.authorize.net - if 200 status is returned, it is assumed to be
# reachable.
my $self = shift;
my $www = $self->{www} ||= GT::WWW->new();
# We're just going to do a HEAD request to make sure we can properly establish
# an HTTPS connection.
unless (gethost(POST_HOST)) {
return $self->error(TEST_CONN_RESOLVE => POST_HOST);
}
$www->url('https://' . POST_HOST);
my $response = $www->head();
unless ($response and my $status = $response->status) {
return $self->error(TEST_CONNECTION => ($response ? "Server response: " . int($status) . " " . $status : $www->error));
}
$self->{connection_tested} = 1;
return 1;
}
#sub test_account {
# -----------------------------------------------------------------------------
1;

773
site/slowtwitch.com/cgi-bin/articles/admin/GT/Payment/Direct/Moneris.pm Normal file
View File

@ -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;