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