package Business::OnlinePayment::Bambora; use strict; use warnings; use base qw/ Business::OnlinePayment::HTTPS /; use feature 'unicode_strings'; use Carp qw( croak ); use Cpanel::JSON::XS; use Data::Dumper; $Data::Dumper::Sortkeys = 1; use MIME::Base64; use Unicode::Truncate qw( truncate_egc ); use URI::Escape; use vars qw/ $VERSION $DEBUG /; $VERSION = '0.01'; $DEBUG = 0; if ( $DEBUG ) { $Data::Dumper::Sortkeys = 1; } =head1 INTERNAL METHODS =head2 set_defaults See L =cut sub set_defaults { my $self = shift; $self->server('api.na.bambora.com'); $self->port('443'); # Create accessors for $self->build_subs(qw/ expiry_month expiry_year invoice_number message_id payment_method phone_number province recurring_payment response_decoded txn_date /); } =head2 submit Dispatch to the appropriate hanlder based on the given action =cut my %action_dispatch_table = ( 'normal authorization' => 'submit_normal_authorization', 'authorization only' => 'submit_authorization_only', 'post authorization' => 'submit_post_authorization', 'reverse authorization' => 'rsubmit_everse_authorization', 'void' => 'submit_viod', 'credit' => 'submit_credit', 'tokenize' => 'submit_tokenize', 'recurring authorization' => 'submit_recurring_authorization', 'modify recurring authorization' => 'modify_recurring_authorization', ); sub submit { my $self = shift; my $action = lc $self->{_content}->{action} or croak 'submit() called with no action set'; my $method = $action_dispatch_table{$action}; $self->submit_action_unsupported() unless $method && $self->can($method); $self->$method(@_); } =head2 submit_normal_authorization Compliete a payment transaction by with an API POST to B See L =cut sub submit_normal_authorization { my $self = shift; # Series of methods to populate or format field values $self->make_invoice_number; $self->set_payment_method; $self->set_expiration; my $content = $self->{_content}; # Build a JSON string my $post_body = encode_json({ order_number => $self->truncate( $content->{invoice_number}, 30 ), amount => $content->{amount}, payment_method => $content->{payment_method}, billing => $self->jhref_billing_address, card => { number => $self->truncate( $content->{card_number}, 20 ), name => $self->truncate( $content->{owner}, 64 ), expiry_month => sprintf( '%02d', $content->{expiry_month} ), expiry_year => sprintf( '%02d', $content->{expiry_year} ), cvd => $content->{cvv2}, recurring_payment => $content->{recurring_payment} ? 1 : 0, } }); if ( $DEBUG ) { warn Dumper({ post_body => $post_body })."\n"; } $self->path('/v1/payments'); my $response = $self->submit_api_request( $post_body ); # Error messages already populated upon failure return unless $self->is_success; # Populate transaction result values $self->message_id( $response->{message_id} ); $self->authorization( $response->{auth_code} ); $self->order_number( $response->{id} ); $self->txn_date( $response->{created} ); $self->avs_code( $response->{card}{avs_result} ); $self->is_success( 1 ); } =head2 submit_api_request json_string Make the appropriate API request with the given JSON string =cut sub submit_api_request { my $self = shift; my $post_body = shift or die 'submit_api_request() requires a json_string parameter'; my ( $response_body, $response_code, %response_headers ) = $self->https_post( { headers => { $self->authorization_header }, 'Content-Type' => 'application/json', }, $post_body, ); $self->server_response( $response_body ); my $response; { local $@; eval{ $response = decode_json( $response_body ) }; if ( $DEBUG ) { warn Dumper({ response_body => $response_body, response => $response, response_code => $response_code, # response_headers => \%response_headers, }); } # API should always return a JSON response, likely network problem if ( $@ || !$response ) { $self->error_message( $response_body || 'connection error' ); $self->is_success( 0 ); return; } } $self->response_decoded( $response ); # Response returned an error if ( $response->{code} && $response->{code} != 1 ) { $self->is_success( 0 ); $self->result_code( $response->{code} ); return $self->error_message( sprintf '%s %s', $response->{code}, $response->{message} ); } # Success # Return the decoded json of the response back to handler $self->is_success( 1 ); return $response; } =head2 submit_action_unsupported Croak with the error message Action $action unsupported =cut sub submit_action_unsupported { croak sprintf 'Action %s unsupported', shift->action } =head2 authorization_header Bambora POST requests authenticate via a HTTP header of the format: Authorization: Passcode Base64Encoded(merchant_id:passcode) Returns a hash representing the authorization header derived from the merchant id (login) and API passcode (password) =cut sub authorization_header { my $self = shift; my $content = $self->{_content}; my %authorization_header = ( Authorization => 'Passcode ' . MIME::Base64::encode_base64( join( ':', $content->{login}, $content->{password} ) ) ); if ( $DEBUG ) { warn Dumper({ authorization_header => \%authorization_header })."\n"; } %authorization_header; } =head2 jhref_billing_address Return a hashref for inclusion into a json object representing the RequestBillingAddress for the API =cut sub jhref_billing_address { my $self = shift; $self->set_province; $self->set_country; $self->set_phone_number; my $content = $self->{_content}; return { name => $self->truncate( $content->{name}, 64 ), address_line1 => $self->truncate( $content->{address}, 64 ), city => $self->truncate( $content->{city}, 64 ), province => $self->truncate( $content->{province}, 2 ), country => $self->truncate( $content->{country}, 2 ), postal_code => $self->truncate( $content->{zip}, 16 ), phone_number => $self->truncate( $content->{phone_number}, 20 ), email_address => $self->truncate( $content->{email}, 64 ), }; } =head2 make_invoice_number If an invoice number has not been specified, generate one using the current epoch timestamp =cut sub make_invoice_number { shift->{_content}{invoice_number} ||= time(); } =head2 set_country Country is expected to be set as an ISO-3166-1 2-letter country code Sets string to upper case. Dies unless country is a two-letter string. In the future, could be extended to convert country names to their respective country codes See: L =cut sub set_country { my $self = shift; my $content = $self->{_content}; my $country = uc $content->{country}; if ( $country !~ /^[A-Z]{2}$/ ) { croak sprintf 'country is not a 2 character string (%s)', $country || 'undef'; }; $content->{country} = $country; } =head2 set_expiration_month_year Split standard expiration field, which may be in the format MM/YY or MMYY, into separate expiry_month and expiry_year fields Will die if values are not numeric =cut sub set_expiration { my $self = shift; my $content = $self->{_content}; my $expiration = $content->{expiration}; my ( $mm, $yy ) = ( $expiration =~ /\// ? split( /\//, $expiration ) : unpack( 'A2 A2', $expiration ) ); croak 'card expiration must be in format MM/YY' if $mm =~ /\D/ || $yy =~ /\D/; return ( $content->{expiry_month} = sprintf( '%02d', $mm ), $content->{expiry_year} = sprintf ('%02d', $yy ), ); } =head2 set_payment_method Set payment_method value to one of the following strings card token payment_profile cash cheque interac apple_pay android_pay =cut sub set_payment_method { # todo - determine correct payment method warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n"; shift->{_content}->{payment_method} = 'card'; } =head2 set_phone_number =cut sub set_phone_number { my $self = shift; my $content = $self->{_content}; my $phone = $content->{phone} or return $content->{phone_number} = undef; $phone =~ s/\D//g; $content->{phone_number} = $phone; } =head2 set_province Outside the US/Canada, API expect province set to the string "--", otherwise to be a 2 character string =cut sub set_province { my $self = shift; my $content = $self->{_content}; my $country = uc $content->{country}; return $content->{province} = '--' unless $country && ( $country eq 'US' || $country eq 'CA' ); $content->{province} = uc $content->{state}; } =head2 truncate string, bytes When given a string, truncate to given string length in a unicode safe way =cut sub truncate { my ( $self, $string, $bytes ) = @_; # truncate_egc dies when asked to truncate undef return $string unless $string; truncate_egc( "$string", $bytes, '' ); } 1;