From f982892c5f462471d94d40d29740178d04a78caa Mon Sep 17 00:00:00 2001 From: mark Date: Fri, 5 Jun 2009 09:05:56 +0000 Subject: [PATCH 1/1] B:OP:WesternACH start --- .cvsignore | 10 ++ Changes | 5 + MANIFEST | 9 + Makefile.PL | 19 +++ README | 43 +++++ lib/Business/OnlinePayment/WesternACH.pm | 274 +++++++++++++++++++++++++++++++ t/00-load.t | 9 + t/check.t | 34 ++++ t/lib/test_account.pl | 19 +++ t/pod.t | 12 ++ 10 files changed, 434 insertions(+) create mode 100644 .cvsignore create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Business/OnlinePayment/WesternACH.pm create mode 100644 t/00-load.t create mode 100644 t/check.t create mode 100644 t/lib/test_account.pl create mode 100644 t/pod.t diff --git a/.cvsignore b/.cvsignore new file mode 100644 index 0000000..f53de7f --- /dev/null +++ b/.cvsignore @@ -0,0 +1,10 @@ +blib* +Makefile +Makefile.old +Build +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +Business-OnlinePayment-WesternACH-* +cover_db diff --git a/Changes b/Changes new file mode 100644 index 0000000..340cdaa --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Business-OnlinePayment-WesternACH + +0.01 Date/time + First version, released on an unsuspecting world. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..fc14e56 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,9 @@ +Changes +MANIFEST +Makefile.PL +README +lib/Business/OnlinePayment/WesternACH.pm +t/00-load.t +t/pod.t +t/check.t +t/lib/test_account.pl diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..ac87433 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,19 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Business::OnlinePayment::WesternACH', + AUTHOR => 'Mark Wells ', + VERSION_FROM => 'lib/Business/OnlinePayment/WesternACH.pm', + ABSTRACT_FROM => 'lib/Business/OnlinePayment/WesternACH.pm', + ($ExtUtils::MakeMaker::VERSION >= 6.3002 + ? ('LICENSE'=> 'perl') + : ()), + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Business-OnlinePayment-WesternACH-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..1a0b56f --- /dev/null +++ b/README @@ -0,0 +1,43 @@ +DESCRIPTION + +Business::OnlinePayment::WesternACH is a Business::OnlinePayment module +for processing electronic checks through Western Clearing Corporation. + +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::OnlinePayment::WesternACH + +You can also look for information at: + + RT, CPAN's request tracker + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Business-OnlinePayment-WesternACH + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Business-OnlinePayment-WesternACH + + CPAN Ratings + http://cpanratings.perl.org/d/Business-OnlinePayment-WesternACH + + Search CPAN + http://search.cpan.org/dist/Business-OnlinePayment-WesternACH/ + + +COPYRIGHT AND LICENCE + +Copyright (C) 2009 Mark Wells + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + diff --git a/lib/Business/OnlinePayment/WesternACH.pm b/lib/Business/OnlinePayment/WesternACH.pm new file mode 100644 index 0000000..52090d9 --- /dev/null +++ b/lib/Business/OnlinePayment/WesternACH.pm @@ -0,0 +1,274 @@ +package Business::OnlinePayment::WesternACH; + +use strict; +use Carp; +use Business::OnlinePayment 3; +use Business::OnlinePayment::HTTPS; +use XML::Simple; +use vars qw($VERSION @ISA $me $DEBUG); + +@ISA = qw(Business::OnlinePayment::HTTPS); +$VERSION = '0.01'; +$me = 'Business::OnlinePayment::WesternACH'; + +$DEBUG = 0; + +my $defaults = { + command => 'payment', + check_ver => 'yes', + sec_code => 'WEB', + tender_type => 'check', + check_number => 9999, +}; + +# Structure of the XML request document +# Right sides of the hash entries are Business::OnlinePayment +# field names. Those that start with _ are local method names. + +my $request = { +TransactionRequest => { + Authentication => { + username => 'login', + password => 'password', + }, + Request => { + command => 'command', + Payment => { + type => '_payment_type', + amount => 'amount', + # effective date: not supported + Tender => { + type => 'tender_type', + amount => 'amount', + InvoiceNumber => { value => 'invoice_number' }, + AccountHolder => { value => '_full_name' }, + Address => { value => 'address' }, + ClientID => { value => 'customer_id' }, + CheckDetails => { + routing => 'routing_code', + account => 'account_number', + check => 'check_number', + type => '_check_type', + verification => 'check_ver', + }, + SECCode => { value => 'sec_code' }, + }, + }, + } +} +}; + +sub set_defaults { + my $self = shift; + $self->server('www.webcheckexpress.com'); + $self->port(443); + $self->path('/requester.php'); + return; +} + +sub submit { + my $self = shift; + $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG; + + eval { + # Return-with-error situations + croak "Unsupported transaction type: '" . $self->transaction_type . "'" + if(not $self->transaction_type =~ /^e?check$/i); + + croak "Unsupported action: '" . $self->{_content}->{action} . "'" + if(!defined($self->_payment_type)); + + croak 'Test transactions not supported' + if($self->test_transaction()); + }; + + if($@) { + $self->is_success(0); + $self->error_message($@); + return; + } + + my $xml_request = XMLout($self->build($request), KeepRoot => 1); + + my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request); + + if(not $response =~ /^200/) { + croak "HTTPS error: '$response'"; + } + + $self->server_response($xml_reply); + my $reply = XMLin($xml_reply, KeepRoot => 1)->{TransactionResponse}; + + if(exists($reply->{Response})) { + $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0); + $self->error_message($reply->{Response}->{ErrorMessage}); + } + elsif(exists($reply->{FatalException})) { + $self->is_success(0); + $self->error_message($reply->{FatalException}); + } + + $DB::single = 1 if $DEBUG; + + return; +} + +sub build { + my $self = shift; + my $content = { $self->content }; + my $skel = shift; + my $data; + if (ref($skel) ne 'HASH') { croak 'Failed to build non-hash' }; + foreach my $k (keys(%$skel)) { + my $val = $skel->{$k}; + # Rules for building from the skeleton: + # 1. If the value is a hashref, build it recursively. + if(ref($val) eq 'HASH') { + $data->{$k} = $self->build($val); + } + # 2. If the value starts with an underscore, it's treated as a method name. + elsif($val =~ /^_/ and $self->can($val)) { + $data->{$k} = $self->can($val)->($self); + } + # 3. If the value is undefined, keep it undefined. + elsif(!defined($val)) { + $data->{$k} = undef; + } + # 4. If the value is the name of a key in $self->content, look up that value. + elsif(exists($content->{$val})) { + $data->{$k} = $content->{$val}; + } + # 5. If the value is a key in $defaults, use that value. + elsif(exists($defaults->{$val})) { + $data->{$k} = $defaults->{$val}; + } + # 6. Fail. + else { + croak "Missing request field: '$val'"; + } + } + return $data; +} + +sub XML { + # For testing build(). + my $self = shift; + return XMLout($self->build($request), KeepRoot => 1); +} + +sub _payment_type { + my $self = shift; + my $action = $self->{_content}->{action}; + if(!defined($action) or $action =~ /^normal authorization$/i) { + return 'debit'; + } + elsif($action =~ /^credit$/i) { + return 'credit'; + } + else { + return; + } +} + +sub _check_type { + my $self = shift; + my $type = $self->{_content}->{account_type}; + return 'checking' if($type =~ /checking/i); + return 'savings' if($type =~ /savings/i); + croak "Invalid account_type: '$type'"; +} + +sub _full_name { + my $self = shift; + return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name}); +} + +1; +__END__ + +=head1 NAME + +Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePayment + +=head1 SYNOPSIS + + use Business::OnlinePayment; + + #### + # Electronic check authorization. We only support + # 'Normal Authorization' and 'Credit'. + #### + + my $tx = new Business::OnlinePayment("AuthorizeNet"); + $tx->content( + type => 'ECHECK', + login => 'testdrive', + password => 'testpass', + action => 'Normal Authorization', + description => 'Business::OnlinePayment test', + amount => '49.95', + invoice_number => '100100', + first_name => 'Jason', + last_name => 'Kohles', + address => '123 Anystreet', + city => 'Anywhere', + state => 'UT', + zip => '84058', + account_type => 'personal checking', + account_number => '1000468551234', + routing_code => '707010024', + check_number => '1001', # optional + ); + $tx->submit(); + + if($tx->is_success()) { + print "Check processed successfully: ".$tx->authorization."\n"; + } else { + print "Check was rejected: ".$tx->error_message."\n"; + } + +=head1 SUPPORTED TRANSACTION TYPES + +=head2 ECHECK + +Content required: type, login, password|transaction_key, action, amount, first_name, last_name, account_number, routing_code, account_type. + +=head1 DESCRIPTION + +For detailed information see L. + +=head1 METHODS AND FUNCTIONS + +See L for the complete list. The following methods either override the methods in L or provide additional functions. + +=head2 result_code + +Currently returns nothing; these transactions don't seem to have result codes. + +=head2 error_message + +Returns the response reason text. This can come from several locations in the response document or from certain local errors. + +=head2 server_response + +Returns the complete response from the server. + +=head1 Handling of content(%content) data: + +=head2 action + +The following actions are valid: + + normal authorization + credit + +=head1 AUTHOR + +Mark Wells with advice from Ivan Kohler . + +=head1 SEE ALSO + +perl(1). L. + +=cut + diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..2b56323 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Business::OnlinePayment::WesternACH' ); +} + +diag( "Testing Business::OnlinePayment::WesternACH $Business::OnlinePayment::WesternACH::VERSION, Perl $], $^X" ); diff --git a/t/check.t b/t/check.t new file mode 100644 index 0000000..661c1a7 --- /dev/null +++ b/t/check.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w + +use Test::More; +require 't/lib/test_account.pl'; + +my($login, $password) = test_account_or_skip(); +plan tests => 2; + +use_ok 'Business::OnlinePayment'; + +my $tx = Business::OnlinePayment->new('WesternACH'); +$tx->content( + type => 'echeck', + login => $login, + password => $password, + action => 'Normal Authorization', + description => 'Business::OnlinePayment checking test', + amount => '40.18', + invoice_number => '10999', + customer_id => 'nobody', + first_name => 'John', + last_name => 'Doe', + address => '123 Anywhere', + city => 'Sacramento', + state => 'CA', + zip => '95824', + account_number => '100012345678', + routing_code => '111000025', + account_type => 'Checking', +); +$tx->submit(); + +ok($tx->is_success()) or diag $tx->error_message; + diff --git a/t/lib/test_account.pl b/t/lib/test_account.pl new file mode 100644 index 0000000..6dfddb5 --- /dev/null +++ b/t/lib/test_account.pl @@ -0,0 +1,19 @@ +# Based on the Business-OnlinePayment-AuthorizeNet tests by +# Jason Kohles and/or Ivan Kohler. + +sub test_account_or_skip { + my ($login, $password) = test_account(); + if(!defined $login) { + plan skip_all => "No test account"; + } + return ($login, $password); +} + +sub test_account { + open TEST_ACCOUNT, 't/test_account' or return; + my ($login, $password) = ; + chomp ($login, $password); + return ($login, $password); +} + +1; 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