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 Date::Format 'time2str';
   9 use Date::Parse  'str2time';
  10 use vars qw($VERSION @ISA $me $DEBUG);
  11
  12 @ISA = qw(Business::OnlinePayment::HTTPS);
  13 $VERSION = '0.04';
  14 $me = 'Business::OnlinePayment::WesternACH';
  15
  16 $DEBUG = 0;
  17
  18 my $defaults = {
  19   command      => 'payment',
  20   check_ver    => 'yes',
  21   sec_code     => 'PPD',
  22   tender_type  => 'check',
  23   check_number => 9999,
  24   schedule     => 'live',
  25 };
  26
  27 my $required = { map { $_ => 1 } ( qw(
  28   login
  29   password
  30   command
  31   amount
  32   tender_type
  33   _full_name
  34   routing_code
  35   check_number
  36   _check_type
  37 ))};
  38
  39
  40
  41 # Structure of the XML request document
  42 # Right sides of the hash entries are Business::OnlinePayment
  43 # field names.  Those that start with _ are local method names.
  44
  45 my $auth = {
  46 Authentication => {
  47   username => 'login',
  48   password => 'password',
  49 }
  50 };
  51
  52 my $request = {
  53 TransactionRequest => {
  54   %$auth,
  55   Request => {
  56     command => 'command',
  57     Payment => {
  58       type   => '_payment_type',
  59       amount => 'amount',
  60       # effective date: not supported
  61       Tender => {
  62         type   => 'tender_type',
  63         amount => 'amount',
  64         InvoiceNumber => { value => 'invoice_number' },
  65         AccountHolder => { value => '_full_name'      },
  66         Address       => { value => 'address'       },
  67         ClientID      => { value => 'customer_id'    },
  68         UserDefinedID => { value => 'email' },
  69         CheckDetails => {
  70           routing      => 'routing_code',
  71           account      => 'account_number',
  72           check        => 'check_number',
  73           type         => '_check_type',
  74           verification => 'check_ver',
  75         },
  76         Authorization => { schedule => 'schedule' },
  77         SECCode => { value => 'sec_code' },
  78       },
  79     },
  80   }
  81 }
  82 };
  83
  84 my $returns_request = {
  85 TransactionRequest => {
  86   %$auth,
  87   Request => {
  88     command => 'command',
  89     DateRange => {
  90       start => '_start',
  91       end   => '_end',
  92     },
  93   },
  94 }
  95 };
  96
  97 sub set_defaults {
  98   my $self = shift;
  99   $self->server('www.webcheckexpress.com');
 100   $self->port(443);
 101   $self->path('/requester.php');
 102   return;
 103 }
 104
 105 sub submit {
 106   my $self = shift;
 107   $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;
 108   my $xml_request;
 109
 110   if ($self->{_content}->{command} eq 'get_returns') {
 111     # Setting get_returns overrides anything else.
 112     $xml_request = XMLout($self->build($returns_request), KeepRoot => 1);
 113   }
 114   else {
 115     # Error-check and prepare as a normal transaction.
 116
 117       eval {
 118       # Return-with-error situations
 119       croak "Unsupported transaction type: '" . $self->transaction_type . "'"
 120         if(not $self->transaction_type =~ /^e?check$/i);
 121
 122       croak "Unsupported action: '" . $self->{_content}->{action} . "'"
 123         if(!defined($self->_payment_type));
 124
 125       croak 'Test transactions not supported'
 126         if($self->test_transaction());
 127     };
 128
 129     if($@) {
 130       $self->is_success(0);
 131       $self->error_message($@);
 132       return;
 133     }
 134
 135     $xml_request = XMLout($self->build($request), KeepRoot => 1);
 136   }
 137   $DB::single=1;
 138   my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
 139
 140   if(not $response =~ /^200/) {
 141     croak "HTTPS error: '$response'";
 142   }
 143
 144   $self->server_response($xml_reply);
 145   my $reply = XMLin($xml_reply, KeepRoot => 1)->{TransactionResponse};
 146
 147   if(exists($reply->{Response})) {
 148     $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0);
 149     $self->error_message($reply->{Response}->{ErrorMessage});
 150     if(exists($reply->{Response}->{TransactionID})) {
 151       # get_returns puts its results here
 152       my $tid = $reply->{Response}->{TransactionID};
 153       if($self->{_content}->{command} eq 'get_returns') {
 154         $self->{_content}->{returns} =  [ map { $_->{value} } @$tid ];
 155       }
 156       else { # It's not get_returns
 157         $self->authorization($tid->{value});
 158       }
 159     }
 160   }
 161   elsif(exists($reply->{FatalException})) {
 162     $self->is_success(0);
 163     $self->error_message($reply->{FatalException});
 164   }
 165
 166   $DB::single = 1 if $DEBUG;
 167
 168   return;
 169 }
 170
 171 sub get_returns {
 172   my $self = shift;
 173   my $content = $self->{_content};
 174   if(exists($content->{'command'})) {
 175     croak 'get_returns: command is already set on this transaction';
 176   }
 177   $content->{'command'} = 'get_returns';
 178   $self->submit;
 179   if($self->is_success) {
 180     if(exists($content->{'returns'})) {
 181       return @{$content->{'returns'}};
 182     }
 183     else {
 184       return ();
 185     }
 186   }
 187   else {
 188     # you need to check error_message() for details.
 189     return ();
 190   }
 191 }
 192
 193 sub build {
 194   my $self = shift;
 195     my $content = { $self->content };
 196     my $skel = shift;
 197     my $data;
 198     if (ref($skel) ne 'HASH') { croak 'Failed to build non-hash' };
 199     foreach my $k (keys(%$skel)) {
 200       my $val = $skel->{$k};
 201       # Rules for building from the skeleton:
 202       # 1. If the value is a hashref, build it recursively.
 203       if(ref($val) eq 'HASH') {
 204         $data->{$k} = $self->build($val);
 205       }
 206       # 2. If the value starts with an underscore, it's treated as a method name.
 207       elsif($val =~ /^_/ and $self->can($val)) {
 208         $data->{$k} = $self->can($val)->($self);
 209       }
 210       # 3. If the value is undefined, keep it undefined.
 211       elsif(!defined($val)) {
 212         $data->{$k} = undef;
 213       }
 214       # 4. If the value is the name of a key in $self->content, look up that value.
 215     elsif(exists($content->{$val})) {
 216       $data->{$k} = $content->{$val};
 217     }
 218     # 5. If the value is a key in $defaults, use that value.
 219     elsif(exists($defaults->{$val})) {
 220       $data->{$k} = $defaults->{$val};
 221     }
 222     # 6. If the value is not required, use an empty string.
 223     elsif(! $required->{$val}) {
 224       $data->{$k} = '';
 225     }
 226     # 7. Fail.
 227     else {
 228       croak "Missing request field: '$val'";
 229     }
 230   }
 231   return $data;
 232 }
 233
 234 sub XML {
 235   # For testing build().
 236   my $self = shift;
 237   return XMLout($self->build($request), KeepRoot => 1);
 238 }
 239
 240 sub _payment_type {
 241   my $self = shift;
 242   my $action = $self->{_content}->{action};
 243   if(!defined($action) or $action =~ /^normal authorization$/i) {
 244     return 'debit';
 245   }
 246   elsif($action =~ /^credit$/i) {
 247     return 'credit';
 248   }
 249   else {
 250     return;
 251   }
 252 }
 253
 254 sub _check_type {
 255   my $self = shift;
 256   my $type = $self->{_content}->{account_type};
 257   return 'checking' if($type =~ /checking/i);
 258   return 'savings'  if($type =~ /savings/i);
 259   croak "Invalid account_type: '$type'";
 260 }
 261
 262 sub _full_name {
 263   my $self = shift;
 264   return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name});
 265 }
 266
 267 sub _start {
 268   my $self = shift;
 269   my $start = time2str('%Y-%m-%d', str2time($self->{_content}->{start}));
 270   croak "Invalid start date: '".$self->{_content}->{start} if !$start;
 271   return $start;
 272 }
 273
 274 sub _end {
 275   my $self = shift;
 276   my $end = $self->{_content}->{end};
 277   if($end) {
 278     $end = time2str('%Y-%m-%d', str2time($end));
 279     croak "Invalid end date: '".$self->{_content}->{end} if !$end;
 280     return $end;
 281   }
 282   else {
 283     return time2str('%Y-%m-%d', time);
 284   }
 285 }
 286
 287 1;
 288 __END__
 289
 290 =head1 NAME
 291
 292 Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePayment
 293
 294 =head1 SYNOPSIS
 295
 296   use Business::OnlinePayment;
 297
 298   ####
 299   # Electronic check authorization.  We only support
 300   # 'Normal Authorization' and 'Credit'.
 301   ####
 302
 303   my $tx = new Business::OnlinePayment("WesternACH");
 304   $tx->content(
 305       type           => 'ECHECK',
 306       login          => 'testdrive',
 307       password       => 'testpass',
 308       action         => 'Normal Authorization',
 309       description    => 'Business::OnlinePayment test',
 310       amount         => '49.95',
 311       invoice_number => '100100',
 312       first_name     => 'Jason',
 313       last_name      => 'Kohles',
 314       address        => '123 Anystreet',
 315       city           => 'Anywhere',
 316       state          => 'UT',
 317       zip            => '84058',
 318       account_type   => 'personal checking',
 319       account_number => '1000468551234',
 320       routing_code   => '707010024',
 321       check_number   => '1001', # optional
 322   );
 323   $tx->submit();
 324
 325   if($tx->is_success()) {
 326       print "Check processed successfully: ".$tx->authorization."\n";
 327   } else {
 328       print "Check was rejected: ".$tx->error_message."\n";
 329   }
 330
 331   my $tx = new Business::OnlinePayment("WesternACH");
 332   $tx->content(
 333       login     => 'testdrive',
 334       password  => 'testpass',
 335       start     => '2009-06-25', # optional; defaults to yesterday
 336       end       => '2009-06-26', # optional; defaults to today
 337       );
 338   $tx->get_returns;
 339
 340
 341 =head1 SUPPORTED TRANSACTION TYPES
 342
 343 =head2 ECHECK
 344
 345 Content required: type, login, password|transaction_key, action, amount, first_name, last_name, account_number, routing_code, account_type.
 346
 347 =head1 DESCRIPTION
 348
 349 For detailed information see L<Business::OnlinePayment>.
 350
 351 =head1 METHODS AND FUNCTIONS
 352
 353 See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.
 354
 355 =head2 result_code
 356
 357 Currently returns nothing; these transactions don't seem to have result codes.
 358
 359 =head2 error_message
 360
 361 Returns the response reason text.  This can come from several locations in the response document or from certain local errors.
 362
 363 =head2 server_response
 364
 365 Returns the complete response from the server.
 366
 367 =head1 Handling of content(%content) data:
 368
 369 =head2 action
 370
 371 The following actions are valid:
 372
 373   normal authorization
 374   credit
 375
 376 =head1 AUTHOR
 377
 378 Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan-westernach@freeside.biz>.
 379
 380 =head1 SEE ALSO
 381
 382 perl(1). L<Business::OnlinePayment>.
 383
 384 =cut
 385