discourse-legacysite-perl/site/slowtwitch.com/cgi-bin/articles/GT/Payment/Direct/AuthorizeDotNet.pm
2024-06-17 21:49:12 +10:00

788 lines
28 KiB
Perl

# ====================================================================
# 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;