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 and $conf->exists('batch-auto_resolve_days') ) {
 811     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 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   } elsif ($status eq 'R' &&
 865            $curuser->access_right('Redownload resolved batches')) {
 866     $first_download = 0;
 867   } else {
 868     die "No pending batch.\n";
 869   }
 870
 871   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 872                        $self->cust_pay_batch;
 873
 874   # handle batch-increment_expiration option
 875   if ( $self->payby eq 'CARD' ) {
 876     my ($cmon, $cyear) = (localtime(time))[4,5];
 877     foreach (@cust_pay_batch) {
 878       my $etime = str2time($_->exp) or next;
 879       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 880       if( $conf->exists('batch-increment_expiration') ) {
 881         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 882         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 883       }
 884       my $error = $_->replace;
 885       return $error if $error;
 886     }
 887   }
 888
 889   if ($first_download) { #remove or reduce entries if customer's balance changed
 890
 891     foreach my $cust_pay_batch (@cust_pay_batch) {
 892
 893       my $balance = $cust_pay_batch->cust_main->balance;
 894       if ($balance <= 0) { # then don't charge this customer
 895         my $error = $cust_pay_batch->delete;
 896         return $error if $error;
 897       } elsif ($balance < $cust_pay_batch->amount) {
 898         # reduce the charge to the remaining balance
 899         $cust_pay_batch->amount($balance);
 900         my $error = $cust_pay_batch->replace;
 901         return $error if $error;
 902       }
 903       # else $balance >= $cust_pay_batch->amount
 904     }
 905   } #if $first_download
 906
 907   '';
 908 }
 909
 910 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 911
 912 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 913 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 914
 915 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 916 L<Business::BatchPayment> module.
 917
 918 =cut
 919
 920 sub export_batch {
 921   my $self = shift;
 922   my %opt = @_;
 923
 924   my $conf = new FS::Conf;
 925   my $batch;
 926
 927   my $gateway = $opt{'gateway'};
 928   if ( $gateway ) {
 929     # welcome to the future
 930     my $fh = IO::Scalar->new(\$batch);
 931     $self->export_to_gateway($gateway, 'file' => $fh);
 932     return $batch;
 933   }
 934
 935   my $format = $opt{'format'} || $conf->config('batch-default_format')
 936     or die "No batch format configured\n";
 937
 938   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 939
 940   &{$info->{'init'}}($conf) if exists($info->{'init'});
 941
 942   my $oldAutoCommit = $FS::UID::AutoCommit;
 943   local $FS::UID::AutoCommit = 0;
 944   my $dbh = dbh;
 945
 946   my $error = $self->prepare_for_export;
 947
 948   die $error if $error;
 949   my $batchtotal = 0;
 950   my $batchcount = 0;
 951
 952   my @cust_pay_batch = $self->cust_pay_batch;
 953
 954   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 955
 956   my $h = $info->{'header'};
 957   if (ref($h) eq 'CODE') {
 958     $batch .= &$h($self, \@cust_pay_batch). $delim;
 959   } else {
 960     $batch .= $h. $delim;
 961   }
 962
 963   foreach my $cust_pay_batch (@cust_pay_batch) {
 964     $batchcount++;
 965     $batchtotal += $cust_pay_batch->amount;
 966     $batch .=
 967     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
 968     $delim;
 969   }
 970
 971   my $f = $info->{'footer'};
 972   if (ref($f) eq 'CODE') {
 973     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
 974   } else {
 975     $batch .= $f. $delim;
 976   }
 977
 978   if ($info->{'autopost'}) {
 979     my $error = &{$info->{'autopost'}}($self, $batch);
 980     if($error) {
 981       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 982       die $error;
 983     }
 984   }
 985
 986   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 987   return $batch;
 988 }
 989
 990 =item export_to_gateway GATEWAY OPTIONS
 991
 992 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
 993 that gateway via Business::BatchPayment. OPTIONS may include:
 994
 995 - file: override the default transport and write to this file (name or handle)
 996
 997 =cut
 998
 999 sub export_to_gateway {
1000
1001   my ($self, $gateway, %opt) = @_;
1002
1003   my $oldAutoCommit = $FS::UID::AutoCommit;
1004   local $FS::UID::AutoCommit = 0;
1005   my $dbh = dbh;
1006
1007   my $error = $self->prepare_for_export;
1008   die $error if $error;
1009
1010   my %proc_opt = (
1011     'output' => $opt{'file'}, # will do nothing if it's empty
1012     # any other constructor options go here
1013   );
1014   my $processor = $gateway->batch_processor(%proc_opt);
1015
1016   my @items = map { $_->request_item } $self->cust_pay_batch;
1017   my $batch = Business::BatchPayment->create(Batch =>
1018     batch_id  => $self->batchnum,
1019     items     => \@items
1020   );
1021   $processor->submit($batch);
1022
1023   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1024   '';
1025 }
1026
1027 sub manual_approve {
1028   my $self = shift;
1029   my $date = time;
1030   my %opt = @_;
1031   my $paybatch = $opt{'paybatch'} || $self->batchnum;
1032   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1033   my $conf = FS::Conf->new;
1034   return 'manual batch approval disabled'
1035     if ( ! $conf->exists('batch-manual_approval') );
1036   return 'batch already resolved' if $self->status eq 'R';
1037   return 'batch not yet submitted' if $self->status eq 'O';
1038
1039   local $SIG{HUP} = 'IGNORE';
1040   local $SIG{INT} = 'IGNORE';
1041   local $SIG{QUIT} = 'IGNORE';
1042   local $SIG{TERM} = 'IGNORE';
1043   local $SIG{TSTP} = 'IGNORE';
1044   local $SIG{PIPE} = 'IGNORE';
1045
1046   my $oldAutoCommit = $FS::UID::AutoCommit;
1047   local $FS::UID::AutoCommit = 0;
1048   my $dbh = dbh;
1049
1050   my $payments = 0;
1051   foreach my $cust_pay_batch (
1052     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1053         status   => '' })
1054   ) {
1055     my $new_cust_pay_batch = new FS::cust_pay_batch {
1056       $cust_pay_batch->hash,
1057       'paid'    => $cust_pay_batch->amount,
1058       '_date'   => $date,
1059       'usernum' => $usernum,
1060     };
1061     my $error = $new_cust_pay_batch->approve($paybatch);
1062     if ( $error ) {
1063       $dbh->rollback;
1064       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1065     }
1066     $payments++;
1067   }
1068   $self->set_status('R');
1069   $dbh->commit;
1070   return;
1071 }
1072
1073 sub _upgrade_data {
1074   # Set up configuration for gateways that have a Business::BatchPayment
1075   # module.
1076
1077   eval "use Class::MOP;";
1078   if ( $@ ) {
1079     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1080     return;
1081   }
1082   my $conf = FS::Conf->new;
1083   for my $format (keys %export_info) {
1084     my $mod = "FS::pay_batch::$format";
1085     if ( $mod->can('_upgrade_gateway')
1086         and $conf->exists("batchconfig-$format") ) {
1087
1088       local $@;
1089       my ($module, %gw_options) = $mod->_upgrade_gateway;
1090       my $gateway = FS::payment_gateway->new({
1091           gateway_namespace => 'Business::BatchPayment',
1092           gateway_module    => $module,
1093       });
1094       my $error = $gateway->insert(%gw_options);
1095       if ( $error ) {
1096         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1097         next;
1098       }
1099
1100       # test whether it loads
1101       my $processor = eval { $gateway->batch_processor };
1102       if ( !$processor ) {
1103         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1104         # if not, remove it so it doesn't hang around and break things
1105         $gateway->delete;
1106       }
1107       else {
1108         # remove the batchconfig-*
1109         warn "Created Business::BatchPayment gateway '".$gateway->label.
1110              "' for '$format' batch processing.\n";
1111         $conf->delete("batchconfig-$format");
1112
1113         # and if appropriate, make it the system default
1114         for my $payby (qw(CARD CHEK)) {
1115           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1116             warn "Setting as default for $payby.\n";
1117             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1118             $conf->delete("batch-fixed_format-$payby");
1119           }
1120         }
1121       } # if $processor
1122     } #if can('_upgrade_gateway') and batchconfig-$format
1123   } #for $format
1124
1125   '';
1126 }
1127
1128 =back
1129
1130 =head1 BUGS
1131
1132 status is somewhat redundant now that download and upload exist
1133
1134 =head1 SEE ALSO
1135
1136 L<FS::Record>, schema.html from the base documentation.
1137
1138 =cut
1139
1140 1;
1141