FS/FS/cust_main/Billing.pm

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