From 39e5b6c3302b1c35174583bdae60b2b8d5a78338 Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Wed, 11 Jul 2012 00:28:53 -0700 Subject: [PATCH] initial commit --- Changes | 4 + MANIFEST | 11 ++ META.yml | 24 ++++ Makefile.PL | 22 ++++ Paymentech.pm | 370 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ README | 55 +++++++++ ignore.txt | 13 ++ t/00-load.t | 9 ++ t/boilerplate.t | 56 +++++++++ t/manifest.t | 13 ++ t/pod.t | 12 ++ 11 files changed, 589 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 Paymentech.pm create mode 100644 README create mode 100644 ignore.txt create mode 100644 t/00-load.t create mode 100644 t/boilerplate.t create mode 100644 t/manifest.t create mode 100644 t/pod.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..a91e799 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Business-BatchPayment-Paymentech + +0.01 unreleased + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..d6bac1b --- /dev/null +++ b/MANIFEST @@ -0,0 +1,11 @@ +Changes +ignore.txt +Makefile.PL +Paymentech.pm +t/boilerplate.t +t/manifest.t +t/pod.t +t/00-load.t +README +MANIFEST +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..2be1054 --- /dev/null +++ b/META.yml @@ -0,0 +1,24 @@ +--- #YAML:1.0 +name: Business-BatchPayment-Paymentech +version: 0.01 +abstract: Chase Paymentech XML batch format. +author: + - Mark Wells +license: perl +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: + Business::BatchPayment: 0 + Moose: 2 + Test::More: 0 +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.57_05 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..839a285 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,22 @@ +use 5.006; +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Business::BatchPayment::Paymentech', + AUTHOR => q{Mark Wells }, + VERSION_FROM => 'Paymentech.pm', + ABSTRACT_FROM => 'Paymentech.pm', + ($ExtUtils::MakeMaker::VERSION >= 6.3002 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Business::BatchPayment' => 0, + 'Moose' => 2.000, + 'Test::More' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Business-BatchPayment-Paymentech-*' }, +); diff --git a/Paymentech.pm b/Paymentech.pm new file mode 100644 index 0000000..bbe3d76 --- /dev/null +++ b/Paymentech.pm @@ -0,0 +1,370 @@ +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 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 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 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<< >> + +=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 + +=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 diff --git a/README b/README new file mode 100644 index 0000000..962dceb --- /dev/null +++ b/README @@ -0,0 +1,55 @@ +Business-BatchPayment-Paymentech + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the README +file from a module distribution so that people browsing the archive +can use it to get an idea of the module's uses. It is usually a good idea +to provide version information here so that people can decide whether +fixes for the module are worth downloading. + + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Business::BatchPayment::Paymentech + +You can also look for information at: + + RT, CPAN's request tracker (report bugs here) + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Business-BatchPayment-Paymentech + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Business-BatchPayment-Paymentech + + CPAN Ratings + http://cpanratings.perl.org/d/Business-BatchPayment-Paymentech + + Search CPAN + http://search.cpan.org/dist/Business-BatchPayment-Paymentech/ + + +LICENSE AND COPYRIGHT + +Copyright (C) 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. + diff --git a/ignore.txt b/ignore.txt new file mode 100644 index 0000000..97aaba5 --- /dev/null +++ b/ignore.txt @@ -0,0 +1,13 @@ +.git* +blib* +Makefile +Makefile.old +Build +Build.bat +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +cover_db +pod2htm*.tmp +Business-BatchPayment-Paymentech-* diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..a9b8015 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Business::BatchPayment::Paymentech' ) || print "Bail out!\n"; +} + +diag( "Testing Business::BatchPayment::Paymentech $Business::BatchPayment::Paymentech::VERSION, Perl $], $^X" ); diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 0000000..74652ba --- /dev/null +++ b/t/boilerplate.t @@ -0,0 +1,56 @@ +#!perl -T + +use 5.006; +use strict; +use warnings; +use Test::More tests => 3; + +sub not_in_file_ok { + my ($filename, %regex) = @_; + open( my $fh, '<', $filename ) + or die "couldn't open $filename for reading: $!"; + + my %violated; + + while (my $line = <$fh>) { + while (my ($desc, $regex) = each %regex) { + if ($line =~ $regex) { + push @{$violated{$desc}||=[]}, $.; + } + } + } + + if (%violated) { + fail("$filename contains boilerplate text"); + diag "$_ appears on lines @{$violated{$_}}" for keys %violated; + } else { + pass("$filename contains no boilerplate text"); + } +} + +sub module_boilerplate_ok { + my ($module) = @_; + not_in_file_ok($module => + 'the great new $MODULENAME' => qr/ - The great new /, + 'boilerplate description' => qr/Quick summary of what the module/, + 'stub function definition' => qr/function[12]/, + ); +} + +TODO: { + local $TODO = "Need to replace the boilerplate text"; + + not_in_file_ok(README => + "The README is used..." => qr/The README is used/, + "'version information here'" => qr/to provide version information/, + ); + + not_in_file_ok(Changes => + "placeholder date/time" => qr(Date/time) + ); + + module_boilerplate_ok('lib/Business/BatchPayment/Paymentech.pm'); + + +} + diff --git a/t/manifest.t b/t/manifest.t new file mode 100644 index 0000000..74d8cac --- /dev/null +++ b/t/manifest.t @@ -0,0 +1,13 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +unless ( $ENV{RELEASE_TESTING} ) { + plan( skip_all => "Author tests not required for installation" ); +} + +eval "use Test::CheckManifest 0.9"; +plan skip_all => "Test::CheckManifest 0.9 required" if $@; +ok_manifest({ exclude => ['/.git', '/blib'] }); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..ee8b18a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok(); -- 2.11.0