1 package Business::BatchPayment::Paymentech;
10 Business::BatchPayment::Paymentech - Chase Paymentech XML batch format.
14 See L<Business::BatchPayment> for general usage notes.
18 use Business::BatchPayment;
20 my @items = Business::BatchPayment::Item->new( ... );
22 my $processor = Business::BatchPayment->processor('Paymentech',
23 merchantID => '123456',
31 my $result = $processor->submit(@items);
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.
38 =head2 PROCESSOR ATTRIBUTES
42 =item login - the username to use for SFTP, and in the "userID" tag
44 =item password - the password for SFTP, and for creating zip files
46 =item merchantID - your 6- or 12-digit Paymentech merchant ID
48 =item bin - your BIN: 000001 or 000002
50 =item terminalID - your 3-digit terminal ID
52 =item industryType - your 2-letter industry type code
58 use File::Temp qw(tempdir);
65 with 'Business::BatchPayment::Processor';
66 with 'Business::BatchPayment::TestMode';
68 # could have some validation on all of these
69 has [ qw(merchantID terminalID bin industryType login password) ] => (
75 has 'fileDateTime' => (
79 DateTime->now->strftime('%Y%m%d%H%M%S')
84 'personal checking' => 'C',
85 'personal savings' => 'S',
86 'business checking' => 'X',
87 'business savings' => 'X',
90 my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );
92 sub default_transport {
94 Business::BatchPayment::Paymentech::Transport->new(
95 login => $self->login,
96 password => $self->password,
97 debug => $self->debug,
98 test_mode => $self->test_mode,
107 my $xml = XML::Writer->new(
112 $self->format_header($batch, $xml);
114 foreach my $item ( @{ $batch->items } ) {
116 $self->format_item($item, $batch, $xml, $count);
119 $self->format_error($item, $_);
122 $self->format_trailer($batch, $xml, $count);
127 my ($self, $batch, $xml) = @_;
128 my $num_items = $batch->count;
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');
140 my ($self, $item, $batch, $xml, $count) = @_;
141 if ( $item->action eq 'payment' ) {
142 $xml->startTag('newOrder', BatchRequestNo => $count);
144 industryType => $self->industryType,
147 merchantID => $self->merchantID,
148 terminalID => $self->terminalID,
150 if ($item->payment_type eq 'CC') {
152 ccAccountNum => $item->card_number,
153 ccExp => $item->expiration,
156 elsif ( $item->payment_type eq 'ECHECK' ) {
159 ecpCheckRT => $item->routing_code,
160 ecpCheckDDA => $item->account_number,
161 ecpBankAcctType => $BankAcctType{ $item->account_type },
162 ecpDelvMethod => 'A',
166 die "payment type ".$item->type." not supported";
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 )
179 orderID => $item->tid,
180 amount => int( $item->amount * 100 ),
183 my $key = shift @order;
184 my $value = shift @order;
185 $xml->dataElement($key, $value);
187 $xml->endTag('newOrder');
188 } # if action eq 'payment'
190 die "action ".$item->action." not supported";
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');
208 my $batch = Business::BatchPayment->create('Batch');
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;
215 $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
216 foreach my $resp (@$newOrderResp) {
218 $batch->push( $self->parse_item($resp) );
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), $_);
230 my ($self, $resp) = @_;
232 my ($mon, $day, $year, $hour, $min, $sec) =
233 $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
234 my $dt = DateTime->new(
243 my %failure_status = (
244 # API version 2.6, April 2013
245 '00' => undef, # Approved
252 'B7' => 'blacklisted', # Fraud
253 'B9' => 'blacklisted', # On Negative File
254 'BB' => 'stolen', # Possible Compromise
255 'BG' => 'blacklisted', # Blocked Account
256 'BQ' => 'blacklisted', # Issuer has Flagged Account as Suspected Fraud
257 'C4' => 'nsf', # Over Credit Limit
258 'D5' => 'blacklisted', # On Negative File
259 'D7' => 'nsf', # Insufficient Funds
260 'F3' => 'inactive', # Account Closed
262 ); # all others are "decline"
264 my $failure_status = undef;
267 if ( $resp->{procStatus} ) {
268 $error_message = $resp->{procStatusMessage};
269 } elsif ( $resp->{respCode} ) {
270 $error_message = $resp->{respCodeMessage};
271 $failure_status = $failure_status{ $resp->{respCode} } || 'decline';
276 my $item = Business::BatchPayment->create(Item =>
277 tid => $resp->{orderID},
279 authorization => $resp->{authorizationCode},
280 order_number => $resp->{txRefNum},
281 approved => ($resp->{approvalStatus} == 1),
282 error_message => $error_message,
283 failure_status => $failure_status,
288 package Business::BatchPayment::Paymentech::Transport;
290 use File::Temp qw( tempdir );
291 use File::Slurp qw( read_file write_file );
293 use Moose::Util::TypeConstraints;
294 extends 'Business::BatchPayment::Transport::SFTP';
295 with 'Business::BatchPayment::TestMode';
300 $self->test_mode ? 'orbitalbatchvar.paymentech.net'
301 : 'orbitalbatch.paymentech.net'
308 where { !defined($_) or ( -d $_ and -w $_ ) },
309 message { "can't write to '$_'" };
311 has 'archive_to' => (
316 # batch content passed as an argument
322 my $tmpdir = tempdir( CLEANUP => 1 );
323 $content =~ /<fileID>(.*)<\/fileID>/;
325 my $archive_dir = $self->archive_to;
327 warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
328 write_file("$tmpdir/$filename.xml", $content);
330 warn "Creating zip file.\n" if $self->debug;
335 "$tmpdir/$filename.zip",
336 "$tmpdir/$filename.xml",
338 unshift @args, '-q' unless $self->debug;
339 system('zip', @args);
340 die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
342 warn "Uploading.\n" if $self->debug;
343 $self->put("$tmpdir/$filename.zip", "$filename.zip");
350 my $tmpdir = tempdir( CLEANUP => 1 );
351 my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
352 my $archive_dir = $self->archive_to;
354 foreach (@$ls_info) {
355 my $filename = $_->{filename}; # still ends in _resp
356 $filename =~ s/\.zip$//;
357 warn "Retrieving $filename.zip\n" if $self->debug;
358 $self->get("$filename.zip", "$tmpdir/$filename.zip");
363 "$tmpdir/$filename.zip",
367 unshift @args, '-q' unless $self->debug;
368 system('unzip', @args);
369 if (! -f "$tmpdir/$filename.xml") {
370 warn "failed to extract $filename.xml from $filename.zip\n";
373 my $content = read_file("$tmpdir/$filename.xml");
374 if ( $archive_dir ) {
375 warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
376 write_file("$archive_dir/$filename.xml", $content);
378 push @batches, $content;
385 'info_compat' => '0.01',
386 'gateway_name' => 'Paymentech',
387 'gateway_url' => 'http://www.chasepaymentech.com/',
388 'module_version' => $VERSION,
389 'supported_types' => [ qw( CC ECHECK ) ],
390 'token_support' => 0,
391 'test_transaction' => 1,
392 'supported_actions' => [ 'Payment' ],
398 Mark Wells, C<< <mark at freeside.biz> >>
402 Relying on external zip/unzip is awkward.
406 You can find documentation for this module with the perldoc command.
408 perldoc Business::BatchPayment::Paymentech
410 Commercial support is available from Freeside Internet Services, Inc.
412 L<http://www.freeside.biz>
414 =head1 ACKNOWLEDGEMENTS
416 =head1 LICENSE AND COPYRIGHT
418 Copyright 2012 Mark Wells.
420 This program is free software; you can redistribute it and/or modify it
421 under the terms of either: the GNU General Public License as published
422 by the Free Software Foundation; or the Artistic License.
424 See http://dev.perl.org/licenses/ for more information.
429 1; # End of Business::BatchPayment::Paymentech