First pass at adding key files
This commit is contained in:
		@@ -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;
 | 
			
		||||
@@ -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;
 | 
			
		||||
@@ -0,0 +1,317 @@
 | 
			
		||||
# ====================================================================
 | 
			
		||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
 | 
			
		||||
#
 | 
			
		||||
#   GT::Payment::Remote::2CheckOut
 | 
			
		||||
#   Author: Jason Rhinelander
 | 
			
		||||
#   CVS Info : 087,071,086,086,085      
 | 
			
		||||
#   $Id: 2CheckOut.pm,v 1.5 2006/08/22 20:39:04 brewt Exp $
 | 
			
		||||
#
 | 
			
		||||
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
# ====================================================================
 | 
			
		||||
#
 | 
			
		||||
# Description:
 | 
			
		||||
#   2CheckOut payment processing.
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package GT::Payment::Remote::2CheckOut;
 | 
			
		||||
use strict;
 | 
			
		||||
use Carp;
 | 
			
		||||
use GT::MD5 'md5_hex';
 | 
			
		||||
require Exporter;
 | 
			
		||||
use vars qw/@EXPORT_OK/;
 | 
			
		||||
@EXPORT_OK = qw/process/;
 | 
			
		||||
 | 
			
		||||
sub process {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
    shift if $_[0] and UNIVERSAL::isa($_[0], __PACKAGE__);
 | 
			
		||||
 | 
			
		||||
    my %opts = @_;
 | 
			
		||||
    $opts{param} and UNIVERSAL::isa($opts{param}, 'GT::CGI') or croak 'Usage: ->process(param => $gtcgi, ...)';
 | 
			
		||||
    my $in = $opts{param};
 | 
			
		||||
 | 
			
		||||
    ref $opts{on_valid} eq 'CODE'
 | 
			
		||||
        or croak 'Usage: ->process(on_valid => \&CODEREF, ...)';
 | 
			
		||||
 | 
			
		||||
    defined $opts{password} and length $opts{password} or croak 'Usage: ->process(password => "password", ...)';
 | 
			
		||||
    defined $opts{sellerid} and length $opts{sellerid} or croak 'Usage: ->process(sellerid => "sellerid", ...)';
 | 
			
		||||
 | 
			
		||||
    $opts{password} eq 'tango' and croak 'Usage: ->process(password => "something other than \'tango\'", ...)';
 | 
			
		||||
 | 
			
		||||
    my $order_number = $in->param('order_number');
 | 
			
		||||
 | 
			
		||||
# Check that the "secret word" (password) combined with the other information
 | 
			
		||||
# actually checks out.
 | 
			
		||||
    my $str = $opts{password} . $opts{sellerid} . $order_number . $in->param('total');
 | 
			
		||||
    my $md5 = md5_hex($str);
 | 
			
		||||
 | 
			
		||||
    if (lc $md5 eq lc $in->param('key')) {
 | 
			
		||||
        $opts{on_valid}->();
 | 
			
		||||
    }
 | 
			
		||||
# If demo mode is enabled, then the order number is set to 1 in the md5:
 | 
			
		||||
# https://www.2checkout.com/documentation/UsersGuide2/chapter6/md5-hash.html
 | 
			
		||||
    elsif ($opts{demo}) {
 | 
			
		||||
        $str = $opts{password} . $opts{sellerid} . 1 . $in->param('total');
 | 
			
		||||
        $md5 = md5_hex($str);
 | 
			
		||||
 | 
			
		||||
        if (lc $md5 eq lc $in->param('key')) {
 | 
			
		||||
            $opts{on_valid}->();
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
__END__
 | 
			
		||||
 | 
			
		||||
=head1 NAME
 | 
			
		||||
 | 
			
		||||
GT::Payment::Remote::2CheckOut - 2CheckOut payment handling
 | 
			
		||||
 | 
			
		||||
=head1 CAVEATS
 | 
			
		||||
 | 
			
		||||
2CheckOut has a pretty weak automated payment system - the security of the
 | 
			
		||||
entire automated payment process hinges on your "Secret Word" (Admin -> Account
 | 
			
		||||
Details -> Return -> Secret Word (near the bottom of the page)) - without it,
 | 
			
		||||
there is no security at all.  Another weakness in the system is that if your
 | 
			
		||||
server is not reachable for whatever reason, the payment information would be
 | 
			
		||||
lost.  Payment providers like 2CheckOut and WorldPay would do well to learn
 | 
			
		||||
from payment systems like that of PayPal - whatever can be said about other
 | 
			
		||||
aspects of PayPal, they do have one of the nicest payment systems around - both
 | 
			
		||||
from a developer and user's point of view.
 | 
			
		||||
 | 
			
		||||
Because of the security issue with not using the "Secret Word", this module
 | 
			
		||||
requires that the secret word be used, even if other 2CheckOut systems may not.
 | 
			
		||||
Additionally, the default secret word of "tango" is not allowed.
 | 
			
		||||
 | 
			
		||||
=head1 SYNOPSIS
 | 
			
		||||
 | 
			
		||||
    use GT::Payment::Remote::2CheckOut;
 | 
			
		||||
    use GT::CGI;
 | 
			
		||||
 | 
			
		||||
    my $in = new GT::CGI;
 | 
			
		||||
 | 
			
		||||
    GT::Payment::Remote::2CheckOut->process(
 | 
			
		||||
        param => $in,
 | 
			
		||||
 | 
			
		||||
        on_valid => \&valid,
 | 
			
		||||
 | 
			
		||||
        sellerid => "1234",
 | 
			
		||||
        password => "Some Good Secret Word"
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
    sub valid {
 | 
			
		||||
        # Update database - the payment has been made successfully.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
=head1 DESCRIPTION
 | 
			
		||||
 | 
			
		||||
This module is designed to handle 2CheckOut payment processing.
 | 
			
		||||
 | 
			
		||||
=head1 REQUIREMENTS
 | 
			
		||||
 | 
			
		||||
GT::CGI and GT::MD5.
 | 
			
		||||
 | 
			
		||||
=head1 FUNCTIONS
 | 
			
		||||
 | 
			
		||||
This module has only one function: process() does the work of actually
 | 
			
		||||
figuring out what to do with a postback.
 | 
			
		||||
 | 
			
		||||
=head2 process
 | 
			
		||||
 | 
			
		||||
process() is the only function provided by this module.  It can be called as
 | 
			
		||||
either a function or class method, and takes a hash (not hash reference) of
 | 
			
		||||
arguments as described below.
 | 
			
		||||
 | 
			
		||||
process() should be called for 2CheckOut initiated postbacks.  This can be set
 | 
			
		||||
up in your main .cgi by looking for 2CheckOut-specific CGI parameters
 | 
			
		||||
('cart_order_id' is a good one to look for) or by making a seperate .cgi file
 | 
			
		||||
exclusively for handling 2CheckOut postbacks.
 | 
			
		||||
 | 
			
		||||
Additionally, it is strongly advised that database connection, authenticate,
 | 
			
		||||
etc.  be performed before calling process() to ensure that the payment is
 | 
			
		||||
recorded successfully.  2CheckOut will not attempt to repost the form data if
 | 
			
		||||
your script produces an error, and the error will be shown to the customer.
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item param
 | 
			
		||||
 | 
			
		||||
param takes a GT::CGI object from which 2CheckOut postback variables are read.
 | 
			
		||||
 | 
			
		||||
=item on_valid
 | 
			
		||||
 | 
			
		||||
on_valid takes a code reference as value.  The code reference will be called
 | 
			
		||||
when a successful payment has been made.  Inside this code reference you are
 | 
			
		||||
responsible for setting a "paid" status for the order in question.  The
 | 
			
		||||
C<cart_order_id> CGI variable will have whatever cart_order_id you provided.
 | 
			
		||||
 | 
			
		||||
=item sellerid
 | 
			
		||||
 | 
			
		||||
This should be passed to seller number.  This is needed, along with the
 | 
			
		||||
password field below, to verify that the posted payment is a genuine 2CheckOut
 | 
			
		||||
payment.
 | 
			
		||||
 | 
			
		||||
=item password
 | 
			
		||||
 | 
			
		||||
This is a "Secret Word" that the admin must set in the 2CheckOut admin area
 | 
			
		||||
(under Look & Feel -> Secret Word).  This field must be set in the admin, and
 | 
			
		||||
passed in here.  Note that the default value, "tango", is not allowed.  Without
 | 
			
		||||
this password, 2CheckOut postbacks should not be considered secure.
 | 
			
		||||
 | 
			
		||||
=item demo
 | 
			
		||||
 | 
			
		||||
Whether or not to initiate and accept demo transactions.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head1 INSTRUCTIONS
 | 
			
		||||
 | 
			
		||||
To implement 2CheckOut payment processing, there are a number of steps required
 | 
			
		||||
in addition to this module.  Basically, this module handles only the postback
 | 
			
		||||
stage of the 2CheckOut payment process.
 | 
			
		||||
 | 
			
		||||
=head2 Directing customers to 2CheckOut
 | 
			
		||||
 | 
			
		||||
This is done by creating a web form containing the following variables.  Your
 | 
			
		||||
form, first of all, should post to
 | 
			
		||||
C<https://www.2checkout.com/2co/buyer/purchase>.  See
 | 
			
		||||
C<https://www.2checkout.com/documentation/UsersGuide2/third_party_carts/2co-system-parameters.html>
 | 
			
		||||
for a complete and up-to-date list of parameters that can be passed to 2CheckOut.
 | 
			
		||||
 | 
			
		||||
Required fields are as follows:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item * sid
 | 
			
		||||
    
 | 
			
		||||
Your 2CheckOut account number
 | 
			
		||||
 | 
			
		||||
=item * total
 | 
			
		||||
 | 
			
		||||
The total amount to be billed, in DD.CC format.
 | 
			
		||||
 | 
			
		||||
=item * cart_order_id
 | 
			
		||||
 | 
			
		||||
A unique order id, which you should store to track the payment.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
The following parameters *may* be passed in, and will be available in the
 | 
			
		||||
postback:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item * card_holder_name
 | 
			
		||||
 | 
			
		||||
=item * street_address
 | 
			
		||||
 | 
			
		||||
=item * city
 | 
			
		||||
 | 
			
		||||
=item * state
 | 
			
		||||
 | 
			
		||||
=item * zip
 | 
			
		||||
 | 
			
		||||
=item * country
 | 
			
		||||
 | 
			
		||||
=item * phone
 | 
			
		||||
 | 
			
		||||
The card holder's details.
 | 
			
		||||
 | 
			
		||||
=item * email
 | 
			
		||||
 | 
			
		||||
The card holder's email address.
 | 
			
		||||
 | 
			
		||||
=item * ship_name
 | 
			
		||||
 | 
			
		||||
=item * ship_street_address
 | 
			
		||||
 | 
			
		||||
=item * ship_city
 | 
			
		||||
 | 
			
		||||
=item * ship_state
 | 
			
		||||
 | 
			
		||||
=item * ship_zip
 | 
			
		||||
 | 
			
		||||
=item * ship_country
 | 
			
		||||
 | 
			
		||||
Shipping info - however, according to 2CheckOut, you must indicate that you
 | 
			
		||||
want to take that you want to take down a seperate shipping and billing address
 | 
			
		||||
on the L<Shipping Details page|https://sellers.2checkout.com/cgi-bin/sellersarea/shipdetails.2c>.
 | 
			
		||||
 | 
			
		||||
=item * demo
 | 
			
		||||
 | 
			
		||||
Should be set to 'Y' if you want demo mode, omitted for regular transactions.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
In the postback CGI, you'll get back all of the billing and shipping variables
 | 
			
		||||
listed above, plus:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item * order_number
 | 
			
		||||
 | 
			
		||||
2CheckOut order number
 | 
			
		||||
 | 
			
		||||
=item * cart_order_id
 | 
			
		||||
 | 
			
		||||
=item * cart_id
 | 
			
		||||
 | 
			
		||||
Your order number, passed back.  Both variables are the same.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head2 Postback
 | 
			
		||||
 | 
			
		||||
Before 2CheckOut postback notification can occur, you must set up the postback
 | 
			
		||||
(in 2CheckOut terminology, "Routine").  This can be set from the Admin ->
 | 
			
		||||
Shopping Cart -> Cart Details.  You need to enable the payment routine, and
 | 
			
		||||
set it to a CGI that you manage.
 | 
			
		||||
 | 
			
		||||
=head2 Putting it all together
 | 
			
		||||
 | 
			
		||||
The typical way to implement all of this is as follows:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item 1 Get necessary merchant information (sid and secret keyword)
 | 
			
		||||
 | 
			
		||||
=item 2 Once the customer has selected what to purchase, generate a
 | 
			
		||||
cart_order_id (a random MD5 hex string works well), and store it somewhere
 | 
			
		||||
(i.e. in the database).
 | 
			
		||||
 | 
			
		||||
=item 3 Make a form with all the necessary fields that
 | 
			
		||||
L<submits to 2CheckOut|/"Directing customers to 2CheckOut">.
 | 
			
		||||
 | 
			
		||||
=item 4 Set up the L<C<on_valid>|/"on_valid"> callback.  If using a dedicated
 | 
			
		||||
CGI script for 2CheckOut callbacks, it should just call process(); otherwise,
 | 
			
		||||
check for the CGI parameter 'cart_order_id' and if present, call process().
 | 
			
		||||
 | 
			
		||||
=item 5 For a valid payment, do whatever you need to do for a valid payment,
 | 
			
		||||
and store some record of the payment having been made (storing at least the
 | 
			
		||||
cart_order_id and the order_number is strongly recommended).  Use the CGI
 | 
			
		||||
parameter 'cart_order_id' to locate the order (i.e. in the database).
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head1 SEE ALSO
 | 
			
		||||
 | 
			
		||||
L<http://www.2checkout.com> - 2CheckOut website.
 | 
			
		||||
 | 
			
		||||
L<http://www.support.2checkout.com/deskpro/faq.php> - 2CheckOut knowledgebase
 | 
			
		||||
 | 
			
		||||
=head1 MAINTAINER
 | 
			
		||||
 | 
			
		||||
Jason Rhinelander
 | 
			
		||||
 | 
			
		||||
=head1 COPYRIGHT
 | 
			
		||||
 | 
			
		||||
Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
http://www.gossamer-threads.com/
 | 
			
		||||
 | 
			
		||||
=head1 VERSION
 | 
			
		||||
 | 
			
		||||
Revision: $Id: 2CheckOut.pm,v 1.5 2006/08/22 20:39:04 brewt Exp $
 | 
			
		||||
 | 
			
		||||
=cut
 | 
			
		||||
							
								
								
									
										573
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Payment/Remote/PayPal.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										573
									
								
								site/slowtwitch.com/cgi-bin/articles/GT/Payment/Remote/PayPal.pm
									
									
									
									
									
										Normal file
									
								
							@@ -0,0 +1,573 @@
 | 
			
		||||
# ====================================================================
 | 
			
		||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
 | 
			
		||||
#
 | 
			
		||||
#   GT::Payment::Remote::PayPal
 | 
			
		||||
#   Author: Jason Rhinelander
 | 
			
		||||
#   CVS Info : 087,071,086,086,085      
 | 
			
		||||
#   $Id: PayPal.pm,v 1.8 2006/04/08 03:42:05 brewt Exp $
 | 
			
		||||
#
 | 
			
		||||
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
# ====================================================================
 | 
			
		||||
#
 | 
			
		||||
# Description:
 | 
			
		||||
#   PayPal IPN payment processing.
 | 
			
		||||
#   IPN information: (PayPal login required)
 | 
			
		||||
#   https://www.paypal.com/cgi-bin/webscr?cmd=p/acc/ipn-info
 | 
			
		||||
#
 | 
			
		||||
#   Net::SSLeay is required.  Windows (ActivePerl) Net::SSLeay packages are
 | 
			
		||||
#   available through Gossamer Threads.
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package GT::Payment::Remote::PayPal;
 | 
			
		||||
use strict;
 | 
			
		||||
use Carp;
 | 
			
		||||
use GT::WWW;
 | 
			
		||||
use GT::WWW::https;
 | 
			
		||||
 | 
			
		||||
# Usage:
 | 
			
		||||
#   process(
 | 
			
		||||
#       param => $GT_CGI_OBJ,
 | 
			
		||||
#       on_valid => \&CODEREF, # Called when everything checks out
 | 
			
		||||
#       on_pending => \&CODEREF, # Optional - another IPN request will come in when no longer pending
 | 
			
		||||
#       on_failed => \&CODEREF, # "The payment has failed. This will only happen if the payment was made from your customer's bank account"
 | 
			
		||||
#       on_denied => \&CODEREF, # "You, the merchant, denied the payment. This will only happen if the payment was previously pending due to one of the "pending reasons" below"
 | 
			
		||||
#       on_invalid => \&CODEREF, # This request did NOT come from PayPal
 | 
			
		||||
#       on_recurring => \&CODEREF, # A recurring payment
 | 
			
		||||
#       on_recurring_signup => \&CODEREF, # A recurring payment signup
 | 
			
		||||
#       on_recurring_cancel => \&CODEREF, # A recurring payment cancellation
 | 
			
		||||
#       on_recurring_failed => \&CODEREF, # A subscription payment failure
 | 
			
		||||
#       on_recurring_eot => \&CODEREF, # A  subscription "end of term" notification
 | 
			
		||||
#       on_recurring_modify => \&CODEREF, # A subscription modification notification
 | 
			
		||||
#       duplicate => \&CODEREF, # Check to make sure this isn't a duplicate (1 = okay, 0/undef = duplicate)
 | 
			
		||||
#       email => \&CODEREF, # Called with the specified e-mail - check it against the primary e-mail account, return 1 for valid, 0/undef for error
 | 
			
		||||
#       on_error => \&CODEREF # Optional
 | 
			
		||||
#   )
 | 
			
		||||
# Only on_error is optional.  on_valid will be called if the request is valid,
 | 
			
		||||
# on_invalid is invalid, and on_error if an error occurs (such as an HTTP error,
 | 
			
		||||
# connection problem, etc.)
 | 
			
		||||
sub process {
 | 
			
		||||
    shift if $_[0] and UNIVERSAL::isa($_[0], __PACKAGE__);
 | 
			
		||||
 | 
			
		||||
    my %opts = @_;
 | 
			
		||||
    $opts{param} and UNIVERSAL::isa($opts{param}, 'GT::CGI') or croak 'Usage: ->process(param => $gtcgi, ...)';
 | 
			
		||||
    my $in = $opts{param};
 | 
			
		||||
    for (qw/on_valid on_failed on_denied duplicate email/) {
 | 
			
		||||
        ref $opts{$_} eq 'CODE' or croak "Usage: ->process($_ => \&CODEREF, ...)";
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    for (qw/on_error on_pending on_invalid on_recurring on_recurring_signup on_recurring_cancel
 | 
			
		||||
        on_recurring_failed on_recurring_eot on_recurring_modify/) {
 | 
			
		||||
        !$opts{$_} or ref $opts{$_} eq 'CODE' or croak "Usage: ->process($_ => \\&CODEREF, ...) (optional)";
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $sandbox = $opts{sandbox} ? 'sandbox.' : '';
 | 
			
		||||
    my $wwws = GT::WWW->new("https://www.${sandbox}paypal.com/cgi-bin/webscr");
 | 
			
		||||
    my @param;
 | 
			
		||||
 | 
			
		||||
    for my $p ($in->param) {
 | 
			
		||||
        for my $v ($in->param($p)) {
 | 
			
		||||
            push @param, $p, $v;
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    # PayPal says:
 | 
			
		||||
    #   You will also need to append a variable named "cmd" with the value
 | 
			
		||||
    #   "_notify-validate" (e.g. cmd=_notify-validate) to the POST string.
 | 
			
		||||
    $wwws->parameters(@param, cmd => '_notify-validate');
 | 
			
		||||
 | 
			
		||||
    my $result = $wwws->post;
 | 
			
		||||
    my $status;
 | 
			
		||||
 | 
			
		||||
    # PayPal says:
 | 
			
		||||
    #   PayPal will respond to the post with a single word, "VERIFIED" or
 | 
			
		||||
    #   "INVALID", in the body of the response. When you receive a VERIFIED
 | 
			
		||||
    #   response, you need to:
 | 
			
		||||
    #
 | 
			
		||||
    #     * Check that the "payment_status" is "completed"
 | 
			
		||||
    #     * If the "payment_status" is "completed", check the "txn_id" against
 | 
			
		||||
    #       the previous PayPal transaction you have processed to ensure it is
 | 
			
		||||
    #       not a duplicate.
 | 
			
		||||
    #     * After you have checked the "payment_status" and "txn_id", make sure
 | 
			
		||||
    #       the "receiver_email" is an email address registered in your PayPal
 | 
			
		||||
    #       account
 | 
			
		||||
    #     * Once you have completed the above checks, you may update your
 | 
			
		||||
    #       database based on the information provided. 
 | 
			
		||||
    if ($result) {
 | 
			
		||||
        my $status = "$result";
 | 
			
		||||
        unless ($status eq 'VERIFIED') {
 | 
			
		||||
            $opts{on_invalid}->($status) if $opts{on_invalid};
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        # For certain txn_types payment_status and txn_id aren't available
 | 
			
		||||
        my $txn_type = $in->param('txn_type');
 | 
			
		||||
        if ($txn_type =~ /^subscr_(?:signup|cancel|failed|eot|modify)$/) {
 | 
			
		||||
            if ($txn_type eq 'subscr_signup') {
 | 
			
		||||
                $opts{on_recurring_signup}->() if $opts{on_recurring_signup};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($txn_type eq 'subscr_cancel') {
 | 
			
		||||
                $opts{on_recurring_cancel}->() if $opts{on_recurring_cancel};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($txn_type eq 'subscr_failed') {
 | 
			
		||||
                $opts{on_recurring_failed}->() if $opts{on_recurring_failed};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($txn_type eq 'substr_eot') {
 | 
			
		||||
                $opts{on_recurring_eot}->() if $opts{on_recurring_eot};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($txn_type eq 'substr_modify') {
 | 
			
		||||
                $opts{on_recurring_modify}->() if $opts{on_recurring_modify};
 | 
			
		||||
            }
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        # * Check that the "payment_status" is "completed" [sic; should be "Completed"]
 | 
			
		||||
        unless ((my $status = $in->param('payment_status')) eq 'Completed') {
 | 
			
		||||
            if ($status eq 'Pending') {
 | 
			
		||||
                $opts{on_pending}->() if $opts{on_pending};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($status eq 'Failed') {
 | 
			
		||||
                $opts{on_failed}->();
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($status eq 'Denied') {
 | 
			
		||||
                $opts{on_denied}->();
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($status eq 'Refunded') {
 | 
			
		||||
                $opts{on_refund}->() if $opts{on_refund};
 | 
			
		||||
            }
 | 
			
		||||
            elsif ($opts{on_error}) {
 | 
			
		||||
                $opts{on_error}->("PayPal sent invalid/unknown payment_status value: '$status'");
 | 
			
		||||
            }
 | 
			
		||||
            return;
 | 
			
		||||
        }
 | 
			
		||||
 | 
			
		||||
        my $txn_id = $in->param('txn_id');
 | 
			
		||||
        return unless $txn_id;
 | 
			
		||||
 | 
			
		||||
        # * If the "payment_status" is "completed", check the "txn_id" against
 | 
			
		||||
        #   the previous PayPal transaction you have processed to ensure it is
 | 
			
		||||
        #   not a duplicate.
 | 
			
		||||
        $opts{duplicate}->($txn_id) or return;
 | 
			
		||||
 | 
			
		||||
        # * After you have checked the "payment_status" and "txn_id", make sure
 | 
			
		||||
        #   the "receiver_email" is an email address registered in your PayPal
 | 
			
		||||
        #   account
 | 
			
		||||
        $opts{email}->($in->param('receiver_email')) or return; # Ignore if the e-mail addresses don't match
 | 
			
		||||
 | 
			
		||||
        if ($txn_type eq 'subscr_payment') {
 | 
			
		||||
            $opts{on_recurring}->() if $opts{on_recurring};
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $opts{on_valid}->();
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    elsif ($opts{on_error}) {
 | 
			
		||||
        if (defined $result) {
 | 
			
		||||
            my $http_status = $result->status;
 | 
			
		||||
            $opts{on_error}->("Server returned a non-okay status: " . int($http_status) . " $http_status");
 | 
			
		||||
        }
 | 
			
		||||
        else {
 | 
			
		||||
            $opts{on_error}->("Connection error: " . $wwws->error);
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
__END__
 | 
			
		||||
 | 
			
		||||
=head1 NAME
 | 
			
		||||
 | 
			
		||||
GT::Payment::Remote::PayPal - PayPal payment handling
 | 
			
		||||
 | 
			
		||||
=head1 SYNOPSIS
 | 
			
		||||
 | 
			
		||||
    use GT::Payment::Remote::PayPal;
 | 
			
		||||
    use GT::CGI;
 | 
			
		||||
 | 
			
		||||
    my $in = new GT::CGI;
 | 
			
		||||
 | 
			
		||||
    GT::Payment::Remote::PayPal->process(
 | 
			
		||||
        param => $in,
 | 
			
		||||
        on_valid => \&valid,
 | 
			
		||||
        on_pending => \&pending,
 | 
			
		||||
        on_failed => \&failed,
 | 
			
		||||
        on_denied => \&denied,
 | 
			
		||||
        on_invalid => \&invalid,
 | 
			
		||||
        on_recurring => \&recurring,
 | 
			
		||||
        on_recurring_signup => \&r_signup,
 | 
			
		||||
        on_recurring_cancel => \&r_cancel,
 | 
			
		||||
        on_recurring_failed => \&r_failed,
 | 
			
		||||
        on_recurring_eot => \&r_eot,
 | 
			
		||||
        on_recurring_modify => \&r_modify,
 | 
			
		||||
        duplicate => \&duplicate,
 | 
			
		||||
        email => \&email,
 | 
			
		||||
        on_error => \&error
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
    sub valid {
 | 
			
		||||
        # Update database - the payment has been made successfully.
 | 
			
		||||
    }
 | 
			
		||||
    sub pending {
 | 
			
		||||
        # Optional; store a "payment pending" status if you wish.  This is optional
 | 
			
		||||
        # because another postback will be made with a completed, failed, or denied
 | 
			
		||||
        # status.
 | 
			
		||||
    }
 | 
			
		||||
    failed {
 | 
			
		||||
        # According to PayPal IPN documentation: "The payment has failed.  This
 | 
			
		||||
        # will only happen if the payment was made from your customer's bank
 | 
			
		||||
        # account."
 | 
			
		||||
        # Store a "payment failed" status for the order
 | 
			
		||||
    }
 | 
			
		||||
    sub denied {
 | 
			
		||||
        # According to PayPal IPN documentation: "You, the merchant, denied the
 | 
			
		||||
        # payment.  This will only happen if the payment was previously pending due
 | 
			
		||||
        # to one of the "pending reasons" [in pending_reason]"
 | 
			
		||||
    }
 | 
			
		||||
    sub invalid {
 | 
			
		||||
        # This means the request did NOT come from PayPal.  You should log the
 | 
			
		||||
        # request for follow up.
 | 
			
		||||
    }
 | 
			
		||||
    sub recurring {
 | 
			
		||||
        # This means a recurring payment has been made successfully.  Update
 | 
			
		||||
        # database.
 | 
			
		||||
    }
 | 
			
		||||
    sub r_signup {
 | 
			
		||||
        # This means a recurring signup has been made (NOT a payment, just a
 | 
			
		||||
        # signup).
 | 
			
		||||
    }
 | 
			
		||||
    sub r_cancel {
 | 
			
		||||
        # The user has cancelled their recurring payment
 | 
			
		||||
    }
 | 
			
		||||
    sub r_failed {
 | 
			
		||||
        # A recurring payment has failed (probably declined).
 | 
			
		||||
    }
 | 
			
		||||
    sub r_eot {
 | 
			
		||||
        # A recurring payment has come to its natural conclusion.  This only
 | 
			
		||||
        # applies to payments with a set number of payments.
 | 
			
		||||
    }
 | 
			
		||||
    sub r_modify {
 | 
			
		||||
        # Something has been modified regarding the recurring payment
 | 
			
		||||
    }
 | 
			
		||||
    sub duplicate {
 | 
			
		||||
        # Check to see if the payment has already been made.  If it _has_ been
 | 
			
		||||
        # made, you should return undef, otherwise return 1 to indicate that this
 | 
			
		||||
        # is not a duplicate postback.  The "txn_id" value is passed in, but is
 | 
			
		||||
        # also available through $in->param('txn_id').
 | 
			
		||||
    }
 | 
			
		||||
    sub email {
 | 
			
		||||
        # This will be called with an e-mail address.  You should check to make
 | 
			
		||||
        # sure that the e-mail address entered is the same as the one on the PayPal
 | 
			
		||||
        # account.  Return true (1) if everything checks out, undef otherwise.
 | 
			
		||||
    }
 | 
			
		||||
    sub error {
 | 
			
		||||
        # An error message is passed in here.  This is called when a error such as
 | 
			
		||||
        # a connection problem or HTTP problem occurs.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
=head1 DESCRIPTION
 | 
			
		||||
 | 
			
		||||
This module is designed to handle PayPal payment processing using PayPal's IPN
 | 
			
		||||
system.  It does very little other than generating and sending a proper
 | 
			
		||||
response to the PayPal server, and calling the provided code reference(s).
 | 
			
		||||
 | 
			
		||||
It is strongly recommended that you familiarize yourself with the PayPal
 | 
			
		||||
"Single Item Purchases Manual" and "IPN Manual" listed in the L</"SEE ALSO">
 | 
			
		||||
section of this document.
 | 
			
		||||
 | 
			
		||||
=head1 REQUIREMENTS
 | 
			
		||||
 | 
			
		||||
GT::WWW with the https protocol, which in turn requires Net::SSLeay.  PPM's are
 | 
			
		||||
available from Gossamer Threads for the latest Windows releases of ActiveState
 | 
			
		||||
Perl 5.6.1 and 5.8.0.
 | 
			
		||||
 | 
			
		||||
=head1 process
 | 
			
		||||
 | 
			
		||||
process() is the only function/method provided by this module.  It can be
 | 
			
		||||
called as either a function or class method, and takes a hash (not hash
 | 
			
		||||
reference) of arguments as described below.  This module requires GT::WWW's
 | 
			
		||||
https interface, which in turn requires Net::SSLeay.
 | 
			
		||||
 | 
			
		||||
process() should be called for PayPal initiated requests.  This can be set up
 | 
			
		||||
in your main CGI by looking for PayPal-specific CGI parameters ('txn_type' is a
 | 
			
		||||
good one to look for) or by making a seperate .cgi file exclusively for
 | 
			
		||||
handling IPN postbacks.
 | 
			
		||||
 | 
			
		||||
Additionally, it is strongly advised that database connection, authenticate,
 | 
			
		||||
etc.  be performed before calling process() to ensure that the payment is
 | 
			
		||||
recorded successfully.  If your CGI script has an error, PayPal will retry the
 | 
			
		||||
postback again 
 | 
			
		||||
 | 
			
		||||
Except where indicated, all arguments are required.
 | 
			
		||||
 | 
			
		||||
=head2 param
 | 
			
		||||
 | 
			
		||||
param takes a GT::CGI object from which PayPal IPN variables are read.
 | 
			
		||||
 | 
			
		||||
=head2 on_valid
 | 
			
		||||
 | 
			
		||||
on_valid takes a code reference as value.  The code reference will be called
 | 
			
		||||
when a successful payment has been made.  Inside this code reference you are
 | 
			
		||||
responsible for setting a "paid" status for the order in question.
 | 
			
		||||
 | 
			
		||||
See the PayPal IPN documentation listed below for information on how to
 | 
			
		||||
identify an order.
 | 
			
		||||
 | 
			
		||||
=head2 on_pending
 | 
			
		||||
 | 
			
		||||
on_pending is called when PayPal sends information on a "Pending" payment.
 | 
			
		||||
This parameter is optional, due to the fact that a "Pending" status means that
 | 
			
		||||
another notification (either "Completed", "Failed", or "Denied") will be made.
 | 
			
		||||
 | 
			
		||||
It is, however, recommended that when a Pending payment is encountered, a note
 | 
			
		||||
be stored in your application that manual intervention is probably required.
 | 
			
		||||
 | 
			
		||||
According to PayPal documentation, there are a few cases where this will
 | 
			
		||||
happen, which can be obtained from the "pending_reason" CGI input variable.
 | 
			
		||||
The possible values and what each means follows (this comes straight from the
 | 
			
		||||
PayPal documentation).
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item "echeck"
 | 
			
		||||
 | 
			
		||||
The payment is pending because it was made by an eCheck, which has not yet
 | 
			
		||||
cleared.
 | 
			
		||||
 | 
			
		||||
=item "multi_currency"
 | 
			
		||||
 | 
			
		||||
You do not have a balance in the currency sent, and you do not have your
 | 
			
		||||
Payment Receiving Preferences set to automatically convert and accept this
 | 
			
		||||
payment. You must manually accept or deny this payment.
 | 
			
		||||
 | 
			
		||||
=item "intl"
 | 
			
		||||
 | 
			
		||||
The payment is pending because you, the merchant, hold an international account
 | 
			
		||||
and do not have a withdrawal mechanism. You must manually accept or deny this
 | 
			
		||||
payment from your Account Overview.
 | 
			
		||||
 | 
			
		||||
=item "verify"
 | 
			
		||||
 | 
			
		||||
The payment is pending because you, the merchant, are not yet verified. You
 | 
			
		||||
must verify your account before you can accept this payment.
 | 
			
		||||
 | 
			
		||||
=item "address"
 | 
			
		||||
 | 
			
		||||
The payment is pending because your customer did not include a confirmed
 | 
			
		||||
shipping address and you, the merchant, have your Payment Receiving Preferences
 | 
			
		||||
set such that you want to manually accept or deny each of these payments. To
 | 
			
		||||
change your preference, go to the "Preferences" section of your "Profile."
 | 
			
		||||
 | 
			
		||||
=item "upgrade"
 | 
			
		||||
 | 
			
		||||
The payment is pending because it was made via credit card and you, the
 | 
			
		||||
merchant, must upgrade your account to Business or Premier status in order to
 | 
			
		||||
receive the funds.
 | 
			
		||||
 | 
			
		||||
=item "unilateral"
 | 
			
		||||
 | 
			
		||||
The payment is pending because it was made to an email address that is not yet
 | 
			
		||||
registered or confirmed.
 | 
			
		||||
 | 
			
		||||
=item "other"
 | 
			
		||||
 | 
			
		||||
The payment is pending for an "other" reason. For more information, contact
 | 
			
		||||
customer service.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head2 on_failed
 | 
			
		||||
 | 
			
		||||
Takes a code reference to call in the event of a failed payment notification.
 | 
			
		||||
A failed payment "will only happen if the payment was made from your customer's
 | 
			
		||||
bank account."
 | 
			
		||||
 | 
			
		||||
You should record a failed payment in your application.
 | 
			
		||||
 | 
			
		||||
=head2 on_denied
 | 
			
		||||
 | 
			
		||||
This code reference is called when a "Denied" payment notification is received.
 | 
			
		||||
"This will only happen if the payment was previously pending due to one of the
 | 
			
		||||
'pending reasons'" above.
 | 
			
		||||
 | 
			
		||||
You should record a failed or denied payment in your application.
 | 
			
		||||
 | 
			
		||||
=head2 on_invalid
 | 
			
		||||
 | 
			
		||||
This code reference will be called when an invalid request is made.  This
 | 
			
		||||
usually means that the request B<did not> come from PayPal.  According to
 | 
			
		||||
PayPal, "if you receive an 'INVALID' notification, it should be treated as
 | 
			
		||||
suspicious and investigated."  Thus it is strongly recommended that a record of
 | 
			
		||||
the invalid request be made.
 | 
			
		||||
 | 
			
		||||
=head2 duplicate
 | 
			
		||||
 | 
			
		||||
This code reference is required to prevent duplicate payments.  It is called
 | 
			
		||||
for potentially successful requests to ensure that it is not a duplicate
 | 
			
		||||
postback.  It is passed the "txn_id" CGI parameter, which is the
 | 
			
		||||
PayPal-generated transaction ID.  You should check this parameter against your
 | 
			
		||||
order database.  If you have already recorded this payment as successfully
 | 
			
		||||
made, should should return C<undef> from this function, to indicate that the
 | 
			
		||||
duplicate check failed.  If the transaction ID is okay (i.e. is not a
 | 
			
		||||
duplicate) return 1 to continue.
 | 
			
		||||
 | 
			
		||||
=head2 recurring
 | 
			
		||||
 | 
			
		||||
A successful recurring payment has been made.  You should set a "paid" status
 | 
			
		||||
for the item in question.
 | 
			
		||||
 | 
			
		||||
=head2 recurring_signup
 | 
			
		||||
 | 
			
		||||
=head2 recurring_cancel
 | 
			
		||||
 | 
			
		||||
=head2 recurring_failed
 | 
			
		||||
 | 
			
		||||
=head2 recurring_eot
 | 
			
		||||
 | 
			
		||||
=head2 recurring_modify
 | 
			
		||||
 | 
			
		||||
These are called when various things have happened to the subscription.  In
 | 
			
		||||
particular, signup refers to a new subscription, cancel refers to a cancelled
 | 
			
		||||
subscription, failed refers to a failed payment, eot refers to a subscription
 | 
			
		||||
that ended naturally (i.e. an end was set when the subscription was initially
 | 
			
		||||
made), and modify is called when a payment has been modified.
 | 
			
		||||
 | 
			
		||||
=head2 email
 | 
			
		||||
 | 
			
		||||
This code reference, like duplicate, is called to ensure that the payment was
 | 
			
		||||
sent to the correct account.  An e-mail address is passed in which must be the
 | 
			
		||||
same as the primary account's e-mail address.  If it is the same, return C<1>.
 | 
			
		||||
If it is I<not> the same, you should return C<undef> and store a note asking
 | 
			
		||||
the user to check that the PayPal e-mail address they have provided is the
 | 
			
		||||
correct, primary, PayPal e-mail address.
 | 
			
		||||
 | 
			
		||||
=head2 on_error
 | 
			
		||||
 | 
			
		||||
This code reference is optional, but recommended.  It is called when a
 | 
			
		||||
non-PayPal generated error occurs - such as a failure to connect to PayPal.  It
 | 
			
		||||
is recommended that you provide this code reference and log any errors that
 | 
			
		||||
occur.  The error message is passed in.
 | 
			
		||||
 | 
			
		||||
=head1 INSTRUCTIONS
 | 
			
		||||
 | 
			
		||||
To implement PayPal payment processing, there are a number of steps required in
 | 
			
		||||
addition to this module.  Basically, this module handles only the postback
 | 
			
		||||
stage of the PayPal IPN process.
 | 
			
		||||
 | 
			
		||||
Full PayPal single item, subscription, and IPN documentation is available at
 | 
			
		||||
the URL's listed in the L<SEE ALSO|/"SEE ALSO"> section.
 | 
			
		||||
 | 
			
		||||
=head2 Directing customers to PayPal
 | 
			
		||||
 | 
			
		||||
This is done by creating a web form containing the following variables.  Your
 | 
			
		||||
form, first of all, must post to C<https://www.paypal.com/cgi-bin/webscr>.
 | 
			
		||||
 | 
			
		||||
Your form should contains various PayPal parameters, as outlined in the PayPal
 | 
			
		||||
manuals linked to in the L<SEE ALSO|/"SEE ALSO"> section.
 | 
			
		||||
 | 
			
		||||
Of particular note is the "notify_url" option, which should be used to specify
 | 
			
		||||
a postback URL for PayPal IPN postbacks.
 | 
			
		||||
The below is simply a list of the required fields, and only those fields that
 | 
			
		||||
are absolutely required are described.  For descriptions of each field, check
 | 
			
		||||
the PayPal Single Item Purchases Manual.
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item cmd
 | 
			
		||||
 | 
			
		||||
Must be set to "_xclick".
 | 
			
		||||
 | 
			
		||||
=item business
 | 
			
		||||
 | 
			
		||||
Your PayPal ID (e-mail address).  Must be confirmed and linked to your Verified
 | 
			
		||||
Business or Premier account.
 | 
			
		||||
 | 
			
		||||
=item item_name
 | 
			
		||||
 | 
			
		||||
=item item_number
 | 
			
		||||
 | 
			
		||||
=item image_url
 | 
			
		||||
 | 
			
		||||
=item no_shipping
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
=item return
 | 
			
		||||
 | 
			
		||||
Although optional, this is highly recommend - takes a URL to bring the buyer
 | 
			
		||||
back to after purchasing.  If not specified, they'll remain at PayPal.
 | 
			
		||||
 | 
			
		||||
=item rm
 | 
			
		||||
 | 
			
		||||
Return method for the L<return|/return> option.  If "1", a GET request without
 | 
			
		||||
the transaction variables will be made, if "2" a POST request WITH the transaction
 | 
			
		||||
variables will be made.
 | 
			
		||||
 | 
			
		||||
=item cancel_return
 | 
			
		||||
 | 
			
		||||
=item no_note
 | 
			
		||||
 | 
			
		||||
=item cn
 | 
			
		||||
 | 
			
		||||
=item cs
 | 
			
		||||
 | 
			
		||||
=item on0
 | 
			
		||||
 | 
			
		||||
=item on1
 | 
			
		||||
 | 
			
		||||
=item os0
 | 
			
		||||
 | 
			
		||||
=item os1
 | 
			
		||||
 | 
			
		||||
=item quantity
 | 
			
		||||
 | 
			
		||||
The quantity of items being purchased.  If omitted, defaults to 1 and will not
 | 
			
		||||
be shown in the payment flow.
 | 
			
		||||
 | 
			
		||||
=item undefined_quantity
 | 
			
		||||
 | 
			
		||||
"If set to "1", the user will be able to edit the quantity.  This means your
 | 
			
		||||
customer will see a field next to quantity which they must complete.  This is
 | 
			
		||||
optional; if omitted or set to "0", the quantity will not be editable by the
 | 
			
		||||
user.  Instead, it will default to 1"
 | 
			
		||||
 | 
			
		||||
=item shipping
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head2 IPN
 | 
			
		||||
 | 
			
		||||
Before PayPal payment notification can occur, you must instruct the user to
 | 
			
		||||
enable Instant Payment Notification (IPN) on their PayPal account.  The
 | 
			
		||||
postback URL should be provided and handled by you either by detecting a PayPal
 | 
			
		||||
request in your main .cgi script (recommended), or through the use of an
 | 
			
		||||
additional .cgi script exclusively for PayPal IPN.
 | 
			
		||||
 | 
			
		||||
If adding to your existing script, it is recommended to look for the 'txn_type'
 | 
			
		||||
CGI parameter, which will be set for PayPal IPN postbacks.
 | 
			
		||||
 | 
			
		||||
Once IPN has been set up, you have to set up your application to direct users
 | 
			
		||||
to PayPal in order to initiate a PayPal payment.
 | 
			
		||||
 | 
			
		||||
=head1 SEE ALSO
 | 
			
		||||
 | 
			
		||||
L<https://www.paypal.com/html/single_item.pdf> - Single Item Purchases Manual
 | 
			
		||||
 | 
			
		||||
L<https://www.paypal.com/html/subscriptions.pdf> - Subscriptions and Recurring
 | 
			
		||||
Payments Manual
 | 
			
		||||
 | 
			
		||||
L<https://www.paypal.com/html/ipn.pdf> - IPN Manual
 | 
			
		||||
 | 
			
		||||
=head1 MAINTAINER
 | 
			
		||||
 | 
			
		||||
Jason Rhinelander
 | 
			
		||||
 | 
			
		||||
=head1 COPYRIGHT
 | 
			
		||||
 | 
			
		||||
Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
http://www.gossamer-threads.com/
 | 
			
		||||
 | 
			
		||||
=head1 VERSION
 | 
			
		||||
 | 
			
		||||
Revision: $Id: PayPal.pm,v 1.8 2006/04/08 03:42:05 brewt Exp $
 | 
			
		||||
 | 
			
		||||
=cut
 | 
			
		||||
@@ -0,0 +1,466 @@
 | 
			
		||||
# ====================================================================
 | 
			
		||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
 | 
			
		||||
#
 | 
			
		||||
#   GT::Payment::Remote::WorldPay
 | 
			
		||||
#   Author: Jason Rhinelander
 | 
			
		||||
#   CVS Info : 087,071,086,086,085      
 | 
			
		||||
#   $Id: WorldPay.pm,v 1.9 2006/08/22 23:03:14 brewt Exp $
 | 
			
		||||
#
 | 
			
		||||
# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
# ====================================================================
 | 
			
		||||
#
 | 
			
		||||
# Description:
 | 
			
		||||
#   WorldPay "Select Junior" payment processing.
 | 
			
		||||
#
 | 
			
		||||
#
 | 
			
		||||
# One major shortcoming of WorldPay is that its callback system is quite weak.
 | 
			
		||||
# It won't try to inform you very hard - it tries once, but if it doesn't
 | 
			
		||||
# connect it gives up and doesn't try again, making it entirely possible and
 | 
			
		||||
# likely that you will have to manually add missing payments at some point.
 | 
			
		||||
#
 | 
			
		||||
 | 
			
		||||
package GT::Payment::Remote::WorldPay;
 | 
			
		||||
use strict;
 | 
			
		||||
use Carp;
 | 
			
		||||
require Exporter;
 | 
			
		||||
use vars qw/@ISA @EXPORT_OK/;
 | 
			
		||||
@ISA = qw/Exporter/;
 | 
			
		||||
@EXPORT_OK = qw/process md5_signature/;
 | 
			
		||||
 | 
			
		||||
sub process {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
    shift if $_[0] and UNIVERSAL::isa($_[0], __PACKAGE__);
 | 
			
		||||
 | 
			
		||||
    my %opts = @_;
 | 
			
		||||
    $opts{param} and UNIVERSAL::isa($opts{param}, 'GT::CGI') or croak 'Usage: ->process(param => $gtcgi, ...)';
 | 
			
		||||
    my $in = $opts{param};
 | 
			
		||||
 | 
			
		||||
    ref $opts{on_valid} eq 'CODE'
 | 
			
		||||
        or ref $opts{on_recurring} eq 'CODE'
 | 
			
		||||
        or croak 'Usage: ->process(on_valid => \&CODEREF, ...)';
 | 
			
		||||
 | 
			
		||||
    defined $opts{password} and length $opts{password} or croak 'Usage: ->process(password => "password", ...)';
 | 
			
		||||
 | 
			
		||||
    for (qw/on_valid on_recurring on_cancel on_invalid_password on_recurring_failed on_recurring_cancelled/) {
 | 
			
		||||
        !$opts{$_} or ref $opts{$_} eq 'CODE' or croak "Usage: ->process($_ => \\&CODEREF, ...)";
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $callbackpw = $in->param('callbackPW');
 | 
			
		||||
    unless ($callbackpw and $callbackpw eq $opts{password}) {
 | 
			
		||||
        $opts{on_invalid_password}->() if $opts{on_invalid_password};
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    my $trans_status = $in->param('transStatus');
 | 
			
		||||
 | 
			
		||||
# The transaction was a testMode transaction, but testMode is not enabled.
 | 
			
		||||
    if ($in->param('testMode') and not $opts{test_mode}) {
 | 
			
		||||
        return;
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    if ($in->param('futurePayId')) {
 | 
			
		||||
        if ($trans_status eq 'Y') {
 | 
			
		||||
            $opts{on_recurring}->() if $opts{on_recurring};
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($trans_status eq 'N') {
 | 
			
		||||
            $opts{on_recurring_failed}->() if $opts{on_recurring_failed};
 | 
			
		||||
        }
 | 
			
		||||
        elsif ($in->param('futurePayStatusChange') eq 'Customer Cancelled') {
 | 
			
		||||
            $opts{on_recurring_cancelled}->() if $opts{on_recurring_cancelled};
 | 
			
		||||
        }
 | 
			
		||||
    }
 | 
			
		||||
    else {
 | 
			
		||||
        if    (uc $trans_status eq 'Y') { $opts{on_valid}->()  if $opts{on_valid}  }
 | 
			
		||||
        elsif (uc $trans_status eq 'C') { $opts{on_cancel}->() if $opts{on_cancel} }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub md5_signature {
 | 
			
		||||
# -----------------------------------------------------------------------------
 | 
			
		||||
    shift if $_[0] and UNIVERSAL::isa($_[0], __PACKAGE__);
 | 
			
		||||
    require GT::MD5;
 | 
			
		||||
    return GT::MD5::md5_hex(join ":", @_);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
 | 
			
		||||
__END__
 | 
			
		||||
 | 
			
		||||
=head1 NAME
 | 
			
		||||
 | 
			
		||||
GT::Payment::Remote::WorldPay - WorldPay payment handling
 | 
			
		||||
 | 
			
		||||
=head1 CAVEATS
 | 
			
		||||
 | 
			
		||||
One thing to note about WorldPay is that its security system is a little weak -
 | 
			
		||||
you can't trust a callback post as actually being genuine, unless you use the
 | 
			
		||||
callback password feature - and even at that it is not a terribly secure
 | 
			
		||||
solution.  In this regard, other payment provides have much cleaner transaction
 | 
			
		||||
systems.  Another shortcoming of WorldPay is that its callback system is
 | 
			
		||||
somewhat weak - it won't try to inform you very hard: it tries once, but if it
 | 
			
		||||
doesn't connect it gives up and doesn't try again, making it entirely possible
 | 
			
		||||
and likely that you will have to manually add (or confirm) missing payments at
 | 
			
		||||
some point, so supporting at least manual payment approval of initiated
 | 
			
		||||
payments is absolutely required.
 | 
			
		||||
 | 
			
		||||
=head1 SYNOPSIS
 | 
			
		||||
 | 
			
		||||
    use GT::Payment::Remote::WorldPay;
 | 
			
		||||
    use GT::CGI;
 | 
			
		||||
 | 
			
		||||
    my $in = new GT::CGI;
 | 
			
		||||
 | 
			
		||||
    GT::Payment::Remote::WorldPay->process(
 | 
			
		||||
        param => $in,
 | 
			
		||||
        on_valid => \&valid,
 | 
			
		||||
        on_cancel => \&cancel,
 | 
			
		||||
 | 
			
		||||
        on_recurring => \&recurring,
 | 
			
		||||
        on_recurring_failed => \&recurring_failed,
 | 
			
		||||
        on_recurring_cancelled => \&recurring_cancelled,
 | 
			
		||||
 | 
			
		||||
        password => "123",
 | 
			
		||||
        on_invalid_password => \&invalid_pw
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
    sub valid {
 | 
			
		||||
        # Update database - the payment has been made successfully.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    sub cancel {
 | 
			
		||||
        # Update database - the user has clicked the "Cancel" button, thereby
 | 
			
		||||
        # cancelling the payment.  You should take note of the cancellation.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    sub on_recurring {
 | 
			
		||||
        # Update database - a recurring payment has been made successfully.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    sub on_recurring_failed {
 | 
			
		||||
        # Update database - a recurring payment has failed.
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    sub on_recurring_cancelled {
 | 
			
		||||
        # Update database - either the customer or the merchant has cancelled
 | 
			
		||||
        # this recurring payment
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    sub on_invalid_password {
 | 
			
		||||
        # Perhaps make a record - a payment callback was received without a
 | 
			
		||||
        # valid password
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
=head1 DESCRIPTION
 | 
			
		||||
 | 
			
		||||
This module is designed to handle WorldPay payment processing using WorldPay's
 | 
			
		||||
"Select Junior" system and callback.
 | 
			
		||||
 | 
			
		||||
=head1 REQUIREMENTS
 | 
			
		||||
 | 
			
		||||
GT::CGI is the only requirement, however GT::MD5 is required in order to use
 | 
			
		||||
the md5_signature function.
 | 
			
		||||
 | 
			
		||||
=head1 FUNCTIONS
 | 
			
		||||
 | 
			
		||||
This module has only two functions.  process() does the work of actually
 | 
			
		||||
figuring out what to do with a postback, and md5_signature() is used to
 | 
			
		||||
generate an MD5 signature for payment verification and security purposes.  Both
 | 
			
		||||
functions can be imported into your package, and can be called as either method
 | 
			
		||||
or function.
 | 
			
		||||
 | 
			
		||||
=head2 process
 | 
			
		||||
 | 
			
		||||
process() is the main function provided by this module.  It can be called as
 | 
			
		||||
either a function or class method, and takes a hash (not hash reference) of
 | 
			
		||||
arguments as described below.
 | 
			
		||||
 | 
			
		||||
process() should be called for WorldPay initiated postbacks.  This can be set
 | 
			
		||||
up in your main CGI by looking for WorldPay-specific CGI parameters
 | 
			
		||||
('transStatus' is a good one to look for) or by making a seperate .cgi file
 | 
			
		||||
exclusively for handling WorldPay postbacks.
 | 
			
		||||
 | 
			
		||||
Additionally, it is strongly advised that database connection, authenticate,
 | 
			
		||||
etc.  be performed before calling process() to ensure that the payment is
 | 
			
		||||
recorded successfully.  WorldPay will not attempt to repost the form data if
 | 
			
		||||
your script produces an error, and the error will be shown to the customer.
 | 
			
		||||
 | 
			
		||||
The L<C<param>|/"param"> argument, either L<C<on_valid>|/"on_valid"> or
 | 
			
		||||
L<C<on_recurring>|/"on_recurring">, and the L<C<password>|/"password"> options
 | 
			
		||||
are required.  Using L<MD5 signing|/"MD5 signing"> as well is strongly advised.
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item param
 | 
			
		||||
 | 
			
		||||
param takes a GT::CGI object from which WorldPay postback variables are read.
 | 
			
		||||
 | 
			
		||||
=item on_valid
 | 
			
		||||
 | 
			
		||||
on_valid takes a code reference as value.  The code reference will be called
 | 
			
		||||
when a successful payment has been made.  Inside this code reference you are
 | 
			
		||||
responsible for setting a "paid" status for the order in question.
 | 
			
		||||
 | 
			
		||||
=item on_cancel
 | 
			
		||||
 | 
			
		||||
Takes a code reference to call in the event of the customer clicking the
 | 
			
		||||
"cancel" button.  Note that this is not sent if the user closes their browser,
 | 
			
		||||
but only if they click "cancel."
 | 
			
		||||
 | 
			
		||||
You should record a cancelled payment in your application.
 | 
			
		||||
 | 
			
		||||
=item password
 | 
			
		||||
 | 
			
		||||
This is a password that the customer should set in the WorldPay Customer
 | 
			
		||||
Management System, and provide to you.  Without this password, WorldPay
 | 
			
		||||
postbacks should not be considered secure.
 | 
			
		||||
 | 
			
		||||
=item on_invalid_password
 | 
			
		||||
 | 
			
		||||
This code reference will be called when the correct password is not present in
 | 
			
		||||
the postback request.  This will also be called if no password is provided.
 | 
			
		||||
 | 
			
		||||
=item on_recurring
 | 
			
		||||
 | 
			
		||||
=item on_recurring_failed
 | 
			
		||||
 | 
			
		||||
=item on_recurring_cancelled
 | 
			
		||||
 | 
			
		||||
In order to support recurring payments, you must at least define
 | 
			
		||||
C<on_recurring>.  C<on_recurring> is called when a successful recurring payment
 | 
			
		||||
has been made.  C<on_recurring_failed> is called for a failed recurring payment
 | 
			
		||||
(e.g. credit card declined).  See
 | 
			
		||||
L<the Recurring charges section|/"Recurring charges"> for more details.
 | 
			
		||||
 | 
			
		||||
Bear in mind that if you do not set up the on_recurring callback, recurring
 | 
			
		||||
payments will be ignored.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head2 md5_signature
 | 
			
		||||
 | 
			
		||||
The md5_signature() function takes a password (this must be set for the
 | 
			
		||||
WorldPay account), and a list of values and generates an appropriate WorldPay
 | 
			
		||||
MD5 signature, which should be included as the "signature" field.  See
 | 
			
		||||
L<the MD5 signing section|/"MD5 signing"> for more details.
 | 
			
		||||
 | 
			
		||||
=head1 INSTRUCTIONS
 | 
			
		||||
 | 
			
		||||
To implement WorldPay payment processing, there are a number of steps required
 | 
			
		||||
in addition to this module.  Basically, this module handles only the postback
 | 
			
		||||
stage of the WorldPay payment process.
 | 
			
		||||
 | 
			
		||||
Full WorldPay "Select Junior" information is available from the "Select Junior
 | 
			
		||||
Integration Guide" available from www.worldpay.com.
 | 
			
		||||
 | 
			
		||||
=head2 Directing customers to WorldPay
 | 
			
		||||
 | 
			
		||||
This is done by creating a web form containing the following variables.  Your
 | 
			
		||||
form, first of all, must make a C<post> request to
 | 
			
		||||
C<https://select.worldpay.com/wcc/purchase>.
 | 
			
		||||
 | 
			
		||||
Required fields are as follows:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item instId
 | 
			
		||||
 | 
			
		||||
Your WorldPay Installation ID.  Example: C<1234>
 | 
			
		||||
 | 
			
		||||
=item currency
 | 
			
		||||
 | 
			
		||||
The currency of the purchase.  Example: C<GBP>
 | 
			
		||||
 | 
			
		||||
=item desc
 | 
			
		||||
 | 
			
		||||
A description of the purchase.  Example: C<Blue T-Shirt, Medium>
 | 
			
		||||
 | 
			
		||||
=item cartId
 | 
			
		||||
 | 
			
		||||
A reference you assign to help you identify the purchase.  Example: C<10a0491>.
 | 
			
		||||
 | 
			
		||||
=item amount
 | 
			
		||||
 | 
			
		||||
The total cost of the purchase.  Example: C<25.35>
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head2 Recurring charges
 | 
			
		||||
 | 
			
		||||
Additionally, in order to set up recurring payments, the WorldPay account must
 | 
			
		||||
have "FuturePay" enabled, and then you need to use the following parameters.
 | 
			
		||||
 | 
			
		||||
The below parameters are used for the "Regular FuturePay Agreements" - there is
 | 
			
		||||
also "Limited FuturePay Agreements" in which a maximum overall charge is set.
 | 
			
		||||
For more information, see L<Repear Billing With FuturePay|/"SEE ALSO">.
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item futurePayType
 | 
			
		||||
 | 
			
		||||
Should contain the value "regular", unless using "Limited FuturePay Agreements,"
 | 
			
		||||
which will work but is not described here.
 | 
			
		||||
 | 
			
		||||
=item option
 | 
			
		||||
 | 
			
		||||
Should contain either 0, 1, or 2.  0 means the payment amount is fixed and
 | 
			
		||||
cannot be changed.  1 means the payment is fixed, but can be changed to another
 | 
			
		||||
amount at any point.  2 means the payment amount must be set before each
 | 
			
		||||
recurring payment.
 | 
			
		||||
 | 
			
		||||
=item startDate
 | 
			
		||||
 | 
			
		||||
Value in the format: "yyyy-mm-dd".  This should be the date on which the first
 | 
			
		||||
future payment should be taken.  Note that this is _NOT_ and CANNOT be today,
 | 
			
		||||
but must be a value in the future.  If using option 2, this value must be at
 | 
			
		||||
least 2 weeks in the future.
 | 
			
		||||
 | 
			
		||||
=item startDelayUnit
 | 
			
		||||
 | 
			
		||||
One digit: 1: day, 2: week, 3: month, 4: year.  Only used if startDate is
 | 
			
		||||
B<not> set.  If using option 2, this value must be at least 2 weeks in the
 | 
			
		||||
future.
 | 
			
		||||
 | 
			
		||||
=item startDelayMult
 | 
			
		||||
 | 
			
		||||
The actual delay is obtained by multiplying this value by startDelayUnit.  So,
 | 
			
		||||
to start in three weeks, this would be "3", and startDelayUnit would be "2".
 | 
			
		||||
Again, this is not used if startDate is specified.  Must be >= 1 if set.
 | 
			
		||||
 | 
			
		||||
=item noOfPayments
 | 
			
		||||
 | 
			
		||||
This number of payments that will be made.  Leave as 0 or unset for unlimited.
 | 
			
		||||
 | 
			
		||||
=item intervalUnit
 | 
			
		||||
 | 
			
		||||
One digit: 1: day, 2: week, 3: month, 4: year.  The unit of interval between
 | 
			
		||||
payments.  This must be set unless noOfPayments is 1.  If using option 1 or
 | 
			
		||||
option 2, the minimum interval is 2 weeks.
 | 
			
		||||
 | 
			
		||||
=item intervalMult
 | 
			
		||||
 | 
			
		||||
The interval between payments is determined by this value multiplied by
 | 
			
		||||
intervalUnit.  So, to make payments every 1 month, this would be "1", and
 | 
			
		||||
intervalUnit would be "3".  Must be >= 1.
 | 
			
		||||
 | 
			
		||||
=item normalAmount
 | 
			
		||||
 | 
			
		||||
This must be set for option 0 and option 1, but cannot be set for option 2.
 | 
			
		||||
 | 
			
		||||
=item initialAmount
 | 
			
		||||
 | 
			
		||||
This can be used for option 0 or option 1, but cannot be set for option 2.  If
 | 
			
		||||
set, this overrides the amount of the first payment.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
For FuturePay (recurring) payments, you still pass the required fields as
 | 
			
		||||
normal, except for the amount field: amount can be passed as 0 or a value - if
 | 
			
		||||
a value is specified, this will be treated as an immediate payment.  So, for
 | 
			
		||||
example, if you wanted to charge someone a monthly subscription of $10 starting
 | 
			
		||||
today you would pass the following variables:
 | 
			
		||||
 | 
			
		||||
    instId=1234 # (the merchant's installation reference here)
 | 
			
		||||
    amount=10
 | 
			
		||||
    cartId=8456a9264q314 # (Some random ID here that you generate)
 | 
			
		||||
    currency=USD # (Whatever currency they are charging in goes here)
 | 
			
		||||
    desc=Subscription For Something Cool # (Description of subscription)
 | 
			
		||||
    option=0
 | 
			
		||||
    normalAmount=10
 | 
			
		||||
    startDelayUnit=3
 | 
			
		||||
    startDelayMult=1
 | 
			
		||||
    intervalUnit=3
 | 
			
		||||
    intervalMult=1
 | 
			
		||||
 | 
			
		||||
=head2 MD5 signing
 | 
			
		||||
 | 
			
		||||
Additionally, using WorldPay's MD5 signature feature is strongly recommended.
 | 
			
		||||
 | 
			
		||||
To enable this feature, provide a field "signatureFields", containing fields
 | 
			
		||||
separated by ":".  Although any fields can be used, "amount:currency:cartId" is
 | 
			
		||||
recommended.  Then, call:
 | 
			
		||||
 | 
			
		||||
    my $md5 = GT::Payment::Remote::WorldPay::md5_signature(
 | 
			
		||||
        $password, $amount, $currency, $cartId
 | 
			
		||||
    );
 | 
			
		||||
 | 
			
		||||
$password should be a password provided by the user and known only to the user
 | 
			
		||||
and WorldPay.  The value returned should be passed as the "signature" variable.
 | 
			
		||||
 | 
			
		||||
This MD5 protection causes WorldPay to reject any faked payment requests and so
 | 
			
		||||
is reasonably secure.
 | 
			
		||||
 | 
			
		||||
=head2 Postback
 | 
			
		||||
 | 
			
		||||
Before WorldPay postback notification can occur, you must instruct the user to
 | 
			
		||||
enable the callback facility in the Customer Management System.  Additionally,
 | 
			
		||||
it is recommended that a proper URL to your CGI be specified there, or else
 | 
			
		||||
pass along a "MC_callback" variable that points to the script _WITHOUT_ a
 | 
			
		||||
leading http:// or https://. (e.g. MC_callback=www.example.com/callback.cgi).
 | 
			
		||||
 | 
			
		||||
Note that a WorldPay limitation prevents the callback protocol (http://) from
 | 
			
		||||
being changed dynamically - whatever protocol is set for your callback URL in
 | 
			
		||||
the Customer Management System will be used with the dynamic callback URL.
 | 
			
		||||
 | 
			
		||||
=head2 Putting it all together
 | 
			
		||||
 | 
			
		||||
The typical way to implement all of this is as follows:
 | 
			
		||||
 | 
			
		||||
=over 4
 | 
			
		||||
 | 
			
		||||
=item 1 Get necessary merchant information (instId, currency, callback
 | 
			
		||||
password, and MD5 password).
 | 
			
		||||
 | 
			
		||||
=item 2 Once the customer has selected what to purchase, generate a cartId (a
 | 
			
		||||
random MD5 hex string works well - but I<do not> use the MD5 signature!), and
 | 
			
		||||
L<generate the MD5 signature|/"MD5 signing">.
 | 
			
		||||
 | 
			
		||||
=item 3 Store the cartId somewhere (i.e. in the database).
 | 
			
		||||
 | 
			
		||||
=item 4 Make a form with all the necessary fields that
 | 
			
		||||
L<submits to WorldPay|/"Directing customers to WorldPay">.
 | 
			
		||||
 | 
			
		||||
=item 5 Set up the necessary callbacks (at least L<C<on_valid>|/"on_valid"> and
 | 
			
		||||
L<C<on_valid>|/"on_cancel">).  If using a dedicated CGI script for WorldPay
 | 
			
		||||
callbacks, it should just call process(); otherwise, check for the CGI
 | 
			
		||||
parameter 'transStatus' and if present, call process().
 | 
			
		||||
 | 
			
		||||
=item 6 For a valid payment, do whatever you need to do for a valid payment,
 | 
			
		||||
and store some record of the payment having been made (storing at least the
 | 
			
		||||
cartId, the transId, and the futurePayId is strongly recommended).  Use the CGI
 | 
			
		||||
parameter 'cartId' to locate the order (i.e. in the database).  It's
 | 
			
		||||
recommended that you check Appendix A of the "Select Junior Integration Guide"
 | 
			
		||||
for all available parameters.
 | 
			
		||||
 | 
			
		||||
=back
 | 
			
		||||
 | 
			
		||||
=head1 SEE ALSO
 | 
			
		||||
 | 
			
		||||
L<http://support.worldpay.com> - WorldPay Knowledge Base, containing many
 | 
			
		||||
useful WorldPay manuals and instructions.
 | 
			
		||||
 | 
			
		||||
L<http://support.worldpay.com/kb/integration_guides/junior/integration/help/sjig.html>
 | 
			
		||||
- Select Junior Integration Guide, from which this documentation and module is
 | 
			
		||||
primarily derived.
 | 
			
		||||
 | 
			
		||||
L<http://support.worldpay.com/kb/product_guides/futurepay/repeatbilling.html> -
 | 
			
		||||
Repeat Billing with FuturePay.
 | 
			
		||||
 | 
			
		||||
=head1 MAINTAINER
 | 
			
		||||
 | 
			
		||||
Jason Rhinelander
 | 
			
		||||
 | 
			
		||||
=head1 COPYRIGHT
 | 
			
		||||
 | 
			
		||||
Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
 | 
			
		||||
http://www.gossamer-threads.com/
 | 
			
		||||
 | 
			
		||||
=head1 VERSION
 | 
			
		||||
 | 
			
		||||
Revision: $Id: WorldPay.pm,v 1.9 2006/08/22 23:03:14 brewt Exp $
 | 
			
		||||
 | 
			
		||||
This module is designed for version 4.4 of the Select Junior payment
 | 
			
		||||
integration.
 | 
			
		||||
 | 
			
		||||
=cut
 | 
			
		||||
		Reference in New Issue
	
	Block a user