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