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       push @order, (
 156         ccAccountNum => $item->card_number,
 157         ccExp        => $item->expiration,
 158       );
 159     }
 160     elsif ( $item->payment_type eq 'ECHECK' ) {
 161       push @order, (
 162         cardBrand       => 'EC',
 163         ecpCheckRT      => $item->routing_code,
 164         ecpCheckDDA     => $item->account_number,
 165         ecpBankAcctType => $BankAcctType{ $item->account_type },
 166         ecpDelvMethod   => 'A',
 167       );
 168     }
 169     else {
 170       die "payment type ".$item->type." not supported";
 171     }
 172     push @order, (
 173       avsZip         => $item->zip,
 174       avsAddress1    => bytes_substr($item->address,   0, 30),
 175       avsAddress2    => bytes_substr($item->address2,  0, 30),
 176       avsCity        => bytes_substr($item->city,      0, 20),
 177       avsState       => bytes_substr($item->state,     0, 2),
 178       avsName        => bytes_substr($item->first_name. ' '. $item->last_name, 0, 30),
 179       ( $paymentech_countries{ $item->country }
 180         ? ( avsCountryCode  => $item->country )
 181         : ()
 182       ),
 183       orderID        => $item->tid,
 184       amount         => int( $item->amount * 100 ),
 185     );
 186     while (@order) {
 187       my $key = shift @order;
 188       my $value = shift @order;
 189       $xml->dataElement($key, $value);
 190     }
 191     $xml->endTag('newOrder');
 192   } # if action eq 'payment'
 193   else {
 194     die "action ".$item->action." not supported";
 195   }
 196   '';
 197 }
 198
 199 sub format_trailer {
 200   my ($self, $batch, $xml, $count) = @_;
 201   $xml->startTag('endOfDay', 'BatchRequestNo', $count);
 202   $xml->dataElement('bin' => $self->bin);
 203   $xml->dataElement('merchantID' => $self->merchantID);
 204   $xml->dataElement('terminalID' => $self->terminalID);
 205   $xml->endTag('endOfDay');
 206   $xml->endTag('transRequest');
 207 }
 208
 209 sub parse_response {
 210   my $self = shift;
 211   my $input = shift;
 212   my $batch = Business::BatchPayment->create('Batch');
 213
 214   my $tree = XML::Simple::XMLin($input, KeepRoot => 1);
 215   my $newOrderResp = $tree->{transResponse}->{newOrderResp};
 216   die "can't find <transResponse><newOrderResp> in input"
 217     unless defined $newOrderResp;
 218
 219   $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
 220   foreach my $resp (@$newOrderResp) {
 221     try {
 222       $batch->push( $self->parse_item($resp) );
 223     } catch {
 224       # parse_error needs a string representation of the
 225       # input data...and if it 's failing because it wasn't valid
 226       # XML, we wouldn't get this far.
 227       $self->parse_error(XML::Simple::XMLout($resp), $_);
 228     };
 229   }
 230   $batch;
 231 }
 232
 233 sub parse_item {
 234   my ($self, $resp) = @_;
 235
 236   my ($mon, $day, $year, $hour, $min, $sec) =
 237   $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
 238   my $dt = DateTime->new(
 239     year    => $year,
 240     month   => $mon,
 241     day     => $day,
 242     hour    => $hour,
 243     minute  => $min,
 244     second  => $sec,
 245   );
 246
 247   my %failure_status = (
 248     # API version 2.6, April 2013
 249     '00'  => undef,       # Approved
 250     '04'  => 'pickup',
 251     '33'  => 'expired',
 252     '41'  => 'stolen',
 253     '42'  => 'inactive',
 254     '43'  => 'stolen',
 255     '44'  => 'inactive',
 256     'B7'  => 'blacklisted', # Fraud
 257     'B9'  => 'blacklisted', # On Negative File
 258     'BB'  => 'stolen',      # Possible Compromise
 259     'BG'  => 'blacklisted', # Blocked Account
 260     'BQ'  => 'blacklisted', # Issuer has Flagged Account as Suspected Fraud
 261     'C4'  => 'nsf',         # Over Credit Limit
 262     'D5'  => 'blacklisted', # On Negative File
 263     'D7'  => 'nsf',         # Insufficient Funds
 264     'F3'  => 'inactive',    # Account Closed
 265     'K6'  => 'nsf',         # NSF
 266   ); # all others are "decline"
 267
 268   my $failure_status = undef;
 269   my $error_message;
 270
 271   if ( $resp->{procStatus} ) {
 272     $error_message = $resp->{procStatusMessage};
 273   } elsif ( $resp->{respCode} ) {
 274     $error_message = $resp->{respCodeMessage};
 275     $failure_status = $failure_status{ $resp->{respCode} } || 'decline';
 276   } else {
 277     $error_message = '';
 278   }
 279
 280   my $item = Business::BatchPayment->create(Item =>
 281     tid           => $resp->{orderID},
 282     process_date  => $dt,
 283     authorization => $resp->{authorizationCode},
 284     order_number  => $resp->{txRefNum},
 285     approved      => ($resp->{approvalStatus} == 1),
 286     error_message => $error_message,
 287     failure_status  => $failure_status,
 288   );
 289   $item;
 290 }
 291
 292 # internal use
 293
 294 sub bytes_substr {
 295   my ($string, $offset, $length, $repl) = @_;
 296   my $bytes = substr(
 297     Encode::encode('utf8', $string),
 298     $offset,
 299     $length,
 300     Encode::encode('utf8', $repl)
 301   );
 302   return Encode::decode('utf8', $bytes, Encode::FB_QUIET);
 303 }
 304
 305
 306 package Business::BatchPayment::Paymentech::Transport;
 307
 308 use File::Temp qw( tempdir );
 309 use File::Slurp qw( read_file write_file );
 310 use Moose;
 311 use Moose::Util::TypeConstraints;
 312 extends 'Business::BatchPayment::Transport::SFTP';
 313 with 'Business::BatchPayment::TestMode';
 314
 315 has '+host' => (
 316   default => sub {
 317     my $self = shift;
 318     $self->test_mode ? 'orbitalbatchvar.paymentech.net'
 319                      : 'orbitalbatch.paymentech.net'
 320   },
 321   lazy => 1,
 322 );
 323
 324 subtype 'Writeable',
 325   as 'Maybe[Str]',
 326   where { !defined($_) or ( -d $_ and -w $_ ) },
 327   message { "can't write to '$_'" };
 328
 329 has 'archive_to' => (
 330   is => 'rw',
 331   isa => 'Writeable'
 332 );
 333
 334 # batch content passed as an argument
 335
 336 sub upload {
 337   local $@;
 338   my $self = shift;
 339   my $content = shift;
 340   my $tmpdir = tempdir( CLEANUP => 1 );
 341   $content =~ /<fileID>(.*)<\/fileID>/;
 342   my $filename = $1;
 343   my $archive_dir = $self->archive_to;
 344
 345   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 346   write_file("$tmpdir/$filename.xml", $content);
 347
 348   warn "Creating zip file.\n" if $self->debug;
 349   my @args = (
 350     '-P',
 351     $self->password,
 352     '-j',
 353     "$tmpdir/$filename.zip",
 354     "$tmpdir/$filename.xml",
 355   );
 356   unshift @args, '-q' unless $self->debug;
 357   system('zip', @args);
 358   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 359
 360   warn "Uploading.\n" if $self->debug;
 361   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 362   return;
 363 };
 364
 365 sub download {
 366   local $@;
 367   my $self = shift;
 368   my $tmpdir = tempdir( CLEANUP => 1 );
 369   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 370   my $archive_dir = $self->archive_to;
 371   my @batches;
 372   foreach (@$ls_info) {
 373     my $filename = $_->{filename}; # still ends in _resp
 374     $filename =~ s/\.zip$//;
 375     warn "Retrieving $filename.zip\n" if $self->debug;
 376     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 377
 378     my @args = (
 379       '-P',
 380       $self->password,
 381       "$tmpdir/$filename.zip",
 382       '-d',
 383       $tmpdir,
 384     );
 385     unshift @args, '-q' unless $self->debug;
 386     system('unzip', @args);
 387     if (! -f "$tmpdir/$filename.xml") {
 388       warn "failed to extract $filename.xml from $filename.zip\n";
 389       next;
 390     }
 391     my $content = read_file("$tmpdir/$filename.xml");
 392     if ( $archive_dir ) {
 393       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 394       write_file("$archive_dir/$filename.xml", $content);
 395     }
 396     push @batches, $content;
 397   }
 398   @batches;
 399 }
 400
 401 sub _info {
 402   {
 403     'info_compat'         => '0.01',
 404     'gateway_name'        => 'Paymentech',
 405     'gateway_url'         => 'http://www.chasepaymentech.com/',
 406     'module_version'      => $VERSION,
 407     'supported_types'     => [ qw( CC ECHECK ) ],
 408     'token_support'       => 0,
 409     'test_transaction'    => 1,
 410     'supported_actions'   => [ 'Payment' ],
 411   }
 412 }
 413
 414 =head1 AUTHOR
 415
 416 Mark Wells, C<< <mark at freeside.biz> >>
 417
 418 =head1 BUGS
 419
 420 Relying on external zip/unzip is awkward.
 421
 422 =head1 SUPPORT
 423
 424 You can find documentation for this module with the perldoc command.
 425
 426     perldoc Business::BatchPayment::Paymentech
 427
 428 Commercial support is available from Freeside Internet Services, Inc.
 429
 430 L<http://www.freeside.biz>
 431
 432 =head1 ACKNOWLEDGEMENTS
 433
 434 =head1 LICENSE AND COPYRIGHT
 435
 436 Copyright 2012 Mark Wells.
 437
 438 This program is free software; you can redistribute it and/or modify it
 439 under the terms of either: the GNU General Public License as published
 440 by the Free Software Foundation; or the Artistic License.
 441
 442 See http://dev.perl.org/licenses/ for more information.
 443
 444
 445 =cut
 446
 447 1; # End of Business::BatchPayment::Paymentech