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