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