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