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'),
 768         subject => $subject,
 769         body    => $body,
 770       );
 771     } else {
 772       # Bail out.
 773       $dbh->rollback if $oldAutoCommit;
 774       die $error_text;
 775     }
 776   }
 777
 778   # Auto-resolve (with brute-force error handling)
 779   foreach my $pay_batch (values %pay_batch_for_update) {
 780     my $error = $pay_batch->try_to_resolve;
 781
 782     if ( $error ) {
 783       $dbh->rollback if $oldAutoCommit;
 784       return $error;
 785     }
 786   }
 787
 788   $dbh->commit if $oldAutoCommit;
 789   return;
 790 }
 791
 792 =item try_to_resolve
 793
 794 Resolve this batch if possible.  A batch can be resolved if all of its
 795 entries have status.  If the system options 'batch-auto_resolve_days'
 796 and 'batch-auto_resolve_status' are set, and the batch's download date is
 797 at least (batch-auto_resolve_days) before the current time, then it can
 798 be auto-resolved; entries with no status will be approved or declined
 799 according to the batch-auto_resolve_status setting.
 800
 801 =cut
 802
 803 sub try_to_resolve {
 804   my $self = shift;
 805   my $conf = FS::Conf->new;;
 806
 807   return if $self->status ne 'I';
 808
 809   my @unresolved = qsearch('cust_pay_batch',
 810     {
 811       batchnum => $self->batchnum,
 812       status   => ''
 813     }
 814   );
 815
 816   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
 817     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 818     # either 'approve' or 'decline'
 819     my $action = $conf->config('batch-auto_resolve_status') || '';
 820     return unless
 821       length($days) and
 822       length($action) and
 823       time > ($self->download + 86400 * $days)
 824       ;
 825
 826     my $error;
 827     foreach my $cpb (@unresolved) {
 828       if ( $action eq 'approve' ) {
 829         # approve it for the full amount
 830         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 831         $error = $cpb->approve($self->batchnum);
 832       }
 833       elsif ( $action eq 'decline' ) {
 834         $error = $cpb->decline('No response from processor');
 835       }
 836       return $error if $error;
 837     }
 838   } elsif ( @unresolved ) {
 839     # auto resolve is not enabled, and we're not ready to resolve
 840     return;
 841   }
 842
 843   $self->set_status('R');
 844 }
 845
 846 =item prepare_for_export
 847
 848 Prepare the batch to be exported.  This will:
 849 - Set the status to "in transit".
 850 - If batch-increment_expiration is set and this is a credit card batch,
 851   increment expiration dates that are in the past.
 852 - If this is the first download for this batch, adjust payment amounts to
 853   not be greater than the customer's current balance.  If the customer's
 854   balance is zero, the entry will be removed.
 855
 856 Use this within a transaction.
 857
 858 =cut
 859
 860 sub prepare_for_export {
 861   my $self = shift;
 862   my $conf = FS::Conf->new;
 863   my $curuser = $FS::CurrentUser::CurrentUser;
 864
 865   my $first_download;
 866   my $status = $self->status;
 867   if ($status eq 'O') {
 868     $first_download = 1;
 869     my $error = $self->set_status('I');
 870     return "error updating pay_batch status: $error\n" if $error;
 871   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 872     $first_download = 0;
 873   } elsif ($status eq 'R' &&
 874            $curuser->access_right('Redownload resolved batches')) {
 875     $first_download = 0;
 876   } else {
 877     die "No pending batch.\n";
 878   }
 879
 880   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 881                        $self->cust_pay_batch;
 882
 883   # handle batch-increment_expiration option
 884   if ( $self->payby eq 'CARD' ) {
 885     my ($cmon, $cyear) = (localtime(time))[4,5];
 886     foreach (@cust_pay_batch) {
 887       my $etime = str2time($_->exp) or next;
 888       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 889       if( $conf->exists('batch-increment_expiration') ) {
 890         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 891         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 892       }
 893       my $error = $_->replace;
 894       return $error if $error;
 895     }
 896   }
 897
 898   if ($first_download) { #remove or reduce entries if customer's balance changed
 899
 900     foreach my $cust_pay_batch (@cust_pay_batch) {
 901
 902       my $balance = $cust_pay_batch->cust_main->balance;
 903       if ($balance <= 0) { # then don't charge this customer
 904         my $error = $cust_pay_batch->delete;
 905         return $error if $error;
 906       } elsif ($balance < $cust_pay_batch->amount) {
 907         # reduce the charge to the remaining balance
 908         $cust_pay_batch->amount($balance);
 909         my $error = $cust_pay_batch->replace;
 910         return $error if $error;
 911       }
 912       # else $balance >= $cust_pay_batch->amount
 913     }
 914   } #if $first_download
 915
 916   '';
 917 }
 918
 919 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 920
 921 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 922 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 923
 924 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 925 L<Business::BatchPayment> module.
 926
 927 =cut
 928
 929 sub export_batch {
 930   my $self = shift;
 931   my %opt = @_;
 932
 933   my $conf = new FS::Conf;
 934   my $batch;
 935
 936   my $gateway = $opt{'gateway'};
 937   if ( $gateway ) {
 938     # welcome to the future
 939     my $fh = IO::Scalar->new(\$batch);
 940     $self->export_to_gateway($gateway, 'file' => $fh);
 941     return $batch;
 942   }
 943
 944   my $format = $opt{'format'} || $conf->config('batch-default_format')
 945     or die "No batch format configured\n";
 946
 947   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 948
 949   &{$info->{'init'}}($conf) if exists($info->{'init'});
 950
 951   my $oldAutoCommit = $FS::UID::AutoCommit;
 952   local $FS::UID::AutoCommit = 0;
 953   my $dbh = dbh;
 954
 955   my $error = $self->prepare_for_export;
 956
 957   die $error if $error;
 958   my $batchtotal = 0;
 959   my $batchcount = 0;
 960
 961   my @cust_pay_batch = $self->cust_pay_batch;
 962
 963   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 964
 965   my $h = $info->{'header'};
 966   if (ref($h) eq 'CODE') {
 967     $batch .= &$h($self, \@cust_pay_batch). $delim;
 968   } else {
 969     $batch .= $h. $delim;
 970   }
 971
 972   foreach my $cust_pay_batch (@cust_pay_batch) {
 973     $batchcount++;
 974     $batchtotal += $cust_pay_batch->amount;
 975     $batch .=
 976     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
 977     $delim;
 978   }
 979
 980   my $f = $info->{'footer'};
 981   if (ref($f) eq 'CODE') {
 982     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
 983   } else {
 984     $batch .= $f. $delim;
 985   }
 986
 987   if ($info->{'autopost'}) {
 988     my $error = &{$info->{'autopost'}}($self, $batch);
 989     if($error) {
 990       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 991       die $error;
 992     }
 993   }
 994
 995   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 996   return $batch;
 997 }
 998
 999 =item export_to_gateway GATEWAY OPTIONS
