X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=lib%2FBusiness%2FOnlinePayment%2FWesternACH.pm;h=4a7389701bd753c55728df96662a95124e4e7b52;hb=aa02cc5759a4ecf515a7ea0275330e36e107d92d;hp=e18a122012d3d84062170c7754c580fc71a2a5a0;hpb=c5ceaf62f0fb0366a47cb6142e6fe4c31c7e9828;p=Business-OnlinePayment-WesternACH.git diff --git a/lib/Business/OnlinePayment/WesternACH.pm b/lib/Business/OnlinePayment/WesternACH.pm index e18a122..4a73897 100644 --- a/lib/Business/OnlinePayment/WesternACH.pm +++ b/lib/Business/OnlinePayment/WesternACH.pm @@ -5,10 +5,13 @@ use Carp; use Business::OnlinePayment 3; use Business::OnlinePayment::HTTPS; use XML::Simple; +use MIME::Base64; +use Date::Format 'time2str'; +use Date::Parse 'str2time'; use vars qw($VERSION @ISA $me $DEBUG); @ISA = qw(Business::OnlinePayment::HTTPS); -$VERSION = '0.02'; +$VERSION = '0.07'; $me = 'Business::OnlinePayment::WesternACH'; $DEBUG = 0; @@ -16,22 +19,40 @@ $DEBUG = 0; my $defaults = { command => 'payment', check_ver => 'yes', - sec_code => 'WEB', + sec_code => 'PPD', tender_type => 'check', check_number => 9999, schedule => 'live', }; +my $required = { map { $_ => 1 } ( qw( + login + password + command + amount + tender_type + _full_name + routing_code + check_number + _check_type +))}; + + + # 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 $auth = { +Authentication => { + username => 'login', + password => 'password', +} +}; + my $request = { TransactionRequest => { - Authentication => { - username => 'login', - password => 'password', - }, + %$auth, Request => { command => 'command', Payment => { @@ -45,6 +66,7 @@ TransactionRequest => { AccountHolder => { value => '_full_name' }, Address => { value => 'address' }, ClientID => { value => 'customer_id' }, + UserDefinedID => { value => 'email' }, CheckDetails => { routing => 'routing_code', account => 'account_number', @@ -60,6 +82,19 @@ TransactionRequest => { } }; +my $returns_request = { +TransactionRequest => { + %$auth, + Request => { + command => 'command', + DateRange => { + start => '_start', + end => '_end', + }, + }, +} +}; + sub set_defaults { my $self = shift; $self->server('www.webcheckexpress.com'); @@ -71,27 +106,36 @@ sub set_defaults { sub submit { my $self = shift; $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG; + $DB::single = $DEBUG; # If you're debugging this, you probably want to stop here. + my $xml_request; - eval { - # Return-with-error situations - croak "Unsupported transaction type: '" . $self->transaction_type . "'" - if(not $self->transaction_type =~ /^e?check$/i); + if ($self->{_content}->{command} eq 'get_returns') { + # Setting get_returns overrides anything else. + $xml_request = XMLout($self->build($returns_request), KeepRoot => 1); + } + else { + # Error-check and prepare as a normal transaction. - croak "Unsupported action: '" . $self->{_content}->{action} . "'" - if(!defined($self->_payment_type)); + eval { + # Return-with-error situations + croak "Unsupported transaction type: '" . $self->transaction_type . "'" + if(not $self->transaction_type =~ /^e?check$/i); - croak 'Test transactions not supported' - if($self->test_transaction()); - }; + croak "Unsupported action: '" . $self->{_content}->{action} . "'" + if(!defined($self->_payment_type)); - if($@) { - $self->is_success(0); - $self->error_message($@); - return; + croak 'Test transactions not supported' + if($self->test_transaction()); + }; + + if($@) { + $self->is_success(0); + $self->error_message($@); + return; + } + + $xml_request = XMLout($self->build($request), KeepRoot => 1); } - - 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/) { @@ -104,39 +148,138 @@ sub submit { if(exists($reply->{Response})) { $self->is_success( ( $reply->{Response}->{status} eq 'successful') ? 1 : 0); $self->error_message($reply->{Response}->{ErrorMessage}); + if(exists($reply->{Response}->{TransactionID})) { + # get_returns puts its results here + my $tid = $reply->{Response}->{TransactionID}; + if($self->{_content}->{command} eq 'get_returns') { + if(ref($tid) eq 'ARRAY') { + $self->{_content}->{returns} = [ map { $_->{value} } @$tid ]; + } + else { + $self->{_content}->{returns} = [ $tid->{value} ]; + } + } + else { # It's not get_returns + $self->authorization($tid->{value}); + } + } } elsif(exists($reply->{FatalException})) { $self->is_success(0); $self->error_message($reply->{FatalException}); } - $DB::single = 1 if $DEBUG; return; } -sub build { +sub get_returns { 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); + my $content = $self->{_content}; + if(exists($content->{'command'})) { + croak 'get_returns: command is already set on this transaction'; + } + if ($content->{'returns_method'} eq 'requester') { +# Obsolete, deprecated method supported for now as a fallback option. + $content->{'command'} = 'get_returns'; + $self->submit; + if($self->is_success) { + if(exists($content->{'returns'})) { + return @{$content->{'returns'}}; + } + else { + return (); + } } - # 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); + # you need to check error_message() for details. + return (); + } + else { + $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG; + $DB::single = $DEBUG; + if (defined($content->{'login'}) and defined($content->{'password'})) { + # transret.php doesn't respect date ranges. It returns anything from the + # same month as the date argument. Therefore we generate one request for + # each month in the date range, and then filter them by date later. + my $path = ('transret.php?style=csv&sort=id&date='); + my $starttime = str2time($self->_start); + my $endtime = str2time($self->_end) - 1; + my @months = map { s/^(....)(..)$/$1-$2-01/; $_ } ( + time2str('%Y%m', $starttime)..time2str('%Y%m', $endtime) + ); + my $headers = { + Authorization => 'Basic ' . MIME::Base64::encode($content->{'login'} . ':' . $content->{'password'}) + }; + my @tids; + foreach my $m (@months) { + $self->path($path . $m); + # B:OP:HTTPS::https_get doesn't use $DEBUG. + my ($page, $reply, %headers) = + $self->https_get( + { headers => $headers }, + {}, + ); + if ($reply =~ /^200/) { + $self->is_success(1); + } + else { + $self->error_message($reply); + carp $reply if $DEBUG; + carp $page if $DEBUG >= 3; + $self->is_success(0); + return; + } + my $index_date_ret = 2; # Usual position of 'Date Returned' + foreach my $trans (split("\cJ", $page)) { + my @fields = split(',', $trans); + # fields: + # id, Date Returned, Type, Amount, Name, Customer ID Number, + # Email Address, Invoice Number, Status Code, SEC + + # we only care about id and date. + next if scalar(@fields) < 10; + if($fields[0] eq 'id') { + # Use this header row to find the 'Date Returned' field. + ($index_date_ret) = grep { lc($fields[$_]) eq 'date returned' } ( 0..scalar(@fields)-1 ); + $index_date_ret ||= 2; + } + next if not($fields[0] =~ /^\d+$/); + my $rettime = str2time($fields[$index_date_ret]); + next if (!$rettime or $rettime < $starttime or $rettime > $endtime); + carp $trans if $DEBUG > 1; + push @tids, $fields[0]; + } + } + return @tids; } - # 3. If the value is undefined, keep it undefined. - elsif(!defined($val)) { - $data->{$k} = undef; + else { + croak 'login and password required'; } - # 4. If the value is the name of a key in $self->content, look up that value. + } +} + +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}; } @@ -144,7 +287,11 @@ sub build { elsif(exists($defaults->{$val})) { $data->{$k} = $defaults->{$val}; } - # 6. Fail. + # 6. If the value is not required, use an empty string. + elsif(! $required->{$val}) { + $data->{$k} = ''; + } + # 7. Fail. else { croak "Missing request field: '$val'"; } @@ -185,6 +332,31 @@ sub _full_name { return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_name}); } +sub _start { + my $self = shift; + if($self->{_content}->{start}) { + my $start = time2str('%Y-%m-%d', str2time($self->{_content}->{start})); + croak "Invalid start date: '".$self->{_content}->{start} if !$start; + return $start; + } + else { + return time2str('%Y-%m-%d', time - 86400); + } +} + +sub _end { + my $self = shift; + my $end = $self->{_content}->{end}; + if($end) { + $end = time2str('%Y-%m-%d', str2time($end)); + croak "Invalid end date: '".$self->{_content}->{end} if !$end; + return $end; + } + else { + return time2str('%Y-%m-%d', time); + } +} + 1; __END__ @@ -201,7 +373,7 @@ Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePa # 'Normal Authorization' and 'Credit'. #### - my $tx = new Business::OnlinePayment("AuthorizeNet"); + my $tx = new Business::OnlinePayment("WesternACH"); $tx->content( type => 'ECHECK', login => 'testdrive', @@ -229,6 +401,16 @@ Business::OnlinePayment::WesternACH - Western ACH backend for Business::OnlinePa print "Check was rejected: ".$tx->error_message."\n"; } + my $tx = new Business::OnlinePayment("WesternACH"); + $tx->content( + login => 'testdrive', + password => 'testpass', + start => '2009-06-25', # optional; defaults to yesterday + end => '2009-06-26', # optional; defaults to today + ); + $tx->get_returns; + + =head1 SUPPORTED TRANSACTION TYPES =head2 ECHECK