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