FS/FS/cust_main/Billing.pm

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