72219: High-Priority: Electronic Check Batches, BillBuddy [download fixes]

[Business-BatchPayment-BillBuddy.git] / BillBuddy.pm

diff --git a/BillBuddy.pm b/BillBuddy.pm
index 88207d2..8eb4860 100644 (file)
--- a/BillBuddy.pm
+++ b/BillBuddy.pm
@@ -83,14 +83,21 @@ See http://dev.perl.org/licenses/ for more information.
 =cut
 
 use Business::BatchPayment;
+use DateTime;
 use Moose;
 with 'Business::BatchPayment::Processor';
 
-our $VERSION = '0.01';
+our $VERSION = '0.03';
 
-has [ qw(username password host) ] => (
+has [ qw(username password) ] => (
+   is  => 'ro',
+   isa => 'Str',
+);
+
+has 'host' => (
    is  => 'ro',
    isa => 'Str',
+   default => 'xmlrpc.billbuddy.com',
 );
 
 has 'path' => (
@@ -127,7 +134,7 @@ sub format_item {
   #18-18 1 blank, filled with space 
   $line .= ' ';
   #19-28 10 amount, numbers only, by cents, zero padded to the left 
-  $line .= sprintf("%10s",$item->amount * 100);
+  $line .= sprintf("%010s",$item->amount * 100);
   #29-30 2 blank, filled with spaces 
   $line .= '  ';
   #31-32 2 account type: "BC" for bank account, "CC" for credit card account 
@@ -158,6 +165,7 @@ sub format_item {
   $line .= $cnum;
   #67-98 32 bank account name or name on the credit card 
   my $name = $item->first_name . ' ' . $item->last_name;
+  $name =~ s/\'//g; # gateway should be handling this, but it's not
   $line .= sprintf("%-32.32s",$name);
   #99-99 1 blank 
   $line .= ' ';
@@ -253,10 +261,11 @@ sub xmlrpc_post {
   my $xmlcontent = $self->xml_format($sid,@param);
   warn $self->host . ' ' . $self->port . ' ' . $path . "\n" . $xmlcontent if $self->debug;
   my ($response, $rcode, %rheaders) = $self->https_post($path,$xmlcontent);
-  die "Bad response from gateway: $rcode" unless $rcode eq '200 OK';
+  die "Bad response from gateway: $rcode\n" unless $rcode eq '200 OK';
   warn $response . "\n" if $self->debug;
   my $rref = XMLin($response, KeyAttr => ['ResponseData'], ForceArray => []);
-  die "Error from gateway: " . $rref->{'ResponseStatusDescription'} if $rref->{'ResponseStatus'};
+  die "Error from gateway: " . $rref->{'ResponseStatusDescription'}. "\n"
+    if $rref->{'ResponseStatus'};
   return $rref;
 }
 
@@ -264,12 +273,28 @@ sub xmlrpc_post {
 sub upload {
   my ($self,$request,$batch) = @_;
   my @tokens = ();
-  # get date from batch
-  my ($date) = $batch->process_date =~ /^(....-..-..)/;
   # login
   my $resp = $self->xmlrpc_post('xmlrpc_tp_Login.asp','',$self->username,$self->password);
   my $sid = $resp->{'ResponseData'}->{'sessionID'};
   die "Could not parse sessionid from gateway response" unless $sid;
+  # get date from login, to ensure we're using upstream date
+  my ($year,$mon,$mday,$hour,$min,$sec) = $resp->{'ResponseTimestamp'} =~ /^(....)-(..)-(..)\s+(..):(..):(..)/;
+  # then add a day and a bit, because "processs date need to be a date in the future"
+  my $date = DateTime->new(
+    year      => $year,
+    month     => $mon,
+    day       => $mday,
+    hour      => $hour,
+    minute    => $min,
+    second    => $sec,
+    # timezone on object mostly doesn't matter,
+    # but this does appear to be the tz being passed by BillBuddy,
+    # and this should avoid DST troubles (Queensland does not do DST)
+    time_zone => 'Australia/Queensland',
+  )->add_duration(
+    # extra hour is buffer for upload to run, hopefully that's plenty
+    DateTime::Duration->new( hours => 25 )
+  )->ymd;
   # start a payment batch
   $resp = $self->xmlrpc_post('xmlrpc_tp_DDRBatch_Open.asp',$sid,$self->username,$date);
   my $batchno = $resp->{'ResponseData'}->{'batchno'};
@@ -313,7 +338,7 @@ sub download {
       my $error = '';
       next if grep(/^$status$/,('submitted','processing','scheduled'));
       $error = "Unknown return status: $status"
-        unless grep(/^$status$/,('deleted','declined'));
+        unless grep(/^$status$/,('approved','deleted','declined'));
       my $item = Business::BatchPayment->create(Item =>
         order_number  => $tid,
         tid           => $resp->{'ResponseData'}->{'referencenumber'},
@@ -321,10 +346,18 @@ sub download {
         error_message => $error,
         authorization => '',
       );
-      #not sure what format date gets returned in, item creation will fail on bad format,
-      #so I'm taking a guess, and not recording the date if my guess is wrong
       if ($resp->{'ResponseData'}->{'actualprocessdate'} =~ /^(\d\d\d\d).(\d\d).(\d\d)/) {
-        $item->payment_date($1.'-'.$2.'-'.$3);
+        $item->payment_date(
+          DateTime->new(
+            year      => $1,
+            month     => $2,
+            day       => $3,
+            # this appears to be the tz being passed by BillBuddy
+            time_zone => 'Australia/Queensland',
+          )
+        );
+      } else {
+        warn "Could not parse actualprocessdate ".$resp->{'ResponseData'}->{'actualprocessdate'};
       }
       push(@batchitems,$item);
     }