FS/FS/pay_batch.pm

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