Paymentech.pm

   1 package Business::BatchPayment::Paymentech;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.02';
   7
   8 =head1 NAME
   9
  10 Business::BatchPayment::Paymentech - Chase Paymentech XML batch format.
  11
  12 =head1 VERSION
  13
  14 Version 0.01
  15
  16 =head1 USAGE
  17
  18 See L<Business::BatchPayment> for general usage notes.
  19
  20 =head2 SYNOPSIS
  21
  22 use Business::BatchPayment;
  23
  24 my @items = Business::BatchPayment::Item->new( ... );
  25
  26 my $processor = Business::BatchPayment->processor('Paymentech',
  27   merchantID    => '123456',
  28   bin           => '00001',
  29   terminalID    => '001',
  30   industryType  => 'EC'
  31   login         => 'TESTUSER',
  32   password      => 'MYPASS',
  33 );
  34
  35 my $result = $processor->submit(@items);
  36
  37 =head2 REQUIREMENTS
  38
  39 Requires L<Net::SFTP::Foreign> and ssh (for file transfer) and the zip and
  40 unzip programs.  Unlikely to work on non-Unix systems.
  41
  42 =head2 PROCESSOR ATTRIBUTES
  43
  44 =over 4
  45
  46 =item login - the username to use for SFTP, and in the "userID" tag
  47
  48 =item password - the password for SFTP, and for creating zip files
  49
  50 =item merchantID - your 6- or 12-digit Paymentech merchant ID
  51
  52 =item bin - your BIN: 000001 or 000002
  53
  54 =item terminalID - your 3-digit terminal ID
  55
  56 =item industryType - your 2-letter industry type code
  57
  58 =back
  59
  60 =cut
  61
  62 use File::Temp qw(tempdir);
  63 use DateTime;
  64 use XML::Writer;
  65 use XML::Simple;
  66 use Try::Tiny;
  67
  68 use Moose;
  69 with 'Business::BatchPayment::Processor';
  70 with 'Business::BatchPayment::TestMode';
  71
  72 # could have some validation on all of these
  73 has [ qw(merchantID terminalID bin industryType login password) ] => (
  74   is  => 'ro',
  75   isa => 'Str',
  76   required => 1,
  77 );
  78
  79 has 'fileDateTime' => (
  80   is => 'ro',
  81   isa => 'Str',
  82   default => sub {
  83     DateTime->now->strftime('%Y%m%d%H%M%S')
  84   },
  85 );
  86
  87 my %BankAcctType = (
  88   'personal checking' => 'C',
  89   'personal savings'  => 'S',
  90   'business checking' => 'X',
  91   'business savings'  => 'X',
  92 );
  93
  94 my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );
  95
  96 sub default_transport {
  97   my $self = shift;
  98   Business::BatchPayment::Paymentech::Transport->new(
  99     login     => $self->login,
 100     password  => $self->password,
 101     put_path  => $self->fileDateTime,
 102     debug     => $self->debug,
 103     test_mode => $self->test_mode,
 104   );
 105 }
 106
 107 sub format_request {
 108   my $self = shift;
 109   my $batch = shift;
 110
 111   my $output;
 112   my $xml = XML::Writer->new(
 113     OUTPUT => \$output,
 114     DATA_MODE => 1,
 115     DATA_INDENT => 2,
 116   );
 117   $self->format_header($batch, $xml);
 118   my $count = 1;
 119   foreach my $item ( @{ $batch->items } ) {
 120     try {
 121       $self->format_item($item, $batch, $xml, $count);
 122       $count++;
 123     } catch {
 124       $self->format_error($item, $_);
 125     };
 126   }
 127   $self->format_trailer($batch, $xml, $count);
 128   return $output;
 129 }
 130
 131 sub format_header {
 132   my ($self, $batch, $xml) = @_;
 133   my $num_items = $batch->count;
 134
 135   $xml->startTag('transRequest', RequestCount => $num_items + 1);
 136   $xml->startTag('batchFileID');
 137   $xml->dataElement(userID => $self->login);
 138   $xml->dataElement(fileDateTime => $self->fileDateTime);
 139   $xml->dataElement(fileID => $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    => substr($item->address,   0, 30),
 175       avsAddress2    => substr($item->address2,  0, 30),
 176       avsCity        => substr($item->city,      0, 20),
 177       avsState       => $item->state,
 178       avsName        => substr($item->first_name .' '. $item->last_name, 0, 30),
 179       avsCountryCode => ( $paymentech_countries{ $item->country }
 180                             ? $_->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 $item = Business::BatchPayment->create(Item =>
 248     tid           => $resp->{orderID},
 249     process_date  => $dt,
 250     authorization => $resp->{authorizationCode},
 251     order_number  => $resp->{txRefNum},
 252     approved      => ($resp->{approvalStatus} == 1),
 253     error_message => $resp->{procStatusMessage},
 254   );
 255   $item;
 256 }
 257
 258 package Business::BatchPayment::Paymentech::Transport;
 259
 260 use File::Temp qw( tempdir );
 261 use File::Slurp qw( read_file write_file );
 262 use Moose;
 263 use Moose::Util::TypeConstraints;
 264 extends 'Business::BatchPayment::Transport::SFTP';
 265 with 'Business::BatchPayment::TestMode';
 266
 267 has '+host' => (
 268   default => sub {
 269     my $self = shift;
 270     $self->test_mode ? 'orbitalbatchvar.paymentech.net'
 271                      : 'orbitalbatch.paymentech.net'
 272   },
 273   lazy => 1,
 274 );
 275
 276 subtype 'Writeable',
 277   as 'Maybe[Str]',
 278   where { !defined($_) or ( -d $_ and -w $_ ) },
 279   message { "can't write to '$_'" };
 280
 281 has 'archive_to' => (
 282   is => 'rw',
 283   isa => 'Writeable'
 284 );
 285
 286 # batch content passed as an argument
 287
 288 sub upload {
 289   local $@;
 290   my $self = shift;
 291   my $content = shift;
 292   my $tmpdir = tempdir( CLEANUP => 1 );
 293   my $filename = $self->put_path; # also the value of the fileId tag
 294   my $archive_dir = $self->archive_to;
 295
 296   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 297   write_file("$tmpdir/$filename.xml", $content);
 298
 299   warn "Creating zip file.\n" if $self->debug;
 300   my @args = (
 301     '-P',
 302     $self->password,
 303     '-j',
 304     "$tmpdir/$filename.zip",
 305     "$tmpdir/$filename.xml",
 306   );
 307   unshift @args, '-q' unless $self->debug;
 308   system('zip', @args);
 309   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 310
 311   warn "Uploading.\n" if $self->debug;
 312   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 313   return;
 314 };
 315
 316 sub download {
 317   local $@;
 318   my $self = shift;
 319   my $tmpdir = tempdir( CLEANUP => 1 );
 320   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 321   my $archive_dir = $self->archive_to;
 322   my @batches;
 323   foreach (@$ls_info) {
 324     my $filename = $_->{filename}; # still ends in _resp
 325     $filename =~ s/\.zip$//;
 326     warn "Retrieving $filename.zip\n" if $self->debug;
 327     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 328
 329     my @args = (
 330       '-P',
 331       $self->password,
 332       "$tmpdir/$filename.zip",
 333       '-d',
 334       $tmpdir,
 335     );
 336     unshift @args, '-q' unless $self->debug;
 337     system('unzip', @args);
 338     if (! -f "$tmpdir/$filename.xml") {
 339       warn "failed to extract $filename.xml from $filename.zip\n";
 340       next;
 341     }
 342     my $content = read_file("$tmpdir/$filename.xml");
 343     if ( $archive_dir ) {
 344       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 345       write_file("$archive_dir/$filename.xml", $content);
 346     }
 347     push @batches, $content;
 348   }
 349   @batches;
 350 }
 351
 352 sub _info {
 353   {
 354     'info_compat'         => '0.01',
 355     'gateway_name'        => 'Paymentech',
 356     'gateway_url'         => 'http://www.chasepaymentech.com/',
 357     'module_version'      => $VERSION,
 358     'supported_types'     => [ qw( CC ECHECK ) ],
 359     'token_support'       => 0,
 360     'test_transaction'    => 1,
 361     'supported_actions'   => [ 'Payment' ],
 362   }
 363 }
 364
 365 =head1 AUTHOR
 366
 367 Mark Wells, C<< <mark at freeside.biz> >>
 368
 369 =head1 BUGS
 370
 371 Relying on external zip/unzip is awkward.
 372
 373 =head1 SUPPORT
 374
 375 You can find documentation for this module with the perldoc command.
 376
 377     perldoc Business::BatchPayment::Paymentech
 378
 379 Commercial support is available from Freeside Internet Services, Inc.
 380
 381 L<http://www.freeside.biz>
 382
 383 =head1 ACKNOWLEDGEMENTS
 384
 385 =head1 LICENSE AND COPYRIGHT
 386
 387 Copyright 2012 Mark Wells.
 388
 389 This program is free software; you can redistribute it and/or modify it
 390 under the terms of either: the GNU General Public License as published
 391 by the Free Software Foundation; or the Artistic License.
 392
 393 See http://dev.perl.org/licenses/ for more information.
 394
 395
 396 =cut
 397
 398 1; # End of Business::BatchPayment::Paymentech