FS/FS/pay_batch.pm

   1 package FS::pay_batch;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG %import_info %export_info $conf );
   5 use Time::Local;
   6 use Text::CSV_XS;
   7 use FS::Record qw( dbh qsearch qsearchs );
   8 use FS::Conf;
   9 use FS::cust_pay;
  10 use FS::agent;
  11 use Date::Parse qw(str2time);
  12 use Business::CreditCard qw(cardtype);
  13 use Scalar::Util 'blessed';
  14 use IO::Scalar;
  15
  16 @ISA = qw(FS::Record);
  17
  18 =head1 NAME
  19
  20 FS::pay_batch - Object methods for pay_batch records
  21
  22 =head1 SYNOPSIS
  23
  24   use FS::pay_batch;
  25
  26   $record = new FS::pay_batch \%hash;
  27   $record = new FS::pay_batch { 'column' => 'value' };
  28
  29   $error = $record->insert;
  30
  31   $error = $new_record->replace($old_record);
  32
  33   $error = $record->delete;
  34
  35   $error = $record->check;
  36
  37 =head1 DESCRIPTION
  38
  39 An FS::pay_batch object represents an payment batch.  FS::pay_batch inherits
  40 from FS::Record.  The following fields are currently supported:
  41
  42 =over 4
  43
  44 =item batchnum - primary key
  45
  46 =item agentnum - optional agent number for agent batches
  47
  48 =item payby - CARD or CHEK
  49
  50 =item status - O (Open), I (In-transit), or R (Resolved)
  51
  52 =item download -
  53
  54 =item upload -
  55
  56
  57 =back
  58
  59 =head1 METHODS
  60
  61 =over 4
  62
  63 =item new HASHREF
  64
  65 Creates a new batch.  To add the batch to the database, see L<"insert">.
  66
  67 Note that this stores the hash reference, not a distinct copy of the hash it
  68 points to.  You can ask the object for a copy with the I<hash> method.
  69
  70 =cut
  71
  72 # the new method can be inherited from FS::Record, if a table method is defined
  73
  74 sub table { 'pay_batch'; }
  75
  76 =item insert
  77
  78 Adds this record to the database.  If there is an error, returns the error,
  79 otherwise returns false.
  80
  81 =cut
  82
  83 # the insert method can be inherited from FS::Record
  84
  85 =item delete
  86
  87 Delete this record from the database.
  88
  89 =cut
  90
  91 # the delete method can be inherited from FS::Record
  92
  93 =item replace OLD_RECORD
  94
  95 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  96 returns the error, otherwise returns false.
  97
  98 =cut
  99
 100 # the replace method can be inherited from FS::Record
 101
 102 =item check
 103
 104 Checks all fields to make sure this is a valid batch.  If there is
 105 an error, returns the error, otherwise returns false.  Called by the insert
 106 and replace methods.
 107
 108 =cut
 109
 110 # the check method should currently be supplied - FS::Record contains some
 111 # data checking routines
 112
 113 sub check {
 114   my $self = shift;
 115
 116   my $error =
 117     $self->ut_numbern('batchnum')
 118     || $self->ut_enum('payby', [ 'CARD', 'CHEK' ])
 119     || $self->ut_enum('status', [ 'O', 'I', 'R' ])
 120     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
 121   ;
 122   return $error if $error;
 123
 124   $self->SUPER::check;
 125 }
 126
 127 =item agent
 128
 129 Returns the L<FS::agent> object for this batch.
 130
 131 =cut
 132
 133 sub agent {
 134   qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
 135 }
 136
 137 =item cust_pay_batch
 138
 139 Returns all L<FS::cust_pay_batch> objects for this batch.
 140
 141 =cut
 142
 143 sub cust_pay_batch {
 144   qsearch('cust_pay_batch', { 'batchnum' => $_[0]->batchnum });
 145 }
 146
 147 =item rebalance
 148
 149 =cut
 150
 151 sub rebalance {
 152   my $self = shift;
 153 }
 154
 155 =item set_status
 156
 157 =cut
 158
 159 sub set_status {
 160   my $self = shift;
 161   $self->status(shift);
 162   $self->download(time)
 163     if $self->status eq 'I' && ! $self->download;
 164   $self->upload(time)
 165     if $self->status eq 'R' && ! $self->upload;
 166   $self->replace();
 167 }
 168
 169 # further false laziness
 170
 171 %import_info = %export_info = ();
 172 foreach my $INC (@INC) {
 173   warn "globbing $INC/FS/pay_batch/*.pm\n" if $DEBUG;
 174   foreach my $file ( glob("$INC/FS/pay_batch/*.pm")) {
 175     warn "attempting to load batch format from $file\n" if $DEBUG;
 176     $file =~ /\/(\w+)\.pm$/;
 177     next if !$1;
 178     my $mod = $1;
 179     my ($import, $export, $name) =
 180       eval "use FS::pay_batch::$mod;
 181            ( \\%FS::pay_batch::$mod\::import_info,
 182              \\%FS::pay_batch::$mod\::export_info,
 183              \$FS::pay_batch::$mod\::name)";
 184     $name ||= $mod; # in case it's not defined
 185     if( $@) {
 186       # in FS::cdr this is a die, not a warn.  That's probably a bug.
 187       warn "error using FS::pay_batch::$mod (skipping): $@\n";
 188       next;
 189     }
 190     if(!keys(%$import)) {
 191       warn "no \%import_info found in FS::pay_batch::$mod (skipping)\n";
 192     }
 193     else {
 194       $import_info{$name} = $import;
 195     }
 196     if(!keys(%$export)) {
 197       warn "no \%export_info found in FS::pay_batch::$mod (skipping)\n";
 198     }
 199     else {
 200       $export_info{$name} = $export;
 201     }
 202   }
 203 }
 204
 205 =item import_results OPTION => VALUE, ...
 206
 207 Import batch results.
 208
 209 Options are:
 210
 211 I<filehandle> - open filehandle of results file.
 212
 213 I<format> - an L<FS::pay_batch> module
 214
 215 I<gateway> - an L<FS::payment_gateway> object for a batch gateway.  This
 216 takes precedence over I<format>.
 217
 218 =cut
 219
 220 sub import_results {
 221   my $self = shift;
 222
 223   my $param = ref($_[0]) ? shift : { @_ };
 224   my $fh = $param->{'filehandle'};
 225   my $job = $param->{'job'};
 226   $job->update_statustext(0) if $job;
 227
 228   my $gateway = $param->{'gateway'};
 229   if ( $gateway ) {
 230     return $self->import_from_gateway($gateway, 'file' => $fh, 'job' => $job);
 231   }
 232
 233   my $format = $param->{'format'};
 234   my $info = $import_info{$format}
 235     or die "unknown format $format";
 236
 237   my $conf = new FS::Conf;
 238
 239   my $filetype            = $info->{'filetype'};      # CSV, fixed, variable
 240   my @fields              = @{ $info->{'fields'}};
 241   my $formatre            = $info->{'formatre'};      # for fixed
 242   my $parse               = $info->{'parse'};         # for variable
 243   my @all_values;
 244   my $begin_condition     = $info->{'begin_condition'};
 245   my $end_condition       = $info->{'end_condition'};
 246   my $end_hook            = $info->{'end_hook'};
 247   my $skip_condition      = $info->{'skip_condition'};
 248   my $hook                = $info->{'hook'};
 249   my $approved_condition  = $info->{'approved'};
 250   my $declined_condition  = $info->{'declined'};
 251   my $close_condition     = $info->{'close_condition'};
 252
 253   my $csv = new Text::CSV_XS;
 254
 255   local $SIG{HUP} = 'IGNORE';
 256   local $SIG{INT} = 'IGNORE';
 257   local $SIG{QUIT} = 'IGNORE';
 258   local $SIG{TERM} = 'IGNORE';
 259   local $SIG{TSTP} = 'IGNORE';
 260   local $SIG{PIPE} = 'IGNORE';
 261
 262   my $oldAutoCommit = $FS::UID::AutoCommit;
 263   local $FS::UID::AutoCommit = 0;
 264   my $dbh = dbh;
 265
 266   my $reself = $self->select_for_update;
 267
 268   if ( $reself->status ne 'I'
 269       and !$conf->exists('batch-manual_approval') ) {
 270     $dbh->rollback if $oldAutoCommit;
 271     return "batchnum ". $self->batchnum. "no longer in transit";
 272   }
 273
 274   my $total = 0;
 275   my $line;
 276
 277   if ($filetype eq 'XML') {
 278     eval "use XML::Simple";
 279     die $@ if $@;
 280     my @xmlkeys = @{ $info->{'xmlkeys'} };  # for XML
 281     my $xmlrow  = $info->{'xmlrow'};        # also for XML
 282
 283     # Do everything differently.
 284     my $data = XML::Simple::XMLin($fh, KeepRoot => 1);
 285     my $rows = $data;
 286     # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ]
 287     $rows = $rows->{$_} foreach( @$xmlrow );
 288     if(!defined($rows)) {
 289       $dbh->rollback if $oldAutoCommit;
 290       return "can't find rows in XML file";
 291     }
 292     $rows = [ $rows ] if ref($rows) ne 'ARRAY';
 293     foreach my $row (@$rows) {
 294       push @all_values, [ @{$row}{@xmlkeys}, $row ];
 295     }
 296   }
 297   else {
 298     while ( defined($line=<$fh>) ) {
 299
 300       next if $line =~ /^\s*$/; #skip blank lines
 301
 302       if ($filetype eq "CSV") {
 303         $csv->parse($line) or do {
 304           $dbh->rollback if $oldAutoCommit;
 305           return "can't parse: ". $csv->error_input();
 306         };
 307         push @all_values, [ $csv->fields(), $line ];
 308       }elsif ($filetype eq 'fixed'){
 309         my @values = ( $line =~ /$formatre/ );
 310         unless (@values) {
 311           $dbh->rollback if $oldAutoCommit;
 312           return "can't parse: ". $line;
 313         };
 314         push @values, $line;
 315         push @all_values, \@values;
 316       }
 317       elsif ($filetype eq 'variable') {
 318         my @values = ( eval { $parse->($self, $line) } );
 319         if( $@ ) {
 320           $dbh->rollback if $oldAutoCommit;
 321           return $@;
 322         };
 323         push @values, $line;
 324         push @all_values, \@values;
 325       }
 326       else {
 327         $dbh->rollback if $oldAutoCommit;
 328         return "Unknown file type $filetype";
 329       }
 330     }
 331   }
 332
 333   my $num = 0;
 334   foreach (@all_values) {
 335     if($job) {
 336       $num++;
 337       $job->update_statustext(int(100 * $num/scalar(@all_values)));
 338     }
 339     my @values = @$_;
 340
 341     my %hash;
 342     my $line = pop @values;
 343     foreach my $field ( @fields ) {
 344       my $value = shift @values;
 345       next unless $field;
 346       $hash{$field} = $value;
 347     }
 348
 349     if ( defined($begin_condition) ) {
 350       if ( &{$begin_condition}(\%hash, $line) ) {
 351         undef $begin_condition;
 352       }
 353       else {
 354         next;
 355       }
 356     }
 357
 358     if ( defined($end_condition) and &{$end_condition}(\%hash, $line) ) {
 359       my $error;
 360       $error = &{$end_hook}(\%hash, $total, $line) if defined($end_hook);
 361       if ( $error ) {
 362         $dbh->rollback if $oldAutoCommit;
 363         return $error;
 364       }
 365       last;
 366     }
 367
 368     if ( defined($skip_condition) and &{$skip_condition}(\%hash, $line) ) {
 369       next;
 370     }
 371
 372     my $cust_pay_batch =
 373       qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
 374     unless ( $cust_pay_batch ) {
 375       return "unknown paybatchnum $hash{'paybatchnum'}\n";
 376     }
 377     my $custnum = $cust_pay_batch->custnum,
 378     my $payby = $cust_pay_batch->payby,
 379
 380     &{$hook}(\%hash, $cust_pay_batch->hashref);
 381
 382     my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
 383
 384     my $error = '';
 385     if ( &{$approved_condition}(\%hash) ) {
 386
 387       foreach ('paid', '_date', 'payinfo') {
 388         $new_cust_pay_batch->$_($hash{$_}) if $hash{$_};
 389       }
 390       $error = $new_cust_pay_batch->approve($hash{'paybatch'} || $self->batchnum);
 391       $total += $hash{'paid'};
 392
 393     } elsif ( &{$declined_condition}(\%hash) ) {
 394
 395       $error = $new_cust_pay_batch->decline;
 396
 397     }
 398
 399     if ( $error ) {
 400       $dbh->rollback if $oldAutoCommit;
 401       return $error;
 402     }
 403
 404     # purge CVV when the batch is processed
 405     if ( $payby =~ /^(CARD|DCRD)$/ ) {
 406       my $payinfo = $hash{'payinfo'} || $cust_pay_batch->payinfo;
 407       if ( ! grep { $_ eq cardtype($payinfo) }
 408           $conf->config('cvv-save') ) {
 409         $new_cust_pay_batch->cust_main->remove_cvv;
 410       }
 411
 412     }
 413
 414   } # foreach (@all_values)
 415
 416   my $close = 1;
 417   if ( defined($close_condition) ) {
 418     # Allow the module to decide whether to close the batch.
 419     # $close_condition can also die() to abort the whole import.
 420     $close = eval { $close_condition->($self) };
 421     if ( $@ ) {
 422       $dbh->rollback;
 423       die $@;
 424     }
 425   }
 426   if ( $close ) {
 427     my $error = $self->set_status('R');
 428     if ( $error ) {
 429       $dbh->rollback if $oldAutoCommit;
 430       return $error;
 431     }
 432   }
 433
 434   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 435   '';
 436
 437 }
 438
 439 use MIME::Base64;
 440 use Storable 'thaw';
 441 use Data::Dumper;
 442 sub process_import_results {
 443   my $job = shift;
 444   my $param = thaw(decode_base64(shift));
 445   $param->{'job'} = $job;
 446   warn Dumper($param) if $DEBUG;
 447   my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n";
 448   my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n";
 449
 450   my $gatewaynum = delete $param->{'gatewaynum'};
 451   if ( $gatewaynum ) {
 452     $param->{'gateway'} = FS::payment_gateway->by_key($gatewaynum)
 453       or die "gatewaynum '$gatewaynum' not found\n";
 454     delete $param->{'format'}; # to avoid confusion
 455   }
 456
 457   my $file = $param->{'uploaded_files'} or die "no files provided\n";
 458   $file =~ s/^(\w+):([\.\w]+)$/$2/;
 459   my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc;
 460   open( $param->{'filehandle'},
 461         '<',
 462         "$dir/$file" )
 463       or die "unable to open '$file'.\n";
 464   my $error = $batch->import_results($param);
 465   unlink $file;
 466   die $error if $error;
 467 }
 468
 469 =item import_from_gateway GATEWAY [ OPTIONS ]
 470
 471 Import results from a L<FS::payment_gateway>, using Business::BatchPayment,
 472 and apply them.  GATEWAY must use the Business::BatchPayment namespace.
 473
 474 This is a class method, since results can be applied to any batch.
 475 The 'batch-reconsider' option determines whether an already-approved
 476 or declined payment can have its status changed by a later import.
 477
 478 OPTIONS may include:
 479
 480 - file: a file name or handle to use as a data source.
 481 - job: an L<FS::queue> object to update with progress messages.
 482
 483 =cut
 484
 485 sub import_from_gateway {
 486   my $class = shift;
 487   my $gateway = shift;
 488   my %opt = @_;
 489   my $conf = FS::Conf->new;
 490
 491   # unavoidable duplication with import_batch, for now
 492   local $SIG{HUP} = 'IGNORE';
 493   local $SIG{INT} = 'IGNORE';
 494   local $SIG{QUIT} = 'IGNORE';
 495   local $SIG{TERM} = 'IGNORE';
 496   local $SIG{TSTP} = 'IGNORE';
 497   local $SIG{PIPE} = 'IGNORE';
 498
 499   my $oldAutoCommit = $FS::UID::AutoCommit;
 500   local $FS::UID::AutoCommit = 0;
 501   my $dbh = dbh;
 502
 503   my $job = delete($opt{'job'});
 504   $job->update_statustext(0) if $job;
 505
 506   my $total = 0;
 507   return "import_from_gateway requires a payment_gateway"
 508     unless eval { $gateway->isa('FS::payment_gateway') };
 509
 510   my %proc_opt = (
 511     'input' => $opt{'file'}, # will do nothing if it's empty
 512     # any other constructor options go here
 513   );
 514
 515   my $processor = $gateway->batch_processor(%proc_opt);
 516
 517   my @batches = $processor->receive;
 518   my $error;
 519   my $num = 0;
 520
 521   # whether to allow items to change status
 522   my $reconsider = $conf->exists('batch-reconsider');
 523
 524   # mutex all affected batches
 525   my %pay_batch_for_update;
 526
 527   BATCH: foreach my $batch (@batches) {
 528     ITEM: foreach my $item ($batch->elements) {
 529       # cust_pay_batch.paybatchnum should be in the 'tid' attribute
 530       my $paybatchnum = $item->tid;
 531       my $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum);
 532       if (!$cust_pay_batch) {
 533         # XXX for one-way batch protocol this needs to create new payments
 534         $error = "unknown paybatchnum $paybatchnum";
 535         last ITEM;
 536       }
 537
 538       my $batchnum = $cust_pay_batch->batchnum;
 539       if ( $batch->batch_id and $batch->batch_id != $batchnum ) {
 540         warn "batch ID ".$batch->batch_id.
 541               " does not match batchnum ".$cust_pay_batch->batchnum."\n";
 542       }
 543
 544       # lock the batch and check its status
 545       my $pay_batch = FS::pay_batch->by_key($batchnum);
 546       $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update;
 547       if ( $pay_batch->status ne 'I' and !$reconsider ) {
 548         $error = "batch $batchnum no longer in transit";
 549         last ITEM;
 550       }
 551
 552       if ( $cust_pay_batch->status ) {
 553         my $new_status = $item->approved ? 'approved' : 'declined';
 554         if ( lc( $cust_pay_batch->status ) eq $new_status ) {
 555           # already imported with this status, so don't touch
 556           next ITEM;
 557         }
 558         elsif ( !$reconsider ) {
 559           # then we're not allowed to change its status, so bail out
 560           $error = "paybatchnum ".$item->tid.
 561             " already resolved with status '". $cust_pay_batch->status . "'";
 562           last ITEM;
 563         }
 564       }
 565
 566       # create a new cust_pay_batch with whatever information we got back
 567       my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
 568       my $new_payinfo;
 569       # update payinfo, if needed
 570       if ( $item->assigned_token ) {
 571         $new_payinfo = $item->assigned_token;
 572       } elsif ( $cust_pay_batch->payby eq 'CARD' ) {
 573         $new_payinfo = $item->card_number if $item->card_number;
 574       } else { #$cust_pay_batch->payby eq 'CHEK'
 575         $new_payinfo = $item->account_number . '@' . $item->routing_code
 576           if $item->account_number;
 577       }
 578       $new_cust_pay_batch->payinfo($new_payinfo) if $new_payinfo;
 579
 580       # set "paid" pseudo-field (transfers to cust_pay) to the actual amount
 581       # paid, if the batch says it's different from the amount requested
 582       if ( defined $item->amount ) {
 583         $new_cust_pay_batch->paid($item->amount);
 584       } else {
 585         $new_cust_pay_batch->paid($cust_pay_batch->amount);
 586       }
 587
 588       # set payment date to when it was processed
 589       $new_cust_pay_batch->_date($item->payment_date->epoch)
 590         if $item->payment_date;
 591
 592       # approval status
 593       if ( $item->approved ) {
 594         # follow Billing_Realtime format for paybatch
 595         my $paybatch = $gateway->gatewaynum .
 596           '-' .
 597           $gateway->gateway_module .
 598           ':' .
 599           $item->authorization .
 600           ':' .
 601           $item->order_number;
 602
 603         $error = $new_cust_pay_batch->approve($paybatch);
 604         $total += $new_cust_pay_batch->paid;
 605       }
 606       else {
 607         $error = $new_cust_pay_batch->decline($item->error_message);
 608       }
 609       last ITEM if $error;
 610       $num++;
 611       $job->update_statustext(int(100 * $num/( $batch->count + 1 ) ),
 612         'Importing batch items')
 613         if $job;
 614     } #foreach $item
 615
 616     if ( $error ) {
 617       $dbh->rollback if $oldAutoCommit;
 618       return $error;
 619     }
 620
 621   } #foreach $batch (input batch, not pay_batch)
 622
 623   # Auto-resolve
 624   foreach my $pay_batch (values %pay_batch_for_update) {
 625     $error = $pay_batch->try_to_resolve;
 626
 627     if ( $error ) {
 628       $dbh->rollback if $oldAutoCommit;
 629       return $error;
 630     }
 631   }
 632
 633   $dbh->commit if $oldAutoCommit;
 634   return;
 635 }
 636
 637 =item try_to_resolve
 638
 639 Resolve this batch if possible.  A batch can be resolved if all of its
 640 entries have a status.  If the system options 'batch-auto_resolve_days'
 641 and 'batch-auto_resolve_status' are set, and the batch's download date is
 642 at least (batch-auto_resolve_days) before the current time, then it can
 643 be auto-resolved; entries with no status will be approved or declined
 644 according to the batch-auto_resolve_status setting.
 645
 646 =cut
 647
 648 sub try_to_resolve {
 649   my $self = shift;
 650   my $conf = FS::Conf->new;;
 651
 652   return if $self->status ne 'I';
 653
 654   my @unresolved = qsearch('cust_pay_batch',
 655     {
 656       batchnum => $self->batchnum,
 657       status   => ''
 658     }
 659   );
 660
 661   if ( @unresolved ) {
 662     my $days = $conf->config('batch-auto_resolve_days') || '';
 663     # either 'approve' or 'decline'
 664     my $action = $conf->config('batch-auto_resolve_status') || '';
 665     return unless
 666       length($days) and
 667       length($action) and
 668       time > ($self->download + 86400 * $days)
 669       ;
 670
 671     my $error;
 672     foreach my $cpb (@unresolved) {
 673       if ( $action eq 'approve' ) {
 674         # approve it for the full amount
 675         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 676         $error = $cpb->approve($self->batchnum);
 677       }
 678       elsif ( $action eq 'decline' ) {
 679         $error = $cpb->decline('No response from processor');
 680       }
 681       return $error if $error;
 682     }
 683   }
 684
 685   $self->set_status('R');
 686 }
 687
 688 =item prepare_for_export
 689
 690 Prepare the batch to be exported.  This will:
 691 - Set the status to "in transit".
 692 - If batch-increment_expiration is set and this is a credit card batch,
 693   increment expiration dates that are in the past.
 694 - If this is the first download for this batch, adjust payment amounts to
 695   not be greater than the customer's current balance.  If the customer's
 696   balance is zero, the entry will be removed.
 697
 698 Use this within a transaction.
 699
 700 =cut
 701
 702 sub prepare_for_export {
 703   my $self = shift;
 704   my $conf = FS::Conf->new;
 705   my $curuser = $FS::CurrentUser::CurrentUser;
 706
 707   my $first_download;
 708   my $status = $self->status;
 709   if ($status eq 'O') {
 710     $first_download = 1;
 711     my $error = $self->set_status('I');
 712     return "error updating pay_batch status: $error\n" if $error;
 713   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 714     $first_download = 0;
 715   } else {
 716     die "No pending batch.\n";
 717   }
 718
 719   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 720                        $self->cust_pay_batch;
 721
 722   # handle batch-increment_expiration option
 723   if ( $self->payby eq 'CARD' ) {
 724     my ($cmon, $cyear) = (localtime(time))[4,5];
 725     foreach (@cust_pay_batch) {
 726       my $etime = str2time($_->exp) or next;
 727       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 728       if( $conf->exists('batch-increment_expiration') ) {
 729         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 730         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 731       }
 732       my $error = $_->replace;
 733       return $error if $error;
 734     }
 735   }
 736
 737   if ($first_download) { #remove or reduce entries if customer's balance changed
 738
 739     foreach my $cust_pay_batch (@cust_pay_batch) {
 740
 741       my $balance = $cust_pay_batch->cust_main->balance;
 742       if ($balance <= 0) { # then don't charge this customer
 743         my $error = $cust_pay_batch->delete;
 744         return $error if $error;
 745       } elsif ($balance < $cust_pay_batch->amount) {
 746         # reduce the charge to the remaining balance
 747         $cust_pay_batch->amount($balance);
 748         my $error = $cust_pay_batch->replace;
 749         return $error if $error;
 750       }
 751       # else $balance >= $cust_pay_batch->amount
 752     }
 753   } #if $first_download
 754
 755   '';
 756 }
 757
 758 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 759
 760 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 761 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 762
 763 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 764 L<Business::BatchPayment> module.
 765
 766 =cut
 767
 768 sub export_batch {
 769   my $self = shift;
 770   my %opt = @_;
 771
 772   my $conf = new FS::Conf;
 773   my $batch;
 774
 775   my $gateway = $opt{'gateway'};
 776   if ( $gateway ) {
 777     # welcome to the future
 778     my $fh = IO::Scalar->new(\$batch);
 779     $self->export_to_gateway($gateway, 'file' => $fh);
 780     return $batch;
 781   }
 782
 783   my $format = $opt{'format'} || $conf->config('batch-default_format')
 784     or die "No batch format configured\n";
 785
 786   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 787
 788   &{$info->{'init'}}($conf) if exists($info->{'init'});
 789
 790   my $oldAutoCommit = $FS::UID::AutoCommit;
 791   local $FS::UID::AutoCommit = 0;
 792   my $dbh = dbh;
 793
 794   my $error = $self->prepare_for_export;
 795
 796   die $error if $error;
 797   my $batchtotal = 0;
 798   my $batchcount = 0;
 799
 800   my @cust_pay_batch = $self->cust_pay_batch;
 801
 802   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 803
 804   my $h = $info->{'header'};
 805   if (ref($h) eq 'CODE') {
 806     $batch .= &$h($self, \@cust_pay_batch). $delim;
 807   } else {
 808     $batch .= $h. $delim;
 809   }
 810
 811   foreach my $cust_pay_batch (@cust_pay_batch) {
 812     $batchcount++;
 813     $batchtotal += $cust_pay_batch->amount;
 814     $batch .=
 815     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
 816     $delim;
 817   }
 818
 819   my $f = $info->{'footer'};
 820   if (ref($f) eq 'CODE') {
 821     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
 822   } else {
 823     $batch .= $f. $delim;
 824   }
 825
 826   if ($info->{'autopost'}) {
 827     my $error = &{$info->{'autopost'}}($self, $batch);
 828     if($error) {
 829       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 830       die $error;
 831     }
 832   }
 833
 834   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 835   return $batch;
 836 }
 837
 838 =item export_to_gateway GATEWAY OPTIONS
 839
 840 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
 841 that gateway via Business::BatchPayment. OPTIONS may include:
 842
 843 - file: override the default transport and write to this file (name or handle)
 844
 845 =cut
 846
 847 sub export_to_gateway {
 848
 849   my ($self, $gateway, %opt) = @_;
 850
 851   my $oldAutoCommit = $FS::UID::AutoCommit;
 852   local $FS::UID::AutoCommit = 0;
 853   my $dbh = dbh;
 854
 855   my $error = $self->prepare_for_export;
 856   die $error if $error;
 857
 858   my %proc_opt = (
 859     'output' => $opt{'file'}, # will do nothing if it's empty
 860     # any other constructor options go here
 861   );
 862   my $processor = $gateway->batch_processor(%proc_opt);
 863
 864   my @items = map { $_->request_item } $self->cust_pay_batch;
 865   my $batch = Business::BatchPayment->create(Batch =>
 866     batch_id  => $self->batchnum,
 867     items     => \@items
 868   );
 869   $processor->submit($batch);
 870
 871   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 872   '';
 873 }
 874
 875 sub manual_approve {
 876   my $self = shift;
 877   my $date = time;
 878   my %opt = @_;
 879   my $paybatch = $opt{'paybatch'} || $self->batchnum;
 880   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
 881   my $conf = FS::Conf->new;
 882   return 'manual batch approval disabled'
 883     if ( ! $conf->exists('batch-manual_approval') );
 884   return 'batch already resolved' if $self->status eq 'R';
 885   return 'batch not yet submitted' if $self->status eq 'O';
 886
 887   local $SIG{HUP} = 'IGNORE';
 888   local $SIG{INT} = 'IGNORE';
 889   local $SIG{QUIT} = 'IGNORE';
 890   local $SIG{TERM} = 'IGNORE';
 891   local $SIG{TSTP} = 'IGNORE';
 892   local $SIG{PIPE} = 'IGNORE';
 893
 894   my $oldAutoCommit = $FS::UID::AutoCommit;
 895   local $FS::UID::AutoCommit = 0;
 896   my $dbh = dbh;
 897
 898   my $payments = 0;
 899   foreach my $cust_pay_batch (
 900     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
 901         status   => '' })
 902   ) {
 903     my $new_cust_pay_batch = new FS::cust_pay_batch {
 904       $cust_pay_batch->hash,
 905       'paid'    => $cust_pay_batch->amount,
 906       '_date'   => $date,
 907       'usernum' => $usernum,
 908     };
 909     my $error = $new_cust_pay_batch->approve($paybatch);
 910     if ( $error ) {
 911       $dbh->rollback;
 912       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
 913     }
 914     $payments++;
 915   }
 916   $self->set_status('R');
 917   $dbh->commit;
 918   return;
 919 }
 920
 921 sub _upgrade_data {
 922   # Set up configuration for gateways that have a Business::BatchPayment
 923   # module.
 924
 925   eval "use Class::MOP;";
 926   if ( $@ ) {
 927     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
 928     return;
 929   }
 930   my $conf = FS::Conf->new;
 931   for my $format (keys %export_info) {
 932     my $mod = "FS::pay_batch::$format";
 933     if ( $mod->can('_upgrade_gateway')
 934         and length( $conf->config("batchconfig-$format") ) ) {
 935
 936       local $@;
 937       my ($module, %gw_options) = $mod->_upgrade_gateway;
 938       my $gateway = FS::payment_gateway->new({
 939           gateway_namespace => 'Business::BatchPayment',
 940           gateway_module    => $module,
 941       });
 942       my $error = $gateway->insert(%gw_options);
 943       if ( $error ) {
 944         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
 945         next;
 946       }
 947
 948       # test whether it loads
 949       my $processor = eval { $gateway->batch_processor };
 950       if ( !$processor ) {
 951         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
 952         # if not, remove it so it doesn't hang around and break things
 953         $gateway->delete;
 954       }
 955       else {
 956         # remove the batchconfig-*
 957         warn "Created Business::BatchPayment gateway '".$gateway->label.
 958              "' for '$format' batch processing.\n";
 959         $conf->delete("batchconfig-$format");
 960
 961         # and if appropriate, make it the system default
 962         for my $payby (qw(CARD CHEK)) {
 963           if ( $conf->config("batch-fixed_format-$payby") eq $format ) {
 964             warn "Setting as default for $payby.\n";
 965             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
 966             $conf->delete("batch-fixed_format-$payby");
 967           }
 968         }
 969       } # if $processor
 970     } #if can('_upgrade_gateway') and batchconfig-$format
 971   } #for $format
 972
 973   '';
 974 }
 975
 976 =back
 977
 978 =head1 BUGS
 979
 980 status is somewhat redundant now that download and upload exist
 981
 982 =head1 SEE ALSO
 983
 984 L<FS::Record>, schema.html from the base documentation.
 985
 986 =cut
 987
 988 1;
 989