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