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