FS/FS/pay_batch.pm

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