package Vend::Payment::Braintree; =head1 NAME Vend::Payment::Braintree - Interchange Braintree support =head1 SYNOPSIS &charge=braintree or [charge mode=braintree param1=value1 param2=value2] =head1 PREREQUISITES Net::Braintree =head1 DESCRIPTION The Vend::Payment::Braintree module implements the braintree() routine for use with Interchange. It is compatible on a call level with the other Interchange payment modules. To enable this module, place this directive in C: Require module Vend::Payment::Braintree This I be in interchange.cfg or a file included from it. The mode can be named anything, but the C parameter must be set to C. To make it the default payment gateway for all credit card transactions in a specific catalog, based on demo catalog settings, you can set in C: Variable MV_PAYMENT_MODE braintree It uses several of the standard settings from Interchange payment. Those with an asterisk are required. The active settings are: =over 4 =item merchant_id* Supplied from Braintree =item public_key* Supplied from Braintree =item private_key* Supplied from Braintree =item environment* One of B, B, B, B, or B. Use C for live transaction processing, and C for testing and development. =item transaction As Braintree is the PayPal successor to Payflow Pro, the transaction identifiers were patterned off of PFP's. The traditional Interchange identifiers for transactions are also supported: Interchange Braintree ---------------- ----------------- auth A return C sale S settle D void V Default transaction is C. There are additional Braintree transactions specific to the particular gateway's API: =over 4 =item mini_auth, M Use when a validation authorization is desired. The C transaction will return any authorization error that may occur on the card along with AVS and CVC validation. The transaction ID in response to a C is a C. This will have to be used for subsequent transaction activity as the Braintree nonce can only be used once. This is the scalar response from $Tag->charge or the value found in [data session payment_id]. =item find, F Use to find the current details of a transaction in Braintree. Particularly useful for issuing refunds where, depending on status, Braintree requires either voiding the authorization or running a credit against the settlement. =item client_token, T Server-side interface for generating and returning the client token needed by front-end integration for interacting with Braintree. Token is returned as the transaction ID, i.e., scalar response from $Tag->charge or value found in [data session payment_id]. =back =item payment_method_nonce Token supplied from Braintree frontend integration that references a specific payment instrument. The nonce is only capable of a single use. To acquire a permanent token to the payment instrument, issue a C transaction and store the resulting transaction ID for use as a C =item payment_method_token Permanent token from Braintree vault for accessing the associated payment instrument. If both a C and C are present in the request, the token is preferred. =item comment1 For compatibility with PFP for passing in the Interchange order number, or other local order identifier, to Braintree to pair with the transactions. =item order_id Transaction ID for follow-on transaction. E.g., transaction ID from an authorization to submit a capture request. =item check_sub Name of a global or catalog subroutine to post-process the raw result from the transaction type as received from Net::Braintree. Subroutine is provided 2 arguments: =over 4 =item $result Hash reference to the full return structure from Net::Braintree. The structure will depend on which transaction type was run and the result of the transaction. So dissecting the first argument will require examining the arg structure itself, Net::Braintree code, and Braintree documentation. =item $transaction Canonical transaction type identifer. Will be one of C, C, C, C, C, C, C, or C. =back Subroutine should return perly true or false, to indiciate if the result of the transaction should be processed as success or failure. =item test Does not support a test identifier like most Interchange payment modules. Control whether running tests or live transactions by the C setting. =back =head2 Fraud detection parameters There are a number of settings associated with additional Braintree services for fraud detection. Currently implemented: =over 4 =item * custom_fields =item * device_data =item * merchant_account_id =item * skip_advanced_fraud_checking =back Fraud results, when present, will be found in the RISK_DATA key of the results hash. See Braintree documentation for details on fraud-detection services. =head2 Credit card data Braintree shields sensitive card-holder data from the merchant to avoid higher levels of PCI burden. However, that necessarily means the usual payment information is unavailable from any user-submitted forms as is typical for Interchange implementations. The card-holder data Braintree does make available after transaction processing can be found in the CARD_DATA key of the results hash. The hash can be accessed like a standard hash or, because it's a Hash::Inflator object, can have its keys accessed via method calls. A typical CARD_DATA hash might look like: 'CARD_DATA' => { 'bin' => '411111', 'card_type' => 'Visa', 'cardholder_name' => 'Gimmy Giblets', 'commercial' => 'Unknown', 'country_of_issuance' => 'USA', 'customer_location' => 'US', 'debit' => 'Yes', 'durbin_regulated' => 'Yes', 'expiration_month' => '08', 'expiration_year' => '2021', 'healthcare' => 'No', 'issuing_bank' => 'Bank of America, National Association', 'last_4' => '1111', 'payroll' => 'No', 'prepaid' => 'No', 'product_id' => 'F', 'token' => 'foobar', 'unique_number_identifier' => 'xxxxxxxxxx80f47de7486c7809ea21e0' }, The exact composition will depend on a number of factors determined by Braintree and the specific payment instrument. But the most important keys--those identifying bin, last 4, cardtype, expiration--should always be present. =head2 Troubleshooting =over 4 =item * Make sure you "Require"d the module in interchange.cfg: Require module Vend::Payment::Braintree =item * Make sure Net::Braintree is installed and working. You can test to see whether your Perl thinks it is: perl -MNet::Braintree -e 'print "$Net::Braintree::VERSION\n"' If that prints a version number, then the module is installed with the version noted. =item * Check the error logs, both catalog and global. =item * Make sure you set your required payment parameters properly. =item * Try an order, then put this code in a page: [calc] my $string = $Tag->uneval( { ref => $Session->{payment_result} }); $string =~ s/{/{\n/; $string =~ s/,/,\n/g; return $string; [/calc] That should show what happened. =item * If all else fails, consultants are available to help with integration for a fee. See https://www.interchangecommerce.org/ for mailing lists and other information. =back =head1 AUTHORS Mark Johnson Jon Jensen =cut use strict; use warnings; BEGIN { require Net::Braintree; # Redefining the refund() routine here because it is broken # in Net::Braintree::Transaction. Without the override, you cannot # submit additional parameters Braintree suppports. # # The CPAN modules are no longer actively maintained and a patch # to fix this issue was rejected. To make handling Braintree as # simple as possible in Interchange, this local override allows # a direct CPAN install of Net::Braintree to fully function. no warnings 'redefine'; *Net::Braintree::Transaction::refund = sub { # Follow-on credit my ($class, $id, $amount) = @_; my $params; if (ref $amount) { $params = $amount; } else { $params = {}; $params->{'amount'} = $amount if $amount; } $class->gateway->transaction->refund($id, $params); }; } ::logGlobal('%s module loaded', __PACKAGE__); *charge_param = \&Vend::Payment::charge_param; sub get_token { my $route = shift || charge_param('mode'); my $opt; if (ref ($route) ) { $opt = $route; } elsif ( not defined($route) && length($route)) { ::logError(__PACKAGE__ . "::get_token requires a route hash or name"); return; } else { $opt = $Vend::Cfg->{Route_repository}{$route}; } my $config = Net::Braintree->configuration; $config->$_($opt->{$_}) for qw( environment merchant_id public_key private_key ); return Net::Braintree::ClientToken->generate; } sub response_map { return qw/ order-id PNREF pop.order-id PNREF pop.auth-code AUTHCODE pop.avs_code AVSZIP pop.avs_zip AVSZIP pop.avs_addr AVSADDR /; } sub method_map { local $_ = shift; return 'create' if /M/; return 'sale' if /S|A/; return 'submit_for_settlement' if /D/; return 'void' if /V/; return 'refund' if /C/; return 'find' if /F/; die "'$_' is an invalid transaction type"; } sub scrub_addresses { my $opt = shift; for (qw( country b_country )) { $opt->{$_} = 'GB' if $opt->{$_} eq 'UK'; } # Braintree says postal codes must be no more than 9 alphanumeric characters, with spaces and hyphens ignored # https://developers.braintreepayments.com/reference/request/address/create/ruby#postal_code for (qw( zip b_zip )) { $opt->{$_} =~ s/[^A-Za-z0-9]+//g; $opt->{$_} = substr($opt->{$_}, 0, 9); } return; } sub handle_avs { my $E = shift; return ('','') if $E; my @rv; for (@_) { my $v = /M/ ? 'Y' : /N/ ? 'N' : /[UI]/ ? 'X' : ''; push @rv, $v; } return @rv; } sub gateway_rejection_reason_code { my $reason = shift; # These negative number codes are our arbitrary invention to include gateway rejections in the same result code. # See https://developers.braintreepayments.com/reference/response/credit-card-verification/ruby#gateway_rejection_reason my %map = ( avs => -101, avs_and_cvv => -102, cvv => -103, duplicate => -104, fraud => -105, three_d_secure => -106, application_incomplete => -107, ); return $map{$reason} || -100; } sub client_token { my ($transtype, $amount, $opt) = @_; my $result; { local $@; $result = eval { no warnings 'redefine'; local *Carp::longmess = \&Carp::shortmess if $opt->{environment} eq 'production'; get_token($opt); } or do { my $err = ::errmsg('Unable to retrieve client token: %s', $@ || 'no information from eval block.'); ::logError($err); return ( MStatus => 'failure-hard', MErrMsg => $err, ); } ; } return ( MStatus => 'success', 'order-id' => $result, ); } sub transaction { my ($transtype, $amount, $opt) = @_; my $method = method_map($transtype); my @args; if ($transtype =~ /[SA]/) { my ($k, $v); for (grep { $opt->{$_} } qw/payment_method_token payment_method_nonce/) { $k = $_; $v = $opt->{$_}; last; } $v or return ( MStatus => 'failure-hard', MErrMsg => ::errmsg('No nonce or token present to process %s type transaction', $transtype), ); my %act = %{ $opt->{actual} }; scrub_addresses(\%act); my %params = ( amount => $amount, $k => $v, options => {}, shipping => { first_name => $act{fname}, last_name => $act{lname}, street_address => $act{address1}, extended_address => $act{address2}, locality => $act{city}, region => $act{state}, postal_code => $act{zip}, country_code_alpha2 => $act{country}, }, ); for (grep { $opt->{$_} } qw/custom_fields device_data merchant_account_id/) { $params{$_} = $opt->{$_}; } for (grep { defined $opt->{$_} } qw/skip_advanced_fraud_checking/) { $params{options}{$_} = $opt->{$_}; } # if $k is a nonce, then we're not using a previously defined # customer. So supply user's billing information and email if ($k eq 'payment_method_nonce') { $params{billing} = { first_name => $act{b_fname}, last_name => $act{b_lname}, street_address => $act{b_address1}, extended_address => $act{b_address2}, locality => $act{b_city}, region => $act{b_state}, postal_code => $act{b_zip}, country_code_alpha2 => $act{b_country}, }; $params{customer} = { first_name => $act{b_fname}, last_name => $act{b_lname}, email => $act{email}, phone => $act{b_phone} || $act{phone} || $act{phone_day} || $act{phone_night}, }; } $params{options}{submit_for_settlement} = $transtype =~ /S/ ? 1 : 0; $params{order_id} = $opt->{comment1} if $opt->{comment1}; push (@args, \%params); } else { push (@args, $opt->{order_id}); push (@args, $amount) unless $transtype =~ /[VF]/; } my $gwl = Vend::Payment::Braintree::GWL -> new({ Enabled => charge_param('gwl_enabled'), LogTable => charge_param('gwl_table'), Source => charge_param('gwl_source'), }) ; $gwl->request({ opt => { %$opt, transtype => $transtype, }, args => $gwl->label_args(\@args), }); #::logDebug("calling braintree's %s transaction method with args %s\n", $method, ::uneval(\@args)); my $result; { local $@; $result = eval { no warnings 'redefine'; local *Carp::longmess = \&Carp::shortmess if $opt->{environment} eq 'production'; my $config = Net::Braintree->configuration; $config->$_($opt->{$_}) for qw/environment merchant_id public_key private_key/; $gwl->start; Net::Braintree::Transaction->$method(@args); } or do { my $err = $@ || "Net::Braintree::Transaction returned no object but did not die for $method call"; $gwl->stop; $gwl->response({ return => {}, eval_error => $err, },); return ( MStatus => 'failure-hard', MErrMsg => ::errmsg('Unable to contact payment processor. Please try again.'), ); } ; $gwl->stop; $gwl->response({ return => { RESPMSG => 'N/A'}, raw => $result, }); } #::logDebug("braintree transaction $method result: " . ::uneval($result)); my ($success, $api_err, $t); unless ($api_err = $result->api_error_response) { $t = $result->transaction; $success = $result->is_success && defined($t) && $t->processor_response_code =~ /^1\d{3}$/; } if ( $success and my $check_sub_name = $opt->{check_sub} || charge_param('check_sub') ) { my $check_sub = $Vend::Cfg->{Sub}{$check_sub_name} || $Global::GlobalSub->{$check_sub_name}; if (ref $check_sub eq 'CODE') { $success = $check_sub->( $result, $transtype, ) ; } } my %response; if ($api_err) { my ($msg, $code); if (exists $api_err->{transaction}) { my $et = $api_err->{transaction}; $msg = $et->{processor_response_text}; $code = $et->{processor_response_code}; } if (exists $api_err->{errors}{transaction}{errors}) { my $arr = $api_err->{errors}{transaction}{errors}; if (ref($arr) eq 'ARRAY' and @$arr) { my $e = $arr->[0]; $msg = $e->{message}; $code = $e->{code}; } } %response = ( RESPMSG => $msg || $api_err->{message} || 'Unknown', RESULT => $code || -1, ); } elsif ($t) { %response = ( PNREF => $t->id, RESPMSG => $t->processor_response_text || $result->message || 'Unknown', RESULT => $t->processor_response_code || -1, STATUS => $t->status, ); $response{AUTHCODE} = $t->processor_authorization_code if $t->processor_authorization_code; @response{qw/AVSADDR AVSZIP/} = handle_avs( $t->avs_error_response_code, $t->avs_street_address_response_code, $t->avs_postal_code_response_code, ) ; { local $_ = $t->cvv_response_code; $response{CVV2MATCH} = /M/ ? 'Y' : /N/ ? 'N' : /[UI]/ ? 'X' : ''; } $response{CARD_DATA} = $t->credit_card_details if $t->credit_card_details; eval { $response{RISK_DATA} = $response{risk_data} = $t->risk_data if $t->risk_data; }; } else { %response = ( RESPMSG => $result->{message} || 'Unknown', RESULT => -1, ); } $response{MStatus} = $success ? 'success' : 'failed'; $response{MErrMsg} = $response{RESPMSG} if !$success; my %response_map = response_map(); for (keys %response_map) { $response{$_} = $response{$response_map{$_}} if defined $response{$response_map{$_}}; } #::logDebug("braintree transaction $method response: " . ::uneval(\%response)); $gwl->response({ return => \%response, raw => $result, }); return %response; } sub customer { my ($transtype, $amount, $opt) = @_; my $method = method_map($transtype); $opt->{payment_method_nonce} or return ( MStatus => 'failure-hard', MErrMsg => ::errmsg('Nonce missing; unable to process %s type transaction', $transtype), ) ; my %act = %{ $opt->{actual} }; scrub_addresses(\%act); my %params = ( first_name => $act{b_fname}, last_name => $act{b_lname}, email => $act{email}, phone => $act{b_phone} || $act{phone} || $act{phone_day} || $act{phone_night}, credit_card => { payment_method_nonce => $opt->{payment_method_nonce}, cardholder_name => "$act{b_fname} $act{b_lname}", billing_address => { first_name => $act{b_fname}, last_name => $act{b_lname}, street_address => $act{b_address1}, extended_address => $act{b_address2}, locality => $act{b_city}, region => $act{b_state}, postal_code => $act{b_zip}, country_code_alpha2 => $act{b_country}, }, options => { verify_card => 1, }, }, ); $params{credit_card}{options}{verification_merchant_account_id} = $opt->{merchant_account_id} if $opt->{merchant_account_id}; for (grep { $opt->{$_} } qw/custom_fields device_data/) { $params{$_} = $opt->{$_}; } my @args = (\%params); my $gwl = Vend::Payment::Braintree::GWL -> new({ Enabled => charge_param('gwl_enabled'), LogTable => charge_param('gwl_table'), Source => charge_param('gwl_source'), }) ; $gwl->request({ opt => { %$opt, transtype => $transtype, }, args => $gwl->label_args(\@args), }); #::logDebug("calling braintree's %s customer method with args %s\n", $method, ::uneval(\@args)); my $result; { local $@; $result = eval { no warnings 'redefine'; local *Carp::longmess = \&Carp::shortmess if $opt->{environment} eq 'production'; my $config = Net::Braintree->configuration; $config->$_($opt->{$_}) for qw/environment merchant_id public_key private_key/; $gwl->start; Net::Braintree::Customer->$method(@args); } or do { my $err = $@ || "Net::Braintree::Customer returned no object but did not die for $method call"; $gwl->stop; $gwl->response({ return => {}, eval_error => $err, },); return ( MStatus => 'failure-hard', MErrMsg => ::errmsg('Unable to contact payment processor. Please try again.'), ); } ; $gwl->stop; $gwl->response({ return => { RESPMSG => 'N/A'}, raw => $result, }); } #::logDebug("braintree customer $method result: " . ::uneval($result)); my ($success, $api_err, $c, $pm, $ver); unless ($api_err = $result->api_error_response) { $c = $result->customer; $pm = $c && $c->payment_methods->[0]; $ver = $pm && $pm->verifications->[0]; $success = $result->is_success && defined($ver) && $ver->processor_response_code =~ /^1\d{3}$/; } if ( $success and my $check_sub_name = $opt->{check_sub} || charge_param('check_sub') ) { my $check_sub = $Vend::Cfg->{Sub}{$check_sub_name} || $Global::GlobalSub->{$check_sub_name}; if (ref $check_sub eq 'CODE') { $success = $check_sub->( $result, $transtype, ) ; } } my %response; if ($api_err) { my ($msg, $code); if (exists $api_err->{verification}) { my $ev = $api_err->{verification}; if ($ev->{gateway_rejection_reason}) { # "If a transaction was authorized before being rejected, the gateway will automatically void it." # https://articles.braintreepayments.com/control-panel/transactions/gateway-rejections $msg = $api_err->{message}; $code = gateway_rejection_reason_code($ev->{gateway_rejection_reason}); } else { $msg = $ev->{processor_response_text}; $code = $ev->{processor_response_code}; } } if (exists $api_err->{errors}{customer}{credit_card}{errors}) { my $arr = $api_err->{errors}{customer}{credit_card}{errors}; if (ref($arr) eq 'ARRAY' and @$arr) { my $e = $arr->[0]; $msg = $e->{message}; $code = $e->{code}; } } if (exists $api_err->{errors}{customer}{credit_card}{billing_address}{errors}) { my $arr = $api_err->{errors}{customer}{credit_card}{billing_address}{errors}; if (ref($arr) eq 'ARRAY' and @$arr) { my $e = $arr->[0]; $msg = $e->{message}; $code = $e->{code}; } } %response = ( RESPMSG => $msg || $api_err->{message} || 'Unknown', RESULT => $code || -1, ); } elsif ($ver) { %response = ( PNREF => $pm->token, RESPMSG => $ver->processor_response_text || $result->message || 'Unknown', RESULT => $ver->processor_response_code || -1, CUSTOMER_ID => $c->id, ); @response{qw/AVSADDR AVSZIP/} = handle_avs( $ver->avs_error_response_code, $ver->avs_street_address_response_code, $ver->avs_postal_code_response_code, ) ; { local $_ = $ver->cvv_response_code; $response{CVV2MATCH} = /M/ ? 'Y' : /N/ ? 'N' : /[UI]/ ? 'X' : ''; } $response{CARD_DATA} = $ver->credit_card if $ver->credit_card; eval { $response{RISK_DATA} = $response{risk_data} = $ver->risk_data if $ver->risk_data; }; } else { %response = ( RESPMSG => $result->{message} || 'Unknown', RESULT => -1, ); } $response{MStatus} = $success ? 'success' : 'failed'; $response{MErrMsg} = $response{RESPMSG} if !$success; my %response_map = response_map(); for (keys %response_map) { $response{$_} = $response{$response_map{$_}} if defined $response{$response_map{$_}}; } #::logDebug("braintree customer $method response: " . ::uneval(\%response)); $gwl->response({ return => \%response, raw => $result, }); return %response; } package Vend::Payment; use strict; use warnings; sub braintree { my ($user, $amount) = @_; #::logDebug("braintree called\n%s\n", ::uneval($user)); my $opt; if(ref $user) { $opt = $user; } else { $opt = {}; } my $actual; if($opt->{actual}) { $actual = $opt->{actual}; } else { my (%actual) = map_actual(); $actual = \%actual; } # This quirk is for ensuring access to actual in subprocessing routines $opt->{actual} ||= $actual; my %type_map = qw/ sale S auth A authorize A void V settle D settle_prior D credit C mini_auth M verify M status F find F client_token T token T T T F F S S C C D D V V A A M M /; my $transtype = $opt->{transaction} || charge_param('transaction') || 'A'; $transtype = $type_map{$transtype} or return ( MStatus => 'failure-hard', MErrMsg => ::errmsg('Unrecognized transaction: %s', $transtype), ); $amount = $opt->{total_cost} if ! $amount; if (! $amount) { my $precision = $opt->{precision} || charge_param('precision') || 2; my $cost = Vend::Interpolate::total_cost(); $amount = Vend::Util::round_to_frac_digits($cost, $precision); } my $sub = $transtype eq 'M' ? \&Vend::Payment::Braintree::customer : $transtype eq 'T' ? \&Vend::Payment::Braintree::client_token : \&Vend::Payment::Braintree::transaction ; return $sub->($transtype, $amount, $opt); } package Vend::Payment::Braintree::GWL; use base qw/Vend::Payment::GatewayLog/; use Scalar::Util qw/reftype/; # Return structure from Net::Braintree is exceptionally bloated. The response # is passed through a number of thinning processes to make it much more # readable and take considerably less storage space. # Constants to define arrays of typically bloating, useless keys per # transaction/reftype combination. They will be culled if they are present but # undefined; otherwise, they will persist into gateway_log table. use constant CUSTOMER_HASH_KEYS => [qw/ customer /]; use constant CUSTOMER_ARRAY_KEYS => [qw/ refund_ids /]; use constant CUSTOMER_SCALAR_KEYS => [qw/ company fax refund_id refunded_transaction_id website /]; use constant CUSTOMER_CC_KEYS => [qw/ subscriptions /]; use constant TRANSACTION_HASH_KEYS => [qw/ descriptor disbursement_details processor_settlement_response_code processor_settlement_response_text subscription /]; use constant TRANSACTION_ARRAY_KEYS => [qw/ add_ons discounts disputes partial_settlement_transaction_ids /]; use constant TRANSACTION_SCALAR_KEYS => [qw/ additional_processor_response authorized_transaction_id channel escrow_status master_merchant_account_id plan_id purchase_order_number service_fee_amount settlement_batch_id sub_merchant_account_id subscription_id three_d_secure_info voice_referral_number /]; # Remove certain completely empty response objects corresponding to KEYS # definitions above. sub thin_hashes { # hashes either empty or with all undef values my ($obj, $prefix, $fields) = @_; for my $k (@$fields) { next unless exists $obj->{$k}; my $h = $obj->{$k}; if (grep { defined($h->{$_}) } keys %$h) { ::logError("Unexpected defined value found in $prefix$k - preserving entire hash\n"); } else { delete $obj->{$k}; } } return; } sub thin_arrays { # empty arrays my ($obj, $prefix, $fields) = @_; for my $k (@$fields) { next unless exists $obj->{$k}; my $arr = $obj->{$k}; if (ref($arr) ne 'ARRAY' or @$arr) { ::logError("Unexpected data type or array not empty in $prefix$k - preserving\n"); } else { delete $obj->{$k}; } } return; } sub thin_scalars { # undef scalars my ($obj, $prefix, $fields) = @_; for my $k (@$fields) { next unless exists $obj->{$k}; if (defined $obj->{$k}) { ::logError("Unexpected defined value in $prefix$k - preserving\n"); } else { delete $obj->{$k}; } } return; } # Stringify timestamps for readability and bloat reduction sub thin_datetimes { # stringify DateTime objects directly on source reference my $ref = shift; my $type = ref ($$ref) or return; if ( $type eq 'DateTime' ) { $$ref = $$ref->formatter->format_datetime($$ref); return; } my $rtype = reftype($$ref); if ( $rtype eq 'HASH' ) { thin_datetimes(\$_) for values %$$ref; } elsif ( $rtype eq 'ARRAY' ) { thin_datetimes(\$_) for @$$ref; } return; } # Deflate all hashes sub hash_deflate { # convert any hash objects into regular hashes my $ref = shift; my $rtype = reftype($$ref) or return; my $type = ref ($$ref); if ($rtype eq 'HASH') { hash_deflate(\$_) for values %$$ref; if ($type ne $rtype) { $$ref = { %$$ref }; } } elsif ($rtype eq 'ARRAY') { hash_deflate(\$_) for @$$ref; } return; } # Main routine to act on the top-level response object. Delegates to the above # routines. sub thin_response_object { my $orig = shift; return $orig unless $orig and reftype($orig) eq 'HASH'; # Deep copy the object contents so we don't affect the original my $obj = eval ::uneval($orig); # Scrub all annoying DateTime objects thin_datetimes(\$obj); # Deflate all remaining hash objects hash_deflate(\$obj); delete $obj->{return}{CARD_DATA}{image_url} if exists $obj->{return}{CARD_DATA}; return $obj unless exists $obj->{raw} and reftype($obj->{raw}) eq 'HASH'; if (exists $orig->{raw}{response}{customer}) { my $customer = $obj->{raw}{response}{customer}; my $prefix = 'raw.response.customer.'; thin_hashes( $customer, $prefix, CUSTOMER_HASH_KEYS); thin_arrays( $customer, $prefix, CUSTOMER_ARRAY_KEYS); thin_scalars($customer, $prefix, CUSTOMER_SCALAR_KEYS); my $cc_n = 0; for my $cc (@{ $customer->{credit_cards} }) { my $cc_prefix = $prefix . "credit_cards.$cc_n."; ++$cc_n; thin_arrays($cc, $cc_prefix, CUSTOMER_CC_KEYS); delete $cc->{image_url}; } } if (exists $orig->{raw}{response}{transaction}) { my $txn = $obj->{raw}{response}{transaction}; my $prefix = 'raw.response.trasaction.'; thin_hashes( $txn, $prefix, TRANSACTION_HASH_KEYS); thin_arrays( $txn, $prefix, TRANSACTION_ARRAY_KEYS); thin_scalars($txn, $prefix, TRANSACTION_SCALAR_KEYS); delete $txn->{credit_card}{image_url}; } return $obj; } # log_it() must be overridden. sub log_it { my $self = shift; my $request = $self->request; unless ($request) { ::logDebug('Cannot write to %s: no request present', $self->table); return; } unless ($self->response) { if ($Vend::Payment::Global_Timeout) { my $msg = errmsg('No response. Global timeout triggered'); ::logDebug($msg); $self->response({ return => { RESULT => -2, RESPMSG => $Vend::Payment::Global_Timeout, }, }); } else { my $msg = errmsg('No response. Reason unknown'); ::logDebug($msg); $self->response({ return => { RESULT => -3, RESPMSG => $msg, }, }); } } my $response = $self->response; my $return = $response->{return}; my $rc = defined ($return->{RESULT}) && $return->{RESULT} =~ /^-?\d+$/ ? $return->{RESULT} : undef ; my $opt = delete $request->{opt}; my $processor = $opt->{route} || $opt->{gateway}; my $thinned_response = eval { thin_response_object($response) }; if ($@ or !$thinned_response) { ::logError("Error thinning Braintree response" . ($@ ? ": $@" : '')); $thinned_response = $response; } #::logDebug("Gateway log thinned response: " . ::uneval($thinned_response)); my %fields = ( trans_type => $opt->{transtype} || 'x', processor => $processor || 'braintree', catalog => $Vend::Cfg->{CatalogName}, result_code => $rc || '', response_msg => $return->{RESPMSG} || '', request_id => $return->{PNREF} || '', order_number => $opt->{comment1} || '', request_duration => $self->duration, request_date => $self->timestamp, request_source => $self->source, email => $opt->{actual}{email} || '', request => ::uneval($request) || '', response => ::uneval($thinned_response) || '', session_id => $::Session->{id} || '', amount => $request->{args}{AMT} || $request->{args}{amount} || '', host_ip => $::Session->{shost} || $::Session->{ohost} || '', username => $::Session->{username} || '', cart_md5 => '', ); if (@$Vend::Items) { my $dump = Data::Dumper -> new($Vend::Items) -> Indent(0) -> Terse(1) -> Deepcopy(1) -> Sortkeys(1) ; $fields{cart_md5} = Digest::MD5::md5_hex($dump->Dump); } $self->write(\%fields); } sub label_args { my $self = shift; my $orig = shift; return 'malformed request argument list' unless reftype ($orig) eq 'ARRAY' && scalar @$orig ; # Ensure manipulations of argument ref are insulated my $arg = eval ::uneval($orig); return $arg->[0] if ref($arg->[0]) and reftype($arg->[0]) eq 'HASH'; my @k = qw/ORIGID AMT/; my %hsh; while (@$arg && @k) { $hsh{ shift (@k) } = shift @$arg; } if (@$arg) { $hsh{unknown} = $arg; } return \%hsh; } 1;