1 package Business::OnlinePayment::WesternACH;
5 use Business::OnlinePayment 3;
6 use Business::OnlinePayment::HTTPS;
9 use Date::Format 'time2str';
10 use Date::Parse 'str2time';
11 use vars qw($VERSION @ISA $me $DEBUG);
13 @ISA = qw(Business::OnlinePayment::HTTPS);
15 $me = 'Business::OnlinePayment::WesternACH';
23 tender_type => 'check',
28 my $required = { map { $_ => 1 } ( qw(
42 # Structure of the XML request document
43 # Right sides of the hash entries are Business::OnlinePayment
44 # field names. Those that start with _ are local method names.
49 password => 'password',
54 TransactionRequest => {
59 type => '_payment_type',
61 # effective date: not supported
63 type => 'tender_type',
65 InvoiceNumber => { value => 'invoice_number' },
66 AccountHolder => { value => '_full_name' },
67 Address => { value => 'address' },
68 ClientID => { value => 'customer_id' },
69 UserDefinedID => { value => 'email' },
71 routing => 'routing_code',
72 account => 'account_number',
73 check => 'check_number',
74 type => '_check_type',
75 verification => 'check_ver',
77 Authorization => { schedule => 'schedule' },
78 SECCode => { value => 'sec_code' },
85 my $returns_request = {
86 TransactionRequest => {
100 $self->server('www.webcheckexpress.com');
102 $self->path('/requester.php');
108 $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;
109 $DB::single = $DEBUG; # If you're debugging this, you probably want to stop here.
112 if ($self->{_content}->{command} eq 'get_returns') {
113 # Setting get_returns overrides anything else.
114 $xml_request = XMLout($self->build($returns_request), KeepRoot => 1);
117 # Error-check and prepare as a normal transaction.
120 # Return-with-error situations
121 croak "Unsupported transaction type: '" . $self->transaction_type . "'"
122 if(not $self->transaction_type =~ /^e?check$/i);
124 croak "Unsupported action: '" . $self->{_content}->{action} . "'"
125 if(!defined($self->_payment_type));
127 croak 'Test transactions not supported'
128 if($self->test_transaction());
132 $self->is_success(0);
133 $self->error_message($@);
137 $xml_request = XMLout($self->build($request), KeepRoot => 1);
139 my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
141 if(not $response =~ /^200/) {
142 croak "HTTPS error: '$response'";
145 $self->server_response($xml_reply);
146 my $reply = XMLin($xml_reply, KeepRoot => 1)->{TransactionResponse};
148 if(exists($reply->{Response})) {
149 $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0);
150 $self->error_message($reply->{Response}->{ErrorMessage});
151 if(exists($reply->{Response}->{TransactionID})) {
152 # get_returns puts its results here
153 my $tid = $reply->{Response}->{TransactionID};
154 if($self->{_content}->{command} eq 'get_returns') {
155 if(ref($tid) eq 'ARRAY') {
156 $self->{_content}->{returns} = [ map { $_->{value} } @$tid ];
159 $self->{_content}->{returns} = [ $tid->{value} ];
162 else { # It's not get_returns
163 $self->authorization($tid->{value});
167 elsif(exists($reply->{FatalException})) {
168 $self->is_success(0);
169 $self->error_message($reply->{FatalException});
178 my $content = $self->{_content};
179 if(exists($content->{'command'})) {
180 croak 'get_returns: command is already set on this transaction';
182 if ($content->{'returns_method'} eq 'requester') {
183 # Obsolete, deprecated method supported for now as a fallback option.
184 $content->{'command'} = 'get_returns';
186 if($self->is_success) {
187 if(exists($content->{'returns'})) {
188 return @{$content->{'returns'}};
194 # you need to check error_message() for details.
198 $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;
199 $DB::single = $DEBUG;
200 if (defined($content->{'login'}) and defined($content->{'password'})) {
201 # transret.php doesn't respect date ranges. It returns anything from the
202 # same month as the date argument. Therefore we generate one request for
203 # each month in the date range, and then filter them by date later.
204 my $path = ('transret.php?style=csv&sort=id&date=');
205 my $starttime = str2time($self->_start);
206 my $endtime = str2time($self->_end) - 1;
207 my @months = map { s/^(....)(..)$/$1-$2-01/; $_ } (
208 time2str('%Y%m', $starttime)..time2str('%Y%m', $endtime)
211 Authorization => 'Basic ' . MIME::Base64::encode($content->{'login'} . ':' . $content->{'password'})
214 foreach my $m (@months) {
215 $self->path($path . $m);
216 # B:OP:HTTPS::https_get doesn't use $DEBUG.
217 my ($page, $reply, %headers) =
219 { headers => $headers },
222 if ($reply =~ /^200/) {
223 $self->is_success(1);
226 $self->error_message($reply);
227 carp $reply if $DEBUG;
228 carp $page if $DEBUG >= 3;
229 $self->is_success(0);
232 my $index_date_ret = 2; # Usual position of 'Date Returned'
233 foreach my $trans (split("\cJ", $page)) {
234 my @fields = split(',', $trans);
236 # id, Date Returned, Type, Amount, Name, Customer ID Number,
237 # Email Address, Invoice Number, Status Code, SEC
239 # we only care about id and date.
240 next if scalar(@fields) < 10;
241 if($fields[0] eq 'id') {
242 # Use this header row to find the 'Date Returned' field.
243 ($index_date_ret) = grep { lc($fields[$_]) eq 'date returned' } ( 0..scalar(@fields)-1 );
244 $index_date_ret ||= 2;
246 next if not($fields[0] =~ /^\d+$/);
247 my $rettime = str2time($fields[$index_date_ret]);
248 next if (!$rettime or $rettime < $starttime or $rettime > $endtime);
249 carp $trans if $DEBUG > 1;
250 push @tids, $fields[0];
256 croak 'login and password required';
263 my $content = { $self->content };
266 if (ref($skel) ne 'HASH') { croak 'Failed to build non-hash' };
267 foreach my $k (keys(%$skel)) {
268 my $val = $skel->{$k};
269 # Rules for building from the skeleton:
270 # 1. If the value is a hashref, build it recursively.
271 if(ref($val) eq 'HASH') {
272 $data->{$k} = $self->build($val);
274 # 2. If the value starts with an underscore, it's treated as a method name.
275 elsif($val =~ /^_/ and $self->can($val)) {
276 $data->{$k} = $self->can($val)->($self);
278 # 3. If the value is undefined, keep it undefined.
279 elsif(!defined($val)) {
282 # 4. If the value is the name of a key in $self->content, look up that value.
283 elsif(exists($content->{$val})) {
284 $data->{$k} = $content->{$val};
286 # 5. If the value is a key in $defaults, use that value.
287 elsif(exists($defaults->{$val})) {
288 $data->{$k} = $defaults->{$val};
290 # 6. If the value is not required, use an empty string.
291 elsif(! $required->{$val}) {
296 croak "Missing request field: '$val'";
303 # For testing build().
305 return XMLout($self->build($request), KeepRoot => 1);
310 my $action = $self->{_content}->{action};
311 if(!defined($action) or $action =~ /^normal authorization$/i) {
314 elsif($action =~ /^credit$/i) {
324 my $type = $self->{_content}->{account_type};
325 return 'checking' if($type =~ /checking/i);
326 return 'savings' if($type =~ /savings/i);
327 croak "Invalid account_type: '$type'";
332 return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name});
337 if($self->{_content}->{start}) {
338 my $start = time2str('%Y-%m-%d', str2time($self->{_content}->{start}));
339 croak "Invalid start date: '".$self->{_content}->{start} if !$start;
343 return time2str('%Y-%m-%d', time - 86400);
349 my $end = $self->{_content}->{end};
351 $end = time2str('%Y-%m-%d', str2time($end));
352 croak "Invalid end date: '".$self->{_content}->{end} if !$end;
356 return time2str('%Y-%m-%d', time);
365 Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePayment
369 use Business::OnlinePayment;
372 # Electronic check authorization. We only support
373 # 'Normal Authorization' and 'Credit'.
376 my $tx = new Business::OnlinePayment("WesternACH");
379 login => 'testdrive',
380 password => 'testpass',
381 action => 'Normal Authorization',
382 description => 'Business::OnlinePayment test',
384 invoice_number => '100100',
385 first_name => 'Jason',
386 last_name => 'Kohles',
387 address => '123 Anystreet',
391 account_type => 'personal checking',
392 account_number => '1000468551234',
393 routing_code => '707010024',
394 check_number => '1001', # optional
398 if($tx->is_success()) {
399 print "Check processed successfully: ".$tx->authorization."\n";
401 print "Check was rejected: ".$tx->error_message."\n";
404 my $tx = new Business::OnlinePayment("WesternACH");
406 login => 'testdrive',
407 password => 'testpass',
408 start => '2009-06-25', # optional; defaults to yesterday
409 end => '2009-06-26', # optional; defaults to today
414 =head1 SUPPORTED TRANSACTION TYPES
418 Content required: type, login, password|transaction_key, action, amount, first_name, last_name, account_number, routing_code, account_type.
422 For detailed information see L<Business::OnlinePayment>.
424 =head1 METHODS AND FUNCTIONS
426 See L<Business::OnlinePayment> for the complete list. The following methods either override the methods in L<Business::OnlinePayment> or provide additional functions.
430 Currently returns nothing; these transactions don't seem to have result codes.
434 Returns the response reason text. This can come from several locations in the response document or from certain local errors.
436 =head2 server_response
438 Returns the complete response from the server.
440 =head1 Handling of content(%content) data:
444 The following actions are valid:
451 Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan-westernach@freeside.biz>.
455 perl(1). L<Business::OnlinePayment>.