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     put_path  => $self->fileDateTime,
  98     debug     => $self->debug,
  99     test_mode => $self->test_mode,
 100   );
 101 }
 102
 103 sub format_request {
 104   my $self = shift;
 105   my $batch = shift;
 106
 107   my $output;
 108   my $xml = XML::Writer->new(
 109     OUTPUT      => \$output,
 110     DATA_MODE   => 1,
 111     DATA_INDENT => 2,
 112   );
 113   $self->format_header($batch, $xml);
 114   my $count = 1;
 115   foreach my $item ( @{ $batch->items } ) {
 116     try {
 117       $self->format_item($item, $batch, $xml, $count);
 118       $count++;
 119     } catch {
 120       $self->format_error($item, $_);
 121     };
 122   }
 123   $self->format_trailer($batch, $xml, $count);
 124   return $output;
 125 }
 126
 127 sub format_header {
 128   my ($self, $batch, $xml) = @_;
 129   my $num_items = $batch->count;
 130
 131   $xml->startTag('transRequest', RequestCount => $num_items + 1);
 132   $xml->startTag('batchFileID');
 133   $xml->dataElement(userID => $self->login);
 134   $xml->dataElement(fileDateTime => $self->fileDateTime);
 135   $xml->dataElement(fileID => $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 $item = Business::BatchPayment->create(Item =>
 244     tid           => $resp->{orderID},
 245     process_date  => $dt,
 246     authorization => $resp->{authorizationCode},
 247     order_number  => $resp->{txRefNum},
 248     approved      => ($resp->{approvalStatus} == 1),
 249     error_message => $resp->{procStatusMessage},
 250   );
 251   $item;
 252 }
 253
 254 package Business::BatchPayment::Paymentech::Transport;
 255
 256 use File::Temp qw( tempdir );
 257 use File::Slurp qw( read_file write_file );
 258 use Moose;
 259 use Moose::Util::TypeConstraints;
 260 extends 'Business::BatchPayment::Transport::SFTP';
 261 with 'Business::BatchPayment::TestMode';
 262
 263 has '+host' => (
 264   default => sub {
 265     my $self = shift;
 266     $self->test_mode ? 'orbitalbatchvar.paymentech.net'
 267                      : 'orbitalbatch.paymentech.net'
 268   },
 269   lazy => 1,
 270 );
 271
 272 subtype 'Writeable',
 273   as 'Maybe[Str]',
 274   where { !defined($_) or ( -d $_ and -w $_ ) },
 275   message { "can't write to '$_'" };
 276
 277 has 'archive_to' => (
 278   is => 'rw',
 279   isa => 'Writeable'
 280 );
 281
 282 # batch content passed as an argument
 283
 284 sub upload {
 285   local $@;
 286   my $self = shift;
 287   my $content = shift;
 288   my $tmpdir = tempdir( CLEANUP => 1 );
 289   my $filename = $self->put_path; # also the value of the fileId tag
 290   my $archive_dir = $self->archive_to;
 291
 292   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 293   write_file("$tmpdir/$filename.xml", $content);
 294
 295   warn "Creating zip file.\n" if $self->debug;
 296   my @args = (
 297     '-P',
 298     $self->password,
 299     '-j',
 300     "$tmpdir/$filename.zip",
 301     "$tmpdir/$filename.xml",
 302   );
 303   unshift @args, '-q' unless $self->debug;
 304   system('zip', @args);
 305   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 306
 307   warn "Uploading.\n" if $self->debug;
 308   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 309   return;
 310 };
 311
 312 sub download {
 313   local $@;
 314   my $self = shift;
 315   my $tmpdir = tempdir( CLEANUP => 1 );
 316   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 317   my $archive_dir = $self->archive_to;
 318   my @batches;
 319   foreach (@$ls_info) {
 320     my $filename = $_->{filename}; # still ends in _resp
 321     $filename =~ s/\.zip$//;
 322     warn "Retrieving $filename.zip\n" if $self->debug;
 323     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 324
 325     my @args = (
 326       '-P',
 327       $self->password,
 328       "$tmpdir/$filename.zip",
 329       '-d',
 330       $tmpdir,
 331     );
 332     unshift @args, '-q' unless $self->debug;
 333     system('unzip', @args);
 334     if (! -f "$tmpdir/$filename.xml") {
 335       warn "failed to extract $filename.xml from $filename.zip\n";
 336       next;
 337     }
 338     my $content = read_file("$tmpdir/$filename.xml");
 339     if ( $archive_dir ) {
 340       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 341       write_file("$archive_dir/$filename.xml", $content);
 342     }
 343     push @batches, $content;
 344   }
 345   @batches;
 346 }
 347
 348 sub _info {
 349   {
 350     'info_compat'         => '0.01',
 351     'gateway_name'        => 'Paymentech',
 352     'gateway_url'         => 'http://www.chasepaymentech.com/',
 353     'module_version'      => $VERSION,
 354     'supported_types'     => [ qw( CC ECHECK ) ],
 355     'token_support'       => 0,
 356     'test_transaction'    => 1,
 357     'supported_actions'   => [ 'Payment' ],
 358   }
 359 }
 360
 361 =head1 AUTHOR
 362
 363 Mark Wells, C<< <mark at freeside.biz> >>
 364
 365 =head1 BUGS
 366
 367 Relying on external zip/unzip is awkward.
 368
 369 =head1 SUPPORT
 370
 371 You can find documentation for this module with the perldoc command.
 372
 373     perldoc Business::BatchPayment::Paymentech
 374
 375 Commercial support is available from Freeside Internet Services, Inc.
 376
 377 L<http://www.freeside.biz>
 378
 379 =head1 ACKNOWLEDGEMENTS
 380
 381 =head1 LICENSE AND COPYRIGHT
 382
 383 Copyright 2012 Mark Wells.
 384
 385 This program is free software; you can redistribute it and/or modify it
 386 under the terms of either: the GNU General Public License as published
 387 by the Free Software Foundation; or the Artistic License.
 388
 389 See http://dev.perl.org/licenses/ for more information.
 390
 391
 392 =cut
 393
 394 1; # End of Business::BatchPayment::Paymentech