lib/Business/OnlinePayment/Bambora.pm

   1 package Business::OnlinePayment::Bambora;
   2 use strict;
   3 use warnings;
   4
   5 =head1 NAME
   6
   7 Business::OnlinePayment::Bambora - Bambora backend for Business::OnlinePayment
   8
   9 =head1 SYNOPSIS
  10
  11 =head2 Card Transaction
  12
  13   use Business::OnlinePayment
  14
  15   my $tr = Business::OnlinePayment->new('Bambora');
  16   $tr->content(
  17     login          => $BAMBORA_MERCHANT_ID,
  18     password       => $BAMBORA_API_KEY,
  19
  20     action         => 'Normal Authorization',
  21     amount         => '13.37',
  22
  23     owner          => 'Business OnlinePayment',
  24     name           => 'Mitch Jackson',
  25     address        => '1407 Graymalkin Lane',
  26     city           => 'Vancouver',
  27     state          => 'BC',
  28     zip            => '111 111',
  29     country        => 'CA',
  30
  31     invoice_number => time(),
  32     card_number    => '4030000010001234',
  33     cvv2           => '123',
  34     expiration     => '1122',
  35     phone          => '415-462-1624',
  36     email          => 'mitch@freeside.biz',
  37   );
  38
  39   $tr->submit;
  40
  41   if ( $tr->is_success ) {
  42     print "Card processed successfully: ".$tr->authorization."\n";
  43   } else {
  44     print "Card was rejected: ".$tr->error_message."\n";
  45   }
  46
  47 =head2 Tokenize
  48
  49   use Business::OnlinePayment
  50
  51   my $tr = Business::OnlinePayment->new('Bambora');
  52   $tr->content(
  53     login          => $BAMBORA_MERCHANT_ID,
  54     password       => $BAMBORA_API_KEY,
  55
  56     action         => 'Tokenize',
  57
  58     owner          => 'Business OnlinePayment',
  59     name           => 'Mitch Jackson',
  60     address        => '1407 Graymalkin Lane',
  61     city           => 'Vancouver',
  62     state          => 'BC',
  63     zip            => '111 111',
  64     country        => 'CA',
  65
  66     invoice_number => time(),
  67     card_number    => '4030000010001234',
  68     cvv2           => '123',
  69     expiration     => '1122',
  70     phone          => '415-462-1624',
  71     email          => 'mitch@freeside.biz',
  72   );
  73
  74   $tr->submit;
  75
  76   if ( $tr->is_success ) {
  77     print "Card tokenized successfully: ".$tr->card_token."\n";
  78   } else {
  79     print "Card was rejected: ".$tr->error_message."\n";
  80   }
  81
  82   my $tr_token = Business::OnlinePayment->new('Bambora');
  83   $tr_token->content(
  84     login          => $BAMBORA_MERCHANT_ID,
  85     password       => $BAMBORA_API_KEY,
  86
  87     action         => 'Normal Authorization',
  88
  89     card_token     => $card_token,
  90     amount         => '7.77',
  91   );
  92
  93   $tr_token->submit;
  94
  95   if ( $tr_token->is_success ) {
  96     print "Card processed successfully: ".$tr_token->authorization."\n";
  97   } else {
  98     print "Card was rejected: ".$tr_token->error_message."\n";
  99   }
 100
 101 =head1 SUPPORTED TRANSACTION TYPES
 102
 103 =head2 CC, Visa, Mastercard, American Express, Discover
 104
 105 Content required: type, login, password, action, amount, card_number, expiration
 106
 107 =head1 DESCRIPTION
 108
 109 For detailed information see L<Business::OnlinePayment>
 110
 111 =head1 METHODS AND FUNCTIONS
 112
 113 See L<Business::OnlinePayment> for the complete list.   The following methods
 114 either override the methods inherited from L<Business::OnlinePayment> or
 115 provide additional functions
 116
 117 =head2 result_code
 118
 119 Returns the response error code
 120
 121 =head2 error_message
 122
 123 Returns the response error description text
 124
 125 =head2 response_page
 126
 127 Returns the complete response from the Bambora API call
 128
 129 =head2 response_decoded
 130
 131 Returns hashref containing the decoded JSON response from the Bambora API call
 132
 133 =head1 Handling of content(%content) data:
 134
 135 =head2 action
 136
 137 The following actions are valid
 138
 139   Normal Authorization
 140   Authorization Only
 141   Reverse Authorization
 142   Post Authorization
 143   Void
 144   Credit
 145   Tokenize
 146
 147 =head1 Settings Bambora parameters from content(%content)
 148
 149 The following rules are applied to map data from %content into
 150 a Bambora API request
 151
 152   Bambora              Business::OnlinePayment-%content
 153   -----------------------------------------------------
 154   order_number          invoice_number
 155   amount                amount
 156
 157   transaction_id        order_number
 158   customer_code         card_token
 159
 160   card:number           card_number
 161   card:name             owner OR name
 162   card:expiry_month     expiration
 163   card:expiry_year      expiration
 164   card:cvd              cvv2
 165
 166   billing:name          name
 167   billing:address_line1 address
 168   billing:city          city
 169   billing:province      state
 170   billing:country       country
 171   billing:postal_code   zip
 172   billing:phone_number  phone
 173   billing:email_address email
 174
 175 =head1 Bambora Authentication
 176
 177 This module generates HTTP Authorization headers based on your
 178 Bambora API Access Pascode.  You must generate an API Access Passcode
 179 within the Bambora merchant portal under the menu headings
 180 Administration > Account Settings > Order Settings
 181
 182 If you intend to use tokenization, you must also copy the same
 183 API Access Passcode to the configuration page found at
 184 Configuration > Payment Profile Configuration
 185
 186 =head1 Tokenization Implementation
 187
 188 Many use tokenization is achieved via the Bambora Payment Profile feature
 189
 190 The token created by this module represents the Bambora customer_code identifier
 191 for Payment Profile records
 192
 193 This module does not support advanced management of the Payment Profile,
 194 such as storing multiple cards onto a single profile, or updating the
 195 stored profile detail
 196
 197 Recommending configuration settings in your Bambora merchant portal:
 198 ( as of the time of this module's writing )
 199
 200   Main Manu > Configuration > Payment Profile Configuration
 201
 202   General Settings:
 203     - Uncheck "Requre unique order numbers"
 204     - Uncheck "Do not allow profile to be created with billing information
 205         duplicated from an existing profile"
 206
 207   Security Settings:
 208     - Select: API Access Passcode (requierd for this API)
 209     - The API Access Passcode will be your "password" using this module
 210
 211   Credit Card Settings
 212     - Uncheck "Do not allow profile to be created with card data duplicated
 213         from an existing profile""
 214
 215 =cut
 216
 217 use base qw/ Business::OnlinePayment::HTTPS /;
 218 use feature 'unicode_strings';
 219 use Carp qw( croak );
 220 use Cpanel::JSON::XS;
 221 use Data::Dumper;
 222     $Data::Dumper::Sortkeys = 1;
 223     $Data::Dumper::Indent   = 1;
 224 use LWP::UserAgent;
 225 use MIME::Base64;
 226 use Time::HiRes;
 227 use Unicode::Truncate qw( truncate_egc );
 228 use URI::Escape;
 229
 230 use vars qw/ $VERSION $DEBUG /;
 231 $VERSION = '0.1';
 232 $DEBUG   = 0;
 233
 234 # =head1 INTERNAL METHODS
 235 #
 236 # =head2 _info
 237 #
 238 # =cut
 239
 240 sub _info {{
 241   info_compat       => '0.01',
 242   module_version    => $VERSION,
 243   supported_types   => [qw/ CC /],
 244   supported_actions => {
 245     CC => [
 246       'Normal Authorization',
 247       'Authorization Only',
 248       'Post Authorization',
 249       'Void',
 250       'Credit',
 251       'Reverse Authorization',
 252       'Tokenize',
 253     ],
 254   },
 255 }}
 256
 257 # =head2 set_defaults
 258 #
 259 # See L<Business::OnlinePayment/set_defaults>
 260 #
 261 # =cut
 262
 263 sub set_defaults {
 264   my $self = shift;
 265
 266   $self->server('api.na.bambora.com');
 267   $self->port('443');
 268
 269   # Create accessors for
 270   $self->build_subs(qw/
 271     card_token
 272     expiry_month
 273     expiry_year
 274     failure_status
 275     invoice_number
 276     message_id
 277     payment_method
 278     phone_number
 279     province
 280     recurring_payment
 281     response_decoded
 282     txn_date
 283   /);
 284 }
 285
 286 # =head2 submit
 287 #
 288 # Dispatch to the appropriate handler based on the given action
 289 #
 290 # =cut
 291
 292 my %action_dispatch_table = (
 293   'normal authorization'           => 'submit_normal_authorization',
 294   'authorization only'             => 'submit_authorization_only',
 295   'post authorization'             => 'submit_post_authorization',
 296   'reverse authorization'          => 'submit_reverse_authorization',
 297   'void'                           => 'submit_void',
 298   'credit'                         => 'submit_credit',
 299   'tokenize'                       => 'submit_tokenize',
 300   'recurring authorization'        => 'submit_recurring_authorization',
 301   'modify recurring authorization' => 'modify_recurring_authorization',
 302 );
 303
 304 sub submit {
 305   my $self = shift;
 306
 307   my $action = lc $self->{_content}->{action}
 308     or croak 'submit() called with no action set';
 309
 310   my $method = $action_dispatch_table{$action};
 311
 312   unless ( $method && $self->can($method) ) {
 313     warn $self->error_message( "Action is unsupported ($action)" );
 314     return $self->is_success(0);
 315   }
 316
 317   $self->$method(@_);
 318 }
 319
 320 # =head2 submit_normal_authorization
 321 #
 322 # Complete a payment transaction by with an API POST to B</payments>
 323 #
 324 # See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>
 325 #
 326 # =cut
 327
 328 sub submit_normal_authorization {
 329   my $self = shift;
 330   my $content = $self->{_content};
 331
 332   # Use epoch time as invoice_number, if none is specified
 333   $content->{invoice_number} ||= time();
 334
 335   # Clarifying Bambora API and Business::OnlinePayment naming conflict
 336   #
 337   # Bambora API:
 338   # - order_number: user supplied identifier for the order, displayed on reports
 339   # - transaction_id: bambora supplied identifier for the order.
 340   #     this number must be referenced for future actions like voids,
 341   #     auth captures, etc
 342   #
 343   # Business::OnlinePayment
 344   # - invoice_number: contains the bambora order number
 345   # - order_number: contains the bambora transaction id
 346
 347   my %post = (
 348     order_number => $self->truncate( $content->{invoice_number}, 30 ),
 349     amount       => $content->{amount},
 350   );
 351
 352   if (
 353     $content->{card_token}
 354     || ( $content->{card_number} && $content->{card_number} =~ /^99\d{14}$/ )
 355   ) {
 356     # Process payment against a stored Payment Profile, whose
 357     # customer_code is used as the card_token
 358
 359     my $card_token = $content->{card_token} || $content->{card_number};
 360
 361     unless ( $card_token =~ /^99\d{14}$/ ) {
 362       $self->error_message(
 363         "Invalid card_token($card_token): Expected 16-digit "
 364         . " beginning with 99"
 365       );
 366       return $self->is_success(0);
 367     }
 368
 369     $post{payment_method} = 'payment_profile';
 370
 371     $post{payment_profile} = {
 372       customer_code => $card_token,
 373       card_id => 1,
 374     };
 375
 376   } elsif ( $content->{card_number} ) {
 377
 378     $post{payment_method} = 'card';
 379
 380     # Add card payment details to %post
 381     $post{card} = $self->jhref_card;
 382     return if $self->error_message;
 383
 384     # Add billing address to card
 385     $post{billing} = $self->jhref_billing_address;
 386
 387     # Designate recurring payment label
 388     $post{card}->{recurring_payment} = $content->{recurring_payment} ? 1 : 0;
 389
 390     # Direct API to issue a complete auth, instead of pre-auth
 391     $post{card}->{complete} = 1;
 392
 393   } else {
 394     croak 'unknown/unsupported payment method!';
 395   }
 396
 397   my $action = lc $content->{action};
 398
 399   if ( $action eq 'normal authorization' ) {
 400     # Perform complete authorization
 401     $self->path('/v1/payments');
 402
 403   } elsif ( $action eq 'authorization only' ) {
 404     # Perform pre-authorization
 405     $self->path('/v1/payments');
 406
 407     # Set the 'complete' flag to false, directing API to perform pre-auth
 408     if ( ref $post{payment_profile} ) {
 409       $post{payment_profile}->{complete} = 0;
 410     } elsif ( ref $post{card} ) {
 411       $post{card}->{complete} = 0;
 412     }
 413
 414   } elsif ( $action eq 'post authorization' ) {
 415     # Complete a pre-authorization
 416
 417     croak 'post authorization cannot be completed - '.
 418           'bambora transaction_id must be set as content order_number '.
 419           'before using submit()'
 420               unless $content->{order_number};
 421
 422     $self->path(
 423       sprintf '/v1/payments/%s/completions',
 424         $content->{order_number}
 425     );
 426
 427     if ( ref $post{card} ) {
 428       $post{card}->{complete} = 1
 429     }
 430   } else {
 431     die "unsupported action $action";
 432   }
 433
 434   # Parse %post into a JSON string, to be attached to the request POST body
 435   my $post_body = encode_json( \%post );
 436
 437   if ( $DEBUG ) {
 438     warn Dumper({
 439       path      => $self->path,
 440       post_body => $post_body,
 441       post_href => \%post,
 442     });
 443   }
 444
 445   my $response = $self->submit_api_request( $post_body );
 446
 447   # Any error messages will have been populated by submit_api_request
 448   return unless $self->is_success;
 449
 450   # Populate transaction result values
 451   $self->message_id( $response->{message_id} );
 452   $self->authorization( $response->{auth_code} );
 453   $self->order_number( $response->{id} );
 454   $self->txn_date( $response->{created} );
 455   $self->avs_code( $response->{card}{avs_result} );
 456   $self->is_success( 1 );
 457
 458   $response;
 459 }
 460
 461 # =head2 submit_authorization_only
 462 #
 463 # Capture a card authorization, but do not complete transaction
 464 #
 465 # =cut
 466
 467 sub submit_authorization_only {
 468   my $self = shift;
 469
 470   $self->submit_normal_authorization;
 471
 472   my $response = $self->response_decoded;
 473
 474   if (
 475     $self->is_success
 476     && (
 477       ref $response
 478       && $response->{type} ne 'PA'
 479     )
 480   ) {
 481     # Bambora API uses nearly identical API calls for normal
 482     # card transactions and pre-authorization. Sanity check
 483     # that response reported a pre-authorization code
 484     die "Expected API Respose type=PA, but type=$response->{type}! ".
 485         "Pre-Authorization attempt may have charged card!";
 486   }
 487 }
 488
 489 # =head2 submit_post_authorization
 490 #
 491 # Complete a card pre-authorization
 492 #
 493 # =cut
 494
 495 sub submit_post_authorization {
 496   shift->submit_normal_authorization;
 497 }
 498
 499 # =head2 submit_reverse_authorization
 500 #
 501 # Reverse a pre-authorization
 502 #
 503 # =cut
 504
 505 sub submit_reverse_authorization {
 506   shift->submit_void;
 507 }
 508
 509 # =head2 submit_void
 510 #
 511 # Process a return against a transaction for the given amount
 512 #
 513 # =cut
 514
 515 sub submit_void {
 516   my $self = shift;
 517   my $content = $self->{_content};
 518
 519   for my $f (qw/ order_number amount/) {
 520     unless ( $content->{$f} ) {
 521       $self->error_message("Cannot process void - missing required content $f");
 522       warn $self->error_message if $DEBUG;
 523
 524       return $self->is_success(0);
 525     }
 526   }
 527
 528   # The posted JSON string needs only contain the amount.
 529   # The bambora order_number being voided is passed in the URL
 530   my %post = (
 531     amount => $content->{amount},
 532   );
 533   my $post_body = encode_json( \%post );
 534
 535   $self->path( sprintf '/v1/payments/%s/returns', $content->{order_number} );
 536   if ( $DEBUG ) {
 537     warn Dumper({
 538       path => $self->path,
 539       post => \%post,
 540       post_body => $post_body,
 541     });
 542   }
 543
 544   my $response = $self->submit_api_request( $post_body );
 545   return if $self->error_message;
 546
 547   $self->is_success(1);
 548
 549   $response;
 550 }
 551
 552 # =head2 submit_tokenize
 553 #
 554 # Bambora tokenization is based on the Payment Profile feature of their API.
 555 #
 556 # The token created by this method represents the Bambora customer_code for the
 557 # Payment Profile.  The token resembles a credit card number.  It is 16 digits
 558 # long, beginning with 99.  No valid card number can begin with the digits 99.
 559 #
 560 # This method creates the payment profile and reports the customer_code
 561 # as the card_token
 562 #
 563 # =cut
 564
 565 sub submit_tokenize {
 566   my $self = shift;
 567   my $content = $self->{_content};
 568
 569   # Check if given card number is already a bambora customer_code
 570   # under this module's token rules
 571   croak "card_number is already tokenized"
 572     if $content->{card_number} =~ /^99\d{14}$/;
 573
 574   my %post = (
 575     customer_code => $self->generate_token,
 576     card          => $self->jhref_card,
 577     billing       => $self->jhref_billing_address,
 578     validate      => 0,
 579   );
 580
 581   # jhref_card may have generated an exception
 582   return if $self->error_message;
 583
 584   $self->path('/v1/profiles');
 585
 586   my $post_body = encode_json( \%post );
 587
 588   if ( $DEBUG ) {
 589     warn Dumper({
 590       path      => $self->path,
 591       post_body => $post_body,
 592       post_href => \%post,
 593     });
 594   }
 595
 596   my $response = $self->submit_api_request( $post_body );
 597   if ( $DEBUG ) {
 598     warn Dumper({
 599       response => $response,
 600       is_success => $self->is_success,
 601       error_message => $self->error_message,
 602     });
 603   }
 604   return unless $self->is_success;
 605
 606   my $customer_code = $response->{customer_code};
 607   if ( !$customer_code ) {
 608     # Should not happen...
 609     # API reported success codes, but
 610     # customer_code value is missing
 611     $self->error_message(
 612       "Fatal error: API reported success, but did not return customer_code"
 613     );
 614     return $self->is_success(0);
 615   }
 616
 617   if ( $customer_code ne $post{customer_code} ) {
 618     # Should not happen...
 619     # API reported success codes, but
 620     # customer_code attached to created profiles does not match
 621     # the token value we attempted to assign to the customer profile
 622     $self->error_message(
 623       "Fatal error: API failed to set payment profile customer_code value"
 624     );
 625     return $self->is_success(0);
 626   }
 627
 628   $self->card_token( $customer_code );
 629
 630   return $response;
 631 }
 632
 633 # =head2 submit_api_request json_string [ POST | PUT ]
 634 #
 635 # Make the appropriate API request with the given JSON string
 636 #
 637 # =cut
 638
 639 sub submit_api_request {
 640   my $self = shift;
 641
 642   my $post_body = shift
 643     or die 'submit_api_request() requires a json_string parameter';
 644
 645   # Default to using https_post, unless PUT has been specified
 646   my $http_method = ( $_[0] && lc $_[0] eq 'put' ) ? 'https_put' : 'https_post';
 647
 648   my ($response_body, $response_code, %response_headers) = $self->$http_method(
 649     {
 650       headers => { $self->authorization_header },
 651       'Content-Type' => 'application/json',
 652     },
 653     $post_body,
 654   );
 655   $self->server_response( $response_body );
 656
 657   my $response;
 658   {
 659     local $@;
 660     eval{ $response = decode_json( $response_body ) };
 661
 662     if ( $DEBUG ) {
 663       warn Dumper({
 664         response_body    => $response_body,
 665         response         => $response,
 666         response_code    => $response_code,
 667         # response_headers => \%response_headers,
 668       });
 669     }
 670
 671     # API should always return a JSON response
 672     if ( $@ || !$response ) {
 673       $self->error_message( $response_body || 'connection error' );
 674       $self->is_success( 0 );
 675       return;
 676     }
 677   }
 678   $self->response_decoded( $response );
 679
 680   if ( $response->{code} && $response->{code} != 1 ) {
 681     # Response returned an error
 682
 683     $self->is_success( 0 );
 684     $self->result_code( $response->{code} );
 685
 686     if ( $response->{message} =~ /decline/i ) {
 687       $self->failure_status('declined');
 688     }
 689
 690     return $self->error_message(
 691       sprintf '%s %s',
 692         $response->{code},
 693         $response->{message}
 694     );
 695   }
 696
 697   # Success
 698   # Return the decoded json of the response back to handler
 699   $self->is_success( 1 );
 700   return $response;
 701 }
 702
 703 =head2 authorization_header
 704
 705 Bambora REST requests authenticate via a HTTP header of the format:
 706 Authorization: Passcode Base64Encoded(merchant_id:passcode)
 707
 708 Returns a hash representing the authorization header derived from
 709 the merchant id (login) and API passcode (password)
 710
 711 =cut
 712
 713 sub authorization_header {
 714   my $self = shift;
 715   my $content = $self->{_content};
 716
 717   my %authorization_header = (
 718     Authorization => 'Passcode ' . MIME::Base64::encode_base64(
 719       join( ':', $content->{login}, $content->{password} )
 720     )
 721   );
 722
 723   if ( $DEBUG ) {
 724     warn Dumper({ authorization_header => \%authorization_header })."\n";
 725   }
 726
 727   %authorization_header;
 728 }
 729
 730 # =head2 jhref_billing_address
 731 #
 732 # Return a hashref for inclusion into a json object
 733 # representing the RequestBillingAddress for the API
 734 #
 735 # =cut
 736
 737 sub jhref_billing_address {
 738   my $self = shift;
 739
 740   $self->parse_province;
 741   $self->parse_country;
 742   $self->parse_phone_number;
 743
 744   my $content = $self->{_content};
 745
 746   return +{
 747     name          => $self->truncate( $content->{name}, 64 ),
 748     address_line1 => $self->truncate( $content->{address}, 64 ),
 749     city          => $self->truncate( $content->{city}, 64 ),
 750     province      => $self->truncate( $content->{province}, 2 ),
 751     country       => $self->truncate( $content->{country}, 2 ),
 752     postal_code   => $self->truncate( $content->{zip}, 16 ),
 753     phone_number  => $self->truncate( $content->{phone_number}, 20 ),
 754     email_address => $self->truncate( $content->{email}, 64 ),
 755   };
 756 }
 757
 758 # =head2 jhref_card
 759 #
 760 # Return a hashref for inclusin into a json object
 761 # representing Card for the API
 762 #
 763 # If necessary values are missing from %content, will set
 764 # error_message and is_success
 765 #
 766 # =cut
 767
 768 sub jhref_card {
 769   my $self = shift;
 770   my $content = $self->{_content};
 771
 772   $self->parse_expiration;
 773
 774   $content->{owner} ||= $content->{name};
 775
 776   # Check required input
 777   for my $f (qw/
 778     card_number
 779     owner
 780     expiry_month
 781     expiry_year
 782   /) {
 783     next if $content->{$f};
 784
 785     $self->error_message(
 786       "Cannot parse card payment - missing required content $f"
 787     );
 788
 789     if ( $DEBUG ) {
 790       warn Dumper({
 791         error_message => $self->error_message,
 792         content => $content,
 793       });
 794     }
 795
 796     $self->is_success( 0 );
 797     return {};
 798   }
 799
 800   return +{
 801     number       => $self->truncate( $content->{card_number}, 20 ),
 802     name         => $self->truncate( $content->{owner}, 64 ),
 803     expiry_month => sprintf( '%02d', $content->{expiry_month} ),
 804     expiry_year  => sprintf( '%02d', $content->{expiry_year} ),
 805
 806     $content->{cvv2} ? ( cvd => $content->{cvv2} ) : (),
 807   }
 808 }
 809
 810 =head2 generate_token
 811
 812 Generate a 16-digit numeric token, beginning with the digits 99,
 813 ending with a valid Luhn checksum, based on the current epoch time
 814 to the microsecond
 815
 816 =cut
 817
 818 sub generate_token {
 819   my $self = shift;
 820
 821   # Pull the current time, to the micro-second from Time::HiRes
 822   # Reverse the time string, so when trimed to 13 digits, the most
 823   # significant digits, the microseconds, are preserved
 824   #
 825   # Collission testing:
 826   #   If a collission were to occur, two Bambora payment profiles would
 827   # be created with the same customer_number token. This would result in
 828   # both payment profiles declining transactions.
 829   #    I generated 1,000,000 tokens with this method in 18 seconds.
 830   # and they were all unique. I think the risk of collission is minimal.
 831   # If this did become a problem for somebody, a time delay could be added
 832   # to this method to eliminate the change of collisions:
 833   #
 834   # sleep(1);
 835
 836   my $timestr =
 837     join '' =>
 838        grep { /\d/ }
 839        reverse
 840        split //, sprintf '%.5f', Time::HiRes::time();
 841   my $token = 99 . substr( $timestr, 0, 13 );
 842   my @token = split //, $token;
 843
 844   # Generate Luhn checksum digit
 845   my $sum = 0;
 846   for my $i ( 0..14 ) {
 847     if ( $i % 2 ) {
 848       $sum += $token[$i];
 849     } else {
 850       my $j = $token[$i]*2;
 851       $j -= 9 if $j > 9;
 852       $sum += $j;
 853     }
 854   }
 855
 856   my $luhn =  $sum % 10 ? 10 - ( $sum % 10 ) : 0;
 857   return $token . $luhn;
 858 }
 859
 860 # =head2 parse_country
 861 #
 862 # Country is expected to be set as an ISO-3166-1 2-letter country code
 863 #
 864 # Sets string to upper case.
 865 #
 866 # Dies unless country is a two-letter string.
 867 #
 868 # Could be extended to convert country names to their respective
 869 # country codes, or validate country codes
 870 #
 871 # See: L<https://en.wikipedia.org/wiki/ISO_3166-1>
 872 #
 873 # =cut
 874
 875 sub parse_country {
 876   my $self = shift;
 877   my $content = $self->{_content};
 878   my $country = uc $content->{country};
 879
 880   if ( $country !~ /^[A-Z]{2}$/ ) {
 881     croak sprintf 'country is not a 2 character string (%s)',
 882       $country || 'undef';
 883   };
 884
 885   $content->{country} = $country;
 886 }
 887
 888 # =head2 parse_expiration
 889 #
 890 # Split B::OP expiration field, which may be in the format
 891 # MM/YY or MMYY, into separate expiry_month and expiry_year fields
 892 #
 893 # Will die if values are not numeric
 894 #
 895 # =cut
 896
 897 sub parse_expiration {
 898   my $self = shift;
 899   my $content = $self->{_content};
 900   my $expiration = $content->{expiration};
 901
 902   unless ( $expiration ) {
 903     $content->{expiry_month} = undef;
 904     $content->{expiry_year}  = undef;
 905     return;
 906   }
 907
 908   my ( $mm, $yy ) = (
 909     $expiration =~ /\//
 910     ? split( /\//, $expiration )
 911     : unpack( 'A2 A2', $expiration )
 912   );
 913
 914   croak 'card expiration must be in format MM/YY'
 915     if $mm =~ /\D/ || $yy =~ /\D/;
 916
 917   return (
 918     $content->{expiry_month} = sprintf( '%02d', $mm ),
 919     $content->{expiry_year}  = sprintf ('%02d', $yy ),
 920   );
 921 }
 922
 923 # =head2 parse_phone_number
 924 #
 925 # Set value for field phone_number, from value in field phone
 926 #
 927 # Bambora API expects only digits in a phone number. Strips all non-digit
 928 # characters
 929 #
 930 # =cut
 931
 932 sub parse_phone_number {
 933   my $self = shift;
 934   my $content = $self->{_content};
 935
 936   my $phone = $content->{phone}
 937     or return $content->{phone_number} = undef;
 938
 939   $phone =~ s/\D//g;
 940   $content->{phone_number} = $phone;
 941 }
 942
 943 # =head2 parse_province
 944 #
 945 # Set value for field province, from value in field state
 946 #
 947 # Outside the US/Canada, API expect province set to the string "--",
 948 # otherwise expects a 2 character string.  Value for province is
 949 # formatted to upper case, and truncated to 2 characters.
 950 #
 951 # =cut
 952
 953 sub parse_province {
 954   my $self = shift;
 955   my $content = $self->{_content};
 956   my $country = uc $content->{country};
 957
 958   return $content->{province} = '--'
 959     unless $country
 960        && ( $country eq 'US' || $country eq 'CA' );
 961
 962   $content->{province} = uc $content->{state};
 963 }
 964
 965 =head2 truncate string, bytes
 966
 967 When given a string, truncate to given string length in a unicode safe way
 968
 969 =cut
 970
 971 sub truncate {
 972   my ( $self, $string, $bytes ) = @_;
 973
 974   # truncate_egc dies when asked to truncate undef
 975   return $string unless $string;
 976
 977   truncate_egc( "$string", $bytes, '' );
 978 }
 979
 980 =head2 https_put { headers => \%headers }, post_body
 981
 982 Implement a limited interface of https_get from Net::HTTPS::Any
 983 for PUT instead of POST -- only implementing current use case of
 984 submitting a JSON request body
 985
 986 Todo: Properly implement https_put in Net::HTTPS::Any
 987
 988 =cut
 989
 990 sub https_put {
 991   my ( $self, $args, $post_body ) = @_;
 992
 993   my $ua = LWP::UserAgent->new;
 994
 995   my %headers = %{ $args->{headers} } if ref $args->{headers};
 996   for my $k ( keys %headers ) {
 997     $ua->default_header( $k => $headers{$k} );
 998   }
 999
1000   my $url = $self->server().$self->path();
1001   my $res = $ua->put( $url, Content => $post_body );
1002
1003   $self->build_subs(qw/ response_page response_code response_headers/);
1004
1005   my @response_headers =
1006     map { $_ => $res->header( $_ ) }
1007     $res->header_field_names;
1008
1009   $self->response_headers( {@response_headers} );
1010   $self->response_code( $res->code );
1011   $self->response_page( $res->decoded_content );
1012
1013   ( $self->response_page, $self->response_code, @response_headers );
1014 }
1015
1016 =head1 AUTHORS
1017
1018 Mitch Jackson <mitch@freeside.biz>
1019
1020 =head1 ADVERTISEMENT
1021
1022 Need a complete, open-source back-office and customer self-service solution?
1023 The Freeside software includes support for credit card and electronic check
1024 processing with IPPay and over 50 other gateways, invoicing, integrated
1025 trouble ticketing, and customer signup and self-service web interfaces.
1026
1027 L<http://freeside.biz/freeside/>
1028
1029 =head1 SEE ALSO
1030
1031 perl(1). L<Business::OnlinePayment>.
1032
1033 =cut
1034
1035 1;