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