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 Supported format keys (defined in the specified FS::pay_batch module) are:
 238
 239 I<filetype> - required, can be CSV, fixed, variable, XML
 240
 241 I<fields> - required list of field names for each row/line
 242
 243 I<formatre> - regular expression for fixed filetype
 244
 245 I<parse> - required for variable filetype
 246
 247 I<xmlkeys> - required for XML filetype
 248
 249 I<xmlrow> - required for XML filetype
 250
 251 I<begin_condition> - sub, ignore all lines before this returns true
 252
 253 I<end_condition> - sub, stop processing lines when this returns true
 254
 255 I<end_hook> - sub, runs immediately after end_condition returns true
 256
 257 I<skip_condition> - sub, skip lines when this returns true
 258
 259 I<hook> - required, sub, runs before approved/declined conditions are checked
 260
 261 I<approved> - required, sub, returns true when approved
 262
 263 I<declined> - required, sub, returns true when declined
 264
 265 I<close_condition> - sub, decide whether or not to close the batch
 266
 267 =cut
 268
 269 sub import_results {
 270   my $self = shift;
 271
 272   my $param = ref($_[0]) ? shift : { @_ };
 273   my $fh = $param->{'filehandle'};
 274   my $job = $param->{'job'};
 275   $job->update_statustext(0) if $job;
 276
 277   my $format = $param->{'format'};
 278   my $info = $import_info{$format}
 279     or die "unknown format $format";
 280
 281   my $conf = new FS::Conf;
 282
 283   my $filetype            = $info->{'filetype'};      # CSV, fixed, variable
 284   my @fields              = @{ $info->{'fields'}};
 285   my $formatre            = $info->{'formatre'};      # for fixed
 286   my $parse               = $info->{'parse'};         # for variable
 287   my @all_values;
 288   my $begin_condition     = $info->{'begin_condition'};
 289   my $end_condition       = $info->{'end_condition'};
 290   my $end_hook            = $info->{'end_hook'};
 291   my $skip_condition      = $info->{'skip_condition'};
 292   my $hook                = $info->{'hook'};
 293   my $approved_condition  = $info->{'approved'};
 294   my $declined_condition  = $info->{'declined'};
 295   my $close_condition     = $info->{'close_condition'};
 296
 297   my $csv = new Text::CSV_XS;
 298
 299   local $SIG{HUP} = 'IGNORE';
 300   local $SIG{INT} = 'IGNORE';
 301   local $SIG{QUIT} = 'IGNORE';
 302   local $SIG{TERM} = 'IGNORE';
 303   local $SIG{TSTP} = 'IGNORE';
 304   local $SIG{PIPE} = 'IGNORE';
 305
 306   my $oldAutoCommit = $FS::UID::AutoCommit;
 307   local $FS::UID::AutoCommit = 0;
 308   my $dbh = dbh;
 309
 310   my $reself = $self->select_for_update;
 311
 312   if ( $reself->status ne 'I'
 313       and !$conf->exists('batch-manual_approval') ) {
 314     $dbh->rollback if $oldAutoCommit;
 315     return "batchnum ". $self->batchnum. "no longer in transit";
 316   }
 317
 318   my $total = 0;
 319   my $line;
 320
 321   if ($filetype eq 'XML') {
 322     eval "use XML::Simple";
 323     die $@ if $@;
 324     my @xmlkeys = @{ $info->{'xmlkeys'} };  # for XML
 325     my $xmlrow  = $info->{'xmlrow'};        # also for XML
 326
 327     # Do everything differently.
 328     my $data = XML::Simple::XMLin($fh, KeepRoot => 1);
 329     my $rows = $data;
 330     # $xmlrow = [ RootKey, FirstLevelKey, SecondLevelKey... ]
 331     $rows = $rows->{$_} foreach( @$xmlrow );
 332     if(!defined($rows)) {
 333       $dbh->rollback if $oldAutoCommit;
 334       return "can't find rows in XML file";
 335     }
 336     $rows = [ $rows ] if ref($rows) ne 'ARRAY';
 337     foreach my $row (@$rows) {
 338       push @all_values, [ @{$row}{@xmlkeys}, $row ];
 339     }
 340   }
 341   else {
 342     while ( defined($line=<$fh>) ) {
 343
 344       next if $line =~ /^\s*$/; #skip blank lines
 345
 346       if ($filetype eq "CSV") {
 347         $csv->parse($line) or do {
 348           $dbh->rollback if $oldAutoCommit;
 349           return "can't parse: ". $csv->error_input();
 350         };
 351         push @all_values, [ $csv->fields(), $line ];
 352       }elsif ($filetype eq 'fixed'){
 353         my @values = ( $line =~ /$formatre/ );
 354         unless (@values) {
 355           $dbh->rollback if $oldAutoCommit;
 356           return "can't parse: ". $line;
 357         };
 358         push @values, $line;
 359         push @all_values, \@values;
 360       }
 361       elsif ($filetype eq 'variable') {
 362         my @values = ( eval { $parse->($self, $line) } );
 363         if( $@ ) {
 364           $dbh->rollback if $oldAutoCommit;
 365           return $@;
 366         };
 367         push @values, $line;
 368         push @all_values, \@values;
 369       }
 370       else {
 371         $dbh->rollback if $oldAutoCommit;
 372         return "Unknown file type $filetype";
 373       }
 374     }
 375   }
 376
 377   my $num = 0;
 378   foreach (@all_values) {
 379     if($job) {
 380       $num++;
 381       $job->update_statustext(int(100 * $num/scalar(@all_values)));
 382     }
 383     my @values = @$_;
 384
 385     my %hash;
 386     my $line = pop @values;
 387     foreach my $field ( @fields ) {
 388       my $value = shift @values;
 389       next unless $field;
 390       $hash{$field} = $value;
 391     }
 392
 393     if ( defined($begin_condition) ) {
 394       if ( &{$begin_condition}(\%hash, $line) ) {
 395         undef $begin_condition;
 396       }
 397       else {
 398         next;
 399       }
 400     }
 401
 402     if ( defined($end_condition) and &{$end_condition}(\%hash, $line) ) {
 403       my $error;
 404       $error = &{$end_hook}(\%hash, $total, $line) if defined($end_hook);
 405       if ( $error ) {
 406         $dbh->rollback if $oldAutoCommit;
 407         return $error;
 408       }
 409       last;
 410     }
 411
 412     if ( defined($skip_condition) and &{$skip_condition}(\%hash, $line) ) {
 413       next;
 414     }
 415
 416     my $cust_pay_batch =
 417       qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'}+0 } );
 418     unless ( $cust_pay_batch ) {
 419       return "unknown paybatchnum $hash{'paybatchnum'}\n";
 420     }
 421     my $custnum = $cust_pay_batch->custnum,
 422     my $payby = $cust_pay_batch->payby,
 423
 424     &{$hook}(\%hash, $cust_pay_batch->hashref);
 425
 426     my $new_cust_pay_batch = new FS::cust_pay_batch { $cust_pay_batch->hash };
 427
 428     my $error = '';
 429     if ( &{$approved_condition}(\%hash) ) {
 430
 431       foreach ('paid', '_date', 'payinfo') {
 432         $new_cust_pay_batch->$_($hash{$_}) if $hash{$_};
 433       }
 434       $error = $new_cust_pay_batch->approve(%hash);
 435       $total += $hash{'paid'};
 436
 437     } elsif ( &{$declined_condition}(\%hash) ) {
 438
 439       $error = $new_cust_pay_batch->decline($hash{'error_message'});;
 440
 441     }
 442
 443     if ( $error ) {
 444       $dbh->rollback if $oldAutoCommit;
 445       return $error;
 446     }
 447
 448     # purge CVV when the batch is processed
 449     if ( $payby =~ /^(CARD|DCRD)$/ ) {
 450       my $payinfo = $hash{'payinfo'} || $cust_pay_batch->payinfo;
 451       if ( ! grep { $_ eq cardtype($payinfo) }
 452           $conf->config('cvv-save') ) {
 453         $new_cust_pay_batch->cust_main->remove_cvv;
 454       }
 455
 456     }
 457
 458   } # foreach (@all_values)
 459
 460   my $close = 1;
 461   if ( defined($close_condition) ) {
 462     # Allow the module to decide whether to close the batch.
 463     # $close_condition can also die() to abort the whole import.
 464     $close = eval { $close_condition->($self) };
 465     if ( $@ ) {
 466       $dbh->rollback;
 467       die $@;
 468     }
 469   }
 470   if ( $close ) {
 471     my $error = $self->set_status('R');
 472     if ( $error ) {
 473       $dbh->rollback if $oldAutoCommit;
 474       return $error;
 475     }
 476   }
 477
 478   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 479   '';
 480
 481 }
 482
 483 use MIME::Base64;
 484 use Storable 'thaw';
 485 use Data::Dumper;
 486 sub process_import_results {
 487   my $job = shift;
 488   my $param = thaw(decode_base64(shift));
 489   $param->{'job'} = $job;
 490   warn Dumper($param) if $DEBUG;
 491   my $gatewaynum = delete $param->{'gatewaynum'};
 492   if ( $gatewaynum ) {
 493     $param->{'gateway'} = FS::payment_gateway->by_key($gatewaynum)
 494       or die "gatewaynum '$gatewaynum' not found\n";
 495     delete $param->{'format'}; # to avoid confusion
 496   }
 497
 498   my $file = $param->{'uploaded_files'} or die "no files provided\n";
 499   $file =~ s/^(\w+):([\.\w]+)$/$2/;
 500   my $dir = '%%%FREESIDE_CACHE%%%/cache.' . $FS::UID::datasrc;
 501   open( $param->{'filehandle'},
 502         '<',
 503         "$dir/$file" )
 504       or die "unable to open '$file'.\n";
 505
 506   my $error;
 507   if ( $param->{gateway} ) {
 508     $error = FS::pay_batch->import_from_gateway(%$param);
 509   } else {
 510     my $batchnum = delete $param->{'batchnum'} or die "no batchnum specified\n";
 511     my $batch = FS::pay_batch->by_key($batchnum) or die "batchnum '$batchnum' not found\n";
 512     $error = $batch->import_results($param);
 513   }
 514   unlink $file;
 515   die $error if $error;
 516 }
 517
 518 =item import_from_gateway [ OPTIONS ]
 519
 520 Import results from a L<FS::payment_gateway>, using Business::BatchPayment,
 521 and apply them.  GATEWAY must use the Business::BatchPayment namespace.
 522
 523 This is a class method, since results can be applied to any batch.
 524 The 'batch-reconsider' option determines whether an already-approved
 525 or declined payment can have its status changed by a later import.
 526
 527 OPTIONS may include:
 528
 529 - gateway: the L<FS::payment_gateway>, required
 530 - filehandle: a file name or handle to use as a data source.
 531 - job: an L<FS::queue> object to update with progress messages.
 532
 533 =cut
 534
 535 sub import_from_gateway {
 536   my $class = shift;
 537   my %opt = @_;
 538   my $gateway = $opt{'gateway'};
 539   my $conf = FS::Conf->new;
 540
 541   # unavoidable duplication with import_batch, for now
 542   local $SIG{HUP} = 'IGNORE';
 543   local $SIG{INT} = 'IGNORE';
 544   local $SIG{QUIT} = 'IGNORE';
 545   local $SIG{TERM} = 'IGNORE';
 546   local $SIG{TSTP} = 'IGNORE';
 547   local $SIG{PIPE} = 'IGNORE';
 548
 549   my $oldAutoCommit = $FS::UID::AutoCommit;
 550   local $FS::UID::AutoCommit = 0;
 551   my $dbh = dbh;
 552
 553   my $job = delete($opt{'job'});
 554   $job->update_statustext(0) if $job;
 555
 556   my $total = 0;
 557   return "import_from_gateway requires a payment_gateway"
 558     unless eval { $gateway->isa('FS::payment_gateway') };
 559
 560   my %proc_opt = (
 561     'input' => $opt{'filehandle'}, # will do nothing if it's empty
 562     # any other constructor options go here
 563   );
 564
 565   my @item_errors;
 566   my $mail_on_error = $conf->config('batch-errors_to');
 567   if ( $mail_on_error ) {
 568     # construct error trap
 569     $proc_opt{'on_parse_error'} = sub {
 570       my ($self, $line, $error) = @_;
 571       push @item_errors, "  '$line'\n$error";
 572     };
 573   }
 574
 575   my $processor = $gateway->batch_processor(%proc_opt);
 576
 577   my @batches = $processor->receive;
 578
 579   my $num = 0;
 580
 581   my $total_items = sum( map{$_->count} @batches);
 582
 583   # whether to allow items to change status
 584   my $reconsider = $conf->exists('batch-reconsider');
 585
 586   # mutex all affected batches
 587   my %pay_batch_for_update;
 588
 589   my %bop2payby = (CC => 'CARD', ECHECK => 'CHEK');
 590
 591   BATCH: foreach my $batch (@batches) {
 592
 593     my %incoming_batch = (
 594       'CARD' => {},
 595       'CHEK' => {},
 596     );
 597
 598     ITEM: foreach my $item ($batch->elements) {
 599
 600       my $cust_pay_batch; # the new batch entry (with status)
 601       my $pay_batch; # the freeside batch it belongs to
 602       my $payby; # CARD or CHEK
 603       my $error;
 604
 605       my $paybatch = $gateway->gatewaynum .  '-' .  $gateway->gateway_module .
 606         ':' . $item->authorization .  ':' . $item->order_number;
 607
 608       if ( $batch->incoming ) {
 609         # This is a one-way batch.
 610         # Locate the customer, find an open batch correct for them,
 611         # create a payment.  Don't bother creating a cust_pay_batch
 612         # entry.
 613         my $cust_main;
 614         if ( defined($item->customer_id)
 615              and $item->customer_id =~ /^\d+$/
 616              and $item->customer_id > 0 ) {
 617
 618           $cust_main = FS::cust_main->by_key($item->customer_id)
 619                        || qsearchs('cust_main',
 620                          { 'agent_custid' => $item->customer_id }
 621                        );
 622           if ( !$cust_main ) {
 623             push @item_errors, "Unknown customer_id ".$item->customer_id;
 624             next ITEM;
 625           }
 626         }
 627         else {
 628           push @item_errors, "Illegal customer_id '".$item->customer_id."'";
 629           next ITEM;
 630         }
 631         # it may also make sense to allow selecting the customer by
 632         # invoice_number, but no modules currently work that way
 633
 634         $payby = $bop2payby{ $item->payment_type };
 635         my $agentnum = '';
 636         $agentnum = $cust_main->agentnum if $conf->exists('batch-spoolagent');
 637
 638         # create a batch if necessary
 639         $pay_batch = $incoming_batch{$payby}->{$agentnum} ||=
 640           FS::pay_batch->new({
 641               status    => 'R', # pre-resolve it
 642               payby     => $payby,
 643               agentnum  => $agentnum,
 644               upload    => time,
 645               title     => $batch->batch_id,
 646           });
 647         if ( !$pay_batch->batchnum ) {
 648           $error = $pay_batch->insert;
 649           die $error if $error; # can't do anything if this fails
 650         }
 651
 652         if ( !$item->approved ) {
 653           $error ||= "payment rejected - ".$item->error_message;
 654         }
 655         if ( !defined($item->amount) or $item->amount <= 0 ) {
 656           $error ||= "no amount in item $num";
 657         }
 658
 659         my $payinfo;
 660         if ( $item->check_number ) {
 661           $payby = 'BILL'; # right?
 662           $payinfo = $item->check_number;
 663         } elsif ( $item->assigned_token ) {
 664           $payinfo = $item->assigned_token;
 665         }
 666         # create the payment
 667         my $cust_pay = FS::cust_pay->new(
 668           {
 669             custnum     => $cust_main->custnum,
 670             _date       => $item->payment_date->epoch,
 671             paid        => sprintf('%.2f',$item->amount),
 672             payby       => $payby,
 673             invnum      => $item->invoice_number,
 674             batchnum    => $pay_batch->batchnum,
 675             payinfo     => $payinfo,
 676             gatewaynum  => $gateway->gatewaynum,
 677             processor   => $gateway->gateway_module,
 678             auth        => $item->authorization,
 679             order_number => $item->order_number,
 680           }
 681         );
 682         $error ||= $cust_pay->insert;
 683         eval { $cust_main->apply_payments };
 684         $error ||= $@;
 685
 686         if ( $error ) {
 687           push @item_errors, 'Payment for customer '.$item->customer_id."\n$error";
 688         }
 689
 690       } else {
 691         # This is a request/reply batch.
 692         # Locate the request (the 'tid' attribute is the paybatchnum).
 693         my $paybatchnum = $item->tid;
 694         $cust_pay_batch = FS::cust_pay_batch->by_key($paybatchnum);
 695         if (!$cust_pay_batch) {
 696           push @item_errors, "paybatchnum $paybatchnum not found";
 697           next ITEM;
 698         }
 699         $payby = $cust_pay_batch->payby;
 700
 701         my $batchnum = $cust_pay_batch->batchnum;
 702         if ( $batch->batch_id and $batch->batch_id != $batchnum ) {
 703           warn "batch ID ".$batch->batch_id.
 704                 " does not match batchnum ".$cust_pay_batch->batchnum."\n";
 705         }
 706
 707         # lock the batch and check its status
 708         $pay_batch = FS::pay_batch->by_key($batchnum);
 709         $pay_batch_for_update{$batchnum} ||= $pay_batch->select_for_update;
 710         if ( $pay_batch->status ne 'I' and !$reconsider ) {
 711           $error = "batch $batchnum no longer in transit";
 712         }
 713
 714         if ( $cust_pay_batch->status ) {
 715           my $new_status = $item->approved ? 'approved' : 'declined';
 716           if ( lc( $cust_pay_batch->status ) eq $new_status ) {
 717             # already imported with this status, so don't touch
 718             next ITEM;
 719           }
 720           elsif ( !$reconsider ) {
 721             # then we're not allowed to change its status, so bail out
 722             $error = "paybatchnum ".$item->tid.
 723             " already resolved with status '". $cust_pay_batch->status . "'";
 724           }
 725         }
 726
 727         if ( $error ) {
 728           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 729           next ITEM;
 730         }
 731
 732         my $new_payinfo;
 733         # update payinfo, if needed
 734         if ( $item->assigned_token ) {
 735           $new_payinfo = $item->assigned_token;
 736         } elsif ( $payby eq 'CARD' ) {
 737           $new_payinfo = $item->card_number if $item->card_number;
 738         } else { #$payby eq 'CHEK'
 739           $new_payinfo = $item->account_number . '@' . $item->routing_code
 740             if $item->account_number;
 741         }
 742         $cust_pay_batch->set('payinfo', $new_payinfo) if $new_payinfo;
 743
 744         # set "paid" pseudo-field (transfers to cust_pay) to the actual amount
 745         # paid, if the batch says it's different from the amount requested
 746         if ( defined $item->amount ) {
 747           $cust_pay_batch->set('paid', $item->amount);
 748         } else {
 749           $cust_pay_batch->set('paid', $cust_pay_batch->amount);
 750         }
 751
 752         # set payment date to when it was processed
 753         $cust_pay_batch->_date($item->payment_date->epoch)
 754           if $item->payment_date;
 755
 756         # approval status
 757         if ( $item->approved ) {
 758           # follow Billing_Realtime format for paybatch
 759           $error = $cust_pay_batch->approve(
 760             'gatewaynum'    => $gateway->gatewaynum,
 761             'processor'     => $gateway->gateway_module,
 762             'auth'          => $item->authorization,
 763             'order_number'  => $item->order_number,
 764           );
 765           $total += $cust_pay_batch->paid;
 766         }
 767         else {
 768           $error = $cust_pay_batch->decline($item->error_message);
 769         }
 770
 771         if ( $error ) {
 772           push @item_errors, "Payment for customer ".$cust_pay_batch->custnum."\n$error";
 773           next ITEM;
 774         }
 775       } # $batch->incoming
 776
 777       $num++;
 778       $job->update_statustext(int(100 * $num/( $total_items ) ),
 779         'Importing batch items')
 780       if $job;
 781
 782     } #foreach $item
 783
 784   } #foreach $batch (input batch, not pay_batch)
 785
 786   # Format an error message
 787   if ( @item_errors ) {
 788     my $error_text = join("\n\n",
 789       "Errors during batch import: ".scalar(@item_errors),
 790       @item_errors
 791     );
 792     if ( $mail_on_error ) {
 793       my $subject = "Batch import errors"; #?
 794       my $body = "Import from gateway ".$gateway->label."\n".$error_text;
 795       send_email(
 796         to      => $mail_on_error,
 797         from    => $conf->invoice_from_full(),
 798         subject => $subject,
 799         body    => $body,
 800       );
 801     } else {
 802       # Bail out.
 803       $dbh->rollback if $oldAutoCommit;
 804       die $error_text;
 805     }
 806   }
 807
 808   # Auto-resolve (with brute-force error handling)
 809   foreach my $pay_batch (values %pay_batch_for_update) {
 810     my $error = $pay_batch->try_to_resolve;
 811
 812     if ( $error ) {
 813       $dbh->rollback if $oldAutoCommit;
 814       return $error;
 815     }
 816   }
 817
 818   $dbh->commit if $oldAutoCommit;
 819   return;
 820 }
 821
 822 =item try_to_resolve
 823
 824 Resolve this batch if possible.  A batch can be resolved if all of its
 825 entries have status.  If the system options 'batch-auto_resolve_days'
 826 and 'batch-auto_resolve_status' are set, and the batch's download date is
 827 at least (batch-auto_resolve_days) before the current time, then it can
 828 be auto-resolved; entries with no status will be approved or declined
 829 according to the batch-auto_resolve_status setting.
 830
 831 =cut
 832
 833 sub try_to_resolve {
 834   my $self = shift;
 835   my $conf = FS::Conf->new;;
 836
 837   return if $self->status ne 'I';
 838
 839   my @unresolved = qsearch('cust_pay_batch',
 840     {
 841       batchnum => $self->batchnum,
 842       status   => ''
 843     }
 844   );
 845
 846   if ( @unresolved and $conf->exists('batch-auto_resolve_days') ) {
 847     my $days = $conf->config('batch-auto_resolve_days'); # can be zero
 848     # either 'approve' or 'decline'
 849     my $action = $conf->config('batch-auto_resolve_status') || '';
 850     return unless
 851       length($days) and
 852       length($action) and
 853       time > ($self->download + 86400 * $days)
 854       ;
 855
 856     my $error;
 857     foreach my $cpb (@unresolved) {
 858       if ( $action eq 'approve' ) {
 859         # approve it for the full amount
 860         $cpb->set('paid', $cpb->amount) unless ($cpb->paid || 0) > 0;
 861         $error = $cpb->approve($self->batchnum);
 862       }
 863       elsif ( $action eq 'decline' ) {
 864         $error = $cpb->decline('No response from processor');
 865       }
 866       return $error if $error;
 867     }
 868   } elsif ( @unresolved ) {
 869     # auto resolve is not enabled, and we're not ready to resolve
 870     return;
 871   }
 872
 873   $self->set_status('R');
 874 }
 875
 876 =item prepare_for_export
 877
 878 Prepare the batch to be exported.  This will:
 879 - Set the status to "in transit".
 880 - If batch-increment_expiration is set and this is a credit card batch,
 881   increment expiration dates that are in the past.
 882 - If this is the first download for this batch, adjust payment amounts to
 883   not be greater than the customer's current balance.  If the customer's
 884   balance is zero, the entry will be removed.
 885
 886 Use this within a transaction.
 887
 888 =cut
 889
 890 sub prepare_for_export {
 891   my $self = shift;
 892   my $conf = FS::Conf->new;
 893   my $curuser = $FS::CurrentUser::CurrentUser;
 894
 895   my $first_download;
 896   my $status = $self->status;
 897   if ($status eq 'O') {
 898     $first_download = 1;
 899     my $error = $self->set_status('I');
 900     return "error updating pay_batch status: $error\n" if $error;
 901   } elsif ($status eq 'I' && $curuser->access_right('Reprocess batches')) {
 902     $first_download = 0;
 903   } elsif ($status eq 'R' &&
 904            $curuser->access_right('Redownload resolved batches')) {
 905     $first_download = 0;
 906   } else {
 907     die "No pending batch.\n";
 908   }
 909
 910   my @cust_pay_batch = sort { $a->paybatchnum <=> $b->paybatchnum }
 911                        $self->cust_pay_batch;
 912
 913   # handle batch-increment_expiration option
 914   if ( $self->payby eq 'CARD' ) {
 915     my ($cmon, $cyear) = (localtime(time))[4,5];
 916     foreach (@cust_pay_batch) {
 917       my $etime = str2time($_->exp) or next;
 918       my ($day, $mon, $year) = (localtime($etime))[3,4,5];
 919       if( $conf->exists('batch-increment_expiration') ) {
 920         $year++ while( $year < $cyear or ($year == $cyear and $mon <= $cmon) );
 921         $_->exp( sprintf('%4u-%02u-%02u', $year + 1900, $mon+1, $day) );
 922       }
 923       my $error = $_->replace;
 924       return $error if $error;
 925     }
 926   }
 927
 928   if ($first_download) { #remove or reduce entries if customer's balance changed
 929
 930     foreach my $cust_pay_batch (@cust_pay_batch) {
 931
 932       my $balance = $cust_pay_batch->cust_main->balance;
 933       if ($balance <= 0) { # then don't charge this customer
 934         my $error = $cust_pay_batch->delete;
 935         return $error if $error;
 936       } elsif ($balance < $cust_pay_batch->amount) {
 937         # reduce the charge to the remaining balance
 938         $cust_pay_batch->amount($balance);
 939         my $error = $cust_pay_batch->replace;
 940         return $error if $error;
 941       }
 942       # else $balance >= $cust_pay_batch->amount
 943     }
 944   } #if $first_download
 945
 946   '';
 947 }
 948
 949 =item export_batch [ format => FORMAT | gateway => GATEWAY ]
 950
 951 Export batch for processing.  FORMAT is the name of an L<FS::pay_batch>
 952 module, in which case the configuration options are in 'batchconfig-FORMAT'.
 953
 954 Alternatively, GATEWAY can be an L<FS::payment_gateway> object set to a
 955 L<Business::BatchPayment> module.
 956
 957 =cut
 958
 959 sub export_batch {
 960   my $self = shift;
 961   my %opt = @_;
 962
 963   my $conf = new FS::Conf;
 964   my $batch;
 965
 966   my $gateway = $opt{'gateway'};
 967   if ( $gateway ) {
 968     # welcome to the future
 969     my $fh = IO::Scalar->new(\$batch);
 970     $self->export_to_gateway($gateway, 'file' => $fh);
 971     return $batch;
 972   }
 973
 974   my $format = $opt{'format'} || $conf->config('batch-default_format')
 975     or die "No batch format configured\n";
 976
 977   my $info = $export_info{$format} or die "Format not found: '$format'\n";
 978
 979   &{$info->{'init'}}($conf, $self->agentnum) if exists($info->{'init'});
 980
 981   my $oldAutoCommit = $FS::UID::AutoCommit;
 982   local $FS::UID::AutoCommit = 0;
 983   my $dbh = dbh;
 984
 985   my $error = $self->prepare_for_export;
 986
 987   die $error if $error;
 988   my $batchtotal = 0;
 989   my $batchcount = 0;
 990
 991   my @cust_pay_batch = $self->cust_pay_batch;
 992
 993   my $delim = exists($info->{'delimiter'}) ? $info->{'delimiter'} : "\n";
 994
 995   my $h = $info->{'header'};
 996   if (ref($h) eq 'CODE') {
 997     $batch .= &$h($self, \@cust_pay_batch). $delim;
 998   } else {
 999     $batch .= $h. $delim;
1000   }
1001
1002   foreach my $cust_pay_batch (@cust_pay_batch) {
1003     $batchcount++;
1004     $batchtotal += $cust_pay_batch->amount;
1005     $batch .=
1006     &{$info->{'row'}}($cust_pay_batch, $self, $batchcount, $batchtotal).
1007     $delim;
1008   }
1009
1010   my $f = $info->{'footer'};
1011   if (ref($f) eq 'CODE') {
1012     $batch .= &$f($self, $batchcount, $batchtotal). $delim;
1013   } else {
1014     $batch .= $f. $delim;
1015   }
1016
1017   if ($info->{'autopost'}) {
1018     my $error = &{$info->{'autopost'}}($self, $batch);
1019     if($error) {
1020       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1021       die $error;
1022     }
1023   }
1024
1025   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1026   return $batch;
1027 }
1028
1029 =item export_to_gateway GATEWAY OPTIONS
1030
1031 Given L<FS::payment_gateway> GATEWAY, export the items in this batch to
1032 that gateway via Business::BatchPayment. OPTIONS may include:
1033
1034 - file: override the default transport and write to this file (name or handle)
1035
1036 =cut
1037
1038 sub export_to_gateway {
1039
1040   my ($self, $gateway, %opt) = @_;
1041
1042   my $oldAutoCommit = $FS::UID::AutoCommit;
1043   local $FS::UID::AutoCommit = 0;
1044   my $dbh = dbh;
1045
1046   my $error = $self->prepare_for_export;
1047   die $error if $error;
1048
1049   my %proc_opt = (
1050     'output' => $opt{'file'}, # will do nothing if it's empty
1051     # any other constructor options go here
1052   );
1053   my $processor = $gateway->batch_processor(%proc_opt);
1054
1055   my @items = map { $_->request_item } $self->cust_pay_batch;
1056   my $batch = Business::BatchPayment->create(Batch =>
1057     batch_id  => $self->batchnum,
1058     items     => \@items
1059   );
1060   $processor->submit($batch);
1061
1062   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1063   '';
1064 }
1065
1066 sub manual_approve {
1067   my $self = shift;
1068   my $date = time;
1069   my %opt = @_;
1070   my $usernum = $opt{'usernum'} || die "manual approval requires a usernum";
1071   my $conf = FS::Conf->new;
1072   return 'manual batch approval disabled'
1073     if ( ! $conf->exists('batch-manual_approval') );
1074   return 'batch already resolved' if $self->status eq 'R';
1075   return 'batch not yet submitted' if $self->status eq 'O';
1076
1077   local $SIG{HUP} = 'IGNORE';
1078   local $SIG{INT} = 'IGNORE';
1079   local $SIG{QUIT} = 'IGNORE';
1080   local $SIG{TERM} = 'IGNORE';
1081   local $SIG{TSTP} = 'IGNORE';
1082   local $SIG{PIPE} = 'IGNORE';
1083
1084   my $oldAutoCommit = $FS::UID::AutoCommit;
1085   local $FS::UID::AutoCommit = 0;
1086   my $dbh = dbh;
1087
1088   my $payments = 0;
1089   foreach my $cust_pay_batch (
1090     qsearch('cust_pay_batch', { batchnum => $self->batchnum,
1091         status   => '' })
1092   ) {
1093     my $new_cust_pay_batch = new FS::cust_pay_batch {
1094       $cust_pay_batch->hash,
1095       'paid'    => $cust_pay_batch->amount,
1096       '_date'   => $date,
1097       'usernum' => $usernum,
1098     };
1099     my $error = $new_cust_pay_batch->approve();
1100     # there are no approval options here (authorization, order_number, etc.)
1101     # because the transaction wasn't really approved
1102     if ( $error ) {
1103       $dbh->rollback;
1104       return 'paybatchnum '.$cust_pay_batch->paybatchnum.": $error";
1105     }
1106     $payments++;
1107   }
1108   $self->set_status('R');
1109   $dbh->commit;
1110   return;
1111 }
1112
1113 sub _upgrade_data {
1114   # Set up configuration for gateways that have a Business::BatchPayment
1115   # module.
1116
1117   eval "use Class::MOP;";
1118   if ( $@ ) {
1119     warn "Moose/Class::MOP not available.\n$@\nSkipping pay_batch upgrade.\n";
1120     return;
1121   }
1122   my $conf = FS::Conf->new;
1123   for my $format (keys %export_info) {
1124     my $mod = "FS::pay_batch::$format";
1125     if ( $mod->can('_upgrade_gateway')
1126         and $conf->exists("batchconfig-$format") ) {
1127
1128       local $@;
1129       my ($module, %gw_options) = $mod->_upgrade_gateway;
1130       my $gateway = FS::payment_gateway->new({
1131           gateway_namespace => 'Business::BatchPayment',
1132           gateway_module    => $module,
1133       });
1134       my $error = $gateway->insert(%gw_options);
1135       if ( $error ) {
1136         warn "Failed to migrate '$format' to a Business::BatchPayment::$module gateway:\n$error\n";
1137         next;
1138       }
1139
1140       # test whether it loads
1141       my $processor = eval { $gateway->batch_processor };
1142       if ( !$processor ) {
1143         warn "Couldn't load Business::BatchPayment module for '$format'.\n";
1144         # if not, remove it so it doesn't hang around and break things
1145         $gateway->delete;
1146       }
1147       else {
1148         # remove the batchconfig-*
1149         warn "Created Business::BatchPayment gateway '".$gateway->label.
1150              "' for '$format' batch processing.\n";
1151         $conf->delete("batchconfig-$format");
1152
1153         # and if appropriate, make it the system default
1154         for my $payby (qw(CARD CHEK)) {
1155           if ( ($conf->config("batch-fixed_format-$payby") || '') eq $format ) {
1156             warn "Setting as default for $payby.\n";
1157             $conf->set("batch-gateway-$payby", $gateway->gatewaynum);
1158             $conf->delete("batch-fixed_format-$payby");
1159           }
1160         }
1161       } # if $processor
1162     } #if can('_upgrade_gateway') and batchconfig-$format
1163   } #for $format
1164
1165   '';
1166 }
1167
1168 =back
1169
1170 =head1 BUGS
1171
1172 status is somewhat redundant now that download and upload exist
1173
1174 =head1 SEE ALSO
1175
1176 L<FS::Record>, schema.html from the base documentation.
1177
1178 =cut
1179
1180 1;
1181