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