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