Fix transret format change

[Business-OnlinePayment-WesternACH.git] / lib / Business / OnlinePayment / WesternACH.pm

diff --git a/lib/Business/OnlinePayment/WesternACH.pm b/lib/Business/OnlinePayment/WesternACH.pm
index b40fad7..4a73897 100644 (file)
--- a/lib/Business/OnlinePayment/WesternACH.pm
+++ b/lib/Business/OnlinePayment/WesternACH.pm
@@ -5,12 +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.03';
+$VERSION = '0.07';
 $me = 'Business::OnlinePayment::WesternACH';
 
 $DEBUG = 0;
@@ -105,6 +106,7 @@ 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;
 
   if ($self->{_content}->{command} eq 'get_returns') {
@@ -134,7 +136,6 @@ sub submit {
     
     $xml_request = XMLout($self->build($request), KeepRoot => 1);
   }
-  $DB::single=1;
   my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
   
   if(not $response =~ /^200/) {
@@ -151,7 +152,12 @@ sub submit {
       # get_returns puts its results here
       my $tid = $reply->{Response}->{TransactionID};
       if($self->{_content}->{command} eq 'get_returns') {
-        $self->{_content}->{returns} =  [ map { $_->{value} } @$tid ];
+        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});
@@ -163,7 +169,6 @@ sub submit {
     $self->error_message($reply->{FatalException});
   }
 
-  $DB::single = 1 if $DEBUG;
 
   return;
 }
@@ -174,20 +179,83 @@ sub get_returns {
   if(exists($content->{'command'})) {
     croak 'get_returns: command is already set on this transaction';
   }
-  $content->{'command'} = 'get_returns';
-  $self->submit;
-  if($self->is_success) {
-    if(exists($content->{'returns'})) {
-      return @{$content->{'returns'}};
-    }
-    else {
-      return ();
+  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 ();
+      }
     }
-  }
-  else {
     # 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;
+    }
+    else {
+      croak 'login and password required';
+    }
+  } 
 }
 
 sub build {
@@ -266,9 +334,14 @@ sub _full_name {
 
 sub _start {
   my $self = shift;
-  my $start = time2str('%Y-%m-%d', str2time($self->{_content}->{start}));
-  croak "Invalid start date: '".$self->{_content}->{start} if !$start;
-  return $start;
+  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 {