1 package Business::BatchPayment::Paymentech;
8 use Unicode::Truncate 'truncate_egc';
12 Business::BatchPayment::Paymentech - Chase Paymentech XML batch format.
16 See L<Business::BatchPayment> for general usage notes.
20 use Business::BatchPayment;
22 my @items = Business::BatchPayment::Item->new( ... );
24 my $processor = Business::BatchPayment->processor('Paymentech',
25 merchantID => '123456',
31 with_recurringInd => 1,
34 my $result = $processor->submit(@items);
38 Requires L<Net::SFTP::Foreign> and ssh (for file transfer) and the zip and
39 unzip programs. Unlikely to work on non-Unix systems.
41 =head2 PROCESSOR ATTRIBUTES
45 =item login - the username to use for SFTP, and in the "userID" tag
47 =item password - the password for SFTP, and for creating zip files
49 =item merchantID - your 6- or 12-digit Paymentech merchant ID
51 =item bin - your BIN: 000001 or 000002
53 =item terminalID - your 3-digit terminal ID
55 =item industryType - your 2-letter industry type code
57 =item with_recurringInd - enable the recurring charge indicator field
63 use File::Temp qw(tempdir);
70 with 'Business::BatchPayment::Processor';
71 with 'Business::BatchPayment::TestMode';
75 # could have some validation on all of these
76 has [ qw(merchantID terminalID bin industryType login password) ] => (
82 has 'with_recurringInd' => (
88 has 'fileDateTime' => (
92 DateTime->now->strftime('%Y%m%d%H%M%S')
97 'personal checking' => 'C',
98 'personal savings' => 'S',
99 'business checking' => 'X',
100 'business savings' => 'X',
103 my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );
105 sub default_transport {
107 Business::BatchPayment::Paymentech::Transport->new(
108 login => $self->login,
109 password => $self->password,
110 debug => $self->debug,
111 test_mode => $self->test_mode,
120 my $xml = XML::Writer->new(
126 $self->format_header($batch, $xml);
128 foreach my $item ( @{ $batch->items } ) {
130 $self->format_item($item, $batch, $xml, $count);
133 $self->format_error($item, $_);
136 $self->format_trailer($batch, $xml, $count);
141 my ($self, $batch, $xml) = @_;
142 my $num_items = $batch->count;
145 $xml->startTag('transRequest', RequestCount => $num_items + 1);
146 $xml->startTag('batchFileID');
147 $xml->dataElement(userID => $self->login);
148 $xml->dataElement(fileDateTime => $self->fileDateTime);
149 $xml->dataElement(fileID => sprintf('%06d-', $batch->batch_id) .
150 $self->fileDateTime);
151 $xml->endTag('batchFileID');
155 my ($self, $item, $batch, $xml, $count) = @_;
156 if ( $item->action eq 'payment' ) {
157 $xml->startTag('newOrder', BatchRequestNo => $count);
159 industryType => $self->industryType,
162 merchantID => $self->merchantID,
163 terminalID => $self->terminalID,
165 if ($item->payment_type eq 'CC') {
166 my $expiration = $item->expiration;
167 $expiration =~ s/\D//g;
169 ccAccountNum => $item->card_number,
170 ccExp => $expiration,
172 } elsif ( $item->payment_type eq 'ECHECK' ) {
175 ecpCheckRT => $item->routing_code,
176 ecpCheckDDA => $item->account_number,
177 ecpBankAcctType => $BankAcctType{ $item->account_type },
178 ecpDelvMethod => 'A',
181 die "payment type ".$item->type." not supported";
183 if ( $self->with_recurringInd ) {
184 if ( $item->recurring_billing eq 'F' ) {
185 push @order, ( recurringInd => 'RF' );
186 } elsif ( $item->recurring_billing eq 'S' ) {
187 push @order, ( recurringInd => 'RS' );
189 } # else don't send recurringInd at all
191 push @order, ( # truncate_egc will die() on empty string
192 avsZip => $item->zip,
193 avsAddress1 => $item->address ? truncate_egc($item->address, 30) : undef,
194 avsAddress2 => $item->address2 ? truncate_egc($item->address2, 30) : undef,
195 avsCity => $item->city ? truncate_egc($item->city, 20) : undef,
196 avsState => $item->state ? truncate_egc($item->state, 2) : undef,
197 avsName => ($item->first_name || $item->last_name)
198 ? truncate_egc($item->first_name.' '.$item->last_name, 30)
200 ( $paymentech_countries{ $item->country }
201 ? ( avsCountryCode => $item->country )
204 orderID => $item->tid,
205 amount => int( $item->amount * 100 ),
208 my $key = shift @order;
209 my $value = shift @order;
210 $xml->dataElement($key, $value);
212 $xml->endTag('newOrder');
213 } # if action eq 'payment'
215 die "action ".$item->action." not supported";
221 my ($self, $batch, $xml, $count) = @_;
222 $xml->startTag('endOfDay', 'BatchRequestNo', $count);
223 $xml->dataElement('bin' => $self->bin);
224 $xml->dataElement('merchantID' => $self->merchantID);
225 $xml->dataElement('terminalID' => $self->terminalID);
226 $xml->endTag('endOfDay');
227 $xml->endTag('transRequest');
233 my $batch = Business::BatchPayment->create('Batch');
235 my $tree = XML::Simple::XMLin($input, KeepRoot => 1);
236 my $newOrderResp = $tree->{transResponse}->{newOrderResp};
237 die "can't find <transResponse><newOrderResp> in input"
238 unless defined $newOrderResp;
240 $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
241 foreach my $resp (@$newOrderResp) {
243 $batch->push( $self->parse_item($resp) );
245 # parse_error needs a string representation of the
246 # input data...and if it 's failing because it wasn't valid
247 # XML, we wouldn't get this far.
248 $self->parse_error(XML::Simple::XMLout($resp), $_);
255 my ($self, $resp) = @_;
257 my ($mon, $day, $year, $hour, $min, $sec) =
258 $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
259 my $dt = DateTime->new(
268 my %failure_status = (
269 # API version 2.6, April 2013
270 '00' => undef, # Approved
277 'B7' => 'blacklisted', # Fraud
278 'B9' => 'blacklisted', # On Negative File
279 'BB' => 'stolen', # Possible Compromise
280 'BG' => 'blacklisted', # Blocked Account
281 'BQ' => 'blacklisted', # Issuer has Flagged Account as Suspected Fraud
282 'C4' => 'nsf', # Over Credit Limit
283 'D5' => 'blacklisted', # On Negative File
284 'D7' => 'nsf', # Insufficient Funds
285 'F3' => 'inactive', # Account Closed
287 ); # all others are "decline"
289 my $failure_status = undef;
292 if ( $resp->{procStatus} ) {
293 $error_message = $resp->{procStatusMessage};
294 } elsif ( $resp->{respCode} ) {
295 $error_message = $resp->{respCodeMessage};
296 $failure_status = $failure_status{ $resp->{respCode} } || 'decline';
301 my $item = Business::BatchPayment->create(Item =>
302 tid => $resp->{orderID},
304 authorization => $resp->{authorizationCode},
305 order_number => $resp->{txRefNum},
306 approved => ($resp->{approvalStatus} == 1),
307 error_message => $error_message,
308 failure_status => $failure_status,
316 # my ($string, $offset, $length, $repl) = @_;
317 # my $bytes = substr(
318 # Encode::encode('utf8', $string || ''),
321 # Encode::encode('utf8', $repl || '')
323 # return Encode::decode('utf8', $bytes, Encode::FB_QUIET);
327 package Business::BatchPayment::Paymentech::Transport;
329 use File::Temp qw( tempdir );
330 use File::Slurp qw( read_file write_file );
332 use Moose::Util::TypeConstraints;
333 extends 'Business::BatchPayment::Transport::SFTP';
334 with 'Business::BatchPayment::TestMode';
339 $self->test_mode ? 'orbitalbatchvar.paymentech.net'
340 : 'orbitalbatch.paymentech.net'
347 where { !defined($_) or ( -d $_ and -w $_ ) },
348 message { "can't write to '$_'" };
350 has 'archive_to' => (
355 # batch content passed as an argument
361 my $tmpdir = tempdir( CLEANUP => 1 );
362 $content =~ /<fileID>(.*)<\/fileID>/;
364 my $archive_dir = $self->archive_to;
366 warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
367 write_file("$tmpdir/$filename.xml", $content);
369 warn "Creating zip file.\n" if $self->debug;
374 "$tmpdir/$filename.zip",
375 "$tmpdir/$filename.xml",
377 unshift @args, '-q' unless $self->debug;
378 system('zip', @args);
379 die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
381 warn "Uploading.\n" if $self->debug;
382 $self->put("$tmpdir/$filename.zip", "$filename.zip");
389 my $tmpdir = tempdir( CLEANUP => 1 );
390 my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
391 my $archive_dir = $self->archive_to;
393 foreach (@$ls_info) {
394 my $filename = $_->{filename}; # still ends in _resp
395 $filename =~ s/\.zip$//;
396 warn "Retrieving $filename.zip\n" if $self->debug;
397 $self->get("$filename.zip", "$tmpdir/$filename.zip");
402 "$tmpdir/$filename.zip",
406 unshift @args, '-q' unless $self->debug;
407 system('unzip', @args);
408 if (! -f "$tmpdir/$filename.xml") {
409 warn "failed to extract $filename.xml from $filename.zip\n";
412 my $content = read_file("$tmpdir/$filename.xml");
413 if ( $archive_dir ) {
414 warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
415 write_file("$archive_dir/$filename.xml", $content);
417 push @batches, $content;
424 'info_compat' => '0.01',
425 'gateway_name' => 'Paymentech',
426 'gateway_url' => 'http://www.chasepaymentech.com/',
427 'module_version' => $VERSION,
428 'supported_types' => [ qw( CC ECHECK ) ],
429 'token_support' => 0,
430 'test_transaction' => 1,
431 'supported_actions' => [ 'Payment' ],
437 Mark Wells, C<< <mark at freeside.biz> >>
441 Relying on external zip/unzip is awkward.
445 You can find documentation for this module with the perldoc command.
447 perldoc Business::BatchPayment::Paymentech
449 Commercial support is available from Freeside Internet Services, Inc.
451 L<http://www.freeside.biz>
453 =head1 ACKNOWLEDGEMENTS
455 =head1 LICENSE AND COPYRIGHT
457 Copyright 2012 Mark Wells.
459 This program is free software; you can redistribute it and/or modify it
460 under the terms of either: the GNU General Public License as published
461 by the Free Software Foundation; or the Artistic License.
463 See http://dev.perl.org/licenses/ for more information.
468 1; # End of Business::BatchPayment::Paymentech