FS/FS/pay_batch.pm

   1 package FS::pay_batch;
   2 use base qw( FS::Record );
   3
   4 use strict;
   5 use vars qw( $DEBUG %import_info %export_info $conf );
   6 use Scalar::Util qw(blessed);
   7 use IO::Scalar;
   8 use List::Util qw(sum);
   9 use Time::Local;
  10 use Text::CSV_XS;
  11 use Date::Parse qw(str2time);
  12 use Business::CreditCard qw( 0.35 cardtype );
  13 use FS::Record qw( dbh qsearch qsearchs );
  14 use FS::Conf;
  15 use FS::cust_pay;
  16 use FS::Log;
  17 use Try::Tiny;
  18
  19 =head1 NAME
  20
  21 FS::pay_batch - Object methods for pay_batch records
  22
  23 =head1 SYNOPSIS
  24
  25   use FS::pay_batch;
  26
  27   $record = new FS::pay_batch \%hash;
  28   $record = new FS::pay_batch { 'column' => 'value' };
  29
  30   $error = $record->insert;
  31
  32   $error = $new_record->replace($old_record);
  33
  34   $error = $record->delete;
  35
  36   $error = $record->check;
  37
  38 =head1 DESCRIPTION
  39
  40 An FS::pay_batch object represents an payment batch.  FS::pay_batch inherits
  41 from FS::Record.  The following fields are currently supported:
  42
  43 =over 4
  44
  45 =item batchnum - primary key
  46
  47 =item agentnum - optional agent number for agent batches
  48
  49 =item payby - CARD or CHEK
  50
  51 =item status - O (Open), I (In-transit), or R (Resolved)
  52
  53 =item download - time when the batch was first downloaded
  54
  55 =item upload - time when the batch was first uploaded
  56
  57 =item title - unique batch identifier
  58
  59 =item processor_id -
  60
  61 =item type - batch type payents (DEBIT), or refunds (CREDIT)
  62
  63 For incoming batches, the combination of 'title', 'payby', and 'agentnum'
  64 must be unique.
  65
  66 =back
  67
  68 =head1 METHODS
  69
  70 =over 4
  71
  72 =item new HASHREF
  73
  74 Creates a new batch.  To add the batch to the database, see L<"insert">.
  75
  76 Note that this stores the hash reference, not a distinct copy of the hash it
  77 points to.  You can ask the object for a copy with the I<hash> method.
  78
  79 =cut
  80
  81 # the new method can be inherited from FS::Record, if a table method is defined
  82
  83 sub table { 'pay_batch'; }
  84
  85 =item insert
  86
  87 Adds this record to the database.  If there is an error, returns the error,
  88 otherwise returns false.
  89
  90 =cut
  91
  92 # the insert method can be inherited from FS::Record
  93
  94 =item delete
  95
  96 Delete this record from the database.
  97
  98 =cut
  99
 100 # the delete method can be inherited from FS::Record
 101
 102 =item replace OLD_RECORD
 103
 104 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 105 returns the error, otherwise returns false.
 106
 107 =cut
 108
 109 # the replace method can be inherited from FS::Record
 110
 111 =item check
 112
 113 Checks all fields to make sure this is a valid batch.  If there is
 114 an error, returns the error, otherwise returns false.  Called by the insert
 115 and replace methods.
 116
 117 =cut
 118
 119 # the check method should currently be supplied - FS::Record contains some
 120 # data checking routines
 121
 122 sub check {
 123   my $self = shift;
 124
 125   my $error =
 126     $self->ut_numbern('batchnum')
 127     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ])
 128     || $self->ut_enum('status', [ 'O', 'I', 'R' ])
 129     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 130     || $self->ut_alphan('title')
 131   ;
 132   return $error if $error;
 133
 134   if ( $self->title ) {
 135     my @existing =
 136       grep { !$self->batchnum or $_->batchnum != $self->batchnum }
 137       qsearch('pay_batch', {
 138           payby     => $self->payby,
 139           agentnum  => $self->agentnum,
 140           title     => $self->title,
 141       });
 142     return "Batch already exists as batchnum ".$existing[0]->batchnum
 143       if @existing;
 144   }
 145
 146   $self->SUPER::check;
 147 }
 148
 149 =item agent
 150
 151 Returns the L<FS::agent> object for this batch.
 152
 153 =item cust_pay_batch
 154
 155 Returns all L<FS::cust_pay_batch> objects for this batch.
 156
 157 =item rebalance
 158
 159 =cut
 160
 161 sub rebalance {
 162   my $self = shift;
 163 }
 164
 165 =item set_status
 166
 167 =cut
 168
 169 sub set_status {
 170   my $self = shift;
 171   $self->status(shift);
 172   $self->download(time)
 173     if $self->status eq 'I' && ! $self->download;
 174   $self->upload(time)
 175     if $self->status eq 'R' && ! $self->upload;
 176   $self->replace();
 177 }
 178
 179 # further false laziness
 180
 181 %import_info = %export_info = ();
 182 foreach my $INC (@INC) {
 183   warn "globbing $INC/FS/pay_batch/*.pm\n" if $DEBUG;
 184   foreach my $file ( glob("$INC/FS/pay_batch/*.pm")) {
 185     warn "attempting to load batch format from $file\n" if $DEBUG;
 186     $file =~ /\/(\w+)\.pm$/;
 187     next if !$1;
 188     my $mod = $1;
 189     my ($import, $export, $name) =
 190       eval "use FS::pay_batch::$mod;
 191            ( \\%FS::pay_batch::$mod\::import_info,
 192              \\%FS::pay_batch::$mod\::export_info,
 193              \$FS::pay_batch::$mod\::name)";
 194     $name ||= $mod; # in case it's not defined
 195     if ($@) {
 196       # in FS::cdr this is a die, not a warn.  That's probably a bug.
 197       warn "error using FS::pay_batch::$mod (skipping): $@\n";
 198       next;
 199     }
 200     if(!keys(%$import)) {
 201       warn "no \%import_info found in FS::pay_batch::$mod (skipping)\n";
 202     }
 203     else {
 204       $import_info{$name} = $import;
 205     }
 206     if(!keys(%$export)) {
 207       warn "no \%export_info found in FS::pay_batch::$mod (skipping)\n";
 208     }
 209     else {
 210       $export_info{$name} = $export;
 211     }
 212   }
 213 }
 214
 215 =item import_results OPTION => VALUE, ...
 216
 217 Import batch results. Can be called as an instance method, if you want to
 218 automatically adjust status on a specific batch, or a class method, if you
 219 don't know which batch(es) the results apply to.
 220
 221 Options are:
 222
 223 I<filehandle> - open filehandle of results file.
 224
 225 I<format> - an L<FS::pay_batch> module
 226
 227 I<gateway> - an L<FS::payment_gateway> object for a batch gateway.  This
 228 takes precedence over I<format>.
 229
 230 I<no_close> - do not try to close batches
 231
 232 Supported format keys (defined in the specified FS::pay_batch module) are:
 233
 234 I<filetype> - required, can be CSV, fixed, variable, XML
 235
 236 I<fields> - required list of field names for each row/line
 237
 238 I<formatre> - regular expression for fixed filetype
 239
 240 I<parse> - required for variable filetype
 241
 242 I<xmlkeys> - required for XML filetype
 243
 244 I<xmlrow> - required for XML filetype
 245
 246 I<begin_condition> - sub, ignore all lines before this returns true
 247
 248 I<end_condition> - sub, stop processing lines when this returns true
 249
 250 I<end_hook> - sub, runs immediately after end_condition returns true
 251
 252 I<skip_condition> - sub, skip lines when this returns true
 253
 254 I<hook> - required, sub, runs before approved/declined conditions are checked
 255
 256 I<approved> - required, sub, returns true when approved
 257
 258 I<declined> - required, sub, returns true when declined
 259
 260 I<close_condition> - sub, decide whether or not to close the batch
 261
 262 =cut
 263
 264 sub import_results {
 265   my $self = shift;
 266
 267   my $param = ref($_[0]) ? shift : { @_ };
 268   my $fh = $param->{'filehandle'};
 269   my $job = $param->{'job'};
 270   $job->update_statustext(0) if $job;
 271
 272   my $format = $param->{'format'};
 273   my $info = $import_info{$format}
 274     or die "unknown format $format";
 275
 276   my $conf = new FS::Conf;
 277
 278   my $filetype            = $info->{'filetype'};      # CSV, fixed, variable
 279   my @fields              = @{ $info->{'fields'}};
 280   my $formatre            = $info->{'formatre'};      # for fixed
 281   my $parse               = $info->{'parse'};         # for variable
 282   my @all_values;
 283   my $begin_condition     = $info->{'begin_condition'};
 284   my $end_condition       = $info->{'end_condition'};
 285   my $end_hook            = $info->{'end_hook'};
 286   my $skip_condition      = $info->{'skip_condition'};
 287   my $hook                = $info->{'hook'};
 288   my $approved_condition  = $info->{'approved'};
 289   my $declined_condition  = $info->{'declined'};
 290   my $close_condition     = $info->{'close_condition'};
 291
 292   my %target_batches; # batches that had at least one payment updated
 293
 294   my $csv = new Text::CSV_XS;
 295
 296   local $SIG{HUP} = 'IGNORE';
 297   local $SIG{INT} = 'IGNORE';
 298   local $SIG{QUIT} = 'IGNORE';
 299   local $SIG{TERM} = 'IGNORE';
 300   local $SIG{TSTP} = 'IGNORE';
 301   local $SIG{PIPE} = 'IGNORE';
 302
 303   my $oldAutoCommit = $FS::UID::AutoCommit;
 304   local $FS::UID::AutoCommit = 0;
 305   my $dbh = dbh;
 306
 307   if ( ref($self) ) {
 308     # if called on a specific pay_batch, check the status of that batch
 309     # before continuing
 310     my $reself = $self->select_for_update;
 311
 312     if ( $reself->status ne 'I'
 313         and !$conf->exists('batch-manual_approval') ) {
 314       $dbh->rollback if $oldAutoCommit;
 315       return "batchnum ". $self->batchnum. "no longer in transit";
 316     }
 317   } # otherwise we can't enforce this constraint. sorry.
 318
 319   my $total = 0;
 320   my $line;
 321
 322   if ($filetype eq 'XML') {
 323     eval "use XML::Simple";
 324     die $@ if $@;
 325     my @xmlkeys = @{ $info->{'xmlkeys'} };  # for XML
 326     my $xmlrow  = $info->{'xmlrow'};        # also for XML
 327
 328     # Do everything differently.
 329     my $data = XML::Simple::XMLin($fh, KeepRoot => 1);
 330     my $rows = $data;
 331     # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ]
 332     $rows = $rows->{$_} foreach( @$xmlrow );
 333     if(!defined($rows)) {
 334       $dbh->rollback if $oldAutoCommit;
 335       return "can't find rows in XML file";
 336     }
 337     $rows = [ $rows ] if ref($rows) ne 'ARRAY';
 338     foreach my $row (@$rows) {
 339       push @all_values, [ @{$row}{@xmlkeys}, $row ];
 340     }
 341   }
 342   else {
 343     while ( defined($line=<$fh>) ) {
 344
 345       next if $line =~ /^\s*$/; #skip blank lines
 346
 347       if ($filetype eq "CSV") {
 348         $csv->parse($line) or do {
 349           $dbh->rollback if $oldAutoCommit;
 350           return "can't parse: ". $csv->error_input();
 351         };
 352         push @all_values, [ $csv->fields(), $line ];
 353       }elsif ($filetype eq 'fixed'){
 354         my @values = ( $line =~ /$formatre/ );
 355         unless (@values) {
 356           $dbh->rollback if $oldAutoCommit;
 357           return "can't parse: ". $line;
 358         };
 359         push @values, $line;
 360         push @all_values, \@values;
 361       }
 362       elsif ($filetype eq 'variable') {
 363         # no longer used
 364         my @values = ( eval { $parse->($self, $line) } );
 365         if( $@ ) {
 366           $dbh->rollback if $oldAutoCommit;
 367           return $@;
 368         };
 369         push @values, $line;
 370         push @all_values, \@values;
 371       }
 372       else {
 373         $dbh->rollback if $oldAutoCommit;
 374         return "Unknown file type $filetype";
 375       }
 376     }
 377   }
 378
 379   my $num = 0;
 380   foreach (@all_values) {
 381     if($job) {
 382       $num++;
 383       $job->update_statustext(int(100 * $num/scalar(@all_values)));
 384     }
 385     my @values = @$_;
 386
 387     my %hash;
 388     my $line = pop @values;
 389     foreach my $field ( @fields ) {
 390       my $value = shift @values;
 391       next unless $field;
 392       $hash{$field} = $value;
 393     }
 394
 395     if ( defined($begin_condition) ) {
 396       if ( &{$begin_condition}(\%hash, $line) ) {
 397         undef $begin_condition;
 398       }
 399       else {
 400         next;
 401       }
 402     }
 403
 404     if ( defined($end_condition) and &{$end_condition}(\%hash, $line) ) {
 405       my $error;
 406       $error = &{$end_hook}(\%hash, $total, $line) if defined($end_hook);
 407       if ( $error ) {
 408         $dbh->rollback if $oldAutoCommit;
 409         return $error;
 410       }
 411       last;
 412     }
 413
 414     if ( defined($skip_condition) and &{$skip_condition}(\%hash, $line) ) {
 415       next;
 416     }
 417
 418     my $cust_pay_batch =
 419       qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
 420     unless ( $cust_pay_batch ) {
 421       return "unknown paybatchnum $hash{'paybatchnum'}\n";
 422     }
 423     # remember that we've touched this batch
 424     $target_batches{ $cust_pay_batch->batchnum } = 1;
 425
 426     my $custnum = $cust_pay_batch->custnum,
 427     my $payby = $cust_pay_batch->payby,
 428
 429     &{$hook}(\%hash, $cust_pay_batch->hashref);
 430
 431     my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
 432
 433     my $error = '';
 434     if ( &{$approved_condition}(\%hash) ) {
 435
 436       foreach ('paid', '_date', 'payinfo') {
 437         $new_cust_pay_batch->$_($hash{$_}) if $hash{$_};
 438       }
 439       $error = $new_cust_pay_batch->approve(%hash);
 440       $total += $hash{'paid'};
 441
 442     } elsif ( &{$declined_condition}(\%hash) ) {
 443
 444       $error = $new_cust_pay_batch->decline($hash{'error_message'});;
 445
 446     }
 447
 448     if ( $error ) {
 449       $dbh->rollback if $oldAutoCommit;
 450       return $error;
 451     }
 452
 453     # purge CVV when the batch is processed
 454     if ( $payby =~ /^(CARD|DCRD)$/ ) {
 455       my $payinfo = $hash{'payinfo'} || $cust_pay_batch->payinfo;
 456       if ( ! grep { $_ eq cardtype($payinfo) }
 457           $conf->config('cvv-save') ) {
 458         $new_cust_pay_batch->cust_main->remove_cvv;
 459       }
 460
 461     }
 462
 463   } # foreach (@all_values)
 464
 465   # decide whether to close batches that had payments posted
 466   if ( !$param->{no_close} ) {
 467     foreach my $batchnum (keys %target_batches) {
 468       my $pay_batch = FS::pay_batch->by_key($batchnum);
 469       my $close = 1;
 470       if ( defined($close_condition) ) {
 471         # Allow the module to decide whether to close the batch.
 472         # $close_condition can also die() to abort the whole import.
 473         $close = eval { $close_condition->($pay_batch) };
 474         if ( $@ ) {
 475           $dbh->rollback;
 476           die $@;
 477         }
 478       }
 479       if ( $close ) {
 480         my $error = $pay_batch->set_status('R');
 481         if ( $error ) {
 482           $dbh->rollback if $oldAutoCommit;
 483           return $error;
 484         }
 485       }
 486     } # foreach $batchnum
 487   } # if (!$param->{no_close})
 488
 489   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 490   '';
 491
 492 }
 493
 494 use Data::Dumper;
 495 sub process_import_results {
 496   my $job = shift;
 497   my $param = shift;
 498   $param->{'job'} = $job;
 499   warn Dumper($param) if $DEBUG;
 500   my $gatewaynum = delete $param->{'gatewaynum'};
 501   if ( $gatewaynum ) {
 502     $param->{'gateway'} = FS::payment_gateway->by_key($gatewaynum)
 503       or die "gatewaynum '$gatewaynum' not found\n";
 504     delete $param->{'format'}; # to avoid confusion
 505   }
 506
 507   my $file = $param->{'uploaded_files'} or die "no files provided\n";
 508   $file =~ s/^(\w+):([\.\w]+)$/$2/;
 509   my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc;
 510   open( $param->{'filehandle'},
 511         '<',
 512         "$dir/$file" )
 513       or die "unable to open '$file'.\n";
 514
 515   my $error;
 516   if ( $param->{gateway} ) {
 517     $error = FS::pay_batch->import_from_gateway(%$param);
 518   } else {
 519     my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n";
 520     my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n";
 521     $error = $batch->import_results($param);
 522   }
 523   unlink $file;
 524   die $error if $error;
 525 }
 526
 527 =item import_from_gateway [ OPTIONS ]
 528
 529 Import results from a L<FS::payment_gateway>, using Business::BatchPayment,
 530 and apply them.  GATEWAY must use the Business::BatchPayment namespace.
 531
 532 This is a class method, since results can be applied to any batch.
 533 The 'batch-reconsider' option determines whether an already-approved
 534 or declined payment can have its status changed by a later import.
 535
 536 OPTIONS may include:
 537
 538 - gateway: the L<FS::payment_gateway>, required
 539 - filehandle: a file name or handle to use as a data source.
 540 - job: an L<FS::queue> object to update with progress messages.
 541
 542 =cut
 543
 544 sub import_from_gateway {
 545   my $class = shift;
 546   my %opt = @_;
 547   my $gateway = $opt{'gateway'};
 548   my $conf = FS::Conf->new;
 549
 550   # unavoidable duplication with import_batch, for now
 551   local $SIG{HUP} = 'IGNORE';
 552   local $SIG{INT} = 'IGNORE';
 553   local $SIG{QUIT} = 'IGNORE';
 554   local $SIG{TERM} = 'IGNORE';
 555   local $SIG{TSTP} = 'IGNORE';
 556   local $SIG{PIPE} = 'IGNORE';
 557
 558   my $oldAutoCommit = $FS::UID::AutoCommit;
 559   local $FS::UID::AutoCommit = 0;
 560   my $dbh = dbh;
 561
 562   my $job = delete($opt{'job'});
 563   $job->update_statustext(0) if $job;
 564
 565   my $total = 0;
 566   return "import_from_gateway requires a payment_gateway"
 567     unless eval { $gateway->isa('FS::payment_gateway') };
 568
 569   my %proc_opt = (
 570     'input' => $opt{'filehandle'}, # will do nothing if it's empty
 571     # any other constructor options go here
 572   );
 573
 574   my @item_errors;
 575   my $errors_not_fatal = $conf->config('batch-errors_not_fatal');
 576   if ( $errors_not_fatal ) {
 577     # construct error trap
 578     $proc_opt{'on_parse_error'} = sub {
 579       my ($self, $line, $error) = @_;
 580       push @item_errors, "  '$line'\n$error";
 581     };
 582   }
 583
 584   my $processor = $gateway->batch_processor(%proc_opt);
 585
 586   my @processor_ids = map { $_->processor_id }
 587                         qsearch({
 588                           'table' => 'pay_batch',
 589                           'hashref' => { 'status' => 'I' },
 590                           'extra_sql' => q( AND processor_id != '' AND processor_id IS NOT NULL)
 591                         });
 592
 593   my @batches = $processor->receive(@processor_ids);
 594
 595   my $num = 0;
 596
 597   my $total_items = sum( map{$_->count} @batches);
 598
 599   # whether to allow items to change status
 600   my $reconsider = $conf->exists('batch-reconsider');
 601
 602   # mutex all affected batches
 603   my %pay_batch_for_update;
 604
 605   my %bop2payby = (CC => 'CARD', ECHECK => 'CHEK');
 606
 607   BATCH: foreach my $batch (@batches) {
 608
 609     my %incoming_batch = (
 610       'CARD' => {},
 611       'CHEK' => {},
 612     );
 613
 614     ITEM: foreach my $item ($batch->elements) {
 615
 616       my $cust_pay_batch; # the new batch entry (with status)
 617       my $pay_batch; # the freeside batch it belongs to
 618       my $payby; # CARD or CHEK
 619       my $error;
 620
 621       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
 622         ':' . ($item->authorization || '') .
 623         ':' . ($item->order_number || '');
 624
 625       if ( $batch->incoming ) {
 626         # This is a one-way batch.
 627         # Locate the customer, find an open batch correct for them,
 628         # create a payment.  Don't bother creating a cust_pay_batch
 629         # entry.
 630         my $cust_main;
 631         if ( defined($item->customer_id)
 632              and $item->customer_id =~ /^\d+$/
 633              and $item->customer_id > 0 ) {
 634
 635           $cust_main = FS::cust_main->by_key($item->customer_id)
 636                        || qsearchs('cust_main',
 637                          { 'agent_custid' => $item->customer_id }
 638                        );
 639           if ( !$cust_main ) {
 640             push @item_errors, "Unknown customer_id ".$item->customer_id;
 641             next ITEM;
 642           }
 643         }
 644         else {
 645           push @item_errors, "Illegal customer_id '".$item->customer_id."'";
 646           next ITEM;
 647         }
 648         # it may also make sense to allow selecting the customer by
 649         # invoice_number, but no modules currently work that way
 650
 651         $payby = $bop2payby{ $item->payment_type };
 652         my $agentnum = '';
 653         $agentnum = $cust_main->agentnum if $conf->exists('batch-spoolagent');
 654
 655         # create a batch if necessary
 656         $pay_batch = $incoming_batch{$payby}->{$agentnum} ||=
 657           FS::pay_batch->new({
 658               status    => 'R', # pre-resolve it
 659               payby     => $payby,
 660               agentnum  => $agentnum,
 661               upload    => time,
 662               title     => $batch->batch_id,
 663           });
 664         if ( !$pay_batch->batchnum ) {
 665           $error = $pay_batch->insert;
 666           die $error if $error; # can't do anything if this fails
 667         }
 668
 669         if ( !$item->approved ) {
 670           $error ||= "payment rejected - ".$item->error_message;
 671         }
 672         if ( !defined($item->amount) or $item->amount <= 0 ) {
 673           $error ||= "no amount in item $num";
 674         }
 675
 676         my $payinfo;
 677         if ( $item->check_number ) {
 678           $payby = 'BILL'; # right?
 679           $payinfo = $item->check_number;
 680         } elsif ( $item->assigned_token ) {
 681           $payinfo = $item->assigned_token;
 682         }
 683         # create the payment
 684         my $cust_pay = FS::cust_pay->new(
 685           {
 686             custnum     => $cust_main->custnum,
 687             _date       => $item->payment_date->epoch,
 688             paid        => sprintf('%.2f',$item->amount),
 689             payby       => $payby,
 690             invnum      => $item->invoice_number,
 691             batchnum    => $pay_batch->batchnum,
 692             payinfo     => $payinfo,
 693             gatewaynum  => $gateway->gatewaynum,
 694             processor   => $gateway->gateway_module,
 695             auth        => $item->authorization,
 696             order_number => $item->order_number,
 697           }
 698         );
 699         $error ||= $cust_pay->insert;
 700         eval { $cust_main->apply_payments };
 701         $error ||= $@;
 702
 703         if ( $error ) {
 704           push @item_errors, 'Payment for customer '.$item->customer_id."\n$error";
 705         }
 706
 707       } else {
 708         # This is a request/reply batch.
 709         # Locate the request (the 'tid' attribute is the paybatchnum).
 710         my $paybatchnum = $item->tid;
 711         $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum);
 712         if (!$cust_pay_batch) {
 713           push @item_errors, "paybatchnum $paybatchnum not found";
 714           next ITEM;
 715         }
 716         $payby = $cust_pay_batch->payby;
 717
 718         my $batchnum = $cust_pay_batch->batchnum;
 719         if ( $batch->batch_id and $batch->batch_id != $batchnum ) {
 720           warn "batch ID ".$batch->batch_id.
 721                 " does not match batchnum ".$cust_pay_batch->batchnum."\n";
 722         }
 723
 724         # lock the batch and check its status
 725         $pay_batch = FS::pay_batch->by_key($batchnum);
 726         $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update;
 727         if ( $pay_batch->status ne 'I' and !$reconsider ) {
 728           $error = "batch $batchnum no longer in transit";
 729         }
 730
 731         if ( $cust_pay_batch->status ) {
 732           my $new_status = $item->approved ? 'approved' : 'declined';
 733           if ( lc( $cust_pay_batch->status ) eq $new_status ) {
 734             # already imported with this status, so don't touch
 735             next ITEM;
 736           }
 737           elsif ( !$reconsider ) {
 738             # then we're not allowed to change its status, so bail out
 739             $error = "paybatchnum ".$item->tid.
 740             " already resolved with status '". $cust_pay_batch->status . "'";
 741           }
 742         }
 743
 744         if ( $error ) {
 745           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 746           next ITEM;
 747         }
 748
 749         my $new_payinfo;
 750         # update payinfo, if needed
 751         if ( $item->assigned_token ) {
 752           $new_payinfo = $item->assigned_token;
 753         } elsif ( $payby eq 'CARD' ) {
 754           $new_payinfo = $item->card_number if $item->card_number;
 755         } else { #$payby eq 'CHEK'
 756           $new_payinfo = $item->account_number . '@' . $item->routing_code
 757             if $item->account_number;
 758         }
 759         $cust_pay_batch->set('payinfo', $new_payinfo) if $new_payinfo;
 760
 761         # set "paid" pseudo-field (transfers to cust_pay) to the actual amount
 762         # paid, if the batch says it's different from the amount requested
 763         if ( defined $item->amount ) {
 764           $cust_pay_batch->set('paid', $item->amount);
 765         } else {
 766           $cust_pay_batch->set('paid', $cust_pay_batch->amount);
 767         }
 768
 769         # set payment date to when it was processed
 770         $cust_pay_batch->_date($item->payment_date->epoch)
 771           if $item->payment_date;
 772
 773         # approval status
 774         if ( $item->approved ) {
 775           # follow Billing_Realtime format for paybatch
 776           $error = $cust_pay_batch->approve(
 777             'gatewaynum'    => $gateway->gatewaynum,
 778             'processor'     => $gateway->gateway_module,
 779             'auth'          => $item->authorization,
 780             'order_number'  => $item->order_number,
 781           );
 782           $total += $cust_pay_batch->paid;
 783         }
 784         else {
 785           $error = $cust_pay_batch->decline($item->error_message,
 786                                             $item->failure_status);
 787         }
 788
 789         if ( $error ) {
 790           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 791           next ITEM;
 792         }
 793       } # $batch->incoming
 794
 795       $num++;
 796       $job->update_statustext(int(100 * $num/( $total_items ) ),
 797         'Importing batch items')
 798       if $job;
 799
 800     } #foreach $item
 801
 802   } #foreach $batch (input batch, not pay_batch)
 803
 804   # Format an error message
 805   if ( @item_errors ) {
 806     my $error_text = join("\n\n",
 807       "Errors during batch import: ".scalar(@item_errors),
 808       @item_errors
 809     );
 810     if ( $errors_not_fatal ) {
 811       my $message = "Import from gateway ".$gateway->label." errors: ".$error_text;
 812       my $log = FS::Log->new('FS::pay_batch::import_from_gateway');
 813       $log->error($message);
 814     } else {
 815       # Bail out.
 816       $dbh->rollback if $oldAutoCommit;
 817       die $error_text;
 818     }
 819   }
 820
 821   # Auto-resolve (with brute-force error handling)
 822   foreach my $pay_batch (values %pay_batch_for_update) {
 823     my $error = $pay_batch->try_to_resolve;
 824
 825     if ( $error ) {
 826       $dbh->rollback if $oldAutoCommit;
 827       return $error;
 828     }
 829   }
 830
 831   $dbh->commit if $oldAutoCommit;
 832   return;
 833 }
 834
 835 =item try_to_resolve
 836
 837 Resolve this batch if possible.  A batch can be resolved if all of its
 838 entries have status.  If the system options 'batch-auto_resolve_days'
 839 and 'batch-auto_resolve_status' are set, and the batch's download date is
 840 at least (batch-auto_resolve_days) before the current time, then it can
 841 be auto-resolved; entries with no status will be approved or declined
 842 according to the batch-auto_resolve_status setting.
 843
 844 =cut
 845
 846 sub try_to_resolve {
 847   my $self = shift;
 848   my $conf = FS::Conf->new;;
 849
 850   return if $self->status ne 'I';
 851
 852   my @unresolved = qsearch('cust_pay_batch',
 853     {
 854       batchnum => $self->batchnum,
 855       status   => ''
 856     }
 857   );
 858
 859   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
 860     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 861     # either 'approve' or 'decline'
 862     my $action = $conf->config('batch-auto_resolve_status') || '';
 863     return unless
 864       length($days) and
 865       length($action) and
 866       time > ($self->download + 86400 * $days)
 867       ;
 868
 869     my $error;
 870     foreach my $cpb (@unresolved) {
 871       if ( $action eq 'approve' ) {
 872         # approve it for the full amount
 873         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 874         $error = $cpb->approve($self->batchnum);
 875       }
 876       elsif ( $action eq 'decline' ) {
 877         $error = $cpb->decline('No response from processor');
 878       }
 879       return $error if $error;
 880     }
 881   } elsif ( @unresolved ) {
 882     # auto resolve is not enabled, and we're not ready to resolve
 883     return;
 884   }
 885
 886   $self->set_status('R');
 887 }
 888
 889 =item prepare_for_export
 890
 891 Prepare the batch to be exported.  This will:
 892 - Set the status to "in transit".
 893 - If batch-increment_expiration is set and this is a credit card batch,
 894   increment expiration dates that are in the past.
 895 - If this is the first download for this batch, adjust payment amounts to
 896   not be greater than the customer's current balance.  If the customer's
 897   balance is zero, the entry will be removed (caution: all cust_pay_batch
 898   entries might be removed!)
 899
 900 Use this within a transaction.
 901
 902 =cut
 903
 904 sub prepare_for_export {
 905   my $self = shift;
 906   my $conf = FS::Conf->new;
 907   my $curuser = $FS::CurrentUser::CurrentUser;
 908
 909   my $first_download;
 910   my $status = $self->status;
 911   if ($status eq 'O') {
 912     $first_download = 1;
 913   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 914     $first_download = 0;
 915   } elsif ($status eq 'R' &&
 916            $curuser->access_right('Redownload resolved batches')) {
 917     $first_download = 0;
 918   } else {
 919     die "No pending batch.\n";
 920   }
 921
 922   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 923                        $self->cust_pay_batch;
 924
 925   # handle batch-increment_expiration option
 926   if ( $self->payby eq 'CARD' ) {
 927     my ($cmon, $cyear) = (localtime(time))[4,5];
 928     foreach (@cust_pay_batch) {
 929       my $etime = str2time($_->exp) or next;
 930       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 931       if( $conf->exists('batch-increment_expiration') ) {
 932         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 933         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 934       }
 935       my $error = $_->replace;
 936       return $error if $error;
 937     }
 938   }
 939
 940   if ($first_download) { #remove or reduce entries if customer's balance changed
 941
 942     foreach my $cust_pay_batch (@cust_pay_batch) {
 943
 944       my $balance = $cust_pay_batch->cust_main->balance;
 945       if ($balance <= 0) { # then don't charge this customer
 946         my $error = $cust_pay_batch->unbatch_and_delete;
 947         return $error if $error;
 948       } elsif ($balance < $cust_pay_batch->amount) {
 949         # reduce the charge to the remaining balance
 950         $cust_pay_batch->amount($balance);
 951         my $error = $cust_pay_batch->replace;
 952         return $error if $error;
 953       }
 954       # else $balance >= $cust_pay_batch->amount
 955     }
 956
 957     #need to do this after unbatch_and_delete
 958     my $error = $self->set_status('I');
 959     return "error updating pay_batch status: $error\n" if $error;
 960
 961   } #if $first_download
 962
 963   '';
 964 }
 965
 966 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 967
 968 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 969 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 970
 971 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 972 L<Business::BatchPayment> module.
 973
 974 Returns the text of the batch.  If batch contains no cust_pay_batch entries
 975 (or has them all removed by L</prepare_for_export>) then the batch will be
 976 resolved and a blank string will be returned.  All other errors are fatal.
 977
 978 =cut
 979
 980 sub export_batch {
 981   my $self = shift;
 982   my %opt = @_;
 983
 984   my $conf = new FS::Conf;
 985   my $batch;
 986
 987   my $gateway = $opt{'gateway'};
 988   if ( $gateway ) {
 989     # welcome to the future
 990     my $fh = IO::Scalar->new(\$batch);
 991     $self->export_to_gateway($gateway, 'file' => $fh);
 992     return $batch;
 993   }
 994
 995   my $format = $opt{'format'} || $conf->config('batch-default_format')
 996     or die "No batch format configured\n";
 997
 998   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 999
1000   &{$info->{'init'}}($conf, $self->agentnum) if exists($info->{'init'});
1001
1002   my $oldAutoCommit = $FS::UID::AutoCommit;
1003   local $FS::UID::AutoCommit = 0;
1004   my $dbh = dbh;
1005
1006   my $error = $self->prepare_for_export;
1007
1008   die $error if $error;
1009   my $batchtotal = 0;
1010   my $batchcount = 0;
1011
1012   my @cust_pay_batch = $self->cust_pay_batch;
1013   unless (@cust_pay_batch) {
1014     # if it's empty, just resolve the batch
1015     $self->set_status('R');
1016     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1017     return '';
1018   }
1019
1020   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
1021
1022   my $h = $info->{'header'};
1023   if (ref($h) eq 'CODE') {
1024     $batch .= &$h($self, \@cust_pay_batch). $delim;
1025   } else {
1026     $batch .= $h. $delim;
1027   }
1028
1029   foreach my $cust_pay_batch (@cust_pay_batch) {
1030     $batchcount++;
1031     $batchtotal += $cust_pay_batch->amount;
1032     $batch .=
1033     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
1034     $delim;
1035   }
1036
1037   my $f = $info->{'footer'};
1038   if (ref($f) eq 'CODE') {
1039     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
1040   } else {
1041     $batch .= $f. $delim;
1042   }
1043
1044   if ($info->{'autopost'}) {
1045     my $error = &{$info->{'autopost'}}($self, $batch);
1046     if($error) {
1047       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1048       die $error;
1049     }
1050   }
1051
1052   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1053   return $batch;
1054 }
1055
1056 =item export_to_gateway GATEWAY OPTIONS
1057
1058 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
1059 that gateway via Business::BatchPayment. OPTIONS may include:
1060
1061 - file: override the default transport and write to this file (name or handle)
1062
1063 If batch contains no cust_pay_batch entries (or has them all removed by
1064 L</prepare_for_export>) then nothing will be transported (or written to
1065 the override file) and the batch will be resolved.
1066
1067 =cut
1068
1069 sub export_to_gateway {
1070
1071   my ($self, $gateway, %opt) = @_;
1072
1073   my $oldAutoCommit = $FS::UID::AutoCommit;
1074   local $FS::UID::AutoCommit = 0;
1075   my $dbh = dbh;
1076
1077   my $error = $self->prepare_for_export;
1078   die $error if $error;
1079
1080   my %proc_opt = (
1081     'output' => $opt{'file'}, # will do nothing if it's empty
1082     # any other constructor options go here
1083   );
1084   my $processor = $gateway->batch_processor(%proc_opt);
1085
1086   my @items = map { $_->request_item } $self->cust_pay_batch;
1087   unless (@items) {
1088     # if it's empty, just resolve the batch
1089     $self->set_status('R');
1090     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1091     return '';
1092   }
1093
1094   try {
1095     my $batch = Business::BatchPayment->create(Batch =>
1096       batch_id  => $self->batchnum,
1097       items     => \@items
1098     );
1099     $processor->submit($batch);
1100
1101     if ($batch->processor_id) {
1102       $self->set('processor_id',$batch->processor_id);
1103       $self->replace;
1104     }
1105   } catch {
1106     $dbh->rollback if $oldAutoCommit;
1107     die $_;
1108   };
1109
1110   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1111   '';
1112 }
1113
1114 sub manual_approve {
1115   my $self = shift;
1116   my $date = time;
1117   my %opt = @_;
1118   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1119   my $conf = FS::Conf->new;
1120   return 'manual batch approval disabled'
1121     if ( ! $conf->exists('batch-manual_approval') );
1122   return 'batch already resolved' if $self->status eq 'R';
1123   return 'batch not yet submitted' if $self->status eq 'O';
1124
1125   local $SIG{HUP} = 'IGNORE';
1126   local $SIG{INT} = 'IGNORE';
1127   local $SIG{QUIT} = 'IGNORE';
1128   local $SIG{TERM} = 'IGNORE';
1129   local $SIG{TSTP} = 'IGNORE';
1130   local $SIG{PIPE} = 'IGNORE';
1131
1132   my $oldAutoCommit = $FS::UID::AutoCommit;
1133   local $FS::UID::AutoCommit = 0;
1134   my $dbh = dbh;
1135
1136   my $payments = 0;
1137   foreach my $cust_pay_batch (
1138     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1139         status   => '' })
1140   ) {
1141     my $new_cust_pay_batch = new FS::cust_pay_batch {
1142       $cust_pay_batch->hash,
1143       'paid'    => $cust_pay_batch->amount,
1144       '_date'   => $date,
1145       'usernum' => $usernum,
1146     };
1147     my $error = $new_cust_pay_batch->approve();
1148     # there are no approval options here (authorization, order_number, etc.)
1149     # because the transaction wasn't really approved
1150     if ( $error ) {
1151       $dbh->rollback;
1152       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1153     }
1154     $payments++;
1155   }
1156   $self->set_status('R');
1157   $dbh->commit;
1158   return;
1159 }
1160
1161 =item batch_download_formats
1162
1163 returns a hash of batch download formats.
1164
1165 my %download_formats = FS::pay_batch::batch_download_formats;
1166
1167 =cut
1168
1169 sub batch_download_formats {
1170
1171   my @formats = (
1172     ''              =>
1173         'Default batch mode',
1174     'NACHA'         =>
1175         '94 byte NACHA',
1176     'csv-td_canada_trust-merchant_pc_batch' =>
1177         'CSV file for TD Canada Trust Merchant PC Batch',
1178     'csv-chase_canada-E-xactBatch' =>
1179         'CSV file for Chase Canada E-xactBatch',
1180     'PAP'           =>
1181         '80 byte file for TD Canada Trust PAP Batch',
1182     'BoM'           =>
1183         'Bank of Montreal ECA batch',
1184     'ach-spiritone' =>
1185         'Spiritone ACH batch',
1186     'paymentech'    =>
1187         'XML file for Chase Paymentech',
1188     'RBC'           =>
1189         'Royal Bank of Canada PDS batch',
1190     'td_eft1464'    =>
1191         '1464 byte file for TD Commercial Banking EFT',
1192     'eft_canada'    =>
1193         'EFT Canada CSV batch',
1194     'CIBC'          =>
1195         '80 byte file for Canadian Imperial Bank of Commerce',
1196     # insert new batch formats here
1197   );
1198
1199 }
1200
1201 =item batch_download_formats
1202
1203 returns a hash of batch download formats.
1204
1205 my %download_formats = FS::pay_batch::batch_download_formats;
1206
1207 =cut
1208
1209 sub can_handle_electronic_refunds {
1210
1211   my $self = shift;
1212   my $format = shift;
1213   my $conf = new FS::Conf;
1214
1215   tie my %download_formats, 'Tie::IxHash', batch_download_formats;
1216
1217   my %paybatch_mods = (
1218     'NACHA'                                 => 'nacha',
1219     'csv-td_canada_trust-merchant_pc_batch' => 'td_canada_trust',
1220     'csv-chase_canada-E-xactBatch'          => 'chase-canada',
1221     'PAP'                                   => 'PAP',
1222     'BoM'                                   => 'BoM',
1223     'ach-spiritone'                         => 'ach_spiritone',
1224     'paymentech'                            => 'paymentech',
1225     'RBC'                                   => 'RBC',
1226     'td_eft1464'                            => 'td_eft1464',
1227     'eft_canada'                            => 'eft_canada',
1228     'CIBC'                                  => 'CIBC',
1229   );
1230
1231   %download_formats = ( $format => $download_formats{$format}, ) if $format;
1232
1233   foreach my $key (keys %download_formats) {
1234     my $mod = "FS::pay_batch::".$paybatch_mods{$key};
1235     if ($mod->can('can_handle_credits')) {
1236       return '1' if $conf->exists('batchconfig-'.$key);
1237     }
1238   }
1239
1240   return;
1241
1242 }
1243
1244 use FS::upgrade_journal;
1245 sub _upgrade_data {
1246
1247   # check if there are any pending batch refunds and no download format configured
1248   # that allows electronic refunds.
1249   unless ( FS::upgrade_journal->is_done('removed_refunds_nodownload_format') ) {
1250
1251     ## get a list of all refunds in batches.
1252     my $extrasql = " LEFT JOIN pay_batch USING ( batchnum ) WHERE cust_pay_batch.paycode = 'C' AND pay_batch.download IS NULL AND pay_batch.type = 'DEBIT' ";
1253
1254     my @batch_refunds = qsearch({
1255       'table'   => 'cust_pay_batch',
1256       'select'  => 'cust_pay_batch.*',
1257       'extra_sql' => $extrasql,
1258     });
1259
1260     my $replace_error;
1261
1262     if (@batch_refunds) {
1263       warn "found ".scalar @batch_refunds." batch refunds.\n";
1264       warn "Searching for their cust refunds...\n" if (scalar @batch_refunds > 0);
1265
1266       my $oldAutoCommit = $FS::UID::AutoCommit;
1267       local $FS::UID::AutoCommit = 0;
1268       my $dbh = dbh;
1269
1270       ## move refund to credit batch.
1271       foreach my $cust_pay_batch (@batch_refunds) {
1272         my $payby = $cust_pay_batch->payby eq "CARD" ? "CARD" : "CHEK";
1273
1274         my %pay_batch = (
1275           'status' => 'O',
1276           'payby'  => $payby,
1277           'type'   => 'CREDIT',
1278         );
1279
1280         my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
1281
1282         unless ( $pay_batch ) {
1283           $pay_batch = new FS::pay_batch \%pay_batch;
1284           my $error = $pay_batch->insert;
1285           if ( $error ) {
1286             $dbh->rollback if $oldAutoCommit;
1287             warn "error creating a $payby credit batch: $error\n";
1288           }
1289         }
1290
1291         $cust_pay_batch->batchnum($pay_batch->batchnum);
1292         $replace_error = $cust_pay_batch->replace();
1293         if ( $replace_error ) {
1294           $dbh->rollback if $oldAutoCommit;
1295           warn "Unable to move credit to a credit batch: $replace_error";
1296         }
1297         else {
1298           warn "Moved cust pay credit ".$cust_pay_batch->paybatchnum." to ".$cust_pay_batch->payby." credit batch ".$cust_pay_batch->batchnum."\n";
1299         }
1300       }
1301     } #end @batch_refunds
1302     else { warn "No batch refunds found\n"; }
1303
1304     FS::upgrade_journal->set_done('removed_refunds_nodownload_format') unless $replace_error;
1305   }
1306
1307   # Set up configuration for gateways that have a Business::BatchPayment
1308   # module.
1309
1310   eval "use Class::MOP;";
1311   if ( $@ ) {
1312     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1313     return;
1314   }
1315   my $conf = FS::Conf->new;
1316   for my $format (keys %export_info) {
1317     my $mod = "FS::pay_batch::$format";
1318     if ( $mod->can('_upgrade_gateway')
1319         and $conf->exists("batchconfig-$format") ) {
1320
1321       local $@;
1322       my ($module, %gw_options) = $mod->_upgrade_gateway;
1323       my $gateway = FS::payment_gateway->new({
1324           gateway_namespace => 'Business::BatchPayment',
1325           gateway_module    => $module,
1326       });
1327       my $error = $gateway->insert(%gw_options);
1328       if ( $error ) {
1329         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1330         next;
1331       }
1332
1333       # test whether it loads
1334       my $processor = eval { $gateway->batch_processor };
1335       if ( !$processor ) {
1336         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1337         # if not, remove it so it doesn't hang around and break things
1338         $gateway->delete;
1339       }
1340       else {
1341         # remove the batchconfig-*
1342         warn "Created Business::BatchPayment gateway '".$gateway->label.
1343              "' for '$format' batch processing.\n";
1344         $conf->delete("batchconfig-$format");
1345
1346         # and if appropriate, make it the system default
1347         for my $payby (qw(CARD CHEK)) {
1348           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1349             warn "Setting as default for $payby.\n";
1350             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1351             $conf->delete("batch-fixed_format-$payby");
1352           }
1353         }
1354       } # if $processor
1355     } #if can('_upgrade_gateway') and batchconfig-$format
1356   } #for $format
1357
1358   '';
1359 }
1360
1361 =back
1362
1363 =head1 BUGS
1364
1365 status is somewhat redundant now that download and upload exist
1366
1367 =head1 SEE ALSO
1368
1369 L<FS::Record>, schema.html from the base documentation.
1370
1371 =cut
1372
1373 1;
1374