File Coverage

blib/lib/Business/OnlinePayment/PaymenTech.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Business::OnlinePayment::PaymenTech;

use strict;
use Carp;
use Business::OnlinePayment::HTTPS;
use XML::Simple;
use Tie::IxHash;
use vars qw($VERSION $DEBUG @ISA $me);

@ISA = qw(Business::OnlinePayment::HTTPS);

$VERSION = '2.05';
$VERSION = eval $VERSION; # modperlstyle: convert the string into a number

$DEBUG = 0;
$me='Business::OnlinePayment::PaymenTech';

my %request_header = (
  'MIME-VERSION'    =>    '1.0',
  'Content-Transfer-Encoding' => 'text',
  'Request-Number'  =>    1,
  'Document-Type'   =>    'Request',
  'Interface-Version' =>  "$me $VERSION",
); # Content-Type has to be passed separately

tie my %new_order, 'Tie::IxHash', (
  OrbitalConnectionUsername => [ ':login', 32 ],
  OrbitalConnectionPassword => [ ':password', 32 ],
  IndustryType              => [ 'EC', 2 ],
  MessageType               => [ ':message_type', 2 ],
  BIN                       => [ ':bin', 6 ],
  MerchantID                => [ ':merchant_id', 12 ],
  TerminalID                => [ ':terminal_id', 3 ],
  CardBrand                 => [ '', 2 ],
  AccountNum                => [ ':card_number', 19 ],
  Exp                       => [ ':expiration', 4 ],
  CurrencyCode              => [ ':currency_code', 3 ],
  CurrencyExponent          => [ ':currency_exp', 6 ],
  CardSecValInd             => [ ':cvvind', 1 ],
  CardSecVal                => [ ':cvv2', 4 ],
  AVSzip                    => [ ':zip', 10 ],
  AVSaddress1               => [ ':address', 30 ],
  AVScity                   => [ ':city', 20 ],
  AVSstate                  => [ ':state', 2 ],
  AVScountryCode            => [ ':country', 2 ],
  OrderID                   => [ ':invoice_number', 22 ],
  Amount                    => [ ':amount', 12 ],
  Comments                  => [ ':email', 64 ],
  TxRefNum                  => [ ':order_number', 40 ],# used only for Refund
);

tie my %mark_for_capture, 'Tie::IxHash', (
  OrbitalConnectionUsername => [ ':login', 32 ],
  OrbitalConnectionPassword => [ ':password', 32 ],
  OrderID                   => [ ':invoice_number', 22 ],
  Amount                    => [ ':amount', 12 ],
  BIN                       => [ ':bin', 6 ],
  MerchantID                => [ ':merchant_id', 12 ],
  TerminalID                => [ ':terminal_id', 3 ],
  TxRefNum                  => [ ':order_number', 40 ],
);

tie my %reversal, 'Tie::IxHash', (
  OrbitalConnectionUsername => [ ':login', 32 ],
  OrbitalConnectionPassword => [ ':password', 32 ],
  TxRefNum                  => [ ':order_number', 40 ],
  TxRefIdx                  => [ '0', 4 ],
  OrderID                   => [ ':invoice_number', 22 ],
  BIN                       => [ ':bin', 6 ],
  MerchantID                => [ ':merchant_id', 12 ],
  TerminalID                => [ ':terminal_id', 3 ],
  OnlineReversalInd         => [ 'Y', 1 ],
# Always attempt to reverse authorization.
);

my %defaults = (
  terminal_id => '001',
  currency    => 'USD',
  cvvind      => '',
);

my @required = ( qw(
  login
  password
  action
  bin
  merchant_id
  invoice_number
  amount
  )
);

my %currency_code = (
# Per ISO 4217.  Add to this as needed.
  USD => [840, 2],
  CAD => [124, 2],
  MXN => [484, 2],
);

my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );

sub set_defaults {
    my $self = shift;

    $self->server('orbitalvar1.paymentech.net') unless $self->server; # this is the test server.
    $self->port('443') unless $self->port;
    $self->path('/authorize') unless $self->path;

    $self->build_subs(qw(
      order_number
    ));

    #leaking gateway-specific anmes?  need to be mapped to B:OP standards :)
    # ProcStatus
    # ApprovalStatus
    # StatusMsg
    # RespCode
    # AuthCode
    # AVSRespCode
    # CVV2RespCode
    # Response
}

sub build {
  my $self = shift;
  my %content = $self->content();
  my $skel = shift;
  tie my %data, 'Tie::IxHash';
  ref($skel) eq 'HASH' or die 'Tried to build non-hash';
  foreach my $k (keys(%$skel)) {
    my $v = $skel->{$k};
    my $l;
    ($v, $l) = @$v if(ref $v eq 'ARRAY');
    if($v =~ /^:(.*)/) {
      # Get the content field with that name.
      $data{$k} = $content{$1};
    }
    else {
      $data{$k} = $v;
    }
    # Ruthlessly enforce field length.
    $data{$k} = substr($data{$k}, 0, $l) if($data{$k} and $l);
  }
  return \%data;
}

