Paymentech.pm

   1 package Business::BatchPayment::Paymentech;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.03';
   7
   8 =head1 NAME
   9
  10 Business::BatchPayment::Paymentech - Chase Paymentech XML batch format.
  11
  12 =head1 USAGE
  13
  14 See L<Business::BatchPayment> for general usage notes.
  15
  16 =head2 SYNOPSIS
  17
  18 use Business::BatchPayment;
  19
  20 my @items = Business::BatchPayment::Item->new( ... );
  21
  22 my $processor = Business::BatchPayment->processor('Paymentech',
  23   merchantID    => '123456',
  24   bin           => '00001',
  25   terminalID    => '001',
  26   industryType  => 'EC'
  27   login         => 'TESTUSER',
  28   password      => 'MYPASS',
  29 );
  30
  31 my $result = $processor->submit(@items);
  32
  33 =head2 REQUIREMENTS
  34
  35 Requires L<Net::SFTP::Foreign> and ssh (for file transfer) and the zip and
  36 unzip programs.  Unlikely to work on non-Unix systems.
  37
  38 =head2 PROCESSOR ATTRIBUTES
  39
  40 =over 4
  41
  42 =item login - the username to use for SFTP, and in the "userID" tag
  43
  44 =item password - the password for SFTP, and for creating zip files
  45
  46 =item merchantID - your 6- or 12-digit Paymentech merchant ID
  47
  48 =item bin - your BIN: 000001 or 000002
  49
  50 =item terminalID - your 3-digit terminal ID
  51
  52 =item industryType - your 2-letter industry type code
  53
  54 =back
  55
  56 =cut
  57
  58 use File::Temp qw(tempdir);
  59 use DateTime;
  60 use XML::Writer;
  61 use XML::Simple;
  62 use Try::Tiny;
  63
  64 use Moose;
  65 with 'Business::BatchPayment::Processor';
  66 with 'Business::BatchPayment::TestMode';
  67
  68 use Encode;
  69
  70 # could have some validation on all of these
  71 has [ qw(merchantID terminalID bin industryType login password) ] => (
  72   is       => 'ro',
  73   isa      => 'Str',
  74   required => 1,
  75 );
  76
  77 has 'fileDateTime' => (
  78   is      => 'ro',
  79   isa     => 'Str',
  80   default => sub {
  81     DateTime->now->strftime('%Y%m%d%H%M%S')
  82   },
  83 );
  84
  85 my %BankAcctType = (
  86   'personal checking' => 'C',
  87   'personal savings'  => 'S',
  88   'business checking' => 'X',
  89   'business savings'  => 'X',
  90 );
  91
  92 my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );
  93
  94 sub default_transport {
  95   my $self = shift;
  96   Business::BatchPayment::Paymentech::Transport->new(
  97     login     => $self->login,
  98     password  => $self->password,
  99     debug     => $self->debug,
 100     test_mode => $self->test_mode,
 101   );
 102 }
 103
 104 sub format_request {
 105   my $self = shift;
 106   my $batch = shift;
 107
 108   my $output;
 109   my $xml = XML::Writer->new(
 110     OUTPUT      => \$output,
 111     DATA_MODE   => 1,
 112     DATA_INDENT => 2,
 113     ENCODING    => 'utf-8',
 114   );
 115   $self->format_header($batch, $xml);
 116   my $count = 1;
 117   foreach my $item ( @{ $batch->items } ) {
 118     try {
 119       $self->format_item($item, $batch, $xml, $count);
 120       $count++;
 121     } catch {
 122       $self->format_error($item, $_);
 123     };
 124   }
 125   $self->format_trailer($batch, $xml, $count);
 126   return $output;
 127 }
 128
 129 sub format_header {
 130   my ($self, $batch, $xml) = @_;
 131   my $num_items = $batch->count;
 132
 133   $xml->xmlDecl();
 134   $xml->startTag('transRequest', RequestCount => $num_items + 1);
 135   $xml->startTag('batchFileID');
 136   $xml->dataElement(userID => $self->login);
 137   $xml->dataElement(fileDateTime => $self->fileDateTime);
 138   $xml->dataElement(fileID => sprintf('%06d-', $batch->batch_id) .
 139                               $self->fileDateTime);
 140   $xml->endTag('batchFileID');
 141 }
 142
 143 sub format_item {
 144   my ($self, $item, $batch, $xml, $count) = @_;
 145   if ( $item->action eq 'payment' ) {
 146     $xml->startTag('newOrder', BatchRequestNo => $count);
 147     my @order = (
 148       industryType => $self->industryType,
 149       transType    => 'AC',
 150       bin          => $self->bin,
 151       merchantID   => $self->merchantID,
 152       terminalID   => $self->terminalID,
 153     );
 154     if ($item->payment_type eq 'CC') {
 155       my $expiration = $item->expiration;
 156       $expiration =~ s/\D//g;
 157       push @order, (
 158         ccAccountNum => $item->card_number,
 159         ccExp        => $expiration,
 160       );
 161     } elsif ( $item->payment_type eq 'ECHECK' ) {
 162       push @order, (
 163         cardBrand       => 'EC',
 164         ecpCheckRT      => $item->routing_code,
 165         ecpCheckDDA     => $item->account_number,
 166         ecpBankAcctType => $BankAcctType{ $item->account_type },
 167         ecpDelvMethod   => 'A',
 168       );
 169     } else {
 170       die "payment type ".$item->type." not supported";
 171     }
 172     if ( $item->recurring_billing eq 'F' ) {
 173       push @order, ( recurringInd => 'RF' );
 174     } elsif ( $item->recurring_billing eq 'S' ) {
 175       push @order, ( recurringInd => 'RS' );
 176     } # else don't send recurringInd at all
 177
 178     push @order, (
 179       avsZip         => $item->zip,
 180       avsAddress1    => bytes_substr($item->address,   0, 30),
 181       avsAddress2    => bytes_substr($item->address2,  0, 30),
 182       avsCity        => bytes_substr($item->city,      0, 20),
 183       avsState       => bytes_substr($item->state,     0, 2),
 184       avsName        => bytes_substr($item->first_name. ' '. $item->last_name, 0, 30),
 185       ( $paymentech_countries{ $item->country }
 186         ? ( avsCountryCode  => $item->country )
 187         : ()
 188       ),
 189       orderID        => $item->tid,
 190       amount         => int( $item->amount * 100 ),
 191     );
 192     while (@order) {
 193       my $key = shift @order;
 194       my $value = shift @order;
 195       $xml->dataElement($key, $value);
 196     }
 197     $xml->endTag('newOrder');
 198   } # if action eq 'payment'
 199   else {
 200     die "action ".$item->action." not supported";
 201   }
 202   '';
 203 }
 204
 205 sub format_trailer {
 206   my ($self, $batch, $xml, $count) = @_;
 207   $xml->startTag('endOfDay', 'BatchRequestNo', $count);
 208   $xml->dataElement('bin' => $self->bin);
 209   $xml->dataElement('merchantID' => $self->merchantID);
 210   $xml->dataElement('terminalID' => $self->terminalID);
 211   $xml->endTag('endOfDay');
 212   $xml->endTag('transRequest');
 213 }
 214
 215 sub parse_response {
 216   my $self = shift;
 217   my $input = shift;
 218   my $batch = Business::BatchPayment->create('Batch');
 219
 220   my $tree = XML::Simple::XMLin($input, KeepRoot => 1);
 221   my $newOrderResp = $tree->{transResponse}->{newOrderResp};
 222   die "can't find <transResponse><newOrderResp> in input"
 223     unless defined $newOrderResp;
 224
 225   $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
 226   foreach my $resp (@$newOrderResp) {
 227     try {
 228       $batch->push( $self->parse_item($resp) );
 229     } catch {
 230       # parse_error needs a string representation of the
 231       # input data...and if it 's failing because it wasn't valid
 232       # XML, we wouldn't get this far.
 233       $self->parse_error(XML::Simple::XMLout($resp), $_);
 234     };
 235   }
 236   $batch;
 237 }
 238
 239 sub parse_item {
 240   my ($self, $resp) = @_;
 241
 242   my ($mon, $day, $year, $hour, $min, $sec) =
 243   $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
 244   my $dt = DateTime->new(
 245     year    => $year,
 246     month   => $mon,
 247     day     => $day,
 248     hour    => $hour,
 249     minute  => $min,
 250     second  => $sec,
 251   );
 252
 253   my %failure_status = (
 254     # API version 2.6, April 2013
 255     '00'  => undef,       # Approved
 256     '04'  => 'pickup',
 257     '33'  => 'expired',
 258     '41'  => 'stolen',
 259     '42'  => 'inactive',
 260     '43'  => 'stolen',
 261     '44'  => 'inactive',
 262     'B7'  => 'blacklisted', # Fraud
 263     'B9'  => 'blacklisted', # On Negative File
 264     'BB'  => 'stolen',      # Possible Compromise
 265     'BG'  => 'blacklisted', # Blocked Account
 266     'BQ'  => 'blacklisted', # Issuer has Flagged Account as Suspected Fraud
 267     'C4'  => 'nsf',         # Over Credit Limit
 268     'D5'  => 'blacklisted', # On Negative File
 269     'D7'  => 'nsf',         # Insufficient Funds
 270     'F3'  => 'inactive',    # Account Closed
 271     'K6'  => 'nsf',         # NSF
 272   ); # all others are "decline"
 273
 274   my $failure_status = undef;
 275   my $error_message;
 276
 277   if ( $resp->{procStatus} ) {
 278     $error_message = $resp->{procStatusMessage};
 279   } elsif ( $resp->{respCode} ) {
 280     $error_message = $resp->{respCodeMessage};
 281     $failure_status = $failure_status{ $resp->{respCode} } || 'decline';
 282   } else {
 283     $error_message = '';
 284   }
 285
 286   my $item = Business::BatchPayment->create(Item =>
 287     tid           => $resp->{orderID},
 288     process_date  => $dt,
 289     authorization => $resp->{authorizationCode},
 290     order_number  => $resp->{txRefNum},
 291     approved      => ($resp->{approvalStatus} == 1),
 292     error_message => $error_message,
 293     failure_status  => $failure_status,
 294   );
 295   $item;
 296 }
 297
 298 # internal use
 299
 300 sub bytes_substr {
 301   my ($string, $offset, $length, $repl) = @_;
 302   my $bytes = substr(
 303     Encode::encode('utf8', $string || ''),
 304     $offset,
 305     $length,
 306     Encode::encode('utf8', $repl || '')
 307   );
 308   return Encode::decode('utf8', $bytes, Encode::FB_QUIET);
 309 }
 310
 311
 312 package Business::BatchPayment::Paymentech::Transport;
 313
 314 use File::Temp qw( tempdir );
 315 use File::Slurp qw( read_file write_file );
 316 use Moose;
 317 use Moose::Util::TypeConstraints;
 318 extends 'Business::BatchPayment::Transport::SFTP';
 319 with 'Business::BatchPayment::TestMode';
 320
 321 has '+host' => (
 322   default => sub {
 323     my $self = shift;
 324     $self->test_mode ? 'orbitalbatchvar.paymentech.net'
 325                      : 'orbitalbatch.paymentech.net'
 326   },
 327   lazy => 1,
 328 );
 329
 330 subtype 'Writeable',
 331   as 'Maybe[Str]',
 332   where { !defined($_) or ( -d $_ and -w $_ ) },
 333   message { "can't write to '$_'" };
 334
 335 has 'archive_to' => (
 336   is => 'rw',
 337   isa => 'Writeable'
 338 );
 339
 340 # batch content passed as an argument
 341
 342 sub upload {
 343   local $@;
 344   my $self = shift;
 345   my $content = shift;
 346   my $tmpdir = tempdir( CLEANUP => 1 );
 347   $content =~ /<fileID>(.*)<\/fileID>/;
 348   my $filename = $1;
 349   my $archive_dir = $self->archive_to;
 350
 351   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 352   write_file("$tmpdir/$filename.xml", $content);
 353
 354   warn "Creating zip file.\n" if $self->debug;
 355   my @args = (
 356     '-P',
 357     $self->password,
 358     '-j',
 359     "$tmpdir/$filename.zip",
 360     "$tmpdir/$filename.xml",
 361   );
 362   unshift @args, '-q' unless $self->debug;
 363   system('zip', @args);
 364   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 365
 366   warn "Uploading.\n" if $self->debug;
 367   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 368   return;
 369 };
 370
 371 sub download {
 372   local $@;
 373   my $self = shift;
 374   my $tmpdir = tempdir( CLEANUP => 1 );
 375   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 376   my $archive_dir = $self->archive_to;
 377   my @batches;
 378   foreach (@$ls_info) {
 379     my $filename = $_->{filename}; # still ends in _resp
 380     $filename =~ s/\.zip$//;
 381     warn "Retrieving $filename.zip\n" if $self->debug;
 382     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 383
 384     my @args = (
 385       '-P',
 386       $self->password,
 387       "$tmpdir/$filename.zip",
 388       '-d',
 389       $tmpdir,
 390     );
 391     unshift @args, '-q' unless $self->debug;
 392     system('unzip', @args);
 393     if (! -f "$tmpdir/$filename.xml") {
 394       warn "failed to extract $filename.xml from $filename.zip\n";
 395       next;
 396     }
 397     my $content = read_file("$tmpdir/$filename.xml");
 398     if ( $archive_dir ) {
 399       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 400       write_file("$archive_dir/$filename.xml", $content);
 401     }
 402     push @batches, $content;
 403   }
 404   @batches;
 405 }
 406
 407 sub _info {
 408   {
 409     'info_compat'         => '0.01',
 410     'gateway_name'        => 'Paymentech',
 411     'gateway_url'         => 'http://www.chasepaymentech.com/',
 412     'module_version'      => $VERSION,
 413     'supported_types'     => [ qw( CC ECHECK ) ],
 414     'token_support'       => 0,
 415     'test_transaction'    => 1,
 416     'supported_actions'   => [ 'Payment' ],
 417   }
 418 }
 419
 420 =head1 AUTHOR
 421
 422 Mark Wells, C<< <mark at freeside.biz> >>
 423
 424 =head1 BUGS
 425
 426 Relying on external zip/unzip is awkward.
 427
 428 =head1 SUPPORT
 429
 430 You can find documentation for this module with the perldoc command.
 431
 432     perldoc Business::BatchPayment::Paymentech
 433
 434 Commercial support is available from Freeside Internet Services, Inc.
 435
 436 L<http://www.freeside.biz>
 437
 438 =head1 ACKNOWLEDGEMENTS
 439
 440 =head1 LICENSE AND COPYRIGHT
 441
 442 Copyright 2012 Mark Wells.
 443
 444 This program is free software; you can redistribute it and/or modify it
 445 under the terms of either: the GNU General Public License as published
 446 by the Free Software Foundation; or the Artistic License.
 447
 448 See http://dev.perl.org/licenses/ for more information.
 449
 450
 451 =cut
 452
 453 1; # End of Business::BatchPayment::Paymentech