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