--- /dev/null
+package Business::BatchPayment::Paymentech;
+
+use 5.006;
+use strict;
+use warnings;
+our $VERSION = '0.01';
+
+=head1 NAME
+
+Business::BatchPayment::Paymentech - Chase Paymentech XML batch format.
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 USAGE
+
+See L<Business::BatchPayment> for general usage notes.
+
+=head2 SYNOPSIS
+
+use Business::BatchPayment;
+
+my @items = Business::BatchPayment::Item->new( ... );
+
+my $processor = Business::BatchPayment->processor('Paymentech',
+ merchantID => '123456',
+ bin => '00001',
+ terminalID => '001',
+ industryType => 'EC'
+ login => 'TESTUSER',
+ password => 'MYPASS',
+);
+
+my $result = $processor->submit(@items);
+
+=head2 REQUIREMENTS
+
+Requires L<Net::SFTP::Foreign> and ssh (for file transfer) and the zip and
+unzip programs. Unlikely to work on non-Unix systems.
+
+=head2 PROCESSOR ATTRIBUTES
+
+=over 4
+
+=item login - the username to use for SFTP, and in the "userID" tag
+
+=item password - the password for SFTP, and for creating zip files
+
+=item merchantID - your 6- or 12-digit Paymentech merchant ID
+
+=item bin - your BIN: 000001 or 000002
+
+=item terminalID - your 3-digit terminal ID
+
+=item industryType - your 2-letter industry type code
+
+=back
+
+=cut
+
+use File::Temp qw(tempdir);
+use DateTime;
+use XML::Writer;
+use XML::Simple;
+
+use Moose;
+with 'Business::BatchPayment::Processor';
+with 'Business::BatchPayment::TestMode';
+
+# could have some validation on all of these
+has [ qw(merchantID terminalID bin industryType login password) ] => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has 'fileDateTime' => (
+ is => 'ro',
+ isa => 'Str',
+ default => sub {
+ DateTime->now->strftime('%Y%m%d%H%M%S')
+ },
+);
+
+my %BankAcctType = (
+ 'personal checking' => 'C',
+ 'personal savings' => 'S',
+ 'business checking' => 'X',
+ 'business savings' => 'X',
+);
+
+sub default_transport {
+ my $self = shift;
+ Business::BatchPayment::Paymentech::Transport->new(
+ login => $self->login,
+ password => $self->password,
+ put_path => $self->fileDateTime,
+ debug => $self->debug,
+ test_mode => $self->test_mode,
+ );
+}
+
+sub format_request {
+ my $self = shift;
+ my $batch = shift;
+
+ # not doing anything with batch_id
+ my $items = $batch->items;
+ my $num_items = scalar @$items;
+
+ my $output;
+ my $xml = XML::Writer->new(
+ OUTPUT => \$output,
+ DATA_MODE => 1,
+ DATA_INDENT => 2,
+ );
+ $xml->startTag('transRequest', RequestCount => $num_items + 1);
+ $xml->startTag('batchFileID');
+ $xml->dataElement(userID => $self->login);
+ $xml->dataElement(fileDateTime => $self->fileDateTime);
+ $xml->dataElement(fileID => $self->fileDateTime);
+ $xml->endTag('batchFileID');
+
+ my $count = 1;
+ foreach my $item (@$items) {
+ if ( $item->action eq 'payment' ) {
+ $xml->startTag('newOrder', BatchRequestNo => $count);
+ my @order = (
+ industryType => $self->industryType,
+ transType => 'AC',
+ bin => $self->bin,
+ merchantID => $self->merchantID,
+ terminalID => $self->terminalID,
+ );
+ if ($item->payment_type eq 'CC') {
+ push @order, (
+ ccAccountNum => $item->card_number,
+ ccExp => $item->expiration,
+ );
+ }
+ elsif ( $item->payment_type eq 'ECHECK' ) {
+ push @order, (
+ cardBrand => 'EC',
+ ecpCheckRT => $item->routing_code,
+ ecpCheckDDA => $item->account_number,
+ ecpBankAcctType => $BankAcctType{ $item->account_type },
+ ecpDelvMethod => 'A',
+ );
+ }
+ else {
+ die "payment type ".$item->type." not supported";
+ }
+ push @order, (
+ avsZip => $item->zip,
+ avsAddress1 => substr($item->address, 0, 30),
+ avsAddress2 => substr($item->address2, 0, 30),
+ avsCity => substr($item->city, 0, 20),
+ avsState => $item->state,
+ avsName => substr($item->first_name .' '. $item->last_name, 0, 30),
+ avsCountryCode => $item->country,
+ orderID => $item->tid,
+ amount => int( $item->amount * 100 ),
+ );
+ while (@order) {
+ my $key = shift @order;
+ my $value = shift @order;
+ $xml->dataElement($key, $value);
+ }
+ $xml->endTag('newOrder');
+ } # if action eq 'payment'
+ else {
+ die "action ".$item->action." not supported";
+ }
+
+ $count++;
+ } # foreach $item
+
+ $xml->startTag('endOfDay', 'BatchRequestNo', $count);
+ $xml->dataElement('bin' => $self->bin);
+ $xml->dataElement('merchantID' => $self->merchantID);
+ $xml->dataElement('terminalID' => $self->terminalID);
+ $xml->endTag('endOfDay');
+
+ $xml->endTag('transRequest');
+
+ return $output;
+}
+
+sub parse_response {
+ my $self = shift;
+ my $input = shift;
+
+ my $tree = XML::Simple::XMLin($input, KeepRoot => 1);
+ my $newOrderResp = $tree->{transResponse}->{newOrderResp};
+ die "can't find <transResponse><newOrderResp> in input"
+ unless defined $newOrderResp;
+
+ $newOrderResp = [ $newOrderResp ] if ref($newOrderResp) ne 'ARRAY';
+ my $items;
+ foreach my $resp (@$newOrderResp) {
+ my ($mon, $day, $year, $hour, $min, $sec) =
+ $resp->{respDateTime} =~ /^(..)(..)(....)(..)(..)(..)$/;
+ my $dt = DateTime->new(
+ year => $year,
+ month => $mon,
+ day => $day,
+ hour => $hour,
+ minute => $min,
+ second => $sec,
+ );
+
+ my $item = Business::BatchPayment->create(Item =>
+ tid => $resp->{orderID},
+ process_date => $dt,
+ authorization => $resp->{authorizationCode},
+ order_number => $resp->{txRefNum},
+ approved => ($resp->{approvalStatus} == 1),
+ error_message => $resp->{procStatusMessage},
+ );
+ push @$items, $item;
+ }
+ if ( @$items ) {
+ return Business::BatchPayment->create(Batch => items => $items);
+ } else {
+ return;
+ }
+}
+
+package Business::BatchPayment::Paymentech::Transport;
+
+use File::Temp qw( tempdir );
+use File::Slurp qw( read_file write_file );
+use Moose;
+use Moose::Util::TypeConstraints;
+extends 'Business::BatchPayment::Transport::SFTP';
+with 'Business::BatchPayment::TestMode';
+
+has '+host' => (
+ default => sub {
+ my $self = shift;
+ $self->test_mode ? 'orbitalbatchvar.paymentech.net'
+ : 'orbitalbatch.paymentech.net'
+ },
+ lazy => 1,
+);
+
+subtype 'Writeable',
+ as 'Maybe[Str]',
+ where { !defined($_) or ( -d $_ and -w $_ ) },
+ message { "can't write to '$_'" };
+
+has 'archive_to' => (
+ is => 'rw',
+ isa => 'Writeable'
+);
+
+# batch content passed as an argument
+
+sub upload {
+ local $@;
+ my $self = shift;
+ my $content = shift;
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ my $filename = $self->put_path; # also the value of the fileId tag
+ my $archive_dir = $self->archive_to;
+
+ warn "Writing temp file to $tmpdir/$filename.xml.\n" if $self->debug;
+ write_file("$tmpdir/$filename.xml", $content);
+
+ warn "Creating zip file.\n" if $self->debug;
+ my @args = (
+ '-P',
+ $self->password,
+ '-j',
+ "$tmpdir/$filename.zip",
+ "$tmpdir/$filename.xml",
+ );
+ unshift @args, '-q' unless $self->debug;
+ system('zip', @args);
+ die "failed to create zip file" if (! -f "$tmpdir/$filename.zip");
+
+ warn "Uploading.\n" if $self->debug;
+ $self->put("$tmpdir/$filename.zip", "$filename.zip");
+ return;
+};
+
+sub download {
+ local $@;
+ my $self = shift;
+ my $tmpdir = tempdir( CLEANUP => 1 );
+ my $ls_info = $self->ls('.', wanted => qr/_resp\.zip$/);
+ my $archive_dir = $self->archive_to;
+ my @batches;
+ foreach (@$ls_info) {
+ my $filename = $_->{filename}; # still ends in _resp
+ $filename =~ s/\.zip$//;
+ warn "Retrieving $filename.zip\n" if $self->debug;
+ $self->get("$filename.zip", "$tmpdir/$filename.zip");
+
+ my @args = (
+ '-P',
+ $self->password,
+ "$tmpdir/$filename.zip",
+ '-d',
+ $tmpdir,
+ );
+ unshift @args, '-q' unless $self->debug;
+ system('unzip', @args);
+ if (! -f "$tmpdir/$filename.xml") {
+ warn "failed to extract $filename.xml from $filename.zip\n";
+ next;
+ }
+ my $content = read_file("$tmpdir/$filename.xml");
+ if ( $archive_dir ) {
+ warn "Copying $tmpdir/$filename.xml to archive dir $archive_dir\n";
+ write_file("$archive_dir/$filename.xml", $content);
+ }
+ push @batches, $content;
+ }
+ @batches;
+}
+
+sub _info {
+ {
+ 'info_compat' => '0.01',
+ 'gateway_name' => 'Paymentech',
+ 'gateway_url' => 'http://www.chasepaymentech.com/',
+ 'module_version' => $VERSION,
+ 'supported_types' => [ qw( CC ECHECK ) ],
+ 'token_support' => 0,
+ 'test_transaction' => 1,
+ 'supported_actions' => [ 'Payment' ],
+ }
+}
+
+=head1 AUTHOR
+
+Mark Wells, C<< <mark at freeside.biz> >>
+
+=head1 BUGS
+
+Relying on external zip/unzip is awkward.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Business::BatchPayment::Paymentech
+
+Commercial support is available from Freeside Internet Services, Inc.
+
+L<http://www.freeside.biz>
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2012 Mark Wells.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+
+=cut
+
+1; # End of Business::BatchPayment::Paymentech
projects / Business-BatchPayment-Paymentech.git / commitdiff