B:OP:WesternACH startstart

10 files changed, 434 insertions, 0 deletions

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 <mark@freeside.biz>',
+    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<Business::OnlinePayment>.
+
+=head1 METHODS AND FUNCTIONS
+
+See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> 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 <mark@freeside.biz> with advice from Ivan Kohler <ivan@freeside.biz>.
+
+=head1 SEE ALSO
+
+perl(1). L<Business::OnlinePayment>.
+
+=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) = <TEST_ACCOUNT>;
+  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();