sub map_fields {
    my($self) = @_;

    my %content = $self->content();
    foreach(qw(merchant_id terminal_id currency)) {
      $content{$_} = $self->{$_} if exists($self->{$_});
    }

    $self->required_fields('action');
    my %message_type =
                  ('normal authorization' => 'AC',
                   'authorization only'   => 'A',
                   'credit'               => 'R',
                   'void'                 => 'V',
                   'post authorization'   => 'MFC', # for our use, doesn't go in the request
                   );
    $content{'message_type'} = $message_type{lc($content{'action'})}
      or die "unsupported action: '".$content{'action'}."'";

    foreach (keys(%defaults) ) {
      $content{$_} = $defaults{$_} if !defined($content{$_});
    }
    if(length($content{merchant_id}) == 12) {
      $content{bin} = '000002' # PNS
    }
    elsif(length($content{merchant_id}) == 6) {
      $content{bin} = '000001' # Salem
    }
    else {
      die "invalid merchant ID: '".$content{merchant_id}."'";
    }

    @content{qw(currency_code currency_exp)} = @{$currency_code{$content{currency}}}
      if $content{currency};

    if($content{card_number} =~ /^(4|6011)/) { # Matches Visa and Discover transactions
      if(defined($content{cvv2})) {
        $content{cvvind} = 1; # "Value is present"
      }
      else {
        $content{cvvind} = 9; # "Value is not available"
      }
    }
    $content{amount} = int($content{amount}*100);
    $content{name} = $content{first_name} . ' ' . $content{last_name};
# According to the spec, the first 8 characters of this have to be unique.
# The test server doesn't enforce this, but we comply anyway to the extent possible.
    if(! $content{invoice_number}) {
      # Choose one arbitrarily
      $content{invoice_number} ||= sprintf("%04x%04x",time % 2**16,int(rand() * 2**16));
    }

    # Always send as MMYY
    $content{expiration} =~ s/\D//g;
    $content{expiration} = sprintf('%04d',$content{expiration});

    $content{country} ||= 'US';
    $content{country} = ( $paymentech_countries{ $content{country} }
                            ? $content{country}
                            : ''
                        ),

    $self->content(%content);
    return;
}

sub submit {
  my($self) = @_;
  $DB::single = $DEBUG;

  $self->map_fields();
  my %content = $self->content;

  my @required_fields = @required;

  my $request;
  if( $content{'message_type'} eq 'MFC' ) {
    $request = { MarkForCapture => $self->build(\%mark_for_capture) };
    push @required_fields, 'order_number';
  }
  elsif( $content{'message_type'} eq 'V' ) {
    $request = { Reversal => $self->build(\%reversal) };
  }
  else {
    $request = { NewOrder => $self->build(\%new_order) };
    push @required_fields, qw(
      card_number
      expiration
      currency
      address
      city
      zip
      );
  }

  $self->required_fields(@required_fields);

  my $post_data = XMLout({ Request => $request }, KeepRoot => 1, NoAttr => 1, NoSort => 1);

  if (!$self->test_transaction()) {
    $self->server('orbital1.paymentech.net');
  }

  warn $post_data if $DEBUG;
  $DB::single = $DEBUG;
  my($page,$server_response,%headers) =
    $self->https_post( { 'Content-Type' => 'application/PTI47',
                         'headers' => \%request_header } ,
                          $post_data);

  warn $page if $DEBUG;

  my $response = XMLin($page, KeepRoot => 0);
  #$self->Response($response);

  #use Data::Dumper;
  #warn Dumper($response) if $DEBUG;

  my ($r) = values(%$response);
  #foreach(qw(ProcStatus RespCode AuthCode AVSRespCode CVV2RespCode)) {
  #  if(exists($r->{$_}) and
  #     !ref($r->{$_})) {
  #    $self->$_($r->{$_});
  #  }
  #}

  foreach (keys %$r) {

    #turn empty hashrefs into the empty string
    $r->{$_} = '' if ref($r->{$_}) && ! keys %{ $r->{$_} };

    #turn hashrefs with content into scalars
    $r->{$_} = $r->{$_}{'content'}
      if ref($r->{$_}) && exists($r->{$_}{'content'});
  }

  if ($server_response !~ /^200/) {

    $self->is_success(0);
    my $error = "Server error: '$server_response'";
    $error .= " / Transaction error: '".
              ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
      if $r->{'ProcStatus'} != 0;
    $self->error_message($error);

  } else {

    if ( !exists($r->{'ProcStatus'}) ) {

      $self->is_success(0);
      $self->error_message( "Malformed response: '$page'" );

    } elsif ( $r->{'ProcStatus'} != 0 or
              # NewOrders get ApprovalStatus, Reversals don't.
              ( exists($r->{'ApprovalStatus'}) ?
                $r->{'ApprovalStatus'} != 1 :
                $r->{'StatusMsg'} ne 'Approved' )
            )
    {

      $self->is_success(0);
      $self->error_message( "Transaction error: '".
                            ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
                          );

    } else { # success!

      $self->is_success(1);
      # For credits, AuthCode is empty and gets converted to a hashref.
      $self->authorization($r->{'AuthCode'}) if !ref($r->{'AuthCode'});
      $self->order_number($r->{'TxRefNum'});
    }

  }

}

1;
__END__