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.01';
+$VERSION = '0.07';
$me = 'Business::OnlinePayment::WesternACH';
$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 => {
AccountHolder => { value => '_full_name' },
Address => { value => 'address' },
ClientID => { value => 'customer_id' },
+ UserDefinedID => { value => 'email' },
CheckDetails => {
routing => 'routing_code',
account => 'account_number',
}
};
+my $returns_request = {
+TransactionRequest => {
+ %$auth,
+ Request => {
+ command => 'command',
+ DateRange => {
+ start => '_start',
+ end => '_end',
+ },
+ },
+}
+};
+
sub set_defaults {
my $self = shift;
$self->server('www.webcheckexpress.com');
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/) {
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};
}
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'";
}
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__
# 'Normal Authorization' and 'Credit'.
####
- my $tx = new Business::OnlinePayment("AuthorizeNet");
+ my $tx = new Business::OnlinePayment("WesternACH");
$tx->content(
type => 'ECHECK',
login => 'testdrive',
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
=head1 AUTHOR
-Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan@freeside.biz>.
+Mark Wells <mark@freeside.biz> with advice from Ivan Kohler <ivan-westernach@freeside.biz>.
=head1 SEE ALSO
projects / Business-OnlinePayment-WesternACH.git / blobdiff