prevent B:BP batches from being marked in-transit if uploading the batch fails, ...
[freeside.git] / FS / FS / pay_batch.pm
index f41b3e3..4aeb331 100644 (file)
@@ -9,11 +9,12 @@ use List::Util qw(sum);
 use Time::Local;
 use Text::CSV_XS;
 use Date::Parse qw(str2time);
 use Time::Local;
 use Text::CSV_XS;
 use Date::Parse qw(str2time);
-use Business::CreditCard qw(cardtype);
-use FS::Misc qw(send_email); # for error notification
+use Business::CreditCard qw( 0.35 cardtype );
 use FS::Record qw( dbh qsearch qsearchs );
 use FS::Conf;
 use FS::cust_pay;
 use FS::Record qw( dbh qsearch qsearchs );
 use FS::Conf;
 use FS::cust_pay;
+use FS::Log;
+use Try::Tiny;
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -209,7 +210,9 @@ foreach my $INC (@INC) {
 
 =item import_results OPTION => VALUE, ...
 
 
 =item import_results OPTION => VALUE, ...
 
-Import batch results.
+Import batch results. Can be called as an instance method, if you want to 
+automatically adjust status on a specific batch, or a class method, if you 
+don't know which batch(es) the results apply to.
 
 Options are:
 
 
 Options are:
 
@@ -220,19 +223,21 @@ I<format> - an L<FS::pay_batch> module
 I<gateway> - an L<FS::payment_gateway> object for a batch gateway.  This 
 takes precedence over I<format>.
 
 I<gateway> - an L<FS::payment_gateway> object for a batch gateway.  This 
 takes precedence over I<format>.
 
+I<no_close> - do not try to close batches
+
 Supported format keys (defined in the specified FS::pay_batch module) are:
 
 Supported format keys (defined in the specified FS::pay_batch module) are:
 
-I<filetype> - CSV, fixed, variable, XML
+I<filetype> - required, can be CSV, fixed, variable, XML
 
 
-I<fields> - list of field names for each row/line
+I<fields> - required list of field names for each row/line
 
 I<formatre> - regular expression for fixed filetype
 
 
 I<formatre> - regular expression for fixed filetype
 
-I<parse> - for variable filetype
+I<parse> - required for variable filetype
 
 
-I<xmlkeys> - for XML filetype
+I<xmlkeys> - required for XML filetype
 
 
-I<xmlrow> - for XML filetype
+I<xmlrow> - required for XML filetype
 
 I<begin_condition> - sub, ignore all lines before this returns true
 
 
 I<begin_condition> - sub, ignore all lines before this returns true
 
@@ -242,11 +247,11 @@ I<end_hook> - sub, runs immediately after end_condition returns true
 
 I<skip_condition> - sub, skip lines when this returns true
 
 
 I<skip_condition> - sub, skip lines when this returns true
 
-I<hook> - sub, runs before approved/declined conditions are checked
+I<hook> - required, sub, runs before approved/declined conditions are checked
 
 
-I<approved> - sub, returns true when approved
+I<approved> - required, sub, returns true when approved
 
 
-I<declined> - sub, returns true when declined
+I<declined> - required, sub, returns true when declined
 
 I<close_condition> - sub, decide whether or not to close the batch
 
 
 I<close_condition> - sub, decide whether or not to close the batch
 
@@ -280,6 +285,8 @@ sub import_results {
   my $declined_condition  = $info->{'declined'};
   my $close_condition     = $info->{'close_condition'};
 
   my $declined_condition  = $info->{'declined'};
   my $close_condition     = $info->{'close_condition'};
 
+  my %target_batches; # batches that had at least one payment updated
+
   my $csv = new Text::CSV_XS;
 
   local $SIG{HUP} = 'IGNORE';
   my $csv = new Text::CSV_XS;
 
   local $SIG{HUP} = 'IGNORE';
@@ -293,13 +300,17 @@ sub import_results {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $reself = $self->select_for_update;
+  if ( ref($self) ) {
+    # if called on a specific pay_batch, check the status of that batch
+    # before continuing
+    my $reself = $self->select_for_update;
 
 
-  if ( $reself->status ne 'I' 
-      and !$conf->exists('batch-manual_approval') ) {
-    $dbh->rollback if $oldAutoCommit;
-    return "batchnum ". $self->batchnum. "no longer in transit";
-  }
+    if ( $reself->status ne 'I' 
+        and !$conf->exists('batch-manual_approval') ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "batchnum ". $self->batchnum. "no longer in transit";
+    }
+  } # otherwise we can't enforce this constraint. sorry.
 
   my $total = 0;
   my $line;
 
   my $total = 0;
   my $line;
@@ -345,6 +356,7 @@ sub import_results {
         push @all_values, \@values;
       }
       elsif ($filetype eq 'variable') {
         push @all_values, \@values;
       }
       elsif ($filetype eq 'variable') {
+        # no longer used
         my @values = ( eval { $parse->($self, $line) } );
         if( $@ ) {
           $dbh->rollback if $oldAutoCommit;
         my @values = ( eval { $parse->($self, $line) } );
         if( $@ ) {
           $dbh->rollback if $oldAutoCommit;
@@ -404,6 +416,9 @@ sub import_results {
     unless ( $cust_pay_batch ) {
       return "unknown paybatchnum $hash{'paybatchnum'}\n";
     }
     unless ( $cust_pay_batch ) {
       return "unknown paybatchnum $hash{'paybatchnum'}\n";
     }
+    # remember that we've touched this batch
+    $target_batches{ $cust_pay_batch->batchnum } = 1;
+
     my $custnum = $cust_pay_batch->custnum,
     my $payby = $cust_pay_batch->payby,
 
     my $custnum = $cust_pay_batch->custnum,
     my $payby = $cust_pay_batch->payby,
 
@@ -443,23 +458,29 @@ sub import_results {
 
   } # foreach (@all_values)
 
 
   } # foreach (@all_values)
 
-  my $close = 1;
-  if ( defined($close_condition) ) {
-    # Allow the module to decide whether to close the batch.
-    # $close_condition can also die() to abort the whole import.
-    $close = eval { $close_condition->($self) };
-    if ( $@ ) {
-      $dbh->rollback;
-      die $@;
-    }
-  }
-  if ( $close ) {
-    my $error = $self->set_status('R');
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $error;
-    }
-  }
+  # decide whether to close batches that had payments posted
+  if ( !$param->{no_close} ) {
+    foreach my $batchnum (keys %target_batches) {
+      my $pay_batch = FS::pay_batch->by_key($batchnum);
+      my $close = 1;
+      if ( defined($close_condition) ) {
+        # Allow the module to decide whether to close the batch.
+        # $close_condition can also die() to abort the whole import.
+        $close = eval { $close_condition->($pay_batch) };
+        if ( $@ ) {
+          $dbh->rollback;
+          die $@;
+        }
+      }
+      if ( $close ) {
+        my $error = $pay_batch->set_status('R');
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+    } # foreach $batchnum
+  } # if (!$param->{no_close})
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
@@ -547,8 +568,8 @@ sub import_from_gateway {
   );
 
   my @item_errors;
   );
 
   my @item_errors;
-  my $mail_on_error = $conf->config('batch-errors_to');
-  if ( $mail_on_error ) {
+  my $errors_not_fatal = $conf->config('batch-errors_not_fatal');
+  if ( $errors_not_fatal ) {
     # construct error trap
     $proc_opt{'on_parse_error'} = sub {
       my ($self, $line, $error) = @_;
     # construct error trap
     $proc_opt{'on_parse_error'} = sub {
       my ($self, $line, $error) = @_;
@@ -558,7 +579,14 @@ sub import_from_gateway {
 
   my $processor = $gateway->batch_processor(%proc_opt);
 
 
   my $processor = $gateway->batch_processor(%proc_opt);
 
-  my @batches = $processor->receive;
+  my @processor_ids = map { $_->processor_id } 
+                        qsearch({
+                          'table' => 'pay_batch',
+                          'hashref' => { 'status' => 'I' },
+                          'extra_sql' => q( AND processor_id != '' AND processor_id IS NOT NULL)
+                        });
+
+  my @batches = $processor->receive(@processor_ids);
 
   my $num = 0;
 
 
   my $num = 0;
 
@@ -587,7 +615,8 @@ sub import_from_gateway {
       my $error;
 
       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
       my $error;
 
       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
-        ':' . $item->authorization .  ':' . $item->order_number;
+        ':' . ($item->authorization || '') .
+        ':' . ($item->order_number || '');
 
       if ( $batch->incoming ) {
         # This is a one-way batch.
 
       if ( $batch->incoming ) {
         # This is a one-way batch.
@@ -774,15 +803,10 @@ sub import_from_gateway {
       "Errors during batch import: ".scalar(@item_errors),
       @item_errors
     );
       "Errors during batch import: ".scalar(@item_errors),
       @item_errors
     );
-    if ( $mail_on_error ) {
-      my $subject = "Batch import errors"; #?
-      my $body = "Import from gateway ".$gateway->label."\n".$error_text;
-      send_email(
-        to      => $mail_on_error,
-        from    => $conf->invoice_from_full(),
-        subject => $subject,
-        body    => $body,
-      );
+    if ( $errors_not_fatal ) {
+      my $message = "Import from gateway ".$gateway->label." errors: ".$error_text;
+      my $log = FS::Log->new('FS::pay_batch::import_from_gateway');
+      $log->error($message);
     } else {
       # Bail out.
       $dbh->rollback if $oldAutoCommit;
     } else {
       # Bail out.
       $dbh->rollback if $oldAutoCommit;
@@ -866,7 +890,8 @@ Prepare the batch to be exported.  This will:
   increment expiration dates that are in the past.
 - If this is the first download for this batch, adjust payment amounts to 
   not be greater than the customer's current balance.  If the customer's 
   increment expiration dates that are in the past.
 - If this is the first download for this batch, adjust payment amounts to 
   not be greater than the customer's current balance.  If the customer's 
-  balance is zero, the entry will be removed.
+  balance is zero, the entry will be removed (caution: all cust_pay_batch
+  entries might be removed!)
 
 Use this within a transaction.
 
 
 Use this within a transaction.
 
@@ -881,8 +906,6 @@ sub prepare_for_export {
   my $status = $self->status;
   if ($status eq 'O') {
     $first_download = 1;
   my $status = $self->status;
   if ($status eq 'O') {
     $first_download = 1;
-    my $error = $self->set_status('I');
-    return "error updating pay_batch status: $error\n" if $error;
   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
     $first_download = 0;
   } elsif ($status eq 'R' && 
   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
     $first_download = 0;
   } elsif ($status eq 'R' && 
@@ -916,7 +939,7 @@ sub prepare_for_export {
 
       my $balance = $cust_pay_batch->cust_main->balance;
       if ($balance <= 0) { # then don't charge this customer
 
       my $balance = $cust_pay_batch->cust_main->balance;
       if ($balance <= 0) { # then don't charge this customer
-        my $error = $cust_pay_batch->delete;
+        my $error = $cust_pay_batch->unbatch_and_delete;
         return $error if $error;
       } elsif ($balance < $cust_pay_batch->amount) {
         # reduce the charge to the remaining balance
         return $error if $error;
       } elsif ($balance < $cust_pay_batch->amount) {
         # reduce the charge to the remaining balance
@@ -926,6 +949,11 @@ sub prepare_for_export {
       }
       # else $balance >= $cust_pay_batch->amount
     }
       }
       # else $balance >= $cust_pay_batch->amount
     }
+
+    #need to do this after unbatch_and_delete
+    my $error = $self->set_status('I');
+    return "error updating pay_batch status: $error\n" if $error;
+
   } #if $first_download
 
   '';
   } #if $first_download
 
   '';
@@ -939,6 +967,10 @@ module, in which case the configuration options are in 'batchconfig-FORMAT'.
 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 L<Business::BatchPayment> module.
 
 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 L<Business::BatchPayment> module.
 
+Returns the text of the batch.  If batch contains no cust_pay_batch entries
+(or has them all removed by L</prepare_for_export>) then the batch will be 
+resolved and a blank string will be returned.  All other errors are fatal.
+
 =cut
 
 sub export_batch {
 =cut
 
 sub export_batch {
@@ -974,6 +1006,12 @@ sub export_batch {
   my $batchcount = 0;
 
   my @cust_pay_batch = $self->cust_pay_batch;
   my $batchcount = 0;
 
   my @cust_pay_batch = $self->cust_pay_batch;
+  unless (@cust_pay_batch) {
+    # if it's empty, just resolve the batch
+    $self->set_status('R');
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return '';
+  }
 
   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 
 
   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 
@@ -1018,6 +1056,10 @@ that gateway via Business::BatchPayment. OPTIONS may include:
 
 - file: override the default transport and write to this file (name or handle)
 
 
 - file: override the default transport and write to this file (name or handle)
 
+If batch contains no cust_pay_batch entries (or has them all removed by 
+L</prepare_for_export>) then nothing will be transported (or written to 
+the override file) and the batch will be resolved.
+
 =cut
 
 sub export_to_gateway {
 =cut
 
 sub export_to_gateway {
@@ -1038,11 +1080,28 @@ sub export_to_gateway {
   my $processor = $gateway->batch_processor(%proc_opt);
 
   my @items = map { $_->request_item } $self->cust_pay_batch;
   my $processor = $gateway->batch_processor(%proc_opt);
 
   my @items = map { $_->request_item } $self->cust_pay_batch;
-  my $batch = Business::BatchPayment->create(Batch =>
-    batch_id  => $self->batchnum,
-    items     => \@items
-  );
-  $processor->submit($batch);
+  unless (@items) {
+    # if it's empty, just resolve the batch
+    $self->set_status('R');
+    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+    return '';
+  }
+
+  try {
+    my $batch = Business::BatchPayment->create(Batch =>
+      batch_id  => $self->batchnum,
+      items     => \@items
+    );
+    $processor->submit($batch);
+
+    if ($batch->processor_id) {
+      $self->set('processor_id',$batch->processor_id);
+      $self->replace;
+    }
+  } catch {
+    $dbh->rollback if $oldAutoCommit;
+    die $_;
+  };
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';