path: root/lib/Business/OnlinePayment/Bambora.pm

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<Business::OnlinePayment/set_defaults>

=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</payments>

See L<https://dev.na.bambora.com/docs/references/payment_APIs/v1-0-5>

=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<https://en.wikipedia.org/wiki/ISO_3166-1>

=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;