FS/FS/pay_batch.pm

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