lib/Business/OnlinePayment/WesternACH.pm

   1 package Business::OnlinePayment::WesternACH;
   2
   3 use strict;
   4 use Carp;
   5 use Business::OnlinePayment 3;
   6 use Business::OnlinePayment::HTTPS;
   7 use XML::Simple;
   8 use vars qw($VERSION @ISA $me $DEBUG);
   9
  10 @ISA = qw(Business::OnlinePayment::HTTPS);
  11 $VERSION = '0.02';
  12 $me = 'Business::OnlinePayment::WesternACH';
  13
  14 $DEBUG = 0;
  15
  16 my $defaults = {
  17   command      => 'payment',
  18   check_ver    => 'yes',
  19   sec_code     => 'WEB',
  20   tender_type  => 'check',
  21   check_number => 9999,
  22   schedule     => 'live',
  23 };
  24
  25 # Structure of the XML request document
  26 # Right sides of the hash entries are Business::OnlinePayment
  27 # field names.  Those that start with _ are local method names.
  28
  29 my $request = {
  30 TransactionRequest => {
  31   Authentication => {
  32     username => 'login',
  33     password => 'password',
  34   },
  35   Request => {
  36     command => 'command',
  37     Payment => {
  38       type   => '_payment_type',
  39       amount => 'amount',
  40       # effective date: not supported
  41       Tender => {
  42         type   => 'tender_type',
  43         amount => 'amount',
  44         InvoiceNumber => { value => 'invoice_number' },
  45         AccountHolder => { value => '_full_name'      },
  46         Address       => { value => 'address'       },
  47         ClientID      => { value => 'customer_id'    },
  48         CheckDetails => {
  49           routing      => 'routing_code',
  50           account      => 'account_number',
  51           check        => 'check_number',
  52           type         => '_check_type',
  53           verification => 'check_ver',
  54         },
  55         Authorization => { schedule => 'schedule' },
  56         SECCode => { value => 'sec_code' },
  57       },
  58     },
  59   }
  60 }
  61 };
  62
  63 sub set_defaults {
  64   my $self = shift;
  65   $self->server('www.webcheckexpress.com');
  66   $self->port(443);
  67   $self->path('/requester.php');
  68   return;
  69 }
  70
  71 sub submit {
  72   my $self = shift;
  73   $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;
  74
  75   eval {
  76     # Return-with-error situations
  77     croak "Unsupported transaction type: '" . $self->transaction_type . "'"
  78       if(not $self->transaction_type =~ /^e?check$/i);
  79
  80     croak "Unsupported action: '" . $self->{_content}->{action} . "'"
  81       if(!defined($self->_payment_type));
  82
  83     croak 'Test transactions not supported'
  84       if($self->test_transaction());
  85   };
  86
  87   if($@) {
  88     $self->is_success(0);
  89     $self->error_message($@);
  90     return;
  91   }
  92
  93   my $xml_request = XMLout($self->build($request), KeepRoot => 1);
  94
  95   my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
  96
  97   if(not $response =~ /^200/) {
  98     croak "HTTPS error: '$response'";
  99   }
 100
 101   $self->server_response($xml_reply);
 102   my $reply = XMLin($xml_reply, KeepRoot => 1)->{TransactionResponse};
 103
 104   if(exists($reply->{Response})) {
 105     $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0);
 106     $self->error_message($reply->{Response}->{ErrorMessage});
 107   }
 108   elsif(exists($reply->{FatalException})) {
 109     $self->is_success(0);
 110     $self->error_message($reply->{FatalException});
 111   }
 112
 113   $DB::single = 1 if $DEBUG;
 114
 115   return;
 116 }
 117
 118 sub build {
 119   my $self = shift;
 120   my $content = { $self->content };
 121   my $skel = shift;
 122   my $data;
 123   if (ref($skel) ne 'HASH') { croak 'Failed to build non-hash' };
 124   foreach my $k (keys(%$skel)) {
 125     my $val = $skel->{$k};
 126     # Rules for building from the skeleton:
 127     # 1. If the value is a hashref, build it recursively.
 128     if(ref($val) eq 'HASH') {
 129       $data->{$k} = $self->build($val);
 130     }
 131     # 2. If the value starts with an underscore, it's treated as a method name.
 132     elsif($val =~ /^_/ and $self->can($val)) {
 133       $data->{$k} = $self->can($val)->($self);
 134     }
 135     # 3. If the value is undefined, keep it undefined.
 136     elsif(!defined($val)) {
 137       $data->{$k} = undef;
 138     }
 139     # 4. If the value is the name of a key in $self->content, look up that value.
 140     elsif(exists($content->{$val})) {
 141       $data->{$k} = $content->{$val};
 142     }
 143     # 5. If the value is a key in $defaults, use that value.
 144     elsif(exists($defaults->{$val})) {
 145       $data->{$k} = $defaults->{$val};
 146     }
 147     # 6. Fail.
 148     else {
 149       croak "Missing request field: '$val'";
 150     }
 151   }
 152   return $data;
 153 }
 154
 155 sub XML {
 156   # For testing build().
 157   my $self = shift;
 158   return XMLout($self->build($request), KeepRoot => 1);
 159 }
 160
 161 sub _payment_type {
 162   my $self = shift;
 163   my $action = $self->{_content}->{action};
 164   if(!defined($action) or $action =~ /^normal authorization$/i) {
 165     return 'debit';
 166   }
 167   elsif($action =~ /^credit$/i) {
 168     return 'credit';
 169   }
 170   else {
 171     return;
 172   }
 173 }
 174
 175 sub _check_type {
 176   my $self = shift;
 177   my $type = $self->{_content}->{account_type};
 178   return 'checking' if($type =~ /checking/i);
 179   return 'savings'  if($type =~ /savings/i);
 180   croak "Invalid account_type: '$type'";
 181 }
 182
 183 sub _full_name {
 184   my $self = shift;
 185   return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name});
 186 }
 187
 188 1;
 189 __END__
 190
 191 =head1 NAME
 192
 193 Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePayment
 194
 195 =head1 SYNOPSIS
 196
 197   use Business::OnlinePayment;
 198
 199   ####
 200   # Electronic check authorization.  We only support
 201   # 'Normal Authorization' and 'Credit'.
 202   ####
 203
 204   my $tx = new Business::OnlinePayment("AuthorizeNet");
 205   $tx->content(
 206       type           => 'ECHECK',
 207       login          => 'testdrive',
 208       password       => 'testpass',
 209       action         => 'Normal Authorization',
 210       description    => 'Business::OnlinePayment test',
 211       amount         => '49.95',
 212       invoice_number => '100100',
 213       first_name     => 'Jason',
 214       last_name      => 'Kohles',
 215       address        => '123 Anystreet',
 216       city           => 'Anywhere',
 217       state          => 'UT',
 218       zip            => '84058',
 219       account_type   => 'personal checking',
 220       account_number => '1000468551234',
 221       routing_code   => '707010024',
 222       check_number   => '1001', # optional
 223   );
 224   $tx->submit();
 225
 226   if($tx->is_success()) {
 227       print "Check processed successfully: ".$tx->authorization."\n";
 228   } else {
 229       print "Check was rejected: ".$tx->error_message."\n";
 230   }
 231
 232 =head1 SUPPORTED TRANSACTION TYPES
 233
 234 =head2 ECHECK
 235
 236 Content required: type, login, password|transaction_key, action, amount, first_name, last_name, account_number, routing_code, account_type.
 237
 238 =head1 DESCRIPTION
 239
 240 For detailed information see L<Business::OnlinePayment>.
 241
 242 =head1 METHODS AND FUNCTIONS
 243
 244 See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.
 245
 246 =head2 result_code
 247
 248 Currently returns nothing; these transactions don't seem to have result codes.
 249
 250 =head2 error_message
 251
 252 Returns the response reason text.  This can come from several locations in the response document or from certain local errors.
 253
 254 =head2 server_response
 255
 256 Returns the complete response from the server.
 257
 258 =head1 Handling of content(%content) data:
 259
 260 =head2 action
 261
 262 The following actions are valid:
 263
 264   normal authorization
 265   credit
 266
 267 =head1 AUTHOR
 268
 269 Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan-westernach@freeside.biz>.
 270
 271 =head1 SEE ALSO
 272
 273 perl(1). L<Business::OnlinePayment>.
 274
 275 =cut
 276