Paymentech.pm

   1 package Business::BatchPayment::Paymentech;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.01';
   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 sub default_transport {
  95   my $self = shift;
  96   Business::BatchPayment::Paymentech::Transport->new(
  97     login     => $self->login,
  98     password  => $self->password,
  99     put_path  => $self->fileDateTime,
 100     debug     => $self->debug,
 101     test_mode => $self->test_mode,
 102   );
 103 }
 104
 105 sub format_request {
 106   my $self = shift;
 107   my $batch = shift;
 108
 109   my $output;
 110   my $xml = XML::Writer->new(
 111     OUTPUT => \$output,
 112     DATA_MODE => 1,
 113     DATA_INDENT => 2,
 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->startTag('transRequest', RequestCount => $num_items + 1);
 134   $xml->startTag('batchFileID');
 135   $xml->dataElement(userID => $self->login);
 136   $xml->dataElement(fileDateTime => $self->fileDateTime);
 137   $xml->dataElement(fileID => $self->fileDateTime);
 138   $xml->endTag('batchFileID');
 139 }
 140
 141 sub format_item {
 142   my ($self, $item, $batch, $xml, $count) = @_;
 143   if ( $item->action eq 'payment' ) {
 144     $xml->startTag('newOrder', BatchRequestNo => $count);
 145     my @order = (
 146       industryType  => $self->industryType,
 147       transType     => 'AC',
 148       bin           => $self->bin,
 149       merchantID    => $self->merchantID,
 150       terminalID    => $self->terminalID,
 151     );
 152     if ($item->payment_type eq 'CC') {
 153       push @order, (
 154         ccAccountNum  => $item->card_number,
 155         ccExp         => $item->expiration,
 156       );
 157     }
 158     elsif ( $item->payment_type eq 'ECHECK' ) {
 159       push @order, (
 160         cardBrand     => 'EC',
 161         ecpCheckRT    => $item->routing_code,
 162         ecpCheckDDA   => $item->account_number,
 163         ecpBankAcctType => $BankAcctType{ $item->account_type },
 164         ecpDelvMethod => 'A',
 165       );
 166     }
 167     else {
 168       die "payment type ".$item->type." not supported";
 169     }
 170     push @order, (
 171       avsZip      => $item->zip,
 172       avsAddress1 => substr($item->address,   0, 30),
 173       avsAddress2 => substr($item->address2,  0, 30),
 174       avsCity     => substr($item->city,      0, 20),
 175       avsState    => $item->state,
 176       avsName     => substr($item->first_name .' '. $item->last_name, 0, 30),
 177       avsCountryCode => $item->country,
 178       orderID     => $item->tid,
 179       amount      => int( $item->amount * 100 ),
 180     );
 181     while (@order) {
 182       my $key = shift @order;
 183       my $value = shift @order;
 184       $xml->dataElement($key, $value);
 185     }
 186     $xml->endTag('newOrder');
 187   } # if action eq 'payment'
 188   else {
 189     die "action ".$item->action." not supported";
 190   }
 191   '';
 192 }
 193
 194 sub format_trailer {
 195   my ($self, $batch, $xml, $count) = @_;
 196   $xml->startTag('endOfDay', 'BatchRequestNo', $count);
 197   $xml->dataElement('bin' => $self->bin);
 198   $xml->dataElement('merchantID' => $self->merchantID);
 199   $xml->dataElement('terminalID' => $self->terminalID);
 200   $xml->endTag('endOfDay');
 201   $xml->endTag('transRequest');
 202 }
 203
 204 sub parse_response {
 205   my $self = shift;
 206   my $input = shift;
 207   my $batch = Business::BatchPayment->create('Batch');
 208
 209   my $tree = XML::Simple::XMLin($input, KeepRoot => 1);
 210   my $newOrderResp = $tree->{transResponse}->{newOrderResp};
 211   die "can't find <transResponse><newOrderResp> in input"
 212     unless defined $newOrderResp;
 213
 214   $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
 215   foreach my $resp (@$newOrderResp) {
 216     try {
 217       $batch->push( $self->parse_item($resp) );
 218     } catch {
 219       # parse_error needs a string representation of the
 220       # input data...and if it 's failing because it wasn't valid
 221       # XML, we wouldn't get this far.
 222       $self->parse_error(XML::Simple::XMLout($resp), $_);
 223     };
 224   }
 225   $batch;
 226 }
 227
 228 sub parse_item {
 229   my ($self, $resp) = @_;
 230
 231   my ($mon, $day, $year, $hour, $min, $sec) =
 232   $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
 233   my $dt = DateTime->new(
 234     year    => $year,
 235     month   => $mon,
 236     day     => $day,
 237     hour    => $hour,
 238     minute  => $min,
 239     second  => $sec,
 240   );
 241
 242   my $item = Business::BatchPayment->create(Item =>
 243     tid           => $resp->{orderID},
 244     process_date  => $dt,
 245     authorization => $resp->{authorizationCode},
 246     order_number  => $resp->{txRefNum},
 247     approved      => ($resp->{approvalStatus} == 1),
 248     error_message => $resp->{procStatusMessage},
 249   );
 250   $item;
 251 }
 252
 253 package Business::BatchPayment::Paymentech::Transport;
 254
 255 use File::Temp qw( tempdir );
 256 use File::Slurp qw( read_file write_file );
 257 use Moose;
 258 use Moose::Util::TypeConstraints;
 259 extends 'Business::BatchPayment::Transport::SFTP';
 260 with 'Business::BatchPayment::TestMode';
 261
 262 has '+host' => (
 263   default => sub {
 264     my $self = shift;
 265     $self->test_mode ? 'orbitalbatchvar.paymentech.net'
 266                      : 'orbitalbatch.paymentech.net'
 267   },
 268   lazy => 1,
 269 );
 270
 271 subtype 'Writeable',
 272   as 'Maybe[Str]',
 273   where { !defined($_) or ( -d $_ and -w $_ ) },
 274   message { "can't write to '$_'" };
 275
 276 has 'archive_to' => (
 277   is => 'rw',
 278   isa => 'Writeable'
 279 );
 280
 281 # batch content passed as an argument
 282
 283 sub upload {
 284   local $@;
 285   my $self = shift;
 286   my $content = shift;
 287   my $tmpdir = tempdir( CLEANUP => 1 );
 288   my $filename = $self->put_path; # also the value of the fileId tag
 289   my $archive_dir = $self->archive_to;
 290
 291   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 292   write_file("$tmpdir/$filename.xml", $content);
 293
 294   warn "Creating zip file.\n" if $self->debug;
 295   my @args = (
 296     '-P',
 297     $self->password,
 298     '-j',
 299     "$tmpdir/$filename.zip",
 300     "$tmpdir/$filename.xml",
 301   );
 302   unshift @args, '-q' unless $self->debug;
 303   system('zip', @args);
 304   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 305
 306   warn "Uploading.\n" if $self->debug;
 307   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 308   return;
 309 };
 310
 311 sub download {
 312   local $@;
 313   my $self = shift;
 314   my $tmpdir = tempdir( CLEANUP => 1 );
 315   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 316   my $archive_dir = $self->archive_to;
 317   my @batches;
 318   foreach (@$ls_info) {
 319     my $filename = $_->{filename}; # still ends in _resp
 320     $filename =~ s/\.zip$//;
 321     warn "Retrieving $filename.zip\n" if $self->debug;
 322     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 323
 324     my @args = (
 325       '-P',
 326       $self->password,
 327       "$tmpdir/$filename.zip",
 328       '-d',
 329       $tmpdir,
 330     );
 331     unshift @args, '-q' unless $self->debug;
 332     system('unzip', @args);
 333     if (! -f "$tmpdir/$filename.xml") {
 334       warn "failed to extract $filename.xml from $filename.zip\n";
 335       next;
 336     }
 337     my $content = read_file("$tmpdir/$filename.xml");
 338     if ( $archive_dir ) {
 339       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 340       write_file("$archive_dir/$filename.xml", $content);
 341     }
 342     push @batches, $content;
 343   }
 344   @batches;
 345 }
 346
 347 sub _info {
 348   {
 349     'info_compat'         => '0.01',
 350     'gateway_name'        => 'Paymentech',
 351     'gateway_url'         => 'http://www.chasepaymentech.com/',
 352     'module_version'      => $VERSION,
 353     'supported_types'     => [ qw( CC ECHECK ) ],
 354     'token_support'       => 0,
 355     'test_transaction'    => 1,
 356     'supported_actions'   => [ 'Payment' ],
 357   }
 358 }
 359
 360 =head1 AUTHOR
 361
 362 Mark Wells, C<< <mark at freeside.biz> >>
 363
 364 =head1 BUGS
 365
 366 Relying on external zip/unzip is awkward.
 367
 368 =head1 SUPPORT
 369
 370 You can find documentation for this module with the perldoc command.
 371
 372     perldoc Business::BatchPayment::Paymentech
 373
 374 Commercial support is available from Freeside Internet Services, Inc.
 375
 376 L<http://www.freeside.biz>
 377
 378 =head1 ACKNOWLEDGEMENTS
 379
 380 =head1 LICENSE AND COPYRIGHT
 381
 382 Copyright 2012 Mark Wells.
 383
 384 This program is free software; you can redistribute it and/or modify it
 385 under the terms of either: the GNU General Public License as published
 386 by the Free Software Foundation; or the Artistic License.
 387
 388 See http://dev.perl.org/licenses/ for more information.
 389
 390
 391 =cut
 392
 393 1; # End of Business::BatchPayment::Paymentech