--- /dev/null
+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
+
projects / Business-OnlinePayment-WesternACH.git / commitdiff