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