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