FS/FS/cust_main/Billing.pm

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