Change default sec_code to 'PPD'

diff --git a/lib/Business/OnlinePayment/WesternACH.pm b/lib/Business/OnlinePayment/WesternACH.pm
index 94ba800..76df268 100644 (file)
--- a/lib/Business/OnlinePayment/WesternACH.pm
+++ b/lib/Business/OnlinePayment/WesternACH.pm
@@ -5,6 +5,8 @@ use Carp;
 use Business::OnlinePayment 3;
 use Business::OnlinePayment::HTTPS;
 use XML::Simple;
+use Date::Format 'time2str';
+use Date::Parse  'str2time';
 use vars qw($VERSION @ISA $me $DEBUG);
 
 @ISA = qw(Business::OnlinePayment::HTTPS);
@@ -16,7 +18,7 @@ $DEBUG = 0;
 my $defaults = {
   command      => 'payment',
   check_ver    => 'yes',
-  sec_code     => 'WEB',
+  sec_code     => 'PPD',
   tender_type  => 'check',
   check_number => 9999,
   schedule     => 'live',
@@ -40,12 +42,16 @@ my $required = { map { $_ => 1 } ( qw(
 # 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 => {
@@ -74,6 +80,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');
@@ -85,27 +104,36 @@ sub set_defaults {
 sub submit {
   my $self = shift;
   $Business::OnlinePayment::HTTPS::DEBUG = $DEBUG;
+  my $xml_request;
+
+  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.
 
-  eval {
-    # Return-with-error situations
-    croak "Unsupported transaction type: '" . $self->transaction_type . "'"
-      if(not $self->transaction_type =~ /^e?check$/i);
+      eval {
+      # Return-with-error situations
+      croak "Unsupported transaction type: '" . $self->transaction_type . "'"
+        if(not $self->transaction_type =~ /^e?check$/i);
 
-    croak "Unsupported action: '" . $self->{_content}->{action} . "'"
-      if(!defined($self->_payment_type));
+      croak "Unsupported action: '" . $self->{_content}->{action} . "'"
+        if(!defined($self->_payment_type));
 
-    croak 'Test transactions not supported'
-      if($self->test_transaction());
-  };
+      croak 'Test transactions not supported'
+        if($self->test_transaction());
+    };
 
-  if($@) {
-    $self->is_success(0);
-    $self->error_message($@);
-    return;
+    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);
-  
+  $DB::single=1;
   my ($xml_reply, $response, %reply_headers) = $self->https_post({ 'Content-Type' => 'text/xml' }, $xml_request);
   
   if(not $response =~ /^200/) {
@@ -118,6 +146,16 @@ 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') {
+        $self->{_content}->{returns} =  [ map { $_->{value} } @$tid ];
+      }
+      else { # It's not get_returns
+        $self->authorization($tid->{value});
+      }
+    }
   }
   elsif(exists($reply->{FatalException})) {
     $self->is_success(0);
@@ -129,28 +167,50 @@ sub submit {
   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);
-    }
-    # 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);
+  my $content = $self->{_content};
+  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'}};
     }
-    # 3. If the value is undefined, keep it undefined.
-    elsif(!defined($val)) {
-      $data->{$k} = undef;
+    else {
+      return ();
     }
-    # 4. If the value is the name of a key in $self->content, look up that value.
+  }
+  else {
+    # you need to check error_message() for details.
+    return ();
+  }
+}
+
+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};
     }
@@ -203,6 +263,26 @@ sub _full_name {
   return join(' ',$self->{_content}->{first_name},$self->{_content}->{last_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;
+}
+
+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__
 
@@ -219,7 +299,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',
@@ -247,6 +327,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