FS/FS/pay_batch.pm

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