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);
 405       $total += $hash{'paid'};
 406
 407     } elsif ( &{$declined_condition}(\%hash) ) {
 408
 409       $error = $new_cust_pay_batch->decline($hash{'error_message'});;
 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       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
 576         ':' . $item->authorization .  ':' . $item->order_number;
 577
 578       if ( $batch->incoming ) {
 579         # This is a one-way batch.
 580         # Locate the customer, find an open batch correct for them,
 581         # create a payment.  Don't bother creating a cust_pay_batch
 582         # entry.
 583         my $cust_main;
 584         if ( defined($item->customer_id)
 585              and $item->customer_id =~ /^\d+$/
 586              and $item->customer_id > 0 ) {
 587
 588           $cust_main = FS::cust_main->by_key($item->customer_id)
 589                        || qsearchs('cust_main',
 590                          { 'agent_custid' => $item->customer_id }
 591                        );
 592           if ( !$cust_main ) {
 593             push @item_errors, "Unknown customer_id ".$item->customer_id;
 594             next ITEM;
 595           }
 596         }
 597         else {
 598           push @item_errors, "Illegal customer_id '".$item->customer_id."'";
 599           next ITEM;
 600         }
 601         # it may also make sense to allow selecting the customer by
 602         # invoice_number, but no modules currently work that way
 603
 604         $payby = $bop2payby{ $item->payment_type };
 605         my $agentnum = '';
 606         $agentnum = $cust_main->agentnum if $conf->exists('batch-spoolagent');
 607
 608         # create a batch if necessary
 609         $pay_batch = $incoming_batch{$payby}->{$agentnum} ||=
 610           FS::pay_batch->new({
 611               status    => 'R', # pre-resolve it
 612               payby     => $payby,
 613               agentnum  => $agentnum,
 614               upload    => time,
 615               title     => $batch->batch_id,
 616           });
 617         if ( !$pay_batch->batchnum ) {
 618           $error = $pay_batch->insert;
 619           die $error if $error; # can't do anything if this fails
 620         }
 621
 622         if ( !$item->approved ) {
 623           $error ||= "payment rejected - ".$item->error_message;
 624         }
 625         if ( !defined($item->amount) or $item->amount <= 0 ) {
 626           $error ||= "no amount in item $num";
 627         }
 628
 629         my $payinfo;
 630         if ( $item->check_number ) {
 631           $payby = 'BILL'; # right?
 632           $payinfo = $item->check_number;
 633         } elsif ( $item->assigned_token ) {
 634           $payinfo = $item->assigned_token;
 635         }
 636         # create the payment
 637         my $cust_pay = FS::cust_pay->new(
 638           {
 639             custnum     => $cust_main->custnum,
 640             _date       => $item->payment_date->epoch,
 641             paid        => sprintf('%.2f',$item->amount),
 642             payby       => $payby,
 643             invnum      => $item->invoice_number,
 644             batchnum    => $pay_batch->batchnum,
 645             payinfo     => $payinfo,
 646             gatewaynum  => $gateway->gatewaynum,
 647             processor   => $gateway->gateway_module,
 648             auth        => $item->authorization,
 649             order_number => $item->order_number,
 650           }
 651         );
 652         $error ||= $cust_pay->insert;
 653         eval { $cust_main->apply_payments };
 654         $error ||= $@;
 655
 656         if ( $error ) {
 657           push @item_errors, 'Payment for customer '.$item->customer_id."\n$error";
 658         }
 659
 660       } else {
 661         # This is a request/reply batch.
 662         # Locate the request (the 'tid' attribute is the paybatchnum).
 663         my $paybatchnum = $item->tid;
 664         $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum);
 665         if (!$cust_pay_batch) {
 666           push @item_errors, "paybatchnum $paybatchnum not found";
 667           next ITEM;
 668         }
 669         $payby = $cust_pay_batch->payby;
 670
 671         my $batchnum = $cust_pay_batch->batchnum;
 672         if ( $batch->batch_id and $batch->batch_id != $batchnum ) {
 673           warn "batch ID ".$batch->batch_id.
 674                 " does not match batchnum ".$cust_pay_batch->batchnum."\n";
 675         }
 676
 677         # lock the batch and check its status
 678         $pay_batch = FS::pay_batch->by_key($batchnum);
 679         $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update;
 680         if ( $pay_batch->status ne 'I' and !$reconsider ) {
 681           $error = "batch $batchnum no longer in transit";
 682         }
 683
 684         if ( $cust_pay_batch->status ) {
 685           my $new_status = $item->approved ? 'approved' : 'declined';
 686           if ( lc( $cust_pay_batch->status ) eq $new_status ) {
 687             # already imported with this status, so don't touch
 688             next ITEM;
 689           }
 690           elsif ( !$reconsider ) {
 691             # then we're not allowed to change its status, so bail out
 692             $error = "paybatchnum ".$item->tid.
 693             " already resolved with status '". $cust_pay_batch->status . "'";
 694           }
 695         }
 696
 697         if ( $error ) {
 698           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 699           next ITEM;
 700         }
 701
 702         my $new_payinfo;
 703         # update payinfo, if needed
 704         if ( $item->assigned_token ) {
 705           $new_payinfo = $item->assigned_token;
 706         } elsif ( $payby eq 'CARD' ) {
 707           $new_payinfo = $item->card_number if $item->card_number;
 708         } else { #$payby eq 'CHEK'
 709           $new_payinfo = $item->account_number . '@' . $item->routing_code
 710             if $item->account_number;
 711         }
 712         $cust_pay_batch->set('payinfo', $new_payinfo) if $new_payinfo;
 713
 714         # set "paid" pseudo-field (transfers to cust_pay) to the actual amount
 715         # paid, if the batch says it's different from the amount requested
 716         if ( defined $item->amount ) {
 717           $cust_pay_batch->set('paid', $item->amount);
 718         } else {
 719           $cust_pay_batch->set('paid', $cust_pay_batch->amount);
 720         }
 721
 722         # set payment date to when it was processed
 723         $cust_pay_batch->_date($item->payment_date->epoch)
 724           if $item->payment_date;
 725
 726         # approval status
 727         if ( $item->approved ) {
 728           # follow Billing_Realtime format for paybatch
 729           $error = $cust_pay_batch->approve(
 730             'gatewaynum'    => $gateway->gatewaynum,
 731             'processor'     => $gateway->gateway_module,
 732             'auth'          => $item->authorization,
 733             'order_number'  => $item->order_number,
 734           );
 735           $total += $cust_pay_batch->paid;
 736         }
 737         else {
 738           $error = $cust_pay_batch->decline($item->error_message);
 739         }
 740
 741         if ( $error ) {
 742           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 743           next ITEM;
 744         }
 745       } # $batch->incoming
 746
 747       $num++;
 748       $job->update_statustext(int(100 * $num/( $total_items ) ),
 749         'Importing batch items')
 750       if $job;
 751
 752     } #foreach $item
 753
 754   } #foreach $batch (input batch, not pay_batch)
 755
 756   # Format an error message
 757   if ( @item_errors ) {
 758     my $error_text = join("\n\n",
 759       "Errors during batch import: ".scalar(@item_errors),
 760       @item_errors
 761     );
 762     if ( $mail_on_error ) {
 763       my $subject = "Batch import errors"; #?
 764       my $body = "Import from gateway ".$gateway->label."\n".$error_text;
 765       send_email(
 766         to      => $mail_on_error,
 767         from    => $conf->config('invoice_from_name') ?
 768                    $conf->config('invoice_from_name') . ' <' .
 769                    $conf->config('invoice_from') . '>' :
 770                    $conf->config('invoice_from'),
 771         subject => $subject,
 772         body    => $body,
 773       );
 774     } else {
 775       # Bail out.
 776       $dbh->rollback if $oldAutoCommit;
 777       die $error_text;
 778     }
 779   }
 780
 781   # Auto-resolve (with brute-force error handling)
 782   foreach my $pay_batch (values %pay_batch_for_update) {
 783     my $error = $pay_batch->try_to_resolve;
 784
 785     if ( $error ) {
 786       $dbh->rollback if $oldAutoCommit;
 787       return $error;
 788     }
 789   }
 790
 791   $dbh->commit if $oldAutoCommit;
 792   return;
 793 }
 794
 795 =item try_to_resolve
 796
 797 Resolve this batch if possible.  A batch can be resolved if all of its
 798 entries have status.  If the system options 'batch-auto_resolve_days'
 799 and 'batch-auto_resolve_status' are set, and the batch's download date is
 800 at least (batch-auto_resolve_days) before the current time, then it can
 801 be auto-resolved; entries with no status will be approved or declined
 802 according to the batch-auto_resolve_status setting.
 803
 804 =cut
 805
 806 sub try_to_resolve {
 807   my $self = shift;
 808   my $conf = FS::Conf->new;;
 809
 810   return if $self->status ne 'I';
 811
 812   my @unresolved = qsearch('cust_pay_batch',
 813     {
 814       batchnum => $self->batchnum,
 815       status   => ''
 816     }
 817   );
 818
 819   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
 820     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 821     # either 'approve' or 'decline'
 822     my $action = $conf->config('batch-auto_resolve_status') || '';
 823     return unless
 824       length($days) and
 825       length($action) and
 826       time > ($self->download + 86400 * $days)
 827       ;
 828
 829     my $error;
 830     foreach my $cpb (@unresolved) {
 831       if ( $action eq 'approve' ) {
 832         # approve it for the full amount
 833         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 834         $error = $cpb->approve($self->batchnum);
 835       }
 836       elsif ( $action eq 'decline' ) {
 837         $error = $cpb->decline('No response from processor');
 838       }
 839       return $error if $error;
 840     }
 841   } elsif ( @unresolved ) {
 842     # auto resolve is not enabled, and we're not ready to resolve
 843     return;
 844   }
 845
 846   $self->set_status('R');
 847 }
 848
 849 =item prepare_for_export
 850
 851 Prepare the batch to be exported.  This will:
 852 - Set the status to "in transit".
 853 - If batch-increment_expiration is set and this is a credit card batch,
 854   increment expiration dates that are in the past.
 855 - If this is the first download for this batch, adjust payment amounts to
 856   not be greater than the customer's current balance.  If the customer's
 857   balance is zero, the entry will be removed.
 858
 859 Use this within a transaction.
 860
 861 =cut
 862
 863 sub prepare_for_export {
 864   my $self = shift;
 865   my $conf = FS::Conf->new;
 866   my $curuser = $FS::CurrentUser::CurrentUser;
 867
 868   my $first_download;
 869   my $status = $self->status;
 870   if ($status eq 'O') {
 871     $first_download = 1;
 872     my $error = $self->set_status('I');
 873     return "error updating pay_batch status: $error\n" if $error;
 874   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 875     $first_download = 0;
 876   } elsif ($status eq 'R' &&
 877            $curuser->access_right('Redownload resolved batches')) {
 878     $first_download = 0;
 879   } else {
 880     die "No pending batch.\n";
 881   }
 882
 883   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 884                        $self->cust_pay_batch;
 885
 886   # handle batch-increment_expiration option
 887   if ( $self->payby eq 'CARD' ) {
 888     my ($cmon, $cyear) = (localtime(time))[4,5];
 889     foreach (@cust_pay_batch) {
 890       my $etime = str2time($_->exp) or next;
 891       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 892       if( $conf->exists('batch-increment_expiration') ) {
 893         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 894         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 895       }
 896       my $error = $_->replace;
 897       return $error if $error;
 898     }
 899   }
 900
 901   if ($first_download) { #remove or reduce entries if customer's balance changed
 902
 903     foreach my $cust_pay_batch (@cust_pay_batch) {
 904
 905       my $balance = $cust_pay_batch->cust_main->balance;
 906       if ($balance <= 0) { # then don't charge this customer
 907         my $error = $cust_pay_batch->delete;
 908         return $error if $error;
 909       } elsif ($balance < $cust_pay_batch->amount) {
 910         # reduce the charge to the remaining balance
 911         $cust_pay_batch->amount($balance);
 912         my $error = $cust_pay_batch->replace;
 913         return $error if $error;
 914       }
 915       # else $balance >= $cust_pay_batch->amount
 916     }
 917   } #if $first_download
 918
 919   '';
 920 }
 921
 922 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 923
 924 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 925 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 926
 927 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 928 L<Business::BatchPayment> module.
 929
 930 =cut
 931
 932 sub export_batch {
 933   my $self = shift;
 934   my %opt = @_;
 935
 936   my $conf = new FS::Conf;
 937   my $batch;
 938
 939   my $gateway = $opt{'gateway'};
 940   if ( $gateway ) {
 941     # welcome to the future
 942     my $fh = IO::Scalar->new(\$batch);
 943     $self->export_to_gateway($gateway, 'file' => $fh);
 944     return $batch;
 945   }
 946
 947   my $format = $opt{'format'} || $conf->config('batch-default_format')
 948     or die "No batch format configured\n";
 949
 950   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 951
 952   &{$info->{'init'}}($conf, $self->agentnum) if exists($info->{'init'});
 953
 954   my $oldAutoCommit = $FS::UID::AutoCommit;
 955   local $FS::UID::AutoCommit = 0;
 956   my $dbh = dbh;
 957
 958   my $error = $self->prepare_for_export;
 959
 960   die $error if $error;
 961   my $batchtotal = 0;
 962   my $batchcount = 0;
 963
 964   my @cust_pay_batch = $self->cust_pay_batch;
 965
 966   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 967
 968   my $h = $info->{'header'};
 969   if (ref($h) eq 'CODE') {
 970     $batch .= &$h($self, \@cust_pay_batch). $delim;
 971   } else {
 972     $batch .= $h. $delim;
 973   }
 974
 975   foreach my $cust_pay_batch (@cust_pay_batch) {
 976     $batchcount++;
 977     $batchtotal += $cust_pay_batch->amount;
 978     $batch .=
 979     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
 980     $delim;
 981   }
 982
 983   my $f = $info->{'footer'};
 984   if (ref($f) eq 'CODE') {
 985     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
 986   } else {
 987     $batch .= $f. $delim;
 988   }
 989
 990   if ($info->{'autopost'}) {
 991     my $error = &{$info->{'autopost'}}($self, $batch);
 992     if($error) {
 993       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 994       die $error;
 995     }
 996   }
 997
 998   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 999   return $batch;
1000 }
1001
1002 =item export_to_gateway GATEWAY OPTIONS
1003
1004 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
1005 that gateway via Business::BatchPayment. OPTIONS may include:
1006
1007 - file: override the default transport and write to this file (name or handle)
1008
1009 =cut
1010
1011 sub export_to_gateway {
1012
1013   my ($self, $gateway, %opt) = @_;
1014
1015   my $oldAutoCommit = $FS::UID::AutoCommit;
1016   local $FS::UID::AutoCommit = 0;
1017   my $dbh = dbh;
1018
1019   my $error = $self->prepare_for_export;
1020   die $error if $error;
1021
1022   my %proc_opt = (
1023     'output' => $opt{'file'}, # will do nothing if it's empty
1024     # any other constructor options go here
1025   );
1026   my $processor = $gateway->batch_processor(%proc_opt);
1027
1028   my @items = map { $_->request_item } $self->cust_pay_batch;
1029   my $batch = Business::BatchPayment->create(Batch =>
1030     batch_id  => $self->batchnum,
1031     items     => \@items
1032   );
1033   $processor->submit($batch);
1034
1035   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1036   '';
1037 }
1038
1039 sub manual_approve {
1040   my $self = shift;
1041   my $date = time;
1042   my %opt = @_;
1043   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1044   my $conf = FS::Conf->new;
1045   return 'manual batch approval disabled'
1046     if ( ! $conf->exists('batch-manual_approval') );
1047   return 'batch already resolved' if $self->status eq 'R';
1048   return 'batch not yet submitted' if $self->status eq 'O';
1049
1050   local $SIG{HUP} = 'IGNORE';
1051   local $SIG{INT} = 'IGNORE';
1052   local $SIG{QUIT} = 'IGNORE';
1053   local $SIG{TERM} = 'IGNORE';
1054   local $SIG{TSTP} = 'IGNORE';
1055   local $SIG{PIPE} = 'IGNORE';
1056
1057   my $oldAutoCommit = $FS::UID::AutoCommit;
1058   local $FS::UID::AutoCommit = 0;
1059   my $dbh = dbh;
1060
1061   my $payments = 0;
1062   foreach my $cust_pay_batch (
1063     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1064         status   => '' })
1065   ) {
1066     my $new_cust_pay_batch = new FS::cust_pay_batch {
1067       $cust_pay_batch->hash,
1068       'paid'    => $cust_pay_batch->amount,
1069       '_date'   => $date,
1070       'usernum' => $usernum,
1071     };
1072     my $error = $new_cust_pay_batch->approve();
1073     # there are no approval options here (authorization, order_number, etc.)
1074     # because the transaction wasn't really approved
1075     if ( $error ) {
1076       $dbh->rollback;
1077       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1078     }
1079     $payments++;
1080   }
1081   $self->set_status('R');
1082   $dbh->commit;
1083   return;
1084 }
1085
1086 sub _upgrade_data {
1087   # Set up configuration for gateways that have a Business::BatchPayment
1088   # module.
1089
1090   eval "use Class::MOP;";
1091   if ( $@ ) {
1092     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1093     return;
1094   }
1095   my $conf = FS::Conf->new;
1096   for my $format (keys %export_info) {
1097     my $mod = "FS::pay_batch::$format";
1098     if ( $mod->can('_upgrade_gateway')
1099         and $conf->exists("batchconfig-$format") ) {
1100
1101       local $@;
1102       my ($module, %gw_options) = $mod->_upgrade_gateway;
1103       my $gateway = FS::payment_gateway->new({
1104           gateway_namespace => 'Business::BatchPayment',
1105           gateway_module    => $module,
1106       });
1107       my $error = $gateway->insert(%gw_options);
1108       if ( $error ) {
1109         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1110         next;
1111       }
1112
1113       # test whether it loads
1114       my $processor = eval { $gateway->batch_processor };
1115       if ( !$processor ) {
1116         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1117         # if not, remove it so it doesn't hang around and break things
1118         $gateway->delete;
1119       }
1120       else {
1121         # remove the batchconfig-*
1122         warn "Created Business::BatchPayment gateway '".$gateway->label.
1123              "' for '$format' batch processing.\n";
1124         $conf->delete("batchconfig-$format");
1125
1126         # and if appropriate, make it the system default
1127         for my $payby (qw(CARD CHEK)) {
1128           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1129             warn "Setting as default for $payby.\n";
1130             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1131             $conf->delete("batch-fixed_format-$payby");
1132           }
1133         }
1134       } # if $processor
1135     } #if can('_upgrade_gateway') and batchconfig-$format
1136   } #for $format
1137
1138   '';
1139 }
1140
1141 =back
1142
1143 =head1 BUGS
1144
1145 status is somewhat redundant now that download and upload exist
1146
1147 =head1 SEE ALSO
1148
1149 L<FS::Record>, schema.html from the base documentation.
1150
1151 =cut
1152
1153 1;
1154