FS/FS/cust_main/Billing.pm

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