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                || $cust_pkg->is_status_delay_cancel
1048            )
1049        and
1050             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1051          || ( $part_pkg->plan eq 'voip_cdr'
1052                && $part_pkg->option('bill_every_call')
1053             )
1054          || $options{cancel}
1055   ) {
1056
1057     # XXX should this be a package event?  probably.  events are called
1058     # at collection time at the moment, though...
1059     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1060       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1061       #don't want to reset usage just cause we want a line item??
1062       #&& $part_pkg->pkgpart == $real_pkgpart;
1063
1064     warn "    bill recur\n" if $DEBUG > 1;
1065     $lineitems++;
1066
1067     # XXX shared with $recur_prog
1068     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1069              || $cust_pkg->setup
1070              || $time;
1071
1072     #over two params!  lets at least switch to a hashref for the rest...
1073     my $increment_next_bill = ( $part_pkg->freq ne '0'
1074                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1075                                 && !$options{cancel}
1076                               );
1077     my %param = ( %setup_param,
1078                   'precommit_hooks'     => $precommit_hooks,
1079                   'increment_next_bill' => $increment_next_bill,
1080                   'discounts'           => \@recur_discounts,
1081                   'real_pkgpart'        => $real_pkgpart,
1082                   'freq_override'       => $options{freq_override} || '',
1083                   'setup_fee'           => 0,
1084                 );
1085
1086     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1087
1088     # There may be some part_pkg for which this is wrong.  Only those
1089     # which can_discount are supported.
1090     # (the UI should prevent adding discounts to these at the moment)
1091
1092     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1093          " for pkgpart ". $cust_pkg->pkgpart.
1094          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1095       if $DEBUG > 2;
1096
1097     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1098     return "$@ running $method for $cust_pkg\n"
1099       if ( $@ );
1100
1101     #base_cancel???
1102     $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1103
1104     if ( $param{'billed_currency'} ) {
1105       $recur_billed_currency = delete $param{'billed_currency'};
1106       $recur_billed_amount   = delete $param{'billed_amount'};
1107     }
1108
1109     if ( $increment_next_bill ) {
1110
1111       my $next_bill;
1112
1113       if ( my $main_pkg = $cust_pkg->main_pkg ) {
1114         # supplemental package
1115         # to keep in sync with the main package, simulate billing at
1116         # its frequency
1117         my $main_pkg_freq = $main_pkg->part_pkg->freq;
1118         my $supp_pkg_freq = $part_pkg->freq;
1119         my $ratio = $supp_pkg_freq / $main_pkg_freq;
1120         if ( $ratio != int($ratio) ) {
1121           # the UI should prevent setting up packages like this, but just
1122           # in case
1123           return "supplemental package period is not an integer multiple of main  package period";
1124         }
1125         $next_bill = $sdate;
1126         for (1..$ratio) {
1127           $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1128         }
1129
1130       } else {
1131         # the normal case
1132       $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1133       return "unparsable frequency: ". $part_pkg->freq
1134         if $next_bill == -1;
1135       }
1136
1137       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1138       # only for figuring next bill date, nothing else, so, reset $sdate again
1139       # here
1140       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1141       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1142       $cust_pkg->last_bill($sdate);
1143
1144       $cust_pkg->setfield('bill', $next_bill );
1145
1146     }
1147
1148     if ( $param{'setup_fee'} ) {
1149       # Add an additional setup fee at the billing stage.
1150       # Used for prorate_defer_bill.
1151       $setup += $param{'setup_fee'};
1152       $unitsetup += $param{'setup_fee'};
1153       $lineitems++;
1154     }
1155
1156     if ( defined $param{'discount_left_setup'} ) {
1157         foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1158             $setup -= $discount_setup;
1159         }
1160     }
1161
1162   }
1163
1164   warn "\$setup is undefined" unless defined($setup);
1165   warn "\$recur is undefined" unless defined($recur);
1166   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1167
1168   ###
1169   # If there's line items, create em cust_bill_pkg records
1170   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1171   ###
1172
1173   if ( $lineitems ) {
1174
1175     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1176       # hmm.. and if just the options are modified in some weird price plan?
1177
1178       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1179         if $DEBUG >1;
1180
1181       my $error = $cust_pkg->replace( $old_cust_pkg,
1182                                       'depend_jobnum'=>$options{depend_jobnum},
1183                                       'options' => { $cust_pkg->options },
1184                                     )
1185         unless $options{no_commit};
1186       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1187         if $error; #just in case
1188     }
1189
1190     $setup = sprintf( "%.2f", $setup );
1191     $recur = sprintf( "%.2f", $recur );
1192     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1193       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1194     }
1195     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1196       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1197     }
1198
1199     my $discount_show_always = $conf->exists('discount-show-always')
1200                                && (    ($setup == 0 && scalar(@setup_discounts))
1201                                     || ($recur == 0 && scalar(@recur_discounts))
1202                                   );
1203
1204     if (    $setup != 0
1205          || $recur != 0
1206          || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1207          || $discount_show_always
1208          || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1209          || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1210        )
1211     {
1212
1213       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1214         if $DEBUG > 1;
1215
1216       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1217       if ( $DEBUG > 1 ) {
1218         warn "      adding customer package invoice detail: $_\n"
1219           foreach @cust_pkg_detail;
1220       }
1221       push @details, @cust_pkg_detail;
1222
1223       my $cust_bill_pkg = new FS::cust_bill_pkg {
1224         'pkgnum'                => $cust_pkg->pkgnum,
1225         'setup'                 => $setup,
1226         'unitsetup'             => $unitsetup,
1227         'setup_billed_currency' => $setup_billed_currency,
1228         'setup_billed_amount'   => $setup_billed_amount,
1229         'recur'                 => $recur,
1230         'unitrecur'             => $unitrecur,
1231         'recur_billed_currency' => $recur_billed_currency,
1232         'recur_billed_amount'   => $recur_billed_amount,
1233         'quantity'              => $cust_pkg->quantity,
1234         'details'               => \@details,
1235         'discounts'             => [ @setup_discounts, @recur_discounts ],
1236         'hidden'                => $part_pkg->hidden,
1237         'freq'                  => $part_pkg->freq,
1238       };
1239
1240       if ( $part_pkg->option('prorate_defer_bill',1)
1241            and !$hash{last_bill} ) {
1242         # both preceding and upcoming, technically
1243         $cust_bill_pkg->sdate( $cust_pkg->setup );
1244         $cust_bill_pkg->edate( $cust_pkg->bill );
1245       } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1246         $cust_bill_pkg->sdate( $hash{last_bill} );
1247         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
1248         $cust_bill_pkg->edate( $time ) if $options{cancel};
1249       } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1250         $cust_bill_pkg->sdate( $sdate );
1251         $cust_bill_pkg->edate( $cust_pkg->bill );
1252         #$cust_bill_pkg->edate( $time ) if $options{cancel};
1253       }
1254
1255       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1256         unless $part_pkg->pkgpart == $real_pkgpart;
1257
1258       $$total_setup += $setup;
1259       $$total_recur += $recur;
1260
1261       ###
1262       # handle taxes
1263       ###
1264
1265       my $error = $tax_engine->add_sale($cust_bill_pkg);
1266       return $error if $error;
1267
1268       $cust_bill_pkg->set_display(
1269         part_pkg     => $part_pkg,
1270         real_pkgpart => $real_pkgpart,
1271       );
1272
1273       push @$cust_bill_pkgs, $cust_bill_pkg;
1274
1275     } #if $setup != 0 || $recur != 0
1276
1277   } #if $line_items
1278
1279   '';
1280
1281 }
1282
1283 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1284
1285 Takes one argument, a cust_pkg object that is being billed.  This will
1286 be called only if the package was created by a package change, and has
1287 not been billed since the package change, and package balance tracking
1288 is enabled.  The second argument can be an alternate package number to
1289 transfer the balance from; this should not be used externally.
1290
1291 Transfers the balance from the previous package (now canceled) to
1292 this package, by crediting one package and creating an invoice item for
1293 the other.  Inserts the credit and returns the invoice item (so that it
1294 can be added to an invoice that's being built).
1295
1296 If the previous package was never billed, and was also created by a package
1297 change, then this will also transfer the balance from I<its> previous
1298 package, and so on, until reaching a package that either has been billed
1299 or was not created by a package change.
1300
1301 =cut
1302
1303 my $balance_transfer_reason;
1304
1305 sub _transfer_balance {
1306   my $self = shift;
1307   my $cust_pkg = shift;
1308   my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1309   my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1310
1311   my @transfers;
1312
1313   # if $from_pkg is not the first package in the chain, and it was never
1314   # billed, walk back
1315   if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1316     @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1317   }
1318
1319   my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1320   if ( $prev_balance != 0 ) {
1321     $balance_transfer_reason ||= FS::reason->new_or_existing(
1322       'reason' => 'Package balance transfer',
1323       'type'   => 'Internal adjustment',
1324       'class'  => 'R'
1325     );
1326
1327     my $credit = FS::cust_credit->new({
1328         'custnum'   => $self->custnum,
1329         'amount'    => abs($prev_balance),
1330         'reasonnum' => $balance_transfer_reason->reasonnum,
1331         '_date'     => $cust_pkg->change_date,
1332     });
1333
1334     my $cust_bill_pkg = FS::cust_bill_pkg->new({
1335         'setup'     => 0,
1336         'recur'     => abs($prev_balance),
1337         #'sdate'     => $from_pkg->last_bill, # not sure about this
1338         #'edate'     => $cust_pkg->change_date,
1339         'itemdesc'  => $self->mt('Previous Balance, [_1]',
1340                                  $from_pkg->part_pkg->pkg),
1341     });
1342
1343     if ( $prev_balance > 0 ) {
1344       # credit the old package, charge the new one
1345       $credit->set('pkgnum', $from_pkgnum);
1346       $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1347     } else {
1348       # the reverse
1349       $credit->set('pkgnum', $cust_pkg->pkgnum);
1350       $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1351     }
1352     my $error = $credit->insert;
1353     die "error transferring package balance from #".$from_pkgnum.
1354         " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1355
1356     push @transfers, $cust_bill_pkg;
1357   } # $prev_balance != 0
1358
1359   return @transfers;
1360 }
1361
1362 #### vestigial code ####
1363
1364 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1365
1366 This is _handle_taxes.  It's called once for each cust_bill_pkg generated
1367 from _make_lines.
1368
1369 TAXLISTHASH is a hashref shared across the entire invoice.  It looks like
1370 this:
1371 {
1372   'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1373   'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1374 }
1375
1376 'cust_main_county' can also be 'tax_rate'.  The first object in the array
1377 is always the cust_main_county or tax_rate identified by the key.
1378
1379 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1380 the 'taxline' method to calculate the amount of the tax.  This doesn't
1381 happen until calculate_taxes, though.
1382
1383 OPTIONS may include:
1384 - part_item: a part_pkg or part_fee object to be used as the package/fee
1385   definition.
1386 - location: a cust_location to be used as the billing location.
1387 - cancel: true if this package is being billed on cancellation.  This
1388   allows tax to be calculated on usage charges only.
1389
1390 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1391 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1392 the customer's default service location).
1393
1394 This method will also calculate exemptions for any taxes that apply to the
1395 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1396 attach them.  This is the only place C<set_exemptions> is called in normal
1397 invoice processing.
1398
1399 =cut
1400
1401 sub _handle_taxes {
1402   my $self = shift;
1403   my $taxlisthash = shift;
1404   my $cust_bill_pkg = shift;
1405   my %options = @_;
1406
1407   # at this point I realize that we have enough information to infer all this
1408   # stuff, instead of passing around giant honking argument lists
1409   my $location = $options{location} || $cust_bill_pkg->tax_location;
1410   my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1411
1412   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1413
1414   return if ( $self->payby eq 'COMP' ); #dubious
1415
1416   if ( $conf->exists('enable_taxproducts')
1417        && ( scalar($part_item->part_pkg_taxoverride)
1418             || $part_item->has_taxproduct
1419           )
1420      )
1421     {
1422
1423     # EXTERNAL TAX RATES (via tax_rate)
1424     my %cust_bill_pkg = ();
1425     my %taxes = ();
1426
1427     my @classes;
1428     my $usage = $cust_bill_pkg->usage || 0;
1429     push @classes, $cust_bill_pkg->usage_classes if $usage;
1430     push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1431     push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1432         and !$options{cancel};
1433     # that's better--probably don't even need $options{cancel} now
1434     # but leave it for now, just to be safe
1435     #
1436     # About $options{cancel}: This protects against charging per-line or
1437     # per-customer or other flat-rate surcharges on a package that's being
1438     # billed on cancellation (which is an out-of-cycle bill and should only
1439     # have usage charges).  See RT#29443.
1440
1441     # customer exemption is now handled in the 'taxline' method
1442     #my $exempt = $conf->exists('cust_class-tax_exempt')
1443     #               ? ( $self->cust_class ? $self->cust_class->tax : '' )
1444     #               : $self->tax;
1445     # standardize this just to be sure
1446     #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1447     #
1448     #if ( !$exempt ) {
1449
1450     unless (exists $taxes{''}) {
1451       # unsure what purpose this serves, but last time I deleted something
1452       # from here just because I didn't see the point, it actually did
1453       # something important.
1454       my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1455       return $err_or_ref unless ref($err_or_ref);
1456       $taxes{''} = $err_or_ref;
1457     }
1458
1459     # NO DISINTEGRATIONS.
1460     # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1461     #
1462     # do not call taxline() with any argument except the entire set of
1463     # cust_bill_pkgs on an invoice that are eligible for the tax.
1464
1465     # only calculate exemptions once for each tax rate, even if it's used
1466     # for multiple classes
1467     my %tax_seen = ();
1468
1469     foreach my $class (@classes) {
1470       my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1471       return $err_or_ref unless ref($err_or_ref);
1472       my @taxes = @$err_or_ref;
1473
1474       next if !@taxes;
1475
1476       foreach my $tax ( @taxes ) {
1477
1478         my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1479         # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1480         # Values are arrayrefs, first the tax object (cust_main_county
1481         # or tax_rate), then the cust_bill_pkg object that the
1482         # tax applies to, then the tax class (setup, recur, usage classnum).
1483         $taxlisthash->{ $tax_id } ||= [ $tax ];
1484         push @{ $taxlisthash->{ $tax_id  } }, $cust_bill_pkg, $class;
1485
1486         # determine any exemptions that apply
1487         if (!$tax_seen{$tax_id}) {
1488           $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1489           $tax_seen{$tax_id} = 1;
1490         }
1491
1492         # tax on tax will be done later, when we actually create the tax
1493         # line items
1494
1495       }
1496     }
1497
1498   } else {
1499
1500     # INTERNAL TAX RATES (cust_main_county)
1501
1502     # We fetch taxes even if the customer is completely exempt,
1503     # because we need to record that fact.
1504
1505     my @loc_keys = qw( district city county state country );
1506     my %taxhash = map { $_ => $location->$_ } @loc_keys;
1507
1508     $taxhash{'taxclass'} = $part_item->taxclass;
1509
1510     warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1511
1512     my @taxes = (); # entries are cust_main_county objects
1513     my %taxhash_elim = %taxhash;
1514     my @elim = qw( district city county state );
1515     do {
1516
1517       #first try a match with taxclass
1518       @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1519
1520       if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1521         #then try a match without taxclass
1522         my %no_taxclass = %taxhash_elim;
1523         $no_taxclass{ 'taxclass' } = '';
1524         @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1525       }
1526
1527       $taxhash_elim{ shift(@elim) } = '';
1528
1529     } while ( !scalar(@taxes) && scalar(@elim) );
1530
1531     foreach (@taxes) {
1532       my $tax_id = 'cust_main_county '.$_->taxnum;
1533       $taxlisthash->{$tax_id} ||= [ $_ ];
1534       $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1535       push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1536     }
1537
1538   }
1539   '';
1540 }
1541
1542 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1543
1544 Internal method used with vendor-provided tax tables.  PART_ITEM is a part_pkg
1545 or part_fee (which will define the tax eligibility of the product), CLASS is
1546 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1547 location where the service was provided (or billed, depending on
1548 configuration).  Returns an arrayref of L<FS::tax_rate> objects that
1549 can apply to this line item.
1550
1551 =cut
1552
1553 sub _gather_taxes {
1554   my $self = shift;
1555   my $part_item = shift;
1556   my $class = shift;
1557   my $location = shift;
1558
1559   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1560
1561   my $geocode = $location->geocode('cch');
1562
1563   [ $part_item->tax_rates('cch', $geocode, $class) ]
1564
1565 }
1566
1567 #### end vestigial code ####
1568
1569 =item collect [ HASHREF | OPTION => VALUE ... ]
1570
1571 (Attempt to) collect money for this customer's outstanding invoices (see
1572 L<FS::cust_bill>).  Usually used after the bill method.
1573
1574 Actions are now triggered by billing events; see L<FS::part_event> and the
1575 billing events web interface.  Old-style invoice events (see
1576 L<FS::part_bill_event>) have been deprecated.
1577
1578 If there is an error, returns the error, otherwise returns false.
1579
1580 Options are passed as name-value pairs.
1581
1582 Currently available options are:
1583
1584 =over 4
1585
1586 =item invoice_time
1587
1588 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.
1589
1590 =item retry
1591
1592 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1593
1594 =item check_freq
1595
1596 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1597
1598 =item quiet
1599
1600 set true to surpress email card/ACH decline notices.
1601
1602 =item debug
1603
1604 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)
1605
1606 =back
1607
1608 # =item payby
1609 #
1610 # allows for one time override of normal customer billing method
1611
1612 =cut
1613
1614 sub collect {
1615   my( $self, %options ) = @_;
1616
1617   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1618
1619   my $invoice_time = $options{'invoice_time'} || time;
1620
1621   #put below somehow?
1622   local $SIG{HUP} = 'IGNORE';
1623   local $SIG{INT} = 'IGNORE';
1624   local $SIG{QUIT} = 'IGNORE';
1625   local $SIG{TERM} = 'IGNORE';
1626   local $SIG{TSTP} = 'IGNORE';
1627   local $SIG{PIPE} = 'IGNORE';
1628
1629   my $oldAutoCommit = $FS::UID::AutoCommit;
1630   local $FS::UID::AutoCommit = 0;
1631   my $dbh = dbh;
1632
1633   $self->select_for_update; #mutex
1634
1635   if ( $DEBUG ) {
1636     my $balance = $self->balance;
1637     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1638   }
1639
1640   if ( exists($options{'retry_card'}) ) {
1641     carp 'retry_card option passed to collect is deprecated; use retry';
1642     $options{'retry'} ||= $options{'retry_card'};
1643   }
1644   if ( exists($options{'retry'}) && $options{'retry'} ) {
1645     my $error = $self->retry_realtime;
1646     if ( $error ) {
1647       $dbh->rollback if $oldAutoCommit;
1648       return $error;
1649     }
1650   }
1651
1652   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1653
1654   #never want to roll back an event just because it returned an error
1655   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1656
1657   $self->do_cust_event(
1658     'debug'      => ( $options{'debug'} || 0 ),
1659     'time'       => $invoice_time,
1660     'check_freq' => $options{'check_freq'},
1661     'stage'      => 'collect',
1662   );
1663
1664 }
1665
1666 =item retry_realtime
1667
1668 Schedules realtime / batch  credit card / electronic check / LEC billing
1669 events for for retry.  Useful if card information has changed or manual
1670 retry is desired.  The 'collect' method must be called to actually retry
1671 the transaction.
1672
1673 Implementation details: For either this customer, or for each of this
1674 customer's open invoices, changes the status of the first "done" (with
1675 statustext error) realtime processing event to "failed".
1676
1677 =cut
1678
1679 sub retry_realtime {
1680   my $self = shift;
1681
1682   local $SIG{HUP} = 'IGNORE';
1683   local $SIG{INT} = 'IGNORE';
1684   local $SIG{QUIT} = 'IGNORE';
1685   local $SIG{TERM} = 'IGNORE';
1686   local $SIG{TSTP} = 'IGNORE';
1687   local $SIG{PIPE} = 'IGNORE';
1688
1689   my $oldAutoCommit = $FS::UID::AutoCommit;
1690   local $FS::UID::AutoCommit = 0;
1691   my $dbh = dbh;
1692
1693   #a little false laziness w/due_cust_event (not too bad, really)
1694
1695   # I guess this is always as of now?
1696   my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1697   my $order = FS::part_event_condition->order_conditions_sql;
1698   my $mine =
1699   '( '
1700    . join ( ' OR ' , map {
1701     my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1702     my $custnum = FS::part_event->eventtables_custnum->{$_};
1703     "( part_event.eventtable = " . dbh->quote($_)
1704     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1705     . " from $_ $cust_join"
1706     . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1707    } FS::part_event->eventtables)
1708    . ') ';
1709
1710   #here is the agent virtualization
1711   my $agent_virt = " (    part_event.agentnum IS NULL
1712                        OR part_event.agentnum = ". $self->agentnum. ' )';
1713
1714   #XXX this shouldn't be hardcoded, actions should declare it...
1715   my @realtime_events = qw(
1716     cust_bill_realtime_card
1717     cust_bill_realtime_check
1718     cust_bill_realtime_lec
1719     cust_bill_batch
1720   );
1721
1722   my $is_realtime_event =
1723     ' part_event.action IN ( '.
1724         join(',', map "'$_'", @realtime_events ).
1725     ' ) ';
1726
1727   my $batch_or_statustext =
1728     "( part_event.action = 'cust_bill_batch'
1729        OR ( statustext IS NOT NULL AND statustext != '' )
1730      )";
1731
1732
1733   my @cust_event = qsearch({
1734     'table'     => 'cust_event',
1735     'select'    => 'cust_event.*',
1736     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1737     'hashref'   => { 'status' => 'done' },
1738     'extra_sql' => " AND $batch_or_statustext ".
1739                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1740   });
1741
1742   my %seen_invnum = ();
1743   foreach my $cust_event (@cust_event) {
1744
1745     #max one for the customer, one for each open invoice
1746     my $cust_X = $cust_event->cust_X;
1747     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1748                           ? $cust_X->invnum
1749                           : 0
1750                         }++
1751          or $cust_event->part_event->eventtable eq 'cust_bill'
1752             && ! $cust_X->owed;
1753
1754     my $error = $cust_event->retry;
1755     if ( $error ) {
1756       $dbh->rollback if $oldAutoCommit;
1757       return "error scheduling event for retry: $error";
1758     }
1759
1760   }
1761
1762   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1763   '';
1764
1765 }
1766
1767 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1768
1769 Runs billing events; see L<FS::part_event> and the billing events web
1770 interface.
1771
1772 If there is an error, returns the error, otherwise returns false.
1773
1774 Options are passed as name-value pairs.
1775
1776 Currently available options are:
1777
1778 =over 4
1779
1780 =item time
1781
1782 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.
1783
1784 =item check_freq
1785
1786 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1787
1788 =item stage
1789
1790 "collect" (the default) or "pre-bill"
1791
1792 =item quiet
1793
1794 set true to surpress email card/ACH decline notices.
1795
1796 =item debug
1797
1798 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)
1799
1800 =back
1801 =cut
1802
1803 # =item payby
1804 #
1805 # allows for one time override of normal customer billing method
1806
1807 # =item retry
1808 #
1809 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1810
1811 sub do_cust_event {
1812   my( $self, %options ) = @_;
1813
1814   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1815
1816   my $time = $options{'time'} || time;
1817
1818   #put below somehow?
1819   local $SIG{HUP} = 'IGNORE';
1820   local $SIG{INT} = 'IGNORE';
1821   local $SIG{QUIT} = 'IGNORE';
1822   local $SIG{TERM} = 'IGNORE';
1823   local $SIG{TSTP} = 'IGNORE';
1824   local $SIG{PIPE} = 'IGNORE';
1825
1826   my $oldAutoCommit = $FS::UID::AutoCommit;
1827   local $FS::UID::AutoCommit = 0;
1828   my $dbh = dbh;
1829
1830   $self->select_for_update; #mutex
1831
1832   if ( $DEBUG ) {
1833     my $balance = $self->balance;
1834     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1835   }
1836
1837 #  if ( exists($options{'retry_card'}) ) {
1838 #    carp 'retry_card option passed to collect is deprecated; use retry';
1839 #    $options{'retry'} ||= $options{'retry_card'};
1840 #  }
1841 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
1842 #    my $error = $self->retry_realtime;
1843 #    if ( $error ) {
1844 #      $dbh->rollback if $oldAutoCommit;
1845 #      return $error;
1846 #    }
1847 #  }
1848
1849   # false laziness w/pay_batch::import_results
1850
1851   my $due_cust_event = $self->due_cust_event(
1852     'debug'      => ( $options{'debug'} || 0 ),
1853     'time'       => $time,
1854     'check_freq' => $options{'check_freq'},
1855     'stage'      => ( $options{'stage'} || 'collect' ),
1856   );
1857   unless( ref($due_cust_event) ) {
1858     $dbh->rollback if $oldAutoCommit;
1859     return $due_cust_event;
1860   }
1861
1862   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1863   #never want to roll back an event just because it or a different one
1864   # returned an error
1865   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1866
1867   foreach my $cust_event ( @$due_cust_event ) {
1868
1869     #XXX lock event
1870
1871     #re-eval event conditions (a previous event could have changed things)
1872     unless ( $cust_event->test_conditions ) {
1873       #don't leave stray "new/locked" records around
1874       my $error = $cust_event->delete;
1875       return $error if $error;
1876       next;
1877     }
1878
1879     {
1880       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1881         if $options{'quiet'};
1882       warn "  running cust_event ". $cust_event->eventnum. "\n"
1883         if $DEBUG > 1;
1884
1885       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1886       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1887         #XXX wtf is this?  figure out a proper dealio with return value
1888         #from do_event
1889         return $error;
1890       }
1891     }
1892
1893   }
1894
1895   '';
1896
1897 }
1898
1899 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1900
1901 Inserts database records for and returns an ordered listref of new events due
1902 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
1903 events are due, an empty listref is returned.  If there is an error, returns a
1904 scalar error message.
1905
1906 To actually run the events, call each event's test_condition method, and if
1907 still true, call the event's do_event method.
1908
1909 Options are passed as a hashref or as a list of name-value pairs.  Available
1910 options are:
1911
1912 =over 4
1913
1914 =item check_freq
1915
1916 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.
1917
1918 =item stage
1919
1920 "collect" (the default) or "pre-bill"
1921
1922 =item time
1923
1924 "Current time" for the events.
1925
1926 =item debug
1927
1928 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)
1929
1930 =item eventtable
1931
1932 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1933
1934 =item objects
1935
1936 Explicitly pass the objects to be tested (typically used with eventtable).
1937
1938 =item testonly
1939
1940 Set to true to return the objects, but not actually insert them into the
1941 database.
1942
1943 =back
1944
1945 =cut
1946
1947 sub due_cust_event {
1948   my $self = shift;
1949   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1950
1951   #???
1952   #my $DEBUG = $opt{'debug'}
1953   $opt{'debug'} ||= 0; # silence some warnings
1954   local($DEBUG) = $opt{'debug'}
1955     if $opt{'debug'} > $DEBUG;
1956   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1957
1958   warn "$me due_cust_event called with options ".
1959        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1960     if $DEBUG;
1961
1962   $opt{'time'} ||= time;
1963
1964   local $SIG{HUP} = 'IGNORE';
1965   local $SIG{INT} = 'IGNORE';
1966   local $SIG{QUIT} = 'IGNORE';
1967   local $SIG{TERM} = 'IGNORE';
1968   local $SIG{TSTP} = 'IGNORE';
1969   local $SIG{PIPE} = 'IGNORE';
1970
1971   my $oldAutoCommit = $FS::UID::AutoCommit;
1972   local $FS::UID::AutoCommit = 0;
1973   my $dbh = dbh;
1974
1975   $self->select_for_update #mutex
1976     unless $opt{testonly};
1977
1978   ###
1979   # find possible events (initial search)
1980   ###
1981
1982   my @cust_event = ();
1983
1984   my @eventtable = $opt{'eventtable'}
1985                      ? ( $opt{'eventtable'} )
1986                      : FS::part_event->eventtables_runorder;
1987
1988   my $check_freq = $opt{'check_freq'} || '1d';
1989
1990   foreach my $eventtable ( @eventtable ) {
1991
1992     my @objects;
1993     if ( $opt{'objects'} ) {
1994
1995       @objects = @{ $opt{'objects'} };
1996
1997     } elsif ( $eventtable eq 'cust_main' ) {
1998
1999       @objects = ( $self );
2000
2001     } else {
2002
2003       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2004       # linkage not needed here because FS::cust_main->$eventtable will
2005       # already supply it
2006
2007       #some false laziness w/Cron::bill bill_where
2008
2009       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable,
2010         'time' => $opt{'time'});
2011       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2012         'time'=>$opt{'time'},
2013       );
2014       $where = $where ? "AND $where" : '';
2015
2016       my $are_part_event =
2017       "EXISTS ( SELECT 1 FROM part_event $join
2018         WHERE check_freq = '$check_freq'
2019         AND eventtable = '$eventtable'
2020         AND ( disabled = '' OR disabled IS NULL )
2021         $where
2022         )
2023       ";
2024       #eofalse
2025
2026       @objects = $self->$eventtable(
2027         'addl_from' => $cm_join,
2028         'extra_sql' => " AND $are_part_event",
2029       );
2030     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2031
2032     my @e_cust_event = ();
2033
2034     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2035
2036     my $cross = "CROSS JOIN $eventtable $linkage";
2037     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2038       unless $eventtable eq 'cust_main';
2039
2040     foreach my $object ( @objects ) {
2041
2042       #this first search uses the condition_sql magic for optimization.
2043       #the more possible events we can eliminate in this step the better
2044
2045       my $cross_where = '';
2046       my $pkey = $object->primary_key;
2047       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2048
2049       my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2050         'time' => $opt{'time'});
2051       my $extra_sql =
2052         FS::part_event_condition->where_conditions_sql( $eventtable,
2053                                                         'time'=>$opt{'time'}
2054                                                       );
2055       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2056
2057       $extra_sql = "AND $extra_sql" if $extra_sql;
2058
2059       #here is the agent virtualization
2060       $extra_sql .= " AND (    part_event.agentnum IS NULL
2061                             OR part_event.agentnum = ". $self->agentnum. ' )';
2062
2063       $extra_sql .= " $order";
2064
2065       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2066         if $opt{'debug'} > 2;
2067       my @part_event = qsearch( {
2068         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2069         'select'    => 'part_event.*',
2070         'table'     => 'part_event',
2071         'addl_from' => "$cross $join",
2072         'hashref'   => { 'check_freq' => $check_freq,
2073                          'eventtable' => $eventtable,
2074                          'disabled'   => '',
2075                        },
2076         'extra_sql' => "AND $cross_where $extra_sql",
2077       } );
2078
2079       if ( $DEBUG > 2 ) {
2080         my $pkey = $object->primary_key;
2081         warn "      ". scalar(@part_event).
2082              " possible events found for $eventtable ". $object->$pkey(). "\n";
2083       }
2084
2085       push @e_cust_event, map {
2086         $_->new_cust_event($object, 'time' => $opt{'time'})
2087       } @part_event;
2088
2089     }
2090
2091     warn "    ". scalar(@e_cust_event).
2092          " subtotal possible cust events found for $eventtable\n"
2093       if $DEBUG > 1;
2094
2095     push @cust_event, @e_cust_event;
2096
2097   }
2098
2099   warn "  ". scalar(@cust_event).
2100        " total possible cust events found in initial search\n"
2101     if $DEBUG; # > 1;
2102
2103
2104   ##
2105   # test stage
2106   ##
2107
2108   $opt{stage} ||= 'collect';
2109   @cust_event =
2110     grep { my $stage = $_->part_event->event_stage;
2111            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2112          }
2113          @cust_event;
2114
2115   ##
2116   # test conditions
2117   ##
2118
2119   my %unsat = ();
2120
2121   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2122                      @cust_event;
2123
2124   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2125     if $DEBUG; # > 1;
2126
2127   warn "    invalid conditions not eliminated with condition_sql:\n".
2128        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2129     if keys %unsat && $DEBUG; # > 1;
2130
2131   ##
2132   # insert
2133   ##
2134
2135   unless( $opt{testonly} ) {
2136     foreach my $cust_event ( @cust_event ) {
2137
2138       my $error = $cust_event->insert();
2139       if ( $error ) {
2140         $dbh->rollback if $oldAutoCommit;
2141         return $error;
2142       }
2143
2144     }
2145   }
2146
2147   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2148
2149   ##
2150   # return
2151   ##
2152
2153   warn "  returning events: ". Dumper(@cust_event). "\n"
2154     if $DEBUG > 2;
2155
2156   \@cust_event;
2157
2158 }
2159
2160 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2161
2162 Applies unapplied payments and credits.
2163
2164 In most cases, this new method should be used in place of sequential
2165 apply_payments and apply_credits methods.
2166
2167 A hash of optional arguments may be passed.  Currently "manual" is supported.
2168 If true, a payment receipt is sent instead of a statement when
2169 'payment_receipt_email' configuration option is set.
2170
2171 If there is an error, returns the error, otherwise returns false.
2172
2173 =cut
2174
2175 sub apply_payments_and_credits {
2176   my( $self, %options ) = @_;
2177
2178   local $SIG{HUP} = 'IGNORE';
2179   local $SIG{INT} = 'IGNORE';
2180   local $SIG{QUIT} = 'IGNORE';
2181   local $SIG{TERM} = 'IGNORE';
2182   local $SIG{TSTP} = 'IGNORE';
2183   local $SIG{PIPE} = 'IGNORE';
2184
2185   my $oldAutoCommit = $FS::UID::AutoCommit;
2186   local $FS::UID::AutoCommit = 0;
2187   my $dbh = dbh;
2188
2189   $self->select_for_update; #mutex
2190
2191   foreach my $cust_bill ( $self->open_cust_bill ) {
2192     my $error = $cust_bill->apply_payments_and_credits(%options);
2193     if ( $error ) {
2194       $dbh->rollback if $oldAutoCommit;
2195       return "Error applying: $error";
2196     }
2197   }
2198
2199   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2200   ''; #no error
2201
2202 }
2203
2204 =item apply_credits OPTION => VALUE ...
2205
2206 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2207 to outstanding invoice balances in chronological order (or reverse
2208 chronological order if the I<order> option is set to B<newest>) and returns the
2209 value of any remaining unapplied credits available for refund (see
2210 L<FS::cust_refund>).
2211
2212 Dies if there is an error.
2213
2214 =cut
2215
2216 sub apply_credits {
2217   my $self = shift;
2218   my %opt = @_;
2219
2220   local $SIG{HUP} = 'IGNORE';
2221   local $SIG{INT} = 'IGNORE';
2222   local $SIG{QUIT} = 'IGNORE';
2223   local $SIG{TERM} = 'IGNORE';
2224   local $SIG{TSTP} = 'IGNORE';
2225   local $SIG{PIPE} = 'IGNORE';
2226
2227   my $oldAutoCommit = $FS::UID::AutoCommit;
2228   local $FS::UID::AutoCommit = 0;
2229   my $dbh = dbh;
2230
2231   $self->select_for_update; #mutex
2232
2233   unless ( $self->total_unapplied_credits ) {
2234     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2235     return 0;
2236   }
2237
2238   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2239       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2240
2241   my @invoices = $self->open_cust_bill;
2242   @invoices = sort { $b->_date <=> $a->_date } @invoices
2243     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2244
2245   if ( $conf->exists('pkg-balances') ) {
2246     # limit @credits to those w/ a pkgnum grepped from $self
2247     my %pkgnums = ();
2248     foreach my $i (@invoices) {
2249       foreach my $li ( $i->cust_bill_pkg ) {
2250         $pkgnums{$li->pkgnum} = 1;
2251       }
2252     }
2253     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2254   }
2255
2256   my $credit;
2257
2258   foreach my $cust_bill ( @invoices ) {
2259
2260     if ( !defined($credit) || $credit->credited == 0) {
2261       $credit = pop @credits or last;
2262     }
2263
2264     my $owed;
2265     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2266       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2267     } else {
2268       $owed = $cust_bill->owed;
2269     }
2270     unless ( $owed > 0 ) {
2271       push @credits, $credit;
2272       next;
2273     }
2274
2275     my $amount = min( $credit->credited, $owed );
2276
2277     my $cust_credit_bill = new FS::cust_credit_bill ( {
2278       'crednum' => $credit->crednum,
2279       'invnum'  => $cust_bill->invnum,
2280       'amount'  => $amount,
2281     } );
2282     $cust_credit_bill->pkgnum( $credit->pkgnum )
2283       if $conf->exists('pkg-balances') && $credit->pkgnum;
2284     my $error = $cust_credit_bill->insert;
2285     if ( $error ) {
2286       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2287       die $error;
2288     }
2289
2290     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2291
2292   }
2293
2294   my $total_unapplied_credits = $self->total_unapplied_credits;
2295
2296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2297
2298   return $total_unapplied_credits;
2299 }
2300
2301 =item apply_payments  [ OPTION => VALUE ... ]
2302
2303 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2304 to outstanding invoice balances in chronological order.
2305
2306  #and returns the value of any remaining unapplied payments.
2307
2308 A hash of optional arguments may be passed.  Currently "manual" is supported.
2309 If true, a payment receipt is sent instead of a statement when
2310 'payment_receipt_email' configuration option is set.
2311
2312 Dies if there is an error.
2313
2314 =cut
2315
2316 sub apply_payments {
2317   my( $self, %options ) = @_;
2318
2319   local $SIG{HUP} = 'IGNORE';
2320   local $SIG{INT} = 'IGNORE';
2321   local $SIG{QUIT} = 'IGNORE';
2322   local $SIG{TERM} = 'IGNORE';
2323   local $SIG{TSTP} = 'IGNORE';
2324   local $SIG{PIPE} = 'IGNORE';
2325
2326   my $oldAutoCommit = $FS::UID::AutoCommit;
2327   local $FS::UID::AutoCommit = 0;
2328   my $dbh = dbh;
2329
2330   $self->select_for_update; #mutex
2331
2332   #return 0 unless
2333
2334   my @payments = $self->unapplied_cust_pay;
2335
2336   my @invoices = $self->open_cust_bill;
2337
2338   if ( $conf->exists('pkg-balances') ) {
2339     # limit @payments to those w/ a pkgnum grepped from $self
2340     my %pkgnums = ();
2341     foreach my $i (@invoices) {
2342       foreach my $li ( $i->cust_bill_pkg ) {
2343         $pkgnums{$li->pkgnum} = 1;
2344       }
2345     }
2346     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2347   }
2348
2349   my $payment;
2350
2351   foreach my $cust_bill ( @invoices ) {
2352
2353     if ( !defined($payment) || $payment->unapplied == 0 ) {
2354       $payment = pop @payments or last;
2355     }
2356
2357     my $owed;
2358     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2359       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2360     } else {
2361       $owed = $cust_bill->owed;
2362     }
2363     unless ( $owed > 0 ) {
2364       push @payments, $payment;
2365       next;
2366     }
2367
2368     my $amount = min( $payment->unapplied, $owed );
2369
2370     my $cbp = {
2371       'paynum' => $payment->paynum,
2372       'invnum' => $cust_bill->invnum,
2373       'amount' => $amount,
2374     };
2375     $cbp->{_date} = $payment->_date
2376         if $options{'manual'} && $options{'backdate_application'};
2377     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2378     $cust_bill_pay->pkgnum( $payment->pkgnum )
2379       if $conf->exists('pkg-balances') && $payment->pkgnum;
2380     my $error = $cust_bill_pay->insert(%options);
2381     if ( $error ) {
2382       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2383       die $error;
2384     }
2385
2386     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2387
2388   }
2389
2390   my $total_unapplied_payments = $self->total_unapplied_payments;
2391
2392   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2393
2394   return $total_unapplied_payments;
2395 }
2396
2397 =back
2398
2399 =head1 FLOW
2400
2401   bill_and_collect
2402
2403     cancel_expired_pkgs
2404     suspend_adjourned_pkgs
2405     unsuspend_resumed_pkgs
2406
2407     bill
2408       (do_cust_event pre-bill)
2409       _make_lines
2410       _omit_zero_value_bundles
2411       calculate_taxes
2412
2413     apply_payments_and_credits
2414     collect
2415       do_cust_event
2416         due_cust_event
2417
2418 =head1 BUGS
2419
2420 =head1 SEE ALSO
2421
2422 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2423
2424 =cut
2425
2426 1;