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
 126   my ( $response_body, $response_code, %response_headers ) = $self->https_post(
 127     {
 128       headers => { $self->authorization_header },
 129       'Content-Type' => 'application/json',
 130     },
 131     $post_body,
 132   );
 133   $self->server_response( $response_body );
 134
 135   my $response;
 136   {
 137     local $@;
 138     eval{ $response = decode_json( $response_body ) };
 139
 140     if ( $DEBUG ) {
 141       warn Dumper({
 142         response_body    => $response_body,
 143         response         => $response,
 144         response_code    => $response_code,
 145         # response_headers => \%response_headers,
 146       });
 147     }
 148
 149     # API should always return a JSON response,
 150     die $response_body || 'connection error'
 151       if $@ || !$response;
 152   }
 153   $self->response_decoded( $response );
 154
 155   if ( $response->{code} && $response->{code} != 1 ) {
 156
 157     $self->is_success( 0 );
 158     $self->result_code( $response->{code} );
 159     return $self->error_message(
 160       sprintf '%s %s',
 161         $response->{code},
 162         $response->{message}
 163     );
 164   }
 165
 166   # success
 167   # Populate transaction result values
 168   $self->message_id( $response->{message_id} );
 169   $self->authorization( $response->{auth_code} );
 170   $self->order_number( $response->{id} );
 171   $self->txn_date( $response->{created} );
 172   $self->avs_code( $response->{card}{avs_result} );
 173   $self->is_success( 1 );
 174 }
 175
 176 =head2 submit_api_request json_string
 177
 178 Make the appropriate API request with the given JSON string
 179
 180 =cut
 181
 182 sub submit_api_request {
 183   my $self = shift;
 184   my $json_string = shift
 185     or die 'submit_api_request() requires a json_string parameter';
 186
 187
 188 }
 189
 190 =head2 submit_action_unsupported
 191
 192 Croak with the error message Action $action unsupported
 193
 194 =cut
 195
 196 sub submit_action_unsupported {
 197   croak sprintf 'Action %s unsupported', shift->action
 198 }
 199
 200 =head2 authorization_header
 201
 202 Bambora POST requests authenticate via a HTTP header of the format:
 203 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 204
 205 Returns a hash representing the authorization header derived from
 206 the merchant id (login) and API passcode (password)
 207
 208 =cut
 209
 210 sub authorization_header {
 211   my $self = shift;
 212   my $content = $self->{_content};
 213
 214   my %authorization_header = (
 215     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 216       join( ':', $content->{login}, $content->{password} )
 217     )
 218   );
 219
 220   if ( $DEBUG ) {
 221     warn Dumper({ authorization_header => \%authorization_header })."\n";
 222   }
 223
 224   %authorization_header;
 225 }
 226
 227 =head2 jhref_billing_address
 228
 229 Return a hashref for inclusion into a json object
 230 representing the RequestBillingAddress for the API
 231
 232 =cut
 233
 234 sub jhref_billing_address {
 235   my $self = shift;
 236
 237   $self->set_province;
 238   $self->set_country;
 239   $self->set_phone_number;
 240
 241   my $content = $self->{_content};
 242
 243   return {
 244     name          => $self->truncate( $content->{name}, 64 ),
 245     address_line1 => $self->truncate( $content->{address}, 64 ),
 246     city          => $self->truncate( $content->{city}, 64 ),
 247     province      => $self->truncate( $content->{province}, 2 ),
 248     country       => $self->truncate( $content->{country}, 2 ),
 249     postal_code   => $self->truncate( $content->{zip}, 16 ),
 250     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 251     email_address => $self->truncate( $content->{email}, 64 ),
 252   };
 253 }
 254
 255 =head2 make_invoice_number
 256
 257 If an invoice number has not been specified, generate one using
 258 the current epoch timestamp
 259
 260 =cut
 261
 262 sub make_invoice_number {
 263   shift->{_content}{invoice_number} ||= time();
 264 }
 265
 266 =head2 set_country
 267
 268 Country is expected to be set as an ISO-3166-1 2-letter country code
 269
 270 Sets string to upper case.
 271
 272 Dies unless country is a two-letter string.
 273
 274 In the future, could be extended to convert country names to their respective
 275 country codes
 276
 277 See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 278
 279 =cut
 280
 281 sub set_country {
 282   my $self = shift;
 283   my $content = $self->{_content};
 284   my $country = uc $content->{country};
 285
 286   if ( $country !~ /^[A-Z]{2}$/ ) {
 287     croak sprintf 'country is not a 2 character string (%s)',
 288       $country || 'undef';
 289   };
 290
 291   $content->{country} = $country;
 292 }
 293
 294 =head2 set_expiration_month_year
 295
 296 Split standard expiration field, which may be in the format
 297 MM/YY or MMYY, into separate expiry_month and expiry_year fields
 298
 299 Will die if values are not numeric
 300
 301 =cut
 302
 303 sub set_expiration {
 304   my $self = shift;
 305   my $content = $self->{_content};
 306   my $expiration = $content->{expiration};
 307
 308   my ( $mm, $yy ) = (
 309     $expiration =~ /\//
 310     ? split( /\//, $expiration )
 311     : unpack( 'A2 A2', $expiration )
 312   );
 313
 314   croak 'card expiration must be in format MM/YY'
 315     if $mm =~ /\D/ || $yy =~ /\D/;
 316
 317   return (
 318     $content->{expiry_month} = sprintf( '%02d', $mm ),
 319     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 320   );
 321 }
 322
 323 =head2 set_payment_method
 324
 325 Set payment_method value to one of the following strings
 326
 327   card
 328   token
 329   payment_profile
 330   cash
 331   cheque
 332   interac
 333   apple_pay
 334   android_pay
 335
 336 =cut
 337
 338 sub set_payment_method {
 339   # todo - determine correct payment method
 340   warn "set_payment_method() STUB FUNCTION ALWAYS RETURNS card!\n";
 341   shift->{_content}->{payment_method} = 'card';
 342 }
 343
 344 =head2 set_phone_number
 345
 346 =cut
 347
 348 sub set_phone_number {
 349   my $self = shift;
 350   my $content = $self->{_content};
 351
 352   my $phone = $content->{phone}
 353     or return $content->{phone_number} = undef;
 354
 355   $phone =~ s/\D//g;
 356   $content->{phone_number} = $phone;
 357 }
 358
 359 =head2 set_province
 360
 361 Outside the US/Canada, API expect province set to the string "--",
 362 otherwise to be a 2 character string
 363
 364 =cut
 365
 366 sub set_province {
 367   my $self = shift;
 368   my $content = $self->{_content};
 369   my $country = uc $content->{country};
 370
 371   return $content->{province} = '--'
 372     unless $country
 373        && ( $country eq 'US' || $country eq 'CA' );
 374
 375   $content->{province} = uc $content->{state};
 376 }
 377
 378 =head2 truncate string, bytes
 379
 380 When given a string, truncate to given string length in a unicode safe way
 381
 382 =cut
 383
 384 sub truncate {
 385   my ( $self, $string, $bytes ) = @_;
 386
 387   # truncate_egc dies when asked to truncate undef
 388   return $string unless $string;
 389
 390   truncate_egc( "$string", $bytes, '' );
 391 }
 392
 393
 394 1;