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