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