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