FS/FS/cust_main/Billing.pm

   1 package FS::cust_main::Billing;
   2
   3 use strict;
   4 use vars qw( $conf $DEBUG $me );
   5 use Carp;
   6 use Data::Dumper;
   7 use List::Util qw( min );
   8 use FS::UID qw( dbh );
   9 use FS::Record qw( qsearch qsearchs dbdef );
  10 use FS::Misc::DateTime qw( day_end );
  11 use Tie::RefHash;
  12 use FS::cust_bill;
  13 use FS::cust_bill_pkg;
  14 use FS::cust_bill_pkg_display;
  15 use FS::cust_bill_pay;
  16 use FS::cust_credit_bill;
  17 use FS::cust_tax_adjustment;
  18 use FS::tax_rate;
  19 use FS::tax_rate_location;
  20 use FS::cust_bill_pkg_tax_location;
  21 use FS::cust_bill_pkg_tax_rate_location;
  22 use FS::part_event;
  23 use FS::part_event_condition;
  24 use FS::pkg_category;
  25 use FS::FeeOrigin_Mixin;
  26 use FS::Log;
  27
  28 # 1 is mostly method/subroutine entry and options
  29 # 2 traces progress of some operations
  30 # 3 is even more information including possibly sensitive data
  31 $DEBUG = 0;
  32 $me = '[FS::cust_main::Billing]';
  33
  34 install_callback FS::UID sub {
  35   $conf = new FS::Conf;
  36   #yes, need it for stuff below (prolly should be cached)
  37 };
  38
  39 =head1 NAME
  40
  41 FS::cust_main::Billing - Billing mixin for cust_main
  42
  43 =head1 SYNOPSIS
  44
  45 =head1 DESCRIPTION
  46
  47 These methods are available on FS::cust_main objects.
  48
  49 =head1 METHODS
  50
  51 =over 4
  52
  53 =item bill_and_collect
  54
  55 Cancels and suspends any packages due, generates bills, applies payments and
  56 credits, and applies collection events to run cards, send bills and notices,
  57 etc.
  58
  59 Any errors prevent subsequent operations from continuing and die (but see the
  60 "fatal" flag below).
  61
  62 Options are passed as name-value pairs.  Currently available options are:
  63
  64 =over 4
  65
  66 =item time
  67
  68 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
  69
  70  use Date::Parse;
  71  ...
  72  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  73
  74 =item invoice_time
  75
  76 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
  77
  78 =item check_freq
  79
  80 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
  81
  82 =item resetup
  83
  84 If set true, re-charges setup fees.
  85
  86 =item fatal
  87
  88 If set any errors prevent subsequent operations from continusing.  If set
  89 specifically to "return", returns the error (or false, if there is no error).
  90 Any other true value causes errors to die.
  91
  92 =item debug
  93
  94 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
  95
  96 =item job
  97
  98 Optional FS::queue entry to receive status updates.
  99
 100 =back
 101
 102 Options are passed to the B<bill> and B<collect> methods verbatim, so all
 103 options of those methods are also available.
 104
 105 =cut
 106
 107 sub bill_and_collect {
 108   my( $self, %options ) = @_;
 109
 110   my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
 111   my %logopt = (object => $self);
 112   $log->debug('start', %logopt);
 113
 114   my $error;
 115
 116   #$options{actual_time} not $options{time} because freeside-daily -d is for
 117   #pre-printing invoices
 118
 119   $options{'actual_time'} ||= time;
 120   my $job = $options{'job'};
 121
 122   my $actual_time = ( $conf->exists('next-bill-ignore-time')
 123                         ? day_end( $options{actual_time} )
 124                         : $options{actual_time}
 125                     );
 126
 127   $job->update_statustext('0,cleaning expired packages') if $job;
 128   $log->debug('canceling expired packages', %logopt);
 129   $error = $self->cancel_expired_pkgs( $actual_time );
 130   if ( $error ) {
 131     $error = "Error expiring custnum ". $self->custnum. ": $error";
 132     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 133     else                                                     { die    $error; }
 134   }
 135
 136   $log->debug('suspending adjourned packages', %logopt);
 137   $error = $self->suspend_adjourned_pkgs( $actual_time );
 138   if ( $error ) {
 139     $error = "Error adjourning custnum ". $self->custnum. ": $error";
 140     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 141     else                                                     { die    $error; }
 142   }
 143
 144   $log->debug('unsuspending resumed packages', %logopt);
 145   $error = $self->unsuspend_resumed_pkgs( $actual_time );
 146   if ( $error ) {
 147     $error = "Error resuming custnum ".$self->custnum. ": $error";
 148     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 149     else                                                     { die    $error; }
 150   }
 151
 152   $job->update_statustext('20,billing packages') if $job;
 153   $log->debug('billing packages', %logopt);
 154   $error = $self->bill( %options );
 155   if ( $error ) {
 156     $error = "Error billing custnum ". $self->custnum. ": $error";
 157     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 158     else                                                     { die    $error; }
 159   }
 160
 161   $job->update_statustext('50,applying payments and credits') if $job;
 162   $log->debug('applying payments and credits', %logopt);
 163   $error = $self->apply_payments_and_credits;
 164   if ( $error ) {
 165     $error = "Error applying custnum ". $self->custnum. ": $error";
 166     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 167     else                                                     { die    $error; }
 168   }
 169
 170   unless ( $conf->exists('cancelled_cust-noevents')
 171            && ! $self->num_ncancelled_pkgs
 172   ) {
 173     $job->update_statustext('70,running collection events') if $job;
 174     $log->debug('running collection events', %logopt);
 175     $error = $self->collect( %options );
 176     if ( $error ) {
 177       $error = "Error collecting custnum ". $self->custnum. ": $error";
 178       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
 179       else                                                   { die    $error; }
 180     }
 181   }
 182
 183   $job->update_statustext('100,finished') if $job;
 184   $log->debug('finish', %logopt);
 185
 186   '';
 187
 188 }
 189
 190 sub cancel_expired_pkgs {
 191   my ( $self, $time, %options ) = @_;
 192
 193   my @cancel_pkgs = $self->ncancelled_pkgs( {
 194     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
 195   } );
 196
 197   my @errors = ();
 198
 199   my @really_cancel_pkgs = ();
 200   my @cancel_reasons = ();
 201
 202   CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
 203     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
 204
 205     if ( $cust_pkg->change_to_pkgnum ) {
 206
 207       my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
 208       if ( !$new_pkg ) {
 209         push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
 210                       $cust_pkg->change_to_pkgnum.'; not expiring';
 211         next CUST_PKG;
 212       }
 213       my $error = $cust_pkg->change( 'cust_pkg'        => $new_pkg,
 214                                      'unprotect_svcs'  => 1,
 215                                    );
 216       push @errors, $error if $error && ref($error) ne 'FS::cust_pkg';
 217
 218     } else { # just cancel it
 219
 220       push @really_cancel_pkgs, $cust_pkg;
 221       push @cancel_reasons, $cpr;
 222
 223     }
 224   }
 225
 226   if (@really_cancel_pkgs) {
 227
 228     my %cancel_opt = ( 'cust_pkg' => \@really_cancel_pkgs,
 229                        'cust_pkg_reason' => \@cancel_reasons,
 230                        'time' => $time,
 231                      );
 232
 233     push @errors, $self->cancel_pkgs(%cancel_opt);
 234
 235   }
 236
 237   join(' / ', @errors);
 238
 239 }
 240
 241 sub suspend_adjourned_pkgs {
 242   my ( $self, $time, %options ) = @_;
 243
 244   my @susp_pkgs = $self->ncancelled_pkgs( {
 245     'extra_sql' =>
 246       " AND ( susp IS NULL OR susp = 0 )
 247         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
 248               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
 249             )
 250       ",
 251   } );
 252
 253   #only because there's no SQL test for is_prepaid :/
 254   @susp_pkgs =
 255     grep {     (    $_->part_pkg->is_prepaid
 256                  && $_->bill
 257                  && $_->bill < $time
 258                )
 259             || (    $_->adjourn
 260                  && $_->adjourn <= $time
 261                )
 262
 263          }
 264          @susp_pkgs;
 265
 266   my @errors = ();
 267
 268   foreach my $cust_pkg ( @susp_pkgs ) {
 269     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
 270       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
 271     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
 272                                             'reason_otaker' => $cpr->otaker
 273                                           )
 274                                         : ()
 275                                   );
 276     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 277   }
 278
 279   join(' / ', @errors);
 280
 281 }
 282
 283 sub unsuspend_resumed_pkgs {
 284   my ( $self, $time, %options ) = @_;
 285
 286   my @unsusp_pkgs = $self->ncancelled_pkgs( {
 287     'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
 288   } );
 289
 290   my @errors = ();
 291
 292   foreach my $cust_pkg ( @unsusp_pkgs ) {
 293     my $error = $cust_pkg->unsuspend( 'time' => $time );
 294     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 295   }
 296
 297   join(' / ', @errors);
 298
 299 }
 300
 301 =item bill OPTIONS
 302
 303 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 304 conjunction with the collect method by calling B<bill_and_collect>.
 305
 306 If there is an error, returns the error, otherwise returns false.
 307
 308 Options are passed as name-value pairs.  Currently available options are:
 309
 310 =over 4
 311
 312 =item resetup
 313
 314 If set true, re-charges setup fees.
 315
 316 =item recurring_only
 317
 318 If set true then only bill recurring charges, not setup, usage, one time
 319 charges, etc.
 320
 321 =item freq_override
 322
 323 If set, then override the normal frequency and look for a part_pkg_discount
 324 to take at that frequency.  This is appropriate only when the normal
 325 frequency for all packages is monthly, and is an error otherwise.  Use
 326 C<pkg_list> to limit the set of packages included in billing.
 327
 328 =item time
 329
 330 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
 331
 332  use Date::Parse;
 333  ...
 334  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 335
 336 =item pkg_list
 337
 338 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
 339
 340  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
 341
 342 =item not_pkgpart
 343
 344 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
 345
 346 =item no_prepaid
 347
 348 Do not bill prepaid packages.  Used by freeside-daily.
 349
 350 =item invoice_time
 351
 352 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
 353
 354 =item cancel
 355
 356 This boolean value informs the us that the package is being cancelled.  This
 357 typically might mean not charging the normal recurring fee but only usage
 358 fees since the last billing. Setup charges may be charged.  Not all package
 359 plans support this feature (they tend to charge 0).
 360
 361 =item no_usage_reset
 362
 363 Prevent the resetting of usage limits during this call.
 364
 365 =item no_commit
 366
 367 Do not save the generated bill in the database.  Useful with return_bill
 368
 369 =item return_bill
 370
 371 A list reference on which the generated bill(s) will be returned.
 372
 373 =item invoice_terms
 374
 375 Optional terms to be printed on this invoice.  Otherwise, customer-specific
 376 terms or the default terms are used.
 377
 378 =back
 379
 380 =cut
 381
 382 sub bill {
 383   my( $self, %options ) = @_;
 384
 385   return '' if $self->payby eq 'COMP';
 386
 387   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 388   my $log = FS::Log->new('FS::cust_main::Billing::bill');
 389   my %logopt = (object => $self);
 390
 391   $log->debug('start', %logopt);
 392   warn "$me bill customer ". $self->custnum. "\n"
 393     if $DEBUG;
 394
 395   my $time = $options{'time'} || time;
 396   my $invoice_time = $options{'invoice_time'} || $time;
 397
 398   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
 399                      ? day_end( $time )
 400                      : $time
 401                  );
 402
 403   $options{'not_pkgpart'} ||= {};
 404   $options{'not_pkgpart'} = { map { $_ => 1 }
 405                                   split(/\s*,\s*/, $options{'not_pkgpart'})
 406                             }
 407     unless ref($options{'not_pkgpart'});
 408
 409   local $SIG{HUP} = 'IGNORE';
 410   local $SIG{INT} = 'IGNORE';
 411   local $SIG{QUIT} = 'IGNORE';
 412   local $SIG{TERM} = 'IGNORE';
 413   local $SIG{TSTP} = 'IGNORE';
 414   local $SIG{PIPE} = 'IGNORE';
 415
 416   my $oldAutoCommit = $FS::UID::AutoCommit;
 417   local $FS::UID::AutoCommit = 0;
 418   my $dbh = dbh;
 419
 420   $log->debug('acquiring lock', %logopt);
 421   warn "$me acquiring lock on customer ". $self->custnum. "\n"
 422     if $DEBUG;
 423
 424   $self->select_for_update; #mutex
 425
 426   $log->debug('running pre-bill events', %logopt);
 427   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
 428     if $DEBUG;
 429
 430   my $error = $self->do_cust_event(
 431     'debug'      => ( $options{'debug'} || 0 ),
 432     'time'       => $invoice_time,
 433     'check_freq' => $options{'check_freq'},
 434     'stage'      => 'pre-bill',
 435   )
 436     unless $options{no_commit};
 437   if ( $error ) {
 438     $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 439     return $error;
 440   }
 441
 442   $log->debug('done running pre-bill events', %logopt);
 443   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
 444     if $DEBUG;
 445
 446   #keep auto-charge and non-auto-charge line items separate
 447   my @passes = ( '', 'no_auto' );
 448
 449   my %cust_bill_pkg = map { $_ => [] } @passes;
 450
 451   ###
 452   # find the packages which are due for billing, find out how much they are
 453   # & generate invoice database.
 454   ###
 455
 456   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
 457   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
 458
 459   my %taxlisthash = map { $_ => {} } @passes;
 460
 461   my @precommit_hooks = ();
 462
 463   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
 464
 465   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
 466
 467     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
 468
 469     my $part_pkg = $cust_pkg->part_pkg;
 470
 471     next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
 472
 473     $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
 474     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
 475
 476     #? to avoid use of uninitialized value errors... ?
 477     $cust_pkg->setfield('bill', '')
 478       unless defined($cust_pkg->bill);
 479
 480     my $real_pkgpart = $cust_pkg->pkgpart;
 481     my %hash = $cust_pkg->hash;
 482
 483     # we could implement this bit as FS::part_pkg::has_hidden, but we already
 484     # suffer from performance issues
 485     $options{has_hidden} = 0;
 486     my @part_pkg = $part_pkg->self_and_bill_linked;
 487     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 488
 489     # if this package was changed from another package,
 490     # and it hasn't been billed since then,
 491     # and package balances are enabled,
 492     if ( $cust_pkg->change_pkgnum
 493         and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
 494         and $cust_pkg->change_date <  $invoice_time
 495       and $conf->exists('pkg-balances') )
 496     {
 497       # _transfer_balance will also create the appropriate credit
 498       my @transfer_items = $self->_transfer_balance($cust_pkg);
 499       # $part_pkg[0] is the "real" part_pkg
 500       my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
 501                   'no_auto' : '';
 502       push @{ $cust_bill_pkg{$pass} }, @transfer_items;
 503       # treating this as recur, just because most charges are recur...
 504       ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
 505
 506       # currently not considering separate_bill here, as it's for
 507       # one-time charges only
 508     }
 509
 510     foreach my $part_pkg ( @part_pkg ) {
 511
 512       my $this_cust_pkg = $cust_pkg;
 513       # for add-on packages, copy the object to avoid leaking changes back to
 514       # the caller if pkg_list is in use; see RT#73607
 515       if ( $part_pkg->get('pkgpart') != $real_pkgpart ) {
 516         $this_cust_pkg = FS::cust_pkg->new({ %hash });
 517       }
 518
 519       my $pass = '';
 520       if ( $this_cust_pkg->separate_bill ) {
 521         # if no_auto is also set, that's fine. we just need to not have
 522         # invoices that are both auto and no_auto, and since the package
 523         # gets an invoice all to itself, it will only be one or the other.
 524         $pass = $this_cust_pkg->pkgnum;
 525         if (!exists $cust_bill_pkg{$pass}) { # it may not exist yet
 526           push @passes, $pass;
 527           $total_setup{$pass} = do { my $z = 0; \$z };
 528           $total_recur{$pass} = do { my $z = 0; \$z };
 529           $taxlisthash{$pass} = {};
 530           $cust_bill_pkg{$pass} = [];
 531         }
 532       } elsif ( ($this_cust_pkg->no_auto || $part_pkg->no_auto) ) {
 533         $pass = 'no_auto';
 534       }
 535
 536       my $next_bill = $this_cust_pkg->getfield('bill') || 0;
 537       my $error;
 538       # let this run once if this is the last bill upon cancellation
 539       while ( $next_bill <= $cmp_time or $options{cancel} ) {
 540         $error =
 541           $self->_make_lines( 'part_pkg'            => $part_pkg,
 542                               'cust_pkg'            => $this_cust_pkg,
 543                               'precommit_hooks'     => \@precommit_hooks,
 544                               'line_items'          => $cust_bill_pkg{$pass},
 545                               'setup'               => $total_setup{$pass},
 546                               'recur'               => $total_recur{$pass},
 547                               'tax_matrix'          => $taxlisthash{$pass},
 548                               'time'                => $time,
 549                               'real_pkgpart'        => $real_pkgpart,
 550                               'options'             => \%options,
 551                             );
 552
 553         # Stop if anything goes wrong
 554         last if $error;
 555
 556         # or if we're not incrementing the bill date.
 557         last if ($this_cust_pkg->getfield('bill') || 0) == $next_bill;
 558
 559         # or if we're letting it run only once
 560         last if $options{cancel};
 561
 562         $next_bill = $this_cust_pkg->getfield('bill') || 0;
 563
 564         #stop if -o was passed to freeside-daily
 565         last if $options{'one_recur'};
 566       }
 567       if ($error) {
 568         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 569         return $error;
 570       }
 571
 572     } #foreach my $part_pkg
 573
 574   } #foreach my $cust_pkg
 575
 576   foreach my $pass (@passes) { # keys %cust_bill_pkg )
 577
 578     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
 579
 580     warn "$me billing pass $pass\n"
 581            #.Dumper(\@cust_bill_pkg)."\n"
 582       if $DEBUG > 2;
 583
 584     ###
 585     # process fees
 586     ###
 587
 588     my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
 589       hashref => { 'billpkgnum' => '' }
 590     );
 591     warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
 592       if @pending_fees and $DEBUG > 1;
 593
 594     # determine whether to generate an invoice
 595     my $generate_bill = scalar(@cust_bill_pkg) > 0;
 596
 597     foreach my $fee (@pending_fees) {
 598       $generate_bill = 1 unless $fee->nextbill;
 599     }
 600
 601     # don't create an invoice with no line items, or where the only line
 602     # items are fees that are supposed to be held until the next invoice
 603     next if !$generate_bill;
 604
 605     # calculate fees...
 606     my @fee_items;
 607     foreach my $fee_origin (@pending_fees) {
 608       my $part_fee = $fee_origin->part_fee;
 609
 610       # check whether the fee is applicable before doing anything expensive:
 611       #
 612       # if the fee def belongs to a different agent, don't charge the fee.
 613       # event conditions should prevent this, but just in case they don't,
 614       # skip the fee.
 615       if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
 616         warn "tried to charge fee#".$part_fee->feepart .
 617              " on customer#".$self->custnum." from a different agent.\n";
 618         next;
 619       }
 620       # also skip if it's disabled
 621       next if $part_fee->disabled eq 'Y';
 622
 623       # Decide which invoice to base the fee on.
 624       my $cust_bill = $fee_origin->cust_bill;
 625       if (!$cust_bill) {
 626         # Then link it to the current invoice. This isn't the real cust_bill
 627         # object that will be inserted--in particular there are no taxes yet.
 628         # If you want to charge a fee on the total invoice amount including
 629         # taxes, you have to put the fee on the next invoice.
 630         $cust_bill = FS::cust_bill->new({
 631             'custnum'       => $self->custnum,
 632             'cust_bill_pkg' => \@cust_bill_pkg,
 633             'charged'       => ${ $total_setup{$pass} } +
 634                                ${ $total_recur{$pass} },
 635         });
 636
 637         # If the origin is for a specific package, then only apply the fee to
 638         # line items from that package.
 639         if ( my $cust_pkg = $fee_origin->cust_pkg ) {
 640           my @charge_fee_on_item;
 641           my $charge_fee_on_amount = 0;
 642           foreach (@cust_bill_pkg) {
 643             if ($_->pkgnum == $cust_pkg->pkgnum) {
 644               push @charge_fee_on_item, $_;
 645               $charge_fee_on_amount += $_->setup + $_->recur;
 646             }
 647           }
 648           $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
 649           $cust_bill->set('charged', $charge_fee_on_amount);
 650         }
 651
 652       } # $cust_bill is now set
 653       # calculate the fee
 654       my $fee_item = $part_fee->lineitem($cust_bill) or next;
 655       # link this so that we can clear the marker on inserting the line item
 656       $fee_item->set('fee_origin', $fee_origin);
 657       push @fee_items, $fee_item;
 658
 659     }
 660
 661     # add fees to the invoice
 662     foreach my $fee_item (@fee_items) {
 663
 664       push @cust_bill_pkg, $fee_item;
 665       ${ $total_setup{$pass} } += $fee_item->setup;
 666       ${ $total_recur{$pass} } += $fee_item->recur;
 667
 668       my $part_fee = $fee_item->part_fee;
 669       my $fee_location = $self->ship_location; # I think?
 670
 671       my $error = $self->_handle_taxes(
 672         $taxlisthash{$pass},
 673         $fee_item,
 674         location => $fee_location
 675         # probably not right to pass cancel => 1 for fees
 676       );
 677       return $error if $error;
 678
 679     }
 680
 681     # XXX implementation of fees is supposed to make this go away...
 682     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 683            !$conf->exists('postal_invoice-recurring_only')
 684        )
 685     {
 686
 687       my $postal_pkg = $self->charge_postal_fee();
 688       if ( $postal_pkg && !ref( $postal_pkg ) ) {
 689
 690         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 691         return "can't charge postal invoice fee for customer ".
 692           $self->custnum. ": $postal_pkg";
 693
 694       } elsif ( $postal_pkg ) {
 695
 696         my $real_pkgpart = $postal_pkg->pkgpart;
 697         # we could implement this bit as FS::part_pkg::has_hidden, but we already
 698         # suffer from performance issues
 699         $options{has_hidden} = 0;
 700         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
 701         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 702
 703         foreach my $part_pkg ( @part_pkg ) {
 704           my %postal_options = %options;
 705           delete $postal_options{cancel};
 706           my $error =
 707             $self->_make_lines( 'part_pkg'            => $part_pkg,
 708                                 'cust_pkg'            => $postal_pkg,
 709                                 'precommit_hooks'     => \@precommit_hooks,
 710                                 'line_items'          => \@cust_bill_pkg,
 711                                 'setup'               => $total_setup{$pass},
 712                                 'recur'               => $total_recur{$pass},
 713                                 'tax_matrix'          => $taxlisthash{$pass},
 714                                 'time'                => $time,
 715                                 'real_pkgpart'        => $real_pkgpart,
 716                                 'options'             => \%postal_options,
 717                               );
 718           if ($error) {
 719             $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 720             return $error;
 721           }
 722         }
 723
 724         # it's silly to have a zero value postal_pkg, but....
 725         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
 726
 727       }
 728
 729     }
 730
 731     my $listref_or_error =
 732       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
 733
 734     unless ( ref( $listref_or_error ) ) {
 735       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 736       return $listref_or_error;
 737     }
 738
 739     foreach my $taxline ( @$listref_or_error ) {
 740       ${ $total_setup{$pass} } =
 741         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
 742       push @cust_bill_pkg, $taxline;
 743     }
 744
 745     #add tax adjustments
 746     warn "adding tax adjustments...\n" if $DEBUG > 2;
 747     foreach my $cust_tax_adjustment (
 748       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
 749                                        'billpkgnum' => '',
 750                                      }
 751              )
 752     ) {
 753
 754       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
 755
 756       my $itemdesc = $cust_tax_adjustment->taxname;
 757       $itemdesc = '' if $itemdesc eq 'Tax';
 758
 759       push @cust_bill_pkg, new FS::cust_bill_pkg {
 760         'pkgnum'      => 0,
 761         'setup'       => $tax,
 762         'recur'       => 0,
 763         'sdate'       => '',
 764         'edate'       => '',
 765         'itemdesc'    => $itemdesc,
 766         'itemcomment' => $cust_tax_adjustment->comment,
 767         'cust_tax_adjustment' => $cust_tax_adjustment,
 768         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 769       };
 770
 771     }
 772
 773     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
 774
 775     my $balance = $self->balance;
 776
 777     my $previous_bill = qsearchs({ 'table'     => 'cust_bill',
 778                                    'hashref'   => { custnum=>$self->custnum },
 779                                    'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
 780                                 });
 781     my $previous_balance =
 782       $previous_bill
 783         ? ( $previous_bill->billing_balance + $previous_bill->charged )
 784         : 0;
 785
 786     $log->debug('creating the new invoice', %logopt);
 787     warn "creating the new invoice\n" if $DEBUG;
 788     #create the new invoice
 789     my $cust_bill = new FS::cust_bill ( {
 790       'custnum'             => $self->custnum,
 791       '_date'               => $invoice_time,
 792       'charged'             => $charged,
 793       'billing_balance'     => $balance,
 794       'previous_balance'    => $previous_balance,
 795       'invoice_terms'       => $options{'invoice_terms'},
 796       'cust_bill_pkg'       => \@cust_bill_pkg,
 797     } );
 798     $error = $cust_bill->insert unless $options{no_commit};
 799     if ( $error ) {
 800       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 801       return "can't create invoice for customer #". $self->custnum. ": $error";
 802     }
 803     push @{$options{return_bill}}, $cust_bill if $options{return_bill};
 804
 805   } #foreach my $pass ( keys %cust_bill_pkg )
 806
 807   foreach my $hook ( @precommit_hooks ) {
 808     eval {
 809       &{$hook}; #($self) ?
 810     } unless $options{no_commit};
 811     if ( $@ ) {
 812       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 813       return "$@ running precommit hook $hook\n";
 814     }
 815   }
 816
 817   $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
 818
 819   ''; #no error
 820 }
 821
 822 #discard bundled packages of 0 value
 823 # XXX we should reconsider whether we even need this
 824 sub _omit_zero_value_bundles {
 825   my @in = @_;
 826
 827   my @out = ();
 828   my @bundle = ();
 829   my $discount_show_always = $conf->exists('discount-show-always');
 830   my $show_this = 0;
 831
 832   # Sort @in the same way we do during invoice rendering, so we can identify
 833   # bundles.  See FS::Template_Mixin::_items_nontax.
 834   @in = sort { $a->pkgnum <=> $b->pkgnum        or
 835                $a->sdate  <=> $b->sdate         or
 836                ($a->pkgpart_override ? 0 : -1)  or
 837                ($b->pkgpart_override ? 0 : 1)   or
 838                $b->hidden cmp $a->hidden        or
 839                $a->pkgpart_override <=> $b->pkgpart_override
 840              } @in;
 841
 842   # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg
 843   # _without_ pkgpart_override, that's the start of the new bundle. if there's
 844   # an existing bundle, and it contains a nonzero amount (or a zero amount
 845   # that's displayable anyway), push all line items in the bundle.
 846   foreach my $cust_bill_pkg ( @in ) {
 847
 848     if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) {
 849       # ship out this bundle and reset it
 850       if ( $show_this ) {
 851         push @out, @bundle;
 852       }
 853       @bundle = ();
 854       $show_this = 0;
 855     }
 856
 857     # add this item to the current bundle
 858     push @bundle, $cust_bill_pkg;
 859
 860     # determine if it makes the bundle displayable
 861     if (   $cust_bill_pkg->setup > 0
 862         or $cust_bill_pkg->recur > 0
 863         or $cust_bill_pkg->setup_show_zero
 864         or $cust_bill_pkg->recur_show_zero
 865         or ($discount_show_always
 866           and scalar(@{ $cust_bill_pkg->get('discounts')})
 867           )
 868     ) {
 869       $show_this++;
 870     }
 871   }
 872
 873   # last bundle
 874   if ( $show_this) {
 875     push @out, @bundle;
 876   }
 877
 878   warn "  _omit_zero_value_bundles: ". scalar(@in).
 879        '->'. scalar(@out). "\n" #. Dumper(@out). "\n"
 880     if $DEBUG > 2;
 881
 882   @out;
 883 }
 884
 885 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
 886
 887 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
 888 Usually used internally by bill method B<bill>.
 889
 890 If there is an error, returns the error, otherwise returns reference to a
 891 list of line items suitable for insertion.
 892
 893 =over 4
 894
 895 =item LINEITEMREF
 896
 897 An array ref of the line items being billed.
 898
 899 =item TAXHASHREF
 900
 901 A strange beast.  The keys to this hash are internal identifiers consisting
 902 of the name of the tax object type, a space, and its unique identifier ( e.g.
 903  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
 904 item in the list is the tax object.  The remaining items are either line
 905 items or floating point values (currency amounts).
 906
 907 The taxes are calculated on this entity.  Calculated exemption records are
 908 transferred to the LINEITEMREF items on the assumption that they are related.
 909
 910 Read the source.
 911
 912 =item INVOICE_TIME
 913
 914 This specifies the date appearing on the associated invoice.  Some
 915 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
 916
 917 =back
 918
 919 =cut
 920
 921 sub calculate_taxes {
 922   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
 923
 924   # $taxlisthash is a hashref
 925   # keys are identifiers, values are arrayrefs
 926   # each arrayref starts with a tax object (cust_main_county or tax_rate)
 927   # then a cust_bill_pkg object the tax applies to, then the charge class
 928   # on that object (setup, recur, a usage class number, or '')
 929   # For internal taxes the charge class is always undef.
 930
 931   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 932
 933   warn "$me calculate_taxes\n"
 934        #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
 935     if $DEBUG > 2;
 936
 937   my $custnum = $self->custnum;
 938   # The main tax accumulator.  One bin for each tax name (itemdesc).
 939   # For each subdivision of tax under this name, push a cust_bill_pkg item
 940   # for the calculated tax into the arrayref.
 941   # keys are tax names
 942   # values are arrayrefs of tax lines
 943   my %taxname = ();
 944
 945   # keys are taxlisthash keys (internal identifiers)
 946   # values are (cumulative) amounts
 947   my %tax_amount = ();
 948
 949   # keys are taxlisthash keys
 950   # values are arrayrefs of cust_tax_exempt_pkg objects
 951   my %tax_exemption;
 952
 953   # For tax on tax calculation, we need to remember which taxable items
 954   # (and charge classes) had which taxes applied to them.
 955   #
 956   # keys are cust_bill_pkg objects (taxable items)
 957   # values are hashrefs
 958   #   keys are charge classes
 959   #   values are hashrefs
 960   #     keys are taxnums (in tax_rate only; cust_main_county doesn't use this)
 961   #     values are the taxlines generated for those taxes
 962   tie my %item_has_tax, 'Tie::RefHash',
 963     map { $_ => {} } @$cust_bill_pkg;
 964
 965   foreach my $tax_id ( keys %$taxlisthash ) {
 966     # $tax_id: the identifier of the tax we are calculating in this pass
 967
 968     my $taxables = $taxlisthash->{$tax_id};
 969     my $tax_object = shift @$taxables;
 970     my $taxnum = $tax_object->taxnum;
 971     # $tax_object is a cust_main_county or tax_rate
 972     # (with billpkgnum, pkgnum, locationnum set)
 973     # the rest of @{ $taxlisthash->{$tax_id} } is cust_bill_pkg objects,
 974     # optionally followed by their charge classes.
 975     warn "found ". $tax_object->taxname. " as $tax_id\n" if $DEBUG > 2;
 976
 977     # taxline calculates the tax on all cust_bill_pkgs in the
 978     # first (arrayref) argument.
 979     #
 980     # Note that non-monthly exemptions have already been calculated and
 981     # attached to the items.  Monthly exemptions will be attached in this
 982     # step.
 983     my $exemptions = $tax_exemption{$tax_id} ||= [];
 984     if ( $tax_object->isa('FS::tax_rate') ) { # EXTERNAL TAXES
 985       # STILL have tax_rate-specific crap in here...
 986       my @taxlines = $tax_object->taxline( $taxables,
 987                               'custnum'      => $custnum,
 988                               'invoice_time' => $invoice_time,
 989                               'exemptions'   => $exemptions,
 990                               );
 991       next if !@taxlines;
 992       if (!ref $taxlines[0]) {
 993         # it's an error string
 994         warn "error evaluating $tax_id on custnum $custnum\n";
 995         return $taxlines[0];
 996       }
 997       foreach my $taxline (@taxlines) {
 998         push @{ $taxname{ $taxline->itemdesc } }, $taxline;
 999         my $link = $taxline->get('cust_bill_pkg_tax_rate_location')->[0];
1000         my $taxable_item = $link->taxable_cust_bill_pkg;
1001         $item_has_tax{$taxable_item}{$taxline->_class}{$taxnum} = $taxline;
1002       }
1003
1004     } else { # INTERNAL TAXES
1005       # we can do this in a single taxline, because it's not stupid
1006
1007       my $taxline =  $tax_object->taxline( $taxables,
1008                         'custnum'      => $custnum,
1009                         'invoice_time' => $invoice_time,
1010                         'exemptions'   => $exemptions,
1011                       );
1012       next if !$taxline;
1013       if (!ref $taxline) {
1014         # it's an error string
1015         warn "error evaluating $tax_id on custnum $custnum\n";
1016         return $taxline;
1017       }
1018       # if the calculated tax is zero, don't even keep it
1019       next if $taxline->setup < 0.001;
1020       push @{ $taxname{ $taxline->itemdesc } }, $taxline;
1021     }
1022   }
1023   $DB::single = 1; # XXX
1024
1025   # all first-tier taxes are calculated.  now for tax on tax:
1026
1027   foreach my $taxable_item ( @$cust_bill_pkg ) {
1028     # taxes that apply to this item
1029     my $this_has_tax = $item_has_tax{$taxable_item};
1030
1031     my $location = $taxable_item->tax_location;
1032
1033     foreach my $charge_class (keys %$this_has_tax) {
1034       # taxes that apply to this item and charge class
1035       my $this_class_has_tax = $this_has_tax->{$charge_class};
1036       foreach my $taxnum (keys %$this_class_has_tax) {
1037
1038         # for each tax item that was calculated in phase 1, get the
1039         # tax definition
1040         my $tax_object = FS::tax_rate->by_key($taxnum);
1041         # and find all taxes that apply to it in this location
1042         my @tot = $tax_object->tax_on_tax( $location );
1043         next if !@tot;
1044         warn "found possible taxed taxnum $taxnum\n"
1045           if $DEBUG > 2;
1046         # Calculate ToT separately for each taxable item and class, and only
1047         # if _that class on the item_ is already taxed under the ToT.  This is
1048         # counterintuitive.
1049         # See RT#5243 and RT#36380.
1050         foreach my $tot (@tot) {
1051           my $totnum = $tot->taxnum;
1052           warn "checking taxnum $totnum which we call ". $tot->taxname ."\n"
1053             if $DEBUG > 2;
1054           # note: if the _null class_ on this item is taxed under the ToT,
1055           # then this specific class is taxed also (because null class
1056           # includes all classes) and so ToT is applicable.
1057           if (
1058                 exists $this_class_has_tax->{ $totnum }
1059              or exists $this_has_tax->{''}{ $totnum }
1060           ) {
1061
1062             warn "calculating tax on tax: taxnum $totnum on $taxnum\n"
1063               if $DEBUG;
1064             my @taxlines = $tot->taxline(
1065                               $this_class_has_tax->{ $taxnum }, # the first-stage tax
1066                               'custnum'       => $custnum,
1067                               'invoice_time'  => $invoice_time,
1068                              );
1069             next if (!@taxlines); # it didn't apply after all
1070             if (!ref($taxlines[0])) {
1071               warn "error evaluating taxnum $totnum TOT on custnum $custnum\n";
1072               return $taxlines[0];
1073             }
1074             foreach my $taxline (@taxlines) {
1075               push @{ $taxname{ $taxline->itemdesc } }, $taxline;
1076             }
1077           } # if $has_tax
1078         } # foreach my $tot (tax-on-tax rate definition)
1079       } # foreach $taxnum (first-tier rate definition)
1080     } # foreach $charge_class
1081   } # foreach $taxable_item
1082
1083   #consolidate and create tax line items
1084   warn "consolidating and generating...\n" if $DEBUG > 2;
1085   my %final_tax_items; # taxname => item
1086   foreach my $taxname ( keys %taxname ) {
1087     my @cust_bill_pkg_tax_location;
1088     my @cust_bill_pkg_tax_rate_location;
1089     my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({
1090         'pkgnum'    => 0,
1091         'recur'     => 0,
1092         'sdate'     => '',
1093         'edate'     => '',
1094         'itemdesc'  => $taxname,
1095         'cust_bill_pkg_tax_location'      => \@cust_bill_pkg_tax_location,
1096         'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
1097     });
1098
1099     my $tax_total = 0;
1100     my %seen = ();
1101     warn "adding $taxname\n" if $DEBUG > 1;
1102     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
1103       next if $taxitem->get('setup') == 0;
1104       # if ( ref($taxitem) eq 'FS::cust_bill_pkg' )  # always true
1105       # then we need to transfer the amount and the links from the
1106       # line item to the new one we're creating.
1107       $tax_total += $taxitem->setup;
1108       my @links = @{
1109         $taxitem->get('cust_bill_pkg_tax_location') ||
1110         $taxitem->get('cust_bill_pkg_tax_rate_location') ||
1111         []
1112       };
1113       foreach my $link ( @links ) {
1114         $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg);
1115         if ($link->isa('FS::cust_bill_pkg_tax_location')) {
1116           push @cust_bill_pkg_tax_location, $link;
1117         } elsif ($link->isa('FS::cust_bill_pkg_tax_rate_location')) {
1118           push @cust_bill_pkg_tax_rate_location, $link;
1119         }
1120       }
1121     }
1122     next unless $tax_total;
1123
1124     # we should really neverround this up...I guess it's okay if taxline
1125     # already returns amounts with 2 decimal places
1126     $tax_total = sprintf('%.2f', $tax_total );
1127     $tax_cust_bill_pkg->set('setup', $tax_total);
1128
1129     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
1130                                                    'disabled'     => '',
1131                                                  },
1132                                );
1133
1134     my @display = ();
1135     if ( $pkg_category and
1136          $conf->config('invoice_latexsummary') ||
1137          $conf->config('invoice_htmlsummary')
1138        )
1139     {
1140
1141       my %hash = (  'section' => $pkg_category->categoryname );
1142       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1143
1144     }
1145     $tax_cust_bill_pkg->set('display', \@display);
1146
1147     $final_tax_items{$taxname} = $tax_cust_bill_pkg;
1148   } # foreach $taxname
1149
1150   # fix ToT backlinks for taxes that have been consolidated
1151   # (has to be done in a separate pass)
1152   foreach my $tax_item (values %final_tax_items) {
1153     foreach my $taxable_link (@{ $tax_item->cust_bill_pkg_tax_rate_location }) {
1154       my $taxed_item = $taxable_link->taxable_cust_bill_pkg;
1155       next if $taxed_item->pkgnum > 0; # primary taxes
1156       my $taxname = $taxed_item->itemdesc;
1157       $taxable_link->set('taxable_cust_bill_pkg', $final_tax_items{ $taxname });
1158     }
1159   }
1160
1161   [ values %final_tax_items ]
1162 }
1163
1164 sub _make_lines {
1165   my ($self, %params) = @_;
1166
1167   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1168
1169   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
1170   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
1171   my $cust_location = $cust_pkg->tax_location;
1172   my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
1173   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
1174   my $total_setup = $params{setup} or die "no setup accumulator specified";
1175   my $total_recur = $params{recur} or die "no recur accumulator specified";
1176   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
1177   my $time = $params{'time'} or die "no time specified";
1178   my (%options) = %{$params{options}};
1179
1180   if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
1181     # this should never happen
1182     die 'freq_override billing attempted on non-monthly package '.
1183       $cust_pkg->pkgnum;
1184   }
1185
1186   my $dbh = dbh;
1187   my $real_pkgpart = $params{real_pkgpart};
1188   my %hash = $cust_pkg->hash;
1189   my $old_cust_pkg = new FS::cust_pkg \%hash;
1190
1191   my @details = ();
1192   my $lineitems = 0;
1193
1194   $cust_pkg->pkgpart($part_pkg->pkgpart);
1195
1196   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1197                      ? day_end( $time )
1198                      : $time
1199                  );
1200
1201   ###
1202   # bill setup
1203   ###
1204
1205   my $setup = 0;
1206   my $unitsetup = 0;
1207   my @setup_discounts = ();
1208   my %setup_param = ( 'discounts'    => \@setup_discounts,
1209                       'real_pkgpart' => $params{real_pkgpart}
1210                     );
1211   # Conditions for setting setup date and charging the setup fee:
1212   # - this is not a recurring-only billing run
1213   # - and the package is not currently being canceled
1214   # - and, unless we're specifically told otherwise via 'resetup':
1215   #   - it doesn't already HAVE a setup date
1216   #   - or a start date in the future
1217   #   - and it's not suspended
1218   # - and it doesn't have an expire date in the past
1219   #
1220   # The "disable_setup_suspended" option is now obsolete; we never set the
1221   # setup date on a suspended package.
1222   if (     ! $options{recurring_only}
1223        and ! $options{cancel}
1224        and ( $options{'resetup'}
1225              || ( ! $cust_pkg->setup
1226                   && ( ! $cust_pkg->start_date
1227                        || $cust_pkg->start_date <= $cmp_time
1228                      )
1229                   && ( ! $cust_pkg->getfield('susp') )
1230               )
1231            )
1232        and ( ! $cust_pkg->expire
1233              || $cust_pkg->expire > $cmp_time )
1234      )
1235   {
1236
1237     warn "    bill setup\n" if $DEBUG > 1;
1238
1239     unless ( $cust_pkg->waive_setup ) {
1240         $lineitems++;
1241
1242         $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1243         return "$@ running calc_setup for $cust_pkg\n"
1244           if $@;
1245
1246         # Only increment unitsetup here if there IS a setup fee.
1247         # prorate_defer_bill may cause calc_setup on a setup-stage package
1248         # to return zero, and the setup fee to be charged later. (This happens
1249         # when it's first billed on the prorate cutoff day. RT#31276.)
1250         if ( $setup ) {
1251           $unitsetup = $cust_pkg->base_setup()
1252                          || $setup; #XXX uuh
1253         }
1254     }
1255
1256     $cust_pkg->setfield('setup', $time)
1257       unless $cust_pkg->setup;
1258           #do need it, but it won't get written to the db
1259           #|| $cust_pkg->pkgpart != $real_pkgpart;
1260
1261     $cust_pkg->setfield('start_date', '')
1262       if $cust_pkg->start_date;
1263
1264   }
1265
1266   ###
1267   # bill recurring fee
1268   ###
1269
1270   my $recur = 0;
1271   my $unitrecur = 0;
1272   my @recur_discounts = ();
1273   my $sdate;
1274
1275   my $override_quantity;
1276
1277   # Conditions for billing the recurring fee:
1278   # - the package doesn't have a future start date
1279   # - and it's not suspended
1280   #   - unless suspend_bill is enabled on the package or package def
1281   #     - but still not, if the package is on hold
1282   #   - or it's suspended for a delayed cancellation
1283   # - and its next bill date is in the past
1284   #   - or it doesn't have a next bill date yet
1285   #   - or it's a one-time charge
1286   #   - or it's a CDR plan with the "bill_every_call" option
1287   #   - or it's being canceled
1288   # - and it doesn't have an expire date in the past (this can happen with
1289   #   advance billing)
1290   #   - again, unless it's being canceled
1291   if (     ! $cust_pkg->start_date
1292        and
1293            ( ! $cust_pkg->susp
1294                || ( $cust_pkg->susp != $cust_pkg->order_date
1295                       && (    $cust_pkg->option('suspend_bill',1)
1296                            || ( $part_pkg->option('suspend_bill', 1)
1297                                  && ! $cust_pkg->option('no_suspend_bill',1)
1298                               )
1299                          )
1300                   )
1301                || $cust_pkg->is_status_delay_cancel
1302            )
1303        and
1304             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1305          || ( $part_pkg->plan eq 'voip_cdr'
1306                && $part_pkg->option('bill_every_call')
1307             )
1308          || $options{cancel}
1309
1310        and
1311           ( ! $cust_pkg->expire
1312             || $cust_pkg->expire > $cmp_time
1313             || $options{cancel}
1314           )
1315   ) {
1316
1317     # XXX should this be a package event?  probably.  events are called
1318     # at collection time at the moment, though...
1319     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1320       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1321       #don't want to reset usage just cause we want a line item??
1322       #&& $part_pkg->pkgpart == $real_pkgpart;
1323
1324     warn "    bill recur\n" if $DEBUG > 1;
1325     $lineitems++;
1326
1327     # XXX shared with $recur_prog
1328     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1329              || $cust_pkg->setup
1330              || $time;
1331
1332     #over two params!  lets at least switch to a hashref for the rest...
1333     my $increment_next_bill = ( $part_pkg->freq ne '0'
1334                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1335                                 && !$options{cancel}
1336                               );
1337     my %param = ( %setup_param,
1338                   'precommit_hooks'     => $precommit_hooks,
1339                   'increment_next_bill' => $increment_next_bill,
1340                   'discounts'           => \@recur_discounts,
1341                   'real_pkgpart'        => $real_pkgpart,
1342                   'freq_override'       => $options{freq_override} || '',
1343                   'setup_fee'           => 0,
1344                 );
1345
1346     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1347
1348     # There may be some part_pkg for which this is wrong.  Only those
1349     # which can_discount are supported.
1350     # (the UI should prevent adding discounts to these at the moment)
1351
1352     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1353          " for pkgpart ". $cust_pkg->pkgpart.
1354          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1355       if $DEBUG > 2;
1356
1357     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1358     return "$@ running $method for $cust_pkg\n"
1359       if ( $@ );
1360
1361     if ($recur eq 'NOTHING') {
1362       # then calc_cancel (or calc_recur but that's not used) has declined to
1363       # generate a recurring lineitem at all. treat this as zero, but also
1364       # try not to generate a lineitem.
1365       $recur = 0;
1366       $lineitems--;
1367     }
1368
1369     #base_cancel???
1370     $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1371
1372     if ( $param{'override_quantity'} ) {
1373       $override_quantity = $param{'override_quantity'};
1374       $unitrecur = $recur / $override_quantity;
1375     }
1376
1377     if ( $increment_next_bill ) {
1378
1379       my $next_bill;
1380
1381       if ( my $main_pkg = $cust_pkg->main_pkg ) {
1382         # supplemental package
1383         # to keep in sync with the main package, simulate billing at
1384         # its frequency
1385         my $main_pkg_freq = $main_pkg->part_pkg->freq;
1386         my $supp_pkg_freq = $part_pkg->freq;
1387         my $ratio = $supp_pkg_freq / $main_pkg_freq;
1388         if ( $ratio != int($ratio) ) {
1389           # the UI should prevent setting up packages like this, but just
1390           # in case
1391           return "supplemental package period is not an integer multiple of main  package period";
1392         }
1393         $next_bill = $sdate;
1394         for (1..$ratio) {
1395           $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1396         }
1397
1398       } else {
1399         # the normal case
1400       $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1401       return "unparsable frequency: ".
1402         ($options{freq_override} || $part_pkg->freq)
1403         if $next_bill == -1;
1404       }
1405
1406       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1407       # only for figuring next bill date, nothing else, so, reset $sdate again
1408       # here
1409       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1410       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1411       $cust_pkg->last_bill($sdate);
1412
1413       $cust_pkg->setfield('bill', $next_bill );
1414
1415     }
1416
1417     if ( $param{'setup_fee'} ) {
1418       # Add an additional setup fee at the billing stage.
1419       # Used for prorate_defer_bill.
1420       $setup += $param{'setup_fee'};
1421       $unitsetup = $cust_pkg->base_setup();
1422       $lineitems++;
1423     }
1424
1425     if ( defined $param{'discount_left_setup'} ) {
1426         foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1427             $setup -= $discount_setup;
1428         }
1429     }
1430
1431   } # end of recurring fee
1432
1433   warn "\$setup is undefined" unless defined($setup);
1434   warn "\$recur is undefined" unless defined($recur);
1435   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1436
1437   ###
1438   # If there's line items, create em cust_bill_pkg records
1439   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1440   ###
1441
1442   if ( $lineitems ) {
1443
1444     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1445       # hmm.. and if just the options are modified in some weird price plan?
1446
1447       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1448         if $DEBUG >1;
1449
1450       my $error = $cust_pkg->replace( $old_cust_pkg,
1451                                       'depend_jobnum'=>$options{depend_jobnum},
1452                                       'options' => { $cust_pkg->options },
1453                                     )
1454         unless $options{no_commit};
1455       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1456         if $error; #just in case
1457     }
1458
1459     $setup = sprintf( "%.2f", $setup );
1460     $recur = sprintf( "%.2f", $recur );
1461     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1462       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1463     }
1464     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1465       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1466     }
1467
1468     my $discount_show_always = $conf->exists('discount-show-always')
1469                                && (    ($setup == 0 && scalar(@setup_discounts))
1470                                     || ($recur == 0 && scalar(@recur_discounts))
1471                                   );
1472
1473     if (    $setup != 0
1474          || $recur != 0
1475          || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1476          || $discount_show_always
1477          || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1478          || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1479        )
1480     {
1481
1482       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1483         if $DEBUG > 1;
1484
1485       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1486       if ( $DEBUG > 1 ) {
1487         warn "      adding customer package invoice detail: $_\n"
1488           foreach @cust_pkg_detail;
1489       }
1490       push @details, @cust_pkg_detail;
1491
1492       my $cust_bill_pkg = new FS::cust_bill_pkg {
1493         'pkgnum'    => $cust_pkg->pkgnum,
1494         'setup'     => $setup,
1495         'unitsetup' => sprintf('%.2f', $unitsetup),
1496         'recur'     => $recur,
1497         'unitrecur' => sprintf('%.2f', $unitrecur),
1498         'quantity'  => $override_quantity || $cust_pkg->quantity,
1499         'details'   => \@details,
1500         'discounts' => [ @setup_discounts, @recur_discounts ],
1501         'hidden'    => $part_pkg->hidden,
1502         'freq'      => $part_pkg->freq,
1503       };
1504
1505       if ( $part_pkg->option('prorate_defer_bill',1)
1506            and !$hash{last_bill} ) {
1507         # both preceding and upcoming, technically
1508         $cust_bill_pkg->sdate( $cust_pkg->setup );
1509         $cust_bill_pkg->edate( $cust_pkg->bill );
1510       } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1511         $cust_bill_pkg->sdate( $hash{last_bill} );
1512         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
1513         $cust_bill_pkg->edate( $time ) if $options{cancel};
1514       } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1515         $cust_bill_pkg->sdate( $sdate );
1516         $cust_bill_pkg->edate( $cust_pkg->bill );
1517         #$cust_bill_pkg->edate( $time ) if $options{cancel};
1518       }
1519
1520       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1521         unless $part_pkg->pkgpart == $real_pkgpart;
1522
1523       $$total_setup += $setup;
1524       $$total_recur += $recur;
1525
1526       ###
1527       # handle taxes
1528       ###
1529
1530       my $error = $self->_handle_taxes( $taxlisthash, $cust_bill_pkg,
1531         cancel => $options{cancel} );
1532       return $error if $error;
1533
1534       $cust_bill_pkg->set_display(
1535         part_pkg     => $part_pkg,
1536         real_pkgpart => $real_pkgpart,
1537       );
1538
1539       push @$cust_bill_pkgs, $cust_bill_pkg;
1540
1541     } #if $setup != 0 || $recur != 0
1542
1543   } #if $line_items
1544
1545   '';
1546
1547 }
1548
1549 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1550
1551 Takes one argument, a cust_pkg object that is being billed.  This will
1552 be called only if the package was created by a package change, and has
1553 not been billed since the package change, and package balance tracking
1554 is enabled.  The second argument can be an alternate package number to
1555 transfer the balance from; this should not be used externally.
1556
1557 Transfers the balance from the previous package (now canceled) to
1558 this package, by crediting one package and creating an invoice item for
1559 the other.  Inserts the credit and returns the invoice item (so that it
1560 can be added to an invoice that's being built).
1561
1562 If the previous package was never billed, and was also created by a package
1563 change, then this will also transfer the balance from I<its> previous
1564 package, and so on, until reaching a package that either has been billed
1565 or was not created by a package change.
1566
1567 =cut
1568
1569 my $balance_transfer_reason;
1570
1571 sub _transfer_balance {
1572   my $self = shift;
1573   my $cust_pkg = shift;
1574   my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1575   my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1576
1577   my @transfers;
1578
1579   # if $from_pkg is not the first package in the chain, and it was never
1580   # billed, walk back
1581   if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1582     @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1583   }
1584
1585   my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1586   if ( $prev_balance != 0 ) {
1587     $balance_transfer_reason ||= FS::reason->new_or_existing(
1588       'reason' => 'Package balance transfer',
1589       'type'   => 'Internal adjustment',
1590       'class'  => 'R'
1591     );
1592
1593     my $credit = FS::cust_credit->new({
1594         'custnum'   => $self->custnum,
1595         'amount'    => abs($prev_balance),
1596         'reasonnum' => $balance_transfer_reason->reasonnum,
1597         '_date'     => $cust_pkg->change_date,
1598     });
1599
1600     my $cust_bill_pkg = FS::cust_bill_pkg->new({
1601         'setup'     => 0,
1602         'recur'     => abs($prev_balance),
1603         #'sdate'     => $from_pkg->last_bill, # not sure about this
1604         #'edate'     => $cust_pkg->change_date,
1605         'itemdesc'  => $self->mt('Previous Balance, [_1]',
1606                                  $from_pkg->part_pkg->pkg),
1607     });
1608
1609     if ( $prev_balance > 0 ) {
1610       # credit the old package, charge the new one
1611       $credit->set('pkgnum', $from_pkgnum);
1612       $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1613     } else {
1614       # the reverse
1615       $credit->set('pkgnum', $cust_pkg->pkgnum);
1616       $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1617     }
1618     my $error = $credit->insert;
1619     die "error transferring package balance from #".$from_pkgnum.
1620         " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1621
1622     push @transfers, $cust_bill_pkg;
1623   } # $prev_balance != 0
1624
1625   return @transfers;
1626 }
1627
1628 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1629
1630 This is _handle_taxes.  It's called once for each cust_bill_pkg generated
1631 from _make_lines.
1632
1633 TAXLISTHASH is a hashref shared across the entire invoice.  It looks like
1634 this:
1635 {
1636   'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1637   'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1638 }
1639
1640 'cust_main_county' can also be 'tax_rate'.  The first object in the array
1641 is always the cust_main_county or tax_rate identified by the key.
1642
1643 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1644 the 'taxline' method to calculate the amount of the tax.  This doesn't
1645 happen until calculate_taxes, though.
1646
1647 OPTIONS may include:
1648 - part_item: a part_pkg or part_fee object to be used as the package/fee
1649   definition.
1650 - location: a cust_location to be used as the billing location.
1651 - cancel: true if this package is being billed on cancellation.  This
1652   allows tax to be calculated on usage charges only.
1653
1654 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1655 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1656 the customer's default service location).
1657
1658 This method will also calculate exemptions for any taxes that apply to the
1659 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1660 attach them.  This is the only place C<set_exemptions> is called in normal
1661 invoice processing.
1662
1663 =cut
1664
1665 sub _handle_taxes {
1666   my $self = shift;
1667   my $taxlisthash = shift;
1668   my $cust_bill_pkg = shift;
1669   my %options = @_;
1670
1671   # at this point I realize that we have enough information to infer all this
1672   # stuff, instead of passing around giant honking argument lists
1673   my $location = $options{location} || $cust_bill_pkg->tax_location;
1674   my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1675
1676   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1677
1678   return if ( $self->payby eq 'COMP' ); #dubious
1679
1680   if ( $conf->exists('enable_taxproducts')
1681        && ( scalar($part_item->part_pkg_taxoverride)
1682             || $part_item->has_taxproduct
1683           )
1684      )
1685     {
1686
1687     # EXTERNAL TAX RATES (via tax_rate)
1688     my %cust_bill_pkg = ();
1689     my %taxes = ();
1690
1691     my @classes;
1692     my $usage = $cust_bill_pkg->usage || 0;
1693     push @classes, $cust_bill_pkg->usage_classes if $usage;
1694     push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1695     push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1696         and !$options{cancel};
1697     # that's better--probably don't even need $options{cancel} now
1698     # but leave it for now, just to be safe
1699     #
1700     # About $options{cancel}: This protects against charging per-line or
1701     # per-customer or other flat-rate surcharges on a package that's being
1702     # billed on cancellation (which is an out-of-cycle bill and should only
1703     # have usage charges).  See RT#29443.
1704
1705     # customer exemption is now handled in the 'taxline' method
1706     #my $exempt = $conf->exists('cust_class-tax_exempt')
1707     #               ? ( $self->cust_class ? $self->cust_class->tax : '' )
1708     #               : $self->tax;
1709     # standardize this just to be sure
1710     #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1711     #
1712     #if ( !$exempt ) {
1713
1714     unless (exists $taxes{''}) {
1715       # unsure what purpose this serves, but last time I deleted something
1716       # from here just because I didn't see the point, it actually did
1717       # something important.
1718       my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1719       return $err_or_ref unless ref($err_or_ref);
1720       $taxes{''} = $err_or_ref;
1721     }
1722
1723     # NO DISINTEGRATIONS.
1724     # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1725     #
1726     # do not call taxline() with any argument except the entire set of
1727     # cust_bill_pkgs on an invoice that are eligible for the tax.
1728
1729     # only calculate exemptions once for each tax rate, even if it's used
1730     # for multiple classes
1731     my %tax_seen = ();
1732
1733     foreach my $class (@classes) {
1734       my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1735       return $err_or_ref unless ref($err_or_ref);
1736       my @taxes = @$err_or_ref;
1737
1738       next if !@taxes;
1739
1740       foreach my $tax ( @taxes ) {
1741
1742         my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1743         # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1744         # Values are arrayrefs, first the tax object (cust_main_county
1745         # or tax_rate), then the cust_bill_pkg object that the
1746         # tax applies to, then the tax class (setup, recur, usage classnum).
1747         $taxlisthash->{ $tax_id } ||= [ $tax ];
1748         push @{ $taxlisthash->{ $tax_id  } }, $cust_bill_pkg, $class;
1749
1750         # determine any exemptions that apply
1751         if (!$tax_seen{$tax_id}) {
1752           $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1753           $tax_seen{$tax_id} = 1;
1754         }
1755
1756         # tax on tax will be done later, when we actually create the tax
1757         # line items
1758
1759       }
1760     }
1761
1762   } else {
1763
1764     # INTERNAL TAX RATES (cust_main_county)
1765
1766     # We fetch taxes even if the customer is completely exempt,
1767     # because we need to record that fact.
1768
1769     my %taxhash = map { $_ => $location->get($_) }
1770                   qw( district county state country );
1771     # city names in cust_main_county are uppercase
1772     $taxhash{'city'} = uc($location->get('city'));
1773
1774     $taxhash{'taxclass'} = $part_item->taxclass;
1775
1776     warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1777
1778     my @taxes = (); # entries are cust_main_county objects
1779     my %taxhash_elim = %taxhash;
1780     my @elim = qw( district city county state );
1781     do {
1782
1783       #first try a match with taxclass
1784       @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1785
1786       if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1787         #then try a match without taxclass
1788         my %no_taxclass = %taxhash_elim;
1789         $no_taxclass{ 'taxclass' } = '';
1790         @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1791       }
1792
1793       $taxhash_elim{ shift(@elim) } = '';
1794
1795     } while ( !scalar(@taxes) && scalar(@elim) );
1796
1797     foreach (@taxes) {
1798       my $tax_id = 'cust_main_county '.$_->taxnum;
1799       $taxlisthash->{$tax_id} ||= [ $_ ];
1800       $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1801       push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1802     }
1803
1804   }
1805   '';
1806 }
1807
1808 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1809
1810 Internal method used with vendor-provided tax tables.  PART_ITEM is a part_pkg
1811 or part_fee (which will define the tax eligibility of the product), CLASS is
1812 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1813 location where the service was provided (or billed, depending on
1814 configuration).  Returns an arrayref of L<FS::tax_rate> objects that
1815 can apply to this line item.
1816
1817 =cut
1818
1819 sub _gather_taxes {
1820   my $self = shift;
1821   my $part_item = shift;
1822   my $class = shift;
1823   my $location = shift;
1824
1825   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1826
1827   my $geocode = $location->geocode('cch');
1828
1829   [ $part_item->tax_rates('cch', $geocode, $class) ]
1830
1831 }
1832
1833 =item collect [ HASHREF | OPTION => VALUE ... ]
1834
1835 (Attempt to) collect money for this customer's outstanding invoices (see
1836 L<FS::cust_bill>).  Usually used after the bill method.
1837
1838 Actions are now triggered by billing events; see L<FS::part_event> and the
1839 billing events web interface.  Old-style invoice events (see
1840 L<FS::part_bill_event>) have been deprecated.
1841
1842 If there is an error, returns the error, otherwise returns false.
1843
1844 Options are passed as name-value pairs.
1845
1846 Currently available options are:
1847
1848 =over 4
1849
1850 =item invoice_time
1851
1852 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
1853
1854 =item retry
1855
1856 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1857
1858 =item check_freq
1859
1860 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1861
1862 =item quiet
1863
1864 set true to surpress email card/ACH decline notices.
1865
1866 =item debug
1867
1868 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1869
1870 =back
1871
1872 # =item payby
1873 #
1874 # allows for one time override of normal customer billing method
1875
1876 =cut
1877
1878 sub collect {
1879   my( $self, %options ) = @_;
1880
1881   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1882
1883   my $invoice_time = $options{'invoice_time'} || time;
1884
1885   #put below somehow?
1886   local $SIG{HUP} = 'IGNORE';
1887   local $SIG{INT} = 'IGNORE';
1888   local $SIG{QUIT} = 'IGNORE';
1889   local $SIG{TERM} = 'IGNORE';
1890   local $SIG{TSTP} = 'IGNORE';
1891   local $SIG{PIPE} = 'IGNORE';
1892
1893   my $oldAutoCommit = $FS::UID::AutoCommit;
1894   local $FS::UID::AutoCommit = 0;
1895   my $dbh = dbh;
1896
1897   $self->select_for_update; #mutex
1898
1899   if ( $DEBUG ) {
1900     my $balance = $self->balance;
1901     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1902   }
1903
1904   if ( exists($options{'retry_card'}) ) {
1905     carp 'retry_card option passed to collect is deprecated; use retry';
1906     $options{'retry'} ||= $options{'retry_card'};
1907   }
1908   if ( exists($options{'retry'}) && $options{'retry'} ) {
1909     my $error = $self->retry_realtime;
1910     if ( $error ) {
1911       $dbh->rollback if $oldAutoCommit;
1912       return $error;
1913     }
1914   }
1915
1916   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1917
1918   #never want to roll back an event just because it returned an error
1919   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1920
1921   $self->do_cust_event(
1922     'debug'      => ( $options{'debug'} || 0 ),
1923     'time'       => $invoice_time,
1924     'check_freq' => $options{'check_freq'},
1925     'stage'      => 'collect',
1926   );
1927
1928 }
1929
1930 =item retry_realtime
1931
1932 Schedules realtime / batch  credit card / electronic check / LEC billing
1933 events for for retry.  Useful if card information has changed or manual
1934 retry is desired.  The 'collect' method must be called to actually retry
1935 the transaction.
1936
1937 Implementation details: For either this customer, or for each of this
1938 customer's open invoices, changes the status of the first "done" (with
1939 statustext error) realtime processing event to "failed".
1940
1941 =cut
1942
1943 sub retry_realtime {
1944   my $self = shift;
1945
1946   local $SIG{HUP} = 'IGNORE';
1947   local $SIG{INT} = 'IGNORE';
1948   local $SIG{QUIT} = 'IGNORE';
1949   local $SIG{TERM} = 'IGNORE';
1950   local $SIG{TSTP} = 'IGNORE';
1951   local $SIG{PIPE} = 'IGNORE';
1952
1953   my $oldAutoCommit = $FS::UID::AutoCommit;
1954   local $FS::UID::AutoCommit = 0;
1955   my $dbh = dbh;
1956
1957   #a little false laziness w/due_cust_event (not too bad, really)
1958
1959   # I guess this is always as of now?
1960   my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1961   my $order = FS::part_event_condition->order_conditions_sql;
1962   my $mine =
1963   '( '
1964    . join ( ' OR ' , map {
1965     my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1966     my $custnum = FS::part_event->eventtables_custnum->{$_};
1967     "( part_event.eventtable = " . dbh->quote($_)
1968     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1969     . " from $_ $cust_join"
1970     . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1971    } FS::part_event->eventtables)
1972    . ') ';
1973
1974   #here is the agent virtualization
1975   my $agent_virt = " (    part_event.agentnum IS NULL
1976                        OR part_event.agentnum = ". $self->agentnum. ' )';
1977
1978   #XXX this shouldn't be hardcoded, actions should declare it...
1979   my @realtime_events = qw(
1980     cust_bill_realtime_card
1981     cust_bill_realtime_check
1982     cust_bill_realtime_lec
1983     cust_bill_batch
1984   );
1985
1986   my $is_realtime_event =
1987     ' part_event.action IN ( '.
1988         join(',', map "'$_'", @realtime_events ).
1989     ' ) ';
1990
1991   my $batch_or_statustext =
1992     "( part_event.action = 'cust_bill_batch'
1993        OR ( statustext IS NOT NULL AND statustext != '' )
1994      )";
1995
1996
1997   my @cust_event = qsearch({
1998     'table'     => 'cust_event',
1999     'select'    => 'cust_event.*',
2000     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
2001     'hashref'   => { 'status' => 'done' },
2002     'extra_sql' => " AND $batch_or_statustext ".
2003                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
2004   });
2005
2006   my %seen_invnum = ();
2007   foreach my $cust_event (@cust_event) {
2008
2009     #max one for the customer, one for each open invoice
2010     my $cust_X = $cust_event->cust_X;
2011     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
2012                           ? $cust_X->invnum
2013                           : 0
2014                         }++
2015          or $cust_event->part_event->eventtable eq 'cust_bill'
2016             && ! $cust_X->owed;
2017
2018     my $error = $cust_event->retry;
2019     if ( $error ) {
2020       $dbh->rollback if $oldAutoCommit;
2021       return "error scheduling event for retry: $error";
2022     }
2023
2024   }
2025
2026   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2027   '';
2028
2029 }
2030
2031 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2032
2033 Runs billing events; see L<FS::part_event> and the billing events web
2034 interface.
2035
2036 If there is an error, returns the error, otherwise returns false.
2037
2038 Options are passed as name-value pairs.
2039
2040 Currently available options are:
2041
2042 =over 4
2043
2044 =item time
2045
2046 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
2047
2048 =item check_freq
2049
2050 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2051
2052 =item stage
2053
2054 "collect" (the default) or "pre-bill"
2055
2056 =item quiet
2057
2058 set true to surpress email card/ACH decline notices.
2059
2060 =item debug
2061
2062 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2063
2064 =back
2065 =cut
2066
2067 # =item payby
2068 #
2069 # allows for one time override of normal customer billing method
2070
2071 # =item retry
2072 #
2073 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2074
2075 sub do_cust_event {
2076   my( $self, %options ) = @_;
2077
2078   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2079
2080   my $time = $options{'time'} || time;
2081
2082   #put below somehow?
2083   local $SIG{HUP} = 'IGNORE';
2084   local $SIG{INT} = 'IGNORE';
2085   local $SIG{QUIT} = 'IGNORE';
2086   local $SIG{TERM} = 'IGNORE';
2087   local $SIG{TSTP} = 'IGNORE';
2088   local $SIG{PIPE} = 'IGNORE';
2089
2090   my $oldAutoCommit = $FS::UID::AutoCommit;
2091   local $FS::UID::AutoCommit = 0;
2092   my $dbh = dbh;
2093
2094   $self->select_for_update; #mutex
2095
2096   if ( $DEBUG ) {
2097     my $balance = $self->balance;
2098     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2099   }
2100
2101 #  if ( exists($options{'retry_card'}) ) {
2102 #    carp 'retry_card option passed to collect is deprecated; use retry';
2103 #    $options{'retry'} ||= $options{'retry_card'};
2104 #  }
2105 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
2106 #    my $error = $self->retry_realtime;
2107 #    if ( $error ) {
2108 #      $dbh->rollback if $oldAutoCommit;
2109 #      return $error;
2110 #    }
2111 #  }
2112
2113   # false laziness w/pay_batch::import_results
2114
2115   my $due_cust_event = $self->due_cust_event(
2116     'debug'      => ( $options{'debug'} || 0 ),
2117     'time'       => $time,
2118     'check_freq' => $options{'check_freq'},
2119     'stage'      => ( $options{'stage'} || 'collect' ),
2120   );
2121   unless( ref($due_cust_event) ) {
2122     $dbh->rollback if $oldAutoCommit;
2123     return $due_cust_event;
2124   }
2125
2126   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2127   #never want to roll back an event just because it or a different one
2128   # returned an error
2129   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2130
2131   foreach my $cust_event ( @$due_cust_event ) {
2132
2133     #XXX lock event
2134
2135     #re-eval event conditions (a previous event could have changed things)
2136     unless ( $cust_event->test_conditions ) {
2137       #don't leave stray "new/locked" records around
2138       my $error = $cust_event->delete;
2139       return $error if $error;
2140       next;
2141     }
2142
2143     {
2144       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
2145         if $options{'quiet'};
2146       warn "  running cust_event ". $cust_event->eventnum. "\n"
2147         if $DEBUG > 1;
2148
2149       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2150       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
2151         #XXX wtf is this?  figure out a proper dealio with return value
2152         #from do_event
2153         return $error;
2154       }
2155     }
2156
2157   }
2158
2159   '';
2160
2161 }
2162
2163 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2164
2165 Inserts database records for and returns an ordered listref of new events due
2166 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2167 events are due, an empty listref is returned.  If there is an error, returns a
2168 scalar error message.
2169
2170 To actually run the events, call each event's test_condition method, and if
2171 still true, call the event's do_event method.
2172
2173 Options are passed as a hashref or as a list of name-value pairs.  Available
2174 options are:
2175
2176 =over 4
2177
2178 =item check_freq
2179
2180 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2181
2182 =item stage
2183
2184 "collect" (the default) or "pre-bill"
2185
2186 =item time
2187
2188 "Current time" for the events.
2189
2190 =item debug
2191
2192 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2193
2194 =item eventtable
2195
2196 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2197
2198 =item objects
2199
2200 Explicitly pass the objects to be tested (typically used with eventtable).
2201
2202 =item testonly
2203
2204 Set to true to return the objects, but not actually insert them into the
2205 database.
2206
2207 =back
2208
2209 =cut
2210
2211 sub due_cust_event {
2212   my $self = shift;
2213   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2214
2215   #???
2216   #my $DEBUG = $opt{'debug'}
2217   $opt{'debug'} ||= 0; # silence some warnings
2218   local($DEBUG) = $opt{'debug'}
2219     if $opt{'debug'} > $DEBUG;
2220   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2221
2222   warn "$me due_cust_event called with options ".
2223        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2224     if $DEBUG;
2225
2226   $opt{'time'} ||= time;
2227
2228   local $SIG{HUP} = 'IGNORE';
2229   local $SIG{INT} = 'IGNORE';
2230   local $SIG{QUIT} = 'IGNORE';
2231   local $SIG{TERM} = 'IGNORE';
2232   local $SIG{TSTP} = 'IGNORE';
2233   local $SIG{PIPE} = 'IGNORE';
2234
2235   my $oldAutoCommit = $FS::UID::AutoCommit;
2236   local $FS::UID::AutoCommit = 0;
2237   my $dbh = dbh;
2238
2239   $self->select_for_update #mutex
2240     unless $opt{testonly};
2241
2242   ###
2243   # find possible events (initial search)
2244   ###
2245
2246   my @cust_event = ();
2247
2248   my @eventtable = $opt{'eventtable'}
2249                      ? ( $opt{'eventtable'} )
2250                      : FS::part_event->eventtables_runorder;
2251
2252   my $check_freq = $opt{'check_freq'} || '1d';
2253
2254   foreach my $eventtable ( @eventtable ) {
2255
2256     my @objects;
2257     if ( $opt{'objects'} ) {
2258
2259       @objects = @{ $opt{'objects'} };
2260
2261     } elsif ( $eventtable eq 'cust_main' ) {
2262
2263       @objects = ( $self );
2264
2265     } else {
2266
2267       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2268       # linkage not needed here because FS::cust_main->$eventtable will
2269       # already supply it
2270
2271       #some false laziness w/Cron::bill bill_where
2272
2273       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable,
2274         'time' => $opt{'time'});
2275       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2276         'time'=>$opt{'time'},
2277       );
2278       $where = $where ? "AND $where" : '';
2279
2280       my $are_part_event =
2281       "EXISTS ( SELECT 1 FROM part_event $join
2282         WHERE check_freq = '$check_freq'
2283         AND eventtable = '$eventtable'
2284         AND ( disabled = '' OR disabled IS NULL )
2285         $where
2286         )
2287       ";
2288       #eofalse
2289
2290       @objects = $self->$eventtable(
2291         'addl_from' => $cm_join,
2292         'extra_sql' => " AND $are_part_event",
2293       );
2294     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2295
2296     my @e_cust_event = ();
2297
2298     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2299
2300     my $cross = "CROSS JOIN $eventtable $linkage";
2301     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2302       unless $eventtable eq 'cust_main';
2303
2304     foreach my $object ( @objects ) {
2305
2306       #this first search uses the condition_sql magic for optimization.
2307       #the more possible events we can eliminate in this step the better
2308
2309       my $cross_where = '';
2310       my $pkey = $object->primary_key;
2311       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2312
2313       my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2314         'time' => $opt{'time'});
2315       my $extra_sql =
2316         FS::part_event_condition->where_conditions_sql( $eventtable,
2317                                                         'time'=>$opt{'time'}
2318                                                       );
2319       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2320
2321       $extra_sql = "AND $extra_sql" if $extra_sql;
2322
2323       #here is the agent virtualization
2324       $extra_sql .= " AND (    part_event.agentnum IS NULL
2325                             OR part_event.agentnum = ". $self->agentnum. ' )';
2326
2327       $extra_sql .= " $order";
2328
2329       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2330         if $opt{'debug'} > 2;
2331       my @part_event = qsearch( {
2332         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2333         'select'    => 'part_event.*',
2334         'table'     => 'part_event',
2335         'addl_from' => "$cross $join",
2336         'hashref'   => { 'check_freq' => $check_freq,
2337                          'eventtable' => $eventtable,
2338                          'disabled'   => '',
2339                        },
2340         'extra_sql' => "AND $cross_where $extra_sql",
2341       } );
2342
2343       if ( $DEBUG > 2 ) {
2344         my $pkey = $object->primary_key;
2345         warn "      ". scalar(@part_event).
2346              " possible events found for $eventtable ". $object->$pkey(). "\n";
2347       }
2348
2349       push @e_cust_event, map {
2350         $_->new_cust_event($object, 'time' => $opt{'time'})
2351       } @part_event;
2352
2353     }
2354
2355     warn "    ". scalar(@e_cust_event).
2356          " subtotal possible cust events found for $eventtable\n"
2357       if $DEBUG > 1;
2358
2359     push @cust_event, @e_cust_event;
2360
2361   }
2362
2363   warn "  ". scalar(@cust_event).
2364        " total possible cust events found in initial search\n"
2365     if $DEBUG; # > 1;
2366
2367
2368   ##
2369   # test stage
2370   ##
2371
2372   $opt{stage} ||= 'collect';
2373   @cust_event =
2374     grep { my $stage = $_->part_event->event_stage;
2375            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2376          }
2377          @cust_event;
2378
2379   ##
2380   # test conditions
2381   ##
2382
2383   my %unsat = ();
2384
2385   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2386                      @cust_event;
2387
2388   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2389     if $DEBUG; # > 1;
2390
2391   warn "    invalid conditions not eliminated with condition_sql:\n".
2392        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2393     if keys %unsat && $DEBUG; # > 1;
2394
2395   ##
2396   # insert
2397   ##
2398
2399   unless( $opt{testonly} ) {
2400     foreach my $cust_event ( @cust_event ) {
2401
2402       my $error = $cust_event->insert();
2403       if ( $error ) {
2404         $dbh->rollback if $oldAutoCommit;
2405         return $error;
2406       }
2407
2408     }
2409   }
2410
2411   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2412
2413   ##
2414   # return
2415   ##
2416
2417   warn "  returning events: ". Dumper(@cust_event). "\n"
2418     if $DEBUG > 2;
2419
2420   \@cust_event;
2421
2422 }
2423
2424 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2425
2426 Applies unapplied payments and credits.
2427 Payments with the no_auto_apply flag set will not be applied.
2428
2429 In most cases, this new method should be used in place of sequential
2430 apply_payments and apply_credits methods.
2431
2432 A hash of optional arguments may be passed.  Currently "manual" is supported.
2433 If true, a payment receipt is sent instead of a statement when
2434 'payment_receipt_email' configuration option is set.
2435
2436 If there is an error, returns the error, otherwise returns false.
2437
2438 =cut
2439
2440 sub apply_payments_and_credits {
2441   my( $self, %options ) = @_;
2442
2443   local $SIG{HUP} = 'IGNORE';
2444   local $SIG{INT} = 'IGNORE';
2445   local $SIG{QUIT} = 'IGNORE';
2446   local $SIG{TERM} = 'IGNORE';
2447   local $SIG{TSTP} = 'IGNORE';
2448   local $SIG{PIPE} = 'IGNORE';
2449
2450   my $oldAutoCommit = $FS::UID::AutoCommit;
2451   local $FS::UID::AutoCommit = 0;
2452   my $dbh = dbh;
2453
2454   $self->select_for_update; #mutex
2455
2456   foreach my $cust_bill ( $self->open_cust_bill ) {
2457     my $error = $cust_bill->apply_payments_and_credits(%options);
2458     if ( $error ) {
2459       $dbh->rollback if $oldAutoCommit;
2460       return "Error applying: $error";
2461     }
2462   }
2463
2464   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2465   ''; #no error
2466
2467 }
2468
2469 =item apply_credits OPTION => VALUE ...
2470
2471 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2472 to outstanding invoice balances in chronological order (or reverse
2473 chronological order if the I<order> option is set to B<newest>) and returns the
2474 value of any remaining unapplied credits available for refund (see
2475 L<FS::cust_refund>).
2476
2477 Dies if there is an error.
2478
2479 =cut
2480
2481 sub apply_credits {
2482   my $self = shift;
2483   my %opt = @_;
2484
2485   local $SIG{HUP} = 'IGNORE';
2486   local $SIG{INT} = 'IGNORE';
2487   local $SIG{QUIT} = 'IGNORE';
2488   local $SIG{TERM} = 'IGNORE';
2489   local $SIG{TSTP} = 'IGNORE';
2490   local $SIG{PIPE} = 'IGNORE';
2491
2492   my $oldAutoCommit = $FS::UID::AutoCommit;
2493   local $FS::UID::AutoCommit = 0;
2494   my $dbh = dbh;
2495
2496   $self->select_for_update; #mutex
2497
2498   unless ( $self->total_unapplied_credits ) {
2499     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2500     return 0;
2501   }
2502
2503   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2504       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2505
2506   my @invoices = $self->open_cust_bill;
2507   @invoices = sort { $b->_date <=> $a->_date } @invoices
2508     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2509
2510   if ( $conf->exists('pkg-balances') ) {
2511     # limit @credits to those w/ a pkgnum grepped from $self
2512     my %pkgnums = ();
2513     foreach my $i (@invoices) {
2514       foreach my $li ( $i->cust_bill_pkg ) {
2515         $pkgnums{$li->pkgnum} = 1;
2516       }
2517     }
2518     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2519   }
2520
2521   my $credit;
2522
2523   foreach my $cust_bill ( @invoices ) {
2524
2525     if ( !defined($credit) || $credit->credited == 0) {
2526       $credit = pop @credits or last;
2527     }
2528
2529     my $owed;
2530     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2531       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2532     } else {
2533       $owed = $cust_bill->owed;
2534     }
2535     unless ( $owed > 0 ) {
2536       push @credits, $credit;
2537       next;
2538     }
2539
2540     my $amount = min( $credit->credited, $owed );
2541
2542     my $cust_credit_bill = new FS::cust_credit_bill ( {
2543       'crednum' => $credit->crednum,
2544       'invnum'  => $cust_bill->invnum,
2545       'amount'  => $amount,
2546     } );
2547     $cust_credit_bill->pkgnum( $credit->pkgnum )
2548       if $conf->exists('pkg-balances') && $credit->pkgnum;
2549     my $error = $cust_credit_bill->insert;
2550     if ( $error ) {
2551       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2552       die $error;
2553     }
2554
2555     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2556
2557   }
2558
2559   my $total_unapplied_credits = $self->total_unapplied_credits;
2560
2561   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2562
2563   return $total_unapplied_credits;
2564 }
2565
2566 =item apply_payments  [ OPTION => VALUE ... ]
2567
2568 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2569 to outstanding invoice balances in chronological order.
2570 Payments with the no_auto_apply flag set will not be applied.
2571
2572  #and returns the value of any remaining unapplied payments.
2573
2574 A hash of optional arguments may be passed.  Currently "manual" is supported.
2575 If true, a payment receipt is sent instead of a statement when
2576 'payment_receipt_email' configuration option is set.
2577
2578 Dies if there is an error.
2579
2580 =cut
2581
2582 sub apply_payments {
2583   my( $self, %options ) = @_;
2584
2585   local $SIG{HUP} = 'IGNORE';
2586   local $SIG{INT} = 'IGNORE';
2587   local $SIG{QUIT} = 'IGNORE';
2588   local $SIG{TERM} = 'IGNORE';
2589   local $SIG{TSTP} = 'IGNORE';
2590   local $SIG{PIPE} = 'IGNORE';
2591
2592   my $oldAutoCommit = $FS::UID::AutoCommit;
2593   local $FS::UID::AutoCommit = 0;
2594   my $dbh = dbh;
2595
2596   $self->select_for_update; #mutex
2597
2598   #return 0 unless
2599
2600   my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay;
2601
2602   my @invoices = $self->open_cust_bill;
2603
2604   if ( $conf->exists('pkg-balances') ) {
2605     # limit @payments to those w/ a pkgnum grepped from $self
2606     my %pkgnums = ();
2607     foreach my $i (@invoices) {
2608       foreach my $li ( $i->cust_bill_pkg ) {
2609         $pkgnums{$li->pkgnum} = 1;
2610       }
2611     }
2612     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2613   }
2614
2615   my $payment;
2616
2617   foreach my $cust_bill ( @invoices ) {
2618
2619     if ( !defined($payment) || $payment->unapplied == 0 ) {
2620       $payment = pop @payments or last;
2621     }
2622
2623     my $owed;
2624     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2625       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2626     } else {
2627       $owed = $cust_bill->owed;
2628     }
2629     unless ( $owed > 0 ) {
2630       push @payments, $payment;
2631       next;
2632     }
2633
2634     my $amount = min( $payment->unapplied, $owed );
2635
2636     my $cbp = {
2637       'paynum' => $payment->paynum,
2638       'invnum' => $cust_bill->invnum,
2639       'amount' => $amount,
2640     };
2641     $cbp->{_date} = $payment->_date
2642         if $options{'manual'} && $options{'backdate_application'};
2643     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2644     $cust_bill_pay->pkgnum( $payment->pkgnum )
2645       if $conf->exists('pkg-balances') && $payment->pkgnum;
2646     my $error = $cust_bill_pay->insert(%options);
2647     if ( $error ) {
2648       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2649       die $error;
2650     }
2651
2652     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2653
2654   }
2655
2656   my $total_unapplied_payments = $self->total_unapplied_payments;
2657
2658   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2659
2660   return $total_unapplied_payments;
2661 }
2662
2663 =back
2664
2665 =head1 FLOW
2666
2667   bill_and_collect
2668
2669     cancel_expired_pkgs
2670     suspend_adjourned_pkgs
2671     unsuspend_resumed_pkgs
2672
2673     bill
2674       (do_cust_event pre-bill)
2675       _make_lines
2676         _handle_taxes
2677           (vendor-only) _gather_taxes
2678       _omit_zero_value_bundles
2679       _handle_taxes (for fees)
2680       calculate_taxes
2681
2682     apply_payments_and_credits
2683     collect
2684       do_cust_event
2685         due_cust_event
2686
2687 =head1 BUGS
2688
2689 =head1 SEE ALSO
2690
2691 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2692
2693 =cut
2694
2695 1;