1000
1001 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
1002 that gateway via Business::BatchPayment. OPTIONS may include:
1003
1004 - file: override the default transport and write to this file (name or handle)
1005
1006 =cut
1007
1008 sub export_to_gateway {
1009
1010   my ($self, $gateway, %opt) = @_;
1011
1012   my $oldAutoCommit = $FS::UID::AutoCommit;
1013   local $FS::UID::AutoCommit = 0;
1014   my $dbh = dbh;
1015
1016   my $error = $self->prepare_for_export;
1017   die $error if $error;
1018
1019   my %proc_opt = (
1020     'output' => $opt{'file'}, # will do nothing if it's empty
1021     # any other constructor options go here
1022   );
1023   my $processor = $gateway->batch_processor(%proc_opt);
1024
1025   my @items = map { $_->request_item } $self->cust_pay_batch;
1026   my $batch = Business::BatchPayment->create(Batch =>
1027     batch_id  => $self->batchnum,
1028     items     => \@items
1029   );
1030   $processor->submit($batch);
1031
1032   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1033   '';
1034 }
1035
1036 sub manual_approve {
1037   my $self = shift;
1038   my $date = time;
1039   my %opt = @_;
1040   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1041   my $conf = FS::Conf->new;
1042   return 'manual batch approval disabled'
1043     if ( ! $conf->exists('batch-manual_approval') );
1044   return 'batch already resolved' if $self->status eq 'R';
1045   return 'batch not yet submitted' if $self->status eq 'O';
1046
1047   local $SIG{HUP} = 'IGNORE';
1048   local $SIG{INT} = 'IGNORE';
1049   local $SIG{QUIT} = 'IGNORE';
1050   local $SIG{TERM} = 'IGNORE';
1051   local $SIG{TSTP} = 'IGNORE';
1052   local $SIG{PIPE} = 'IGNORE';
1053
1054   my $oldAutoCommit = $FS::UID::AutoCommit;
1055   local $FS::UID::AutoCommit = 0;
1056   my $dbh = dbh;
1057
1058   my $payments = 0;
1059   foreach my $cust_pay_batch (
1060     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1061         status   => '' })
1062   ) {
1063     my $new_cust_pay_batch = new FS::cust_pay_batch {
1064       $cust_pay_batch->hash,
1065       'paid'    => $cust_pay_batch->amount,
1066       '_date'   => $date,
1067       'usernum' => $usernum,
1068     };
1069     my $error = $new_cust_pay_batch->approve();
1070     # there are no approval options here (authorization, order_number, etc.)
1071     # because the transaction wasn't really approved
1072     if ( $error ) {
1073       $dbh->rollback;
1074       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1075     }
1076     $payments++;
1077   }
1078   $self->set_status('R');
1079   $dbh->commit;
1080   return;
1081 }
1082
1083 sub _upgrade_data {
1084   # Set up configuration for gateways that have a Business::BatchPayment
1085   # module.
1086
1087   eval "use Class::MOP;";
1088   if ( $@ ) {
1089     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1090     return;
1091   }
1092   my $conf = FS::Conf->new;
1093   for my $format (keys %export_info) {
1094     my $mod = "FS::pay_batch::$format";
1095     if ( $mod->can('_upgrade_gateway')
1096         and $conf->exists("batchconfig-$format") ) {
1097
1098       local $@;
1099       my ($module, %gw_options) = $mod->_upgrade_gateway;
1100       my $gateway = FS::payment_gateway->new({
1101           gateway_namespace => 'Business::BatchPayment',
1102           gateway_module    => $module,
1103       });
1104       my $error = $gateway->insert(%gw_options);
1105       if ( $error ) {
1106         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1107         next;
1108       }
1109
1110       # test whether it loads
1111       my $processor = eval { $gateway->batch_processor };
1112       if ( !$processor ) {
1113         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1114         # if not, remove it so it doesn't hang around and break things
1115         $gateway->delete;
1116       }
1117       else {
1118         # remove the batchconfig-*
1119         warn "Created Business::BatchPayment gateway '".$gateway->label.
1120              "' for '$format' batch processing.\n";
1121         $conf->delete("batchconfig-$format");
1122
1123         # and if appropriate, make it the system default
1124         for my $payby (qw(CARD CHEK)) {
1125           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1126             warn "Setting as default for $payby.\n";
1127             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1128             $conf->delete("batch-fixed_format-$payby");
1129           }
1130         }
1131       } # if $processor
1132     } #if can('_upgrade_gateway') and batchconfig-$format
1133   } #for $format
1134
1135   '';
1136 }
1137
1138 =back
1139
1140 =head1 BUGS
1141
1142 status is somewhat redundant now that download and upload exist
1143
1144 =head1 SEE ALSO
1145
1146 L<FS::Record>, schema.html from the base documentation.
1147
1148 =cut
1149
1150 1;
1151