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