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       avsCountryCode => ( $paymentech_countries{ $item->country }
 176                             ? $_->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   $content =~ /<fileID>(.*)<\/fileID>/;
 290   my $filename = $1;
 291   my $archive_dir = $self->archive_to;
 292
 293   warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
 294   write_file("$tmpdir/$filename.xml", $content);
 295
 296   warn "Creating zip file.\n" if $self->debug;
 297   my @args = (
 298     '-P',
 299     $self->password,
 300     '-j',
 301     "$tmpdir/$filename.zip",
 302     "$tmpdir/$filename.xml",
 303   );
 304   unshift @args, '-q' unless $self->debug;
 305   system('zip', @args);
 306   die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
 307
 308   warn "Uploading.\n" if $self->debug;
 309   $self->put("$tmpdir/$filename.zip", "$filename.zip");
 310   return;
 311 };
 312
 313 sub download {
 314   local $@;
 315   my $self = shift;
 316   my $tmpdir = tempdir( CLEANUP => 1 );
 317   my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
 318   my $archive_dir = $self->archive_to;
 319   my @batches;
 320   foreach (@$ls_info) {
 321     my $filename = $_->{filename}; # still ends in _resp
 322     $filename =~ s/\.zip$//;
 323     warn "Retrieving $filename.zip\n" if $self->debug;
 324     $self->get("$filename.zip", "$tmpdir/$filename.zip");
 325
 326     my @args = (
 327       '-P',
 328       $self->password,
 329       "$tmpdir/$filename.zip",
 330       '-d',
 331       $tmpdir,
 332     );
 333     unshift @args, '-q' unless $self->debug;
 334     system('unzip', @args);
 335     if (! -f "$tmpdir/$filename.xml") {
 336       warn "failed to extract $filename.xml from $filename.zip\n";
 337       next;
 338     }
 339     my $content = read_file("$tmpdir/$filename.xml");
 340     if ( $archive_dir ) {
 341       warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
 342       write_file("$archive_dir/$filename.xml", $content);
 343     }
 344     push @batches, $content;
 345   }
 346   @batches;
 347 }
 348
 349 sub _info {
 350   {
 351     'info_compat'         => '0.01',
 352     'gateway_name'        => 'Paymentech',
 353     'gateway_url'         => 'http://www.chasepaymentech.com/',
 354     'module_version'      => $VERSION,
 355     'supported_types'     => [ qw( CC ECHECK ) ],
 356     'token_support'       => 0,
 357     'test_transaction'    => 1,
 358     'supported_actions'   => [ 'Payment' ],
 359   }
 360 }
 361
 362 =head1 AUTHOR
 363
 364 Mark Wells, C<< <mark at freeside.biz> >>
 365
 366 =head1 BUGS
 367
 368 Relying on external zip/unzip is awkward.
 369
 370 =head1 SUPPORT
 371
 372 You can find documentation for this module with the perldoc command.
 373
 374     perldoc Business::BatchPayment::Paymentech
 375
 376 Commercial support is available from Freeside Internet Services, Inc.
 377
 378 L<http://www.freeside.biz>
 379
 380 =head1 ACKNOWLEDGEMENTS
 381
 382 =head1 LICENSE AND COPYRIGHT
 383
 384 Copyright 2012 Mark Wells.
 385
 386 This program is free software; you can redistribute it and/or modify it
 387 under the terms of either: the GNU General Public License as published
 388 by the Free Software Foundation; or the Artistic License.
 389
 390 See http://dev.perl.org/licenses/ for more information.
 391
 392
 393 =cut
 394
 395 1; # End of Business::BatchPayment::Paymentech