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