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