lib/Business/OnlinePayment/Bambora.pm

   1 package Business::OnlinePayment::Bambora;
   2 use strict;
   3 use warnings;
   4 use base qw/ Business::OnlinePayment::HTTPS /;
   5 use feature 'unicode_strings';
   6
   7 use Carp qw( croak );
   8 use Cpanel::JSON::XS;
   9 use Data::Dumper; $Data::Dumper::Sortkeys = 1;
  10 use MIME::Base64;
  11 use Unicode::Truncate qw( truncate_egc );
  12 use URI::Escape;
  13
  14 use vars qw/ $VERSION $DEBUG /;
  15 $VERSION = '0.01';
  16 $DEBUG   = 0;
  17
  18 if ( $DEBUG ) {
  19     $Data::Dumper::Sortkeys = 1;
  20 }
  21
  22 =head1 INTERNAL METHODS
  23
  24 =head2 set_defaults
  25
  26 See L<Business::OnlinePayment/set_defaults>
  27
  28 =cut
  29
  30 sub set_defaults {
  31   my $self = shift;
  32
  33   $self->server('api.na.bambora.com');
  34   $self->port('443');
  35
  36   # Create accessors for
  37   $self->build_subs(qw/
  38     expiry_month
  39     expiry_year
  40     invoice_number
  41     message_id
  42     payment_method
  43     phone_number
  44     province
  45     recurring_payment
  46     response_decoded
  47     txn_date
  48   /);
  49 }
  50
  51 =head2 submit
  52
  53 Dispatch to the appropriate hanlder based on the given action
  54
  55 =cut
  56
  57 my %action_dispatch_table = (
  58   'normal authorization'           => 'submit_normal_authorization',
  59   'authorization only'             => 'submit_authorization_only',
  60   'post authorization'             => 'submit_post_authorization',
  61   'reverse authorization'          => 'rsubmit_everse_authorization',
  62   'void'                           => 'submit_viod',
  63   'credit'                         => 'submit_credit',
  64   'tokenize'                       => 'submit_tokenize',
  65   'recurring authorization'        => 'submit_recurring_authorization',
  66   'modify recurring authorization' => 'modify_recurring_authorization',
  67 );
  68
  69 sub submit {
  70   my $self = shift;
  71
  72   my $action = lc $self->{_content}->{action}
  73     or croak 'submit() called with no action set';
  74
  75   my $method = $action_dispatch_table{$action};
  76
  77   $self->submit_action_unsupported()
  78     unless $method
  79         && $self->can($method);
  80
  81   $self->$method(@_);
  82 }
  83
  84 =head2 submit_normal_authorization
  85
  86 Compliete a payment transaction by with an API POST to B</payments>
  87
  88 See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>
  89
  90 =cut
  91
  92 sub submit_normal_authorization {
  93   my $self = shift;
  94
  95   # Series of methods to populate or format field values
  96   $self->make_invoice_number;
  97   $self->set_payment_method;
  98   $self->set_expiration;
  99
 100   my $content = $self->{_content};
 101
 102   # Build a JSON string
 103   my $post_body = encode_json({
 104     order_number   => $self->truncate( $content->{invoice_number}, 30 ),
 105     amount         => $content->{amount},
 106     payment_method => $content->{payment_method},
 107
 108     billing        => $self->jhref_billing_address,
 109
 110     card => {
 111       number            => $self->truncate( $content->{card_number}, 20 ),
 112       name              => $self->truncate( $content->{owner}, 64 ),
 113       expiry_month      => sprintf( '%02d', $content->{expiry_month} ),
 114       expiry_year       => sprintf( '%02d', $content->{expiry_year} ),
 115       cvd               => $content->{cvv2},
 116       recurring_payment => $content->{recurring_payment} ? 1 : 0,
 117     }
 118   });
 119
 120   if ( $DEBUG ) {
 121     warn Dumper({ post_body => $post_body })."\n";
 122   }
 123
 124   $self->path('/v1/payments');
 125   my $response = $self->submit_api_request( $post_body );
 126
 127   # Error messages already populated upon failure
 128   return unless $self->is_success;
 129
 130   # Populate transaction result values
 131   $self->message_id( $response->{message_id} );
 132   $self->authorization( $response->{auth_code} );
 133   $self->order_number( $response->{id} );
 134   $self->txn_date( $response->{created} );
 135   $self->avs_code( $response->{card}{avs_result} );
 136   $self->is_success( 1 );
 137 }
 138
 139 =head2 submit_api_request json_string
 140
 141 Make the appropriate API request with the given JSON string
 142
 143 =cut
 144
 145 sub submit_api_request {
 146   my $self = shift;
 147   my $post_body = shift
 148     or die 'submit_api_request() requires a json_string parameter';
 149
 150   my ( $response_body, $response_code, %response_headers ) = $self->https_post(
 151     {
 152       headers => { $self->authorization_header },
 153       'Content-Type' => 'application/json',
 154     },
 155     $post_body,
 156   );
 157   $self->server_response( $response_body );
 158
 159   my $response;
 160   {
 161     local $@;
 162     eval{ $response = decode_json( $response_body ) };
 163
 164     if ( $DEBUG ) {
 165       warn Dumper({
 166         response_body    => $response_body,
 167         response         => $response,
 168         response_code    => $response_code,
 169         # response_headers => \%response_headers,
 170       });
 171     }
 172
 173     # API should always return a JSON response, likely network problem
 174     if ( $@ || !$response ) {
 175       $self->error_message( $response_body || 'connection error' );
 176       $self->is_success( 0 );
 177       return;
 178     }
 179   }
 180   $self->response_decoded( $response );
 181
 182   # Response returned an error
 183   if ( $response->{code} && $response->{code} != 1 ) {
 184     $self->is_success( 0 );
 185     $self->result_code( $response->{code} );
 186
 187     return $self->error_message(
 188       sprintf '%s %s',
 189         $response->{code},
 190         $response->{message}
 191     );
 192   }
 193
 194   # Success
 195   # Return the decoded json of the response back to handler
 196   $self->is_success( 1 );
 197   return $response;
 198
 199 }
 200
 201 =head2 submit_action_unsupported
 202
 203 Croak with the error message Action $action unsupported
 204
 205 =cut
 206
 207 sub submit_action_unsupported {
 208   croak sprintf 'Action %s unsupported', shift->action
 209 }
 210
 211 =head2 authorization_header
 212
 213 Bambora POST requests authenticate via a HTTP header of the format:
 214 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 215
 216 Returns a hash representing the authorization header derived from
 217 the merchant id (login) and API passcode (password)
 218
 219 =cut
 220
 221 sub authorization_header {
 222   my $self = shift;
 223   my $content = $self->{_content};
 224
 225   my %authorization_header = (
 226     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 227       join( ':', $content->{login}, $content->{password} )
 228     )
 229   );
 230
 231   if ( $DEBUG ) {
 232     warn Dumper({ authorization_header => \%authorization_header })."\n";
 233   }
 234
 235   %authorization_header;
 236 }
 237
 238 =head2 jhref_billing_address
 239
 240 Return a hashref for inclusion into a json object
 241 representing the RequestBillingAddress for the API
 242
 243 =cut
 244
 245 sub jhref_billing_address {
 246   my $self = shift;
 247
 248   $self->set_province;
 249   $self->set_country;
 250   $self->set_phone_number;
 251
 252   my $content = $self->{_content};
 253
 254   return {
 255     name          => $self->truncate( $content->{name}, 64 ),
 256     address_line1 => $self->truncate( $content->{address}, 64 ),
 257     city          => $self->truncate( $content->{city}, 64 ),
 258     province      => $self->truncate( $content->{province}, 2 ),
 259     country       => $self->truncate( $content->{country}, 2 ),
 260     postal_code   => $self->truncate( $content->{zip}, 16 ),
 261     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 262     email_address => $self->truncate( $content->{email}, 64 ),
 263   };
 264 }
 265
 266 =head2 make_invoice_number
 267
 268 If an invoice number has not been specified, generate one using
 269 the current epoch timestamp
 270
 271 =cut
 272
 273 sub make_invoice_number {
 274   shift->{_content}{invoice_number} ||= time();
 275 }
 276
 277 =head2 set_country
 278
 279 Country is expected to be set as an ISO-3166-1 2-letter country code
 280
 281 Sets string to upper case.
 282
 283 Dies unless country is a two-letter string.
 284
 285 In the future, could be extended to convert country names to their respective
 286 country codes
 287
 288 See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 289
 290 =cut
 291
 292 sub set_country {
 293   my $self = shift;
 294   my $content = $self->{_content};
 295   my $country = uc $content->{country};
 296
 297   if ( $country !~ /^[A-Z]{2}$/ ) {
 298     croak sprintf 'country is not a 2 character string (%s)',
 299       $country || 'undef';
 300   };
 301
 302   $content->{country} = $country;
 303 }
 304
 305 =head2 set_expiration_month_year
 306
 307 Split standard expiration field, which may be in the format
 308 MM/YY or MMYY, into separate expiry_month and expiry_year fields
 309
 310 Will die if values are not numeric
 311
 312 =cut
 313
 314 sub set_expiration {
 315   my $self = shift;
 316   my $content = $self->{_content};
 317   my $expiration = $content->{expiration};
 318
 319   my ( $mm, $yy ) = (
 320     $expiration =~ /\//
 321     ? split( /\//, $expiration )
 322     : unpack( 'A2 A2', $expiration )
 323   );
 324
 325   croak 'card expiration must be in format MM/YY'
 326     if $mm =~ /\D/ || $yy =~ /\D/;
 327
 328   return (
 329     $content->{expiry_month} = sprintf( '%02d', $mm ),
 330     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 331   );
 332 }
 333
 334 =head2 set_payment_method
 335
 336 Set payment_method value to one of the following strings
 337
 338   card
 339   token
 340   payment_profile
 341   cash
 342   cheque
 343   interac
 344   apple_pay
 345   android_pay
 346
 347 =cut
 348
 349 sub set_payment_method {
 350   # todo - determine correct payment method
 351   warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n";
 352   shift->{_content}->{payment_method} = 'card';
 353 }
 354
 355 =head2 set_phone_number
 356
 357 =cut
 358
 359 sub set_phone_number {
 360   my $self = shift;
 361   my $content = $self->{_content};
 362
 363   my $phone = $content->{phone}
 364     or return $content->{phone_number} = undef;
 365
 366   $phone =~ s/\D//g;
 367   $content->{phone_number} = $phone;
 368 }
 369
 370 =head2 set_province
 371
 372 Outside the US/Canada, API expect province set to the string "--",
 373 otherwise to be a 2 character string
 374
 375 =cut
 376
 377 sub set_province {
 378   my $self = shift;
 379   my $content = $self->{_content};
 380   my $country = uc $content->{country};
 381
 382   return $content->{province} = '--'
 383     unless $country
 384        && ( $country eq 'US' || $country eq 'CA' );
 385
 386   $content->{province} = uc $content->{state};
 387 }
 388
 389 =head2 truncate string, bytes
 390
 391 When given a string, truncate to given string length in a unicode safe way
 392
 393 =cut
 394
 395 sub truncate {
 396   my ( $self, $string, $bytes ) = @_;
 397
 398   # truncate_egc dies when asked to truncate undef
 399   return $string unless $string;
 400
 401   truncate_egc( "$string", $bytes, '' );
 402 }
 403
 404
 405 1;