Paymentech.pm

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