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::Misc qw(send_email); # for error notification
  14 use FS::Record qw( dbh qsearch qsearchs );
  15 use FS::Conf;
  16 use FS::cust_pay;
  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 $mail_on_error = $conf->config('batch-errors_to');
 571   if ( $mail_on_error ) {
 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 ( $mail_on_error ) {
 805       my $subject = "Batch import errors"; #?
 806       my $body = "Import from gateway ".$gateway->label."\n".$error_text;
 807       send_email(
 808         to      => $mail_on_error,
 809         from    => $conf->invoice_from_full(),
 810         subject => $subject,
 811         body    => $body,
 812       );
 813     } else {
 814       # Bail out.
 815       $dbh->rollback if $oldAutoCommit;
 816       die $error_text;
 817     }
 818   }
 819
 820   # Auto-resolve (with brute-force error handling)
 821   foreach my $pay_batch (values %pay_batch_for_update) {
 822     my $error = $pay_batch->try_to_resolve;
 823
 824     if ( $error ) {
 825       $dbh->rollback if $oldAutoCommit;
 826       return $error;
 827     }
 828   }
 829
 830   $dbh->commit if $oldAutoCommit;
 831   return;
 832 }
 833
 834 =item try_to_resolve
 835
 836 Resolve this batch if possible.  A batch can be resolved if all of its
 837 entries have status.  If the system options 'batch-auto_resolve_days'
 838 and 'batch-auto_resolve_status' are set, and the batch's download date is
 839 at least (batch-auto_resolve_days) before the current time, then it can
 840 be auto-resolved; entries with no status will be approved or declined
 841 according to the batch-auto_resolve_status setting.
 842
 843 =cut
 844
 845 sub try_to_resolve {
 846   my $self = shift;
 847   my $conf = FS::Conf->new;;
 848
 849   return if $self->status ne 'I';
 850
 851   my @unresolved = qsearch('cust_pay_batch',
 852     {
 853       batchnum => $self->batchnum,
 854       status   => ''
 855     }
 856   );
 857
 858   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
 859     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 860     # either 'approve' or 'decline'
 861     my $action = $conf->config('batch-auto_resolve_status') || '';
 862     return unless
 863       length($days) and
 864       length($action) and
 865       time > ($self->download + 86400 * $days)
 866       ;
 867
 868     my $error;
 869     foreach my $cpb (@unresolved) {
 870       if ( $action eq 'approve' ) {
 871         # approve it for the full amount
 872         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 873         $error = $cpb->approve($self->batchnum);
 874       }
 875       elsif ( $action eq 'decline' ) {
 876         $error = $cpb->decline('No response from processor');
 877       }
 878       return $error if $error;
 879     }
 880   } elsif ( @unresolved ) {
 881     # auto resolve is not enabled, and we're not ready to resolve
 882     return;
 883   }
 884
 885   $self->set_status('R');
 886 }
 887
 888 =item prepare_for_export
 889
 890 Prepare the batch to be exported.  This will:
 891 - Set the status to "in transit".
 892 - If batch-increment_expiration is set and this is a credit card batch,
 893   increment expiration dates that are in the past.
 894 - If this is the first download for this batch, adjust payment amounts to
 895   not be greater than the customer's current balance.  If the customer's
 896   balance is zero, the entry will be removed.
 897
 898 Use this within a transaction.
 899
 900 =cut
 901
 902 sub prepare_for_export {
 903   my $self = shift;
 904   my $conf = FS::Conf->new;
 905   my $curuser = $FS::CurrentUser::CurrentUser;
 906
 907   my $first_download;
 908   my $status = $self->status;
 909   if ($status eq 'O') {
 910     $first_download = 1;
 911     my $error = $self->set_status('I');
 912     return "error updating pay_batch status: $error\n" if $error;
 913   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 914     $first_download = 0;
 915   } elsif ($status eq 'R' &&
 916            $curuser->access_right('Redownload resolved batches')) {
 917     $first_download = 0;
 918   } else {
 919     die "No pending batch.\n";
 920   }
 921
 922   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 923                        $self->cust_pay_batch;
 924
 925   # handle batch-increment_expiration option
 926   if ( $self->payby eq 'CARD' ) {
 927     my ($cmon, $cyear) = (localtime(time))[4,5];
 928     foreach (@cust_pay_batch) {
 929       my $etime = str2time($_->exp) or next;
 930       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 931       if( $conf->exists('batch-increment_expiration') ) {
 932         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 933         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 934       }
 935       my $error = $_->replace;
 936       return $error if $error;
 937     }
 938   }
 939
 940   if ($first_download) { #remove or reduce entries if customer's balance changed
 941
 942     foreach my $cust_pay_batch (@cust_pay_batch) {
 943
 944       my $balance = $cust_pay_batch->cust_main->balance;
 945       if ($balance <= 0) { # then don't charge this customer
 946         my $error = $cust_pay_batch->delete;
 947         return $error if $error;
 948       } elsif ($balance < $cust_pay_batch->amount) {
 949         # reduce the charge to the remaining balance
 950         $cust_pay_batch->amount($balance);
 951         my $error = $cust_pay_batch->replace;
 952         return $error if $error;
 953       }
 954       # else $balance >= $cust_pay_batch->amount
 955     }
 956   } #if $first_download
 957
 958   '';
 959 }
 960
 961 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 962
 963 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 964 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 965
 966 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 967 L<Business::BatchPayment> module.
 968
 969 =cut
 970
 971 sub export_batch {
 972   my $self = shift;
 973   my %opt = @_;
 974
 975   my $conf = new FS::Conf;
 976   my $batch;
 977
 978   my $gateway = $opt{'gateway'};
 979   if ( $gateway ) {
 980     # welcome to the future
 981     my $fh = IO::Scalar->new(\$batch);
 982     $self->export_to_gateway($gateway, 'file' => $fh);
 983     return $batch;
 984   }
 985
 986   my $format = $opt{'format'} || $conf->config('batch-default_format')
 987     or die "No batch format configured\n";
 988
 989   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 990
 991   &{$info->{'init'}}($conf, $self->agentnum) if exists($info->{'init'});
 992
 993   my $oldAutoCommit = $FS::UID::AutoCommit;
 994   local $FS::UID::AutoCommit = 0;
 995   my $dbh = dbh;
 996
 997   my $error = $self->prepare_for_export;
 998
 999   die $error if $error;
1000   my $batchtotal = 0;
1001   my $batchcount = 0;
1002
1003   my @cust_pay_batch = $self->cust_pay_batch;
1004
1005   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
1006
1007   my $h = $info->{'header'};
1008   if (ref($h) eq 'CODE') {
1009     $batch .= &$h($self, \@cust_pay_batch). $delim;
1010   } else {
1011     $batch .= $h. $delim;
1012   }
1013
1014   foreach my $cust_pay_batch (@cust_pay_batch) {
1015     $batchcount++;
1016     $batchtotal += $cust_pay_batch->amount;
1017     $batch .=
1018     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
1019     $delim;
1020   }
1021
1022   my $f = $info->{'footer'};
1023   if (ref($f) eq 'CODE') {
1024     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
1025   } else {
1026     $batch .= $f. $delim;
1027   }
1028
1029   if ($info->{'autopost'}) {
1030     my $error = &{$info->{'autopost'}}($self, $batch);
1031     if($error) {
1032       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1033       die $error;
1034     }
1035   }
1036
1037   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1038   return $batch;
1039 }
1040
1041 =item export_to_gateway GATEWAY OPTIONS
1042
1043 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
1044 that gateway via Business::BatchPayment. OPTIONS may include:
1045
1046 - file: override the default transport and write to this file (name or handle)
1047
1048 =cut
1049
1050 sub export_to_gateway {
1051
1052   my ($self, $gateway, %opt) = @_;
1053
1054   my $oldAutoCommit = $FS::UID::AutoCommit;
1055   local $FS::UID::AutoCommit = 0;
1056   my $dbh = dbh;
1057
1058   my $error = $self->prepare_for_export;
1059   die $error if $error;
1060
1061   my %proc_opt = (
1062     'output' => $opt{'file'}, # will do nothing if it's empty
1063     # any other constructor options go here
1064   );
1065   my $processor = $gateway->batch_processor(%proc_opt);
1066
1067   my @items = map { $_->request_item } $self->cust_pay_batch;
1068   my $batch = Business::BatchPayment->create(Batch =>
1069     batch_id  => $self->batchnum,
1070     items     => \@items
1071   );
1072   $processor->submit($batch);
1073
1074   if ($batch->processor_id) {
1075     $self->set('processor_id',$batch->processor_id);
1076     $self->replace;
1077   }
1078
1079   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1080   '';
1081 }
1082
1083 sub manual_approve {
1084   my $self = shift;
1085   my $date = time;
1086   my %opt = @_;
1087   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1088   my $conf = FS::Conf->new;
1089   return 'manual batch approval disabled'
1090     if ( ! $conf->exists('batch-manual_approval') );
1091   return 'batch already resolved' if $self->status eq 'R';
1092   return 'batch not yet submitted' if $self->status eq 'O';
1093
1094   local $SIG{HUP} = 'IGNORE';
1095   local $SIG{INT} = 'IGNORE';
1096   local $SIG{QUIT} = 'IGNORE';
1097   local $SIG{TERM} = 'IGNORE';
1098   local $SIG{TSTP} = 'IGNORE';
1099   local $SIG{PIPE} = 'IGNORE';
1100
1101   my $oldAutoCommit = $FS::UID::AutoCommit;
1102   local $FS::UID::AutoCommit = 0;
1103   my $dbh = dbh;
1104
1105   my $payments = 0;
1106   foreach my $cust_pay_batch (
1107     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1108         status   => '' })
1109   ) {
1110     my $new_cust_pay_batch = new FS::cust_pay_batch {
1111       $cust_pay_batch->hash,
1112       'paid'    => $cust_pay_batch->amount,
1113       '_date'   => $date,
1114       'usernum' => $usernum,
1115     };
1116     my $error = $new_cust_pay_batch->approve();
1117     # there are no approval options here (authorization, order_number, etc.)
1118     # because the transaction wasn't really approved
1119     if ( $error ) {
1120       $dbh->rollback;
1121       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1122     }
1123     $payments++;
1124   }
1125   $self->set_status('R');
1126   $dbh->commit;
1127   return;
1128 }
1129
1130 sub _upgrade_data {
1131   # Set up configuration for gateways that have a Business::BatchPayment
1132   # module.
1133
1134   eval "use Class::MOP;";
1135   if ( $@ ) {
1136     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1137     return;
1138   }
1139   my $conf = FS::Conf->new;
1140   for my $format (keys %export_info) {
1141     my $mod = "FS::pay_batch::$format";
1142     if ( $mod->can('_upgrade_gateway')
1143         and $conf->exists("batchconfig-$format") ) {
1144
1145       local $@;
1146       my ($module, %gw_options) = $mod->_upgrade_gateway;
1147       my $gateway = FS::payment_gateway->new({
1148           gateway_namespace => 'Business::BatchPayment',
1149           gateway_module    => $module,
1150       });
1151       my $error = $gateway->insert(%gw_options);
1152       if ( $error ) {
1153         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1154         next;
1155       }
1156
1157       # test whether it loads
1158       my $processor = eval { $gateway->batch_processor };
1159       if ( !$processor ) {
1160         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1161         # if not, remove it so it doesn't hang around and break things
1162         $gateway->delete;
1163       }
1164       else {
1165         # remove the batchconfig-*
1166         warn "Created Business::BatchPayment gateway '".$gateway->label.
1167              "' for '$format' batch processing.\n";
1168         $conf->delete("batchconfig-$format");
1169
1170         # and if appropriate, make it the system default
1171         for my $payby (qw(CARD CHEK)) {
1172           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1173             warn "Setting as default for $payby.\n";
1174             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1175             $conf->delete("batch-fixed_format-$payby");
1176           }
1177         }
1178       } # if $processor
1179     } #if can('_upgrade_gateway') and batchconfig-$format
1180   } #for $format
1181
1182   '';
1183 }
1184
1185 =back
1186
1187 =head1 BUGS
1188
1189 status is somewhat redundant now that download and upload exist
1190
1191 =head1 SEE ALSO
1192
1193 L<FS::Record>, schema.html from the base documentation.
1194
1195 =cut
1196
1197 1;
1198