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