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           $taxlisthash{$pass} = {};
 541           $cust_bill_pkg{$pass} = [];
 542         }
 543       } elsif ( ($cust_pkg->no_auto || $part_pkg->no_auto) ) {
 544         $pass = 'no_auto';
 545       }
 546
 547       my $next_bill = $cust_pkg->getfield('bill') || 0;
 548       my $error;
 549       # let this run once if this is the last bill upon cancellation
 550       while ( $next_bill <= $cmp_time or $options{cancel} ) {
 551         $error =
 552           $self->_make_lines( 'part_pkg'            => $part_pkg,
 553                               'cust_pkg'            => $cust_pkg,
 554                               'precommit_hooks'     => \@precommit_hooks,
 555                               'line_items'          => $cust_bill_pkg{$pass},
 556                               'setup'               => $total_setup{$pass},
 557                               'recur'               => $total_recur{$pass},
 558                               'tax_engine'          => $tax_engines{$pass},
 559                               'time'                => $time,
 560                               'real_pkgpart'        => $real_pkgpart,
 561                               'options'             => \%options,
 562                             );
 563
 564         # Stop if anything goes wrong
 565         last if $error;
 566
 567         # or if we're not incrementing the bill date.
 568         last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
 569
 570         # or if we're letting it run only once
 571         last if $options{cancel};
 572
 573         $next_bill = $cust_pkg->getfield('bill') || 0;
 574
 575         #stop if -o was passed to freeside-daily
 576         last if $options{'one_recur'};
 577       }
 578       if ($error) {
 579         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 580         return $error;
 581       }
 582
 583     } #foreach my $part_pkg
 584
 585   } #foreach my $cust_pkg
 586
 587   foreach my $pass (@passes) { # keys %cust_bill_pkg )
 588
 589     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
 590
 591     warn "$me billing pass $pass\n"
 592            #.Dumper(\@cust_bill_pkg)."\n"
 593       if $DEBUG > 2;
 594
 595     ###
 596     # process fees
 597     ###
 598
 599     my @pending_event_fees = FS::cust_event_fee->by_cust($self->custnum,
 600       hashref => { 'billpkgnum' => '' }
 601     );
 602     warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n"
 603       if @pending_event_fees and $DEBUG > 1;
 604
 605     # determine whether to generate an invoice
 606     my $generate_bill = scalar(@cust_bill_pkg) > 0;
 607
 608     foreach my $event_fee (@pending_event_fees) {
 609       $generate_bill = 1 unless $event_fee->nextbill;
 610     }
 611
 612     # don't create an invoice with no line items, or where the only line
 613     # items are fees that are supposed to be held until the next invoice
 614     next if !$generate_bill;
 615
 616     # calculate fees...
 617     my @fee_items;
 618     foreach my $event_fee (@pending_event_fees) {
 619       my $object = $event_fee->cust_event->cust_X;
 620       my $part_fee = $event_fee->part_fee;
 621       my $cust_bill;
 622       if ( $object->isa('FS::cust_main')
 623            or $object->isa('FS::cust_pkg')
 624            or $object->isa('FS::cust_pay_batch') )
 625       {
 626         # Not the real cust_bill object that will be inserted--in particular
 627         # there are no taxes yet.  If you want to charge a fee on the total
 628         # invoice amount including taxes, you have to put the fee on the next
 629         # invoice.
 630         $cust_bill = FS::cust_bill->new({
 631             'custnum'       => $self->custnum,
 632             'cust_bill_pkg' => \@cust_bill_pkg,
 633             'charged'       => ${ $total_setup{$pass} } +
 634                                ${ $total_recur{$pass} },
 635         });
 636
 637         # If this is a package event, only apply the fee to line items
 638         # from that package.
 639         if ($object->isa('FS::cust_pkg')) {
 640           $cust_bill->set('cust_bill_pkg',
 641             [ grep  { $_->pkgnum == $object->pkgnum } @cust_bill_pkg ]
 642           );
 643         }
 644
 645       } elsif ( $object->isa('FS::cust_bill') ) {
 646         # simple case: applying the fee to a previous invoice (late fee,
 647         # etc.)
 648         $cust_bill = $object;
 649       }
 650       # if the fee def belongs to a different agent, don't charge the fee.
 651       # event conditions should prevent this, but just in case they don't,
 652       # skip the fee.
 653       if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
 654         warn "tried to charge fee#".$part_fee->feepart .
 655              " on customer#".$self->custnum." from a different agent.\n";
 656         next;
 657       }
 658       # also skip if it's disabled
 659       next if $part_fee->disabled eq 'Y';
 660       # calculate the fee
 661       my $fee_item = $part_fee->lineitem($cust_bill) or next;
 662       # link this so that we can clear the marker on inserting the line item
 663       $fee_item->set('cust_event_fee', $event_fee);
 664       push @fee_items, $fee_item;
 665
 666     }
 667
 668     # add fees to the invoice
 669     foreach my $fee_item (@fee_items) {
 670
 671       push @cust_bill_pkg, $fee_item;
 672       ${ $total_setup{$pass} } += $fee_item->setup;
 673       ${ $total_recur{$pass} } += $fee_item->recur;
 674
 675       my $part_fee = $fee_item->part_fee;
 676       my $fee_location = $self->ship_location; # I think?
 677
 678       my $error = $tax_engines{''}->add_sale($fee_item);
 679
 680       return $error if $error;
 681
 682     }
 683
 684     # XXX implementation of fees is supposed to make this go away...
 685     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 686            !$conf->exists('postal_invoice-recurring_only')
 687        )
 688     {
 689
 690       my $postal_pkg = $self->charge_postal_fee();
 691       if ( $postal_pkg && !ref( $postal_pkg ) ) {
 692
 693         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 694         return "can't charge postal invoice fee for customer ".
 695           $self->custnum. ": $postal_pkg";
 696
 697       } elsif ( $postal_pkg ) {
 698
 699         my $real_pkgpart = $postal_pkg->pkgpart;
 700         # we could implement this bit as FS::part_pkg::has_hidden, but we already
 701         # suffer from performance issues
 702         $options{has_hidden} = 0;
 703         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
 704         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 705
 706         foreach my $part_pkg ( @part_pkg ) {
 707           my %postal_options = %options;
 708           delete $postal_options{cancel};
 709           my $error =
 710             $self->_make_lines( 'part_pkg'            => $part_pkg,
 711                                 'cust_pkg'            => $postal_pkg,
 712                                 'precommit_hooks'     => \@precommit_hooks,
 713                                 'line_items'          => \@cust_bill_pkg,
 714                                 'setup'               => $total_setup{$pass},
 715                                 'recur'               => $total_recur{$pass},
 716                                 'tax_engine'          => $tax_engines{$pass},
 717                                 'time'                => $time,
 718                                 'real_pkgpart'        => $real_pkgpart,
 719                                 'options'             => \%postal_options,
 720                               );
 721           if ($error) {
 722             $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 723             return $error;
 724           }
 725         }
 726
 727         # it's silly to have a zero value postal_pkg, but....
 728         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
 729
 730       }
 731
 732     }
 733
 734     #add tax adjustments
 735     #XXX does this work with batch tax engines?
 736     warn "adding tax adjustments...\n" if $DEBUG > 2;
 737     foreach my $cust_tax_adjustment (
 738       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
 739                                        'billpkgnum' => '',
 740                                      }
 741              )
 742     ) {
 743
 744       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
 745
 746       my $itemdesc = $cust_tax_adjustment->taxname;
 747       $itemdesc = '' if $itemdesc eq 'Tax';
 748
 749       push @cust_bill_pkg, new FS::cust_bill_pkg {
 750         'pkgnum'      => 0,
 751         'setup'       => $tax,
 752         'recur'       => 0,
 753         'sdate'       => '',
 754         'edate'       => '',
 755         'itemdesc'    => $itemdesc,
 756         'itemcomment' => $cust_tax_adjustment->comment,
 757         'cust_tax_adjustment' => $cust_tax_adjustment,
 758         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 759       };
 760
 761     }
 762
 763     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
 764
 765     my $balance = $self->balance;
 766
 767     my $previous_bill = qsearchs({ 'table'     => 'cust_bill',
 768                                    'hashref'   => { custnum=>$self->custnum },
 769                                    'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
 770                                 });
 771     my $previous_balance =
 772       $previous_bill
 773         ? ( $previous_bill->billing_balance + $previous_bill->charged )
 774         : 0;
 775
 776     $log->debug('creating the new invoice', %logopt);
 777     warn "creating the new invoice\n" if $DEBUG;
 778     #create the new invoice
 779     my $cust_bill = new FS::cust_bill ( {
 780       'custnum'             => $self->custnum,
 781       '_date'               => $invoice_time,
 782       'charged'             => $charged,
 783       'billing_balance'     => $balance,
 784       'previous_balance'    => $previous_balance,
 785       'invoice_terms'       => $options{'invoice_terms'},
 786       'cust_bill_pkg'       => \@cust_bill_pkg,
 787       'pending'             => 'Y', # clear this after doing taxes
 788     } );
 789
 790     if (!$options{no_commit}) {
 791       # probably we ought to insert it as pending, and then rollback
 792       # without ever un-pending it
 793       $error = $cust_bill->insert;
 794       if ( $error ) {
 795         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 796         return "can't create invoice for customer #". $self->custnum. ": $error";
 797       }
 798
 799     }
 800
 801     # calculate and append taxes
 802     if ( ! $tax_is_batch) {
 803       my $arrayref_or_error = $tax_engines{$pass}->calculate_taxes($cust_bill);
 804
 805       unless ( ref( $arrayref_or_error ) ) {
 806         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 807         return $arrayref_or_error;
 808       }
 809
 810       # or should this be in TaxEngine?
 811       my $total_tax = 0;
 812       foreach my $taxline ( @$arrayref_or_error ) {
 813         $total_tax += $taxline->setup;
 814         $taxline->set('invnum' => $cust_bill->invnum); # just to be sure
 815         push @cust_bill_pkg, $taxline; # for return_bill
 816
 817         if (!$options{no_commit}) {
 818           my $error = $taxline->insert;
 819           if ( $error ) {
 820             $dbh->rollback if $oldAutoCommit;
 821             return $error;
 822           }
 823         }
 824
 825       }
 826
 827       # add tax to the invoice amount and finalize it
 828       ${ $total_setup{$pass} } = sprintf('%.2f', ${ $total_setup{$pass} } + $total_tax);
 829       $charged = sprintf('%.2f', $charged + $total_tax);
 830       $cust_bill->set('charged', $charged);
 831       $cust_bill->set('pending', '');
 832
 833       if (!$options{no_commit}) {
 834         my $error = $cust_bill->replace;
 835         if ( $error ) {
 836           $dbh->rollback if $oldAutoCommit;
 837           return $error;
 838         }
 839       }
 840
 841     } # if !$tax_is_batch
 842       # if it IS batch, then we'll do all this in process_tax_batch
 843
 844     push @{$options{return_bill}}, $cust_bill if $options{return_bill};
 845
 846   } #foreach my $pass ( keys %cust_bill_pkg )
 847
 848   foreach my $hook ( @precommit_hooks ) {
 849     eval {
 850       &{$hook}; #($self) ?
 851     } unless $options{no_commit};
 852     if ( $@ ) {
 853       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 854       return "$@ running precommit hook $hook\n";
 855     }
 856   }
 857
 858   $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
 859
 860   ''; #no error
 861 }
 862
 863 #discard bundled packages of 0 value
 864 sub _omit_zero_value_bundles {
 865   my @in = @_;
 866
 867   my @cust_bill_pkg = ();
 868   my @cust_bill_pkg_bundle = ();
 869   my $sum = 0;
 870   my $discount_show_always = 0;
 871
 872   foreach my $cust_bill_pkg ( @in ) {
 873
 874     $discount_show_always = ($cust_bill_pkg->get('discounts')
 875                                 && scalar(@{$cust_bill_pkg->get('discounts')})
 876                                 && $conf->exists('discount-show-always'));
 877
 878     warn "  pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
 879          "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
 880          "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
 881       if $DEBUG > 0;
 882
 883     if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
 884       push @cust_bill_pkg, @cust_bill_pkg_bundle
 885         if $sum > 0
 886         || ($sum == 0 && (    $discount_show_always
 887                            || grep {$_->recur_show_zero || $_->setup_show_zero}
 888                                    @cust_bill_pkg_bundle
 889                          )
 890            );
 891       @cust_bill_pkg_bundle = ();
 892       $sum = 0;
 893     }
 894
 895     $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
 896     push @cust_bill_pkg_bundle, $cust_bill_pkg;
 897
 898   }
 899
 900   push @cust_bill_pkg, @cust_bill_pkg_bundle
 901     if $sum > 0
 902     || ($sum == 0 && (    $discount_show_always
 903                        || grep {$_->recur_show_zero || $_->setup_show_zero}
 904                                @cust_bill_pkg_bundle
 905                      )
 906        );
 907
 908   warn "  _omit_zero_value_bundles: ". scalar(@in).
 909        '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
 910     if $DEBUG > 2;
 911
 912   (@cust_bill_pkg);
 913
 914 }
 915
 916 sub _make_lines {
 917   my ($self, %params) = @_;
 918
 919   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 920
 921   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 922   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 923   my $cust_location = $cust_pkg->tax_location;
 924   my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
 925   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 926   my $total_setup = $params{setup} or die "no setup accumulator specified";
 927   my $total_recur = $params{recur} or die "no recur accumulator specified";
 928   my $time = $params{'time'} or die "no time specified";
 929   my (%options) = %{$params{options}};
 930
 931   my $tax_engine = $params{tax_engine};
 932
 933   if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
 934     # this should never happen
 935     die 'freq_override billing attempted on non-monthly package '.
 936       $cust_pkg->pkgnum;
 937   }
 938
 939   my $dbh = dbh;
 940   my $real_pkgpart = $params{real_pkgpart};
 941   my %hash = $cust_pkg->hash;
 942   my $old_cust_pkg = new FS::cust_pkg \%hash;
 943
 944   my @details = ();
 945   my $lineitems = 0;
 946
 947   $cust_pkg->pkgpart($part_pkg->pkgpart);
 948
 949   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
 950                      ? day_end( $time )
 951                      : $time
 952                  );
 953
 954   ###
 955   # bill setup
 956   ###
 957
 958   my $setup = 0;
 959   my $unitsetup = 0;
 960   my @setup_discounts = ();
 961   my %setup_param = ( 'discounts'     => \@setup_discounts,
 962                       'real_pkgpart'  => $params{real_pkgpart}
 963                     );
 964   my $setup_billed_currency = '';
 965   my $setup_billed_amount = 0;
 966   # Conditions for setting setup date and charging the setup fee:
 967   # - this is not a recurring-only billing run
 968   # - and the package is not currently being canceled
 969   # - and, unless we're specifically told otherwise via 'resetup':
 970   #   - it doesn't already HAVE a setup date
 971   #   - or a start date in the future
 972   #   - and it's not suspended
 973   #
 974   # The last condition used to check the "disable_setup_suspended" option but
 975   # that's obsolete. We now never set the setup date on a suspended package.
 976   if (     ! $options{recurring_only}
 977        and ! $options{cancel}
 978        and ( $options{'resetup'}
 979              || ( ! $cust_pkg->setup
 980                   && ( ! $cust_pkg->start_date
 981                        || $cust_pkg->start_date <= $cmp_time
 982                      )
 983                   && ( ! $cust_pkg->getfield('susp') )
 984                 )
 985            )
 986      )
 987   {
 988
 989     warn "    bill setup\n" if $DEBUG > 1;
 990
 991     unless ( $cust_pkg->waive_setup ) {
 992         $lineitems++;
 993
 994         $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
 995         return "$@ running calc_setup for $cust_pkg\n"
 996           if $@;
 997
 998         $unitsetup = $cust_pkg->base_setup()
 999                        || $setup; #XXX uuh
1000
1001         if ( $setup_param{'billed_currency'} ) {
1002           $setup_billed_currency = delete $setup_param{'billed_currency'};
1003           $setup_billed_amount   = delete $setup_param{'billed_amount'};
1004         }
1005     }
1006
1007     $cust_pkg->setfield('setup', $time)
1008       unless $cust_pkg->setup;
1009           #do need it, but it won't get written to the db
1010           #|| $cust_pkg->pkgpart != $real_pkgpart;
1011
1012     $cust_pkg->setfield('start_date', '')
1013       if $cust_pkg->start_date;
1014
1015   }
1016
1017   ###
1018   # bill recurring fee
1019   ###
1020
1021   my $recur = 0;
1022   my $unitrecur = 0;
1023   my @recur_discounts = ();
1024   my $recur_billed_currency = '';
1025   my $recur_billed_amount = 0;
1026   my $sdate;
1027   if (     ! $cust_pkg->start_date
1028        and
1029            ( ! $cust_pkg->susp
1030                || ( $cust_pkg->susp != $cust_pkg->order_date
1031                       && (    $cust_pkg->option('suspend_bill',1)
1032                            || ( $part_pkg->option('suspend_bill', 1)
1033                                  && ! $cust_pkg->option('no_suspend_bill',1)
1034                               )
1035                          )
1036                   )
1037            )
1038        and
1039             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1040          || ( $part_pkg->plan eq 'voip_cdr'
1041                && $part_pkg->option('bill_every_call')
1042             )
1043          || $options{cancel}
1044   ) {
1045
1046     # XXX should this be a package event?  probably.  events are called
1047     # at collection time at the moment, though...
1048     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1049       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1050       #don't want to reset usage just cause we want a line item??
1051       #&& $part_pkg->pkgpart == $real_pkgpart;
1052
1053     warn "    bill recur\n" if $DEBUG > 1;
1054     $lineitems++;
1055
1056     # XXX shared with $recur_prog
1057     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1058              || $cust_pkg->setup
1059              || $time;
1060
1061     #over two params!  lets at least switch to a hashref for the rest...
1062     my $increment_next_bill = ( $part_pkg->freq ne '0'
1063                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1064                                 && !$options{cancel}
1065                               );
1066     my %param = ( %setup_param,
1067                   'precommit_hooks'     => $precommit_hooks,
1068                   'increment_next_bill' => $increment_next_bill,
1069                   'discounts'           => \@recur_discounts,
1070                   'real_pkgpart'        => $real_pkgpart,
1071                   'freq_override'       => $options{freq_override} || '',
1072                   'setup_fee'           => 0,
1073                 );
1074
1075     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1076
1077     # There may be some part_pkg for which this is wrong.  Only those
1078     # which can_discount are supported.
1079     # (the UI should prevent adding discounts to these at the moment)
1080
1081     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1082          " for pkgpart ". $cust_pkg->pkgpart.
1083          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1084       if $DEBUG > 2;
1085
1086     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1087     return "$@ running $method for $cust_pkg\n"
1088       if ( $@ );
1089
1090     #base_cancel???
1091     $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1092
1093     if ( $param{'billed_currency'} ) {
1094       $recur_billed_currency = delete $param{'billed_currency'};
1095       $recur_billed_amount   = delete $param{'billed_amount'};
1096     }
1097
1098     if ( $increment_next_bill ) {
1099
1100       my $next_bill;
1101
1102       if ( my $main_pkg = $cust_pkg->main_pkg ) {
1103         # supplemental package
1104         # to keep in sync with the main package, simulate billing at
1105         # its frequency
1106         my $main_pkg_freq = $main_pkg->part_pkg->freq;
1107         my $supp_pkg_freq = $part_pkg->freq;
1108         my $ratio = $supp_pkg_freq / $main_pkg_freq;
1109         if ( $ratio != int($ratio) ) {
1110           # the UI should prevent setting up packages like this, but just
1111           # in case
1112           return "supplemental package period is not an integer multiple of main  package period";
1113         }
1114         $next_bill = $sdate;
1115         for (1..$ratio) {
1116           $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1117         }
1118
1119       } else {
1120         # the normal case
1121       $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1122       return "unparsable frequency: ". $part_pkg->freq
1123         if $next_bill == -1;
1124       }
1125
1126       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1127       # only for figuring next bill date, nothing else, so, reset $sdate again
1128       # here
1129       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1130       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1131       $cust_pkg->last_bill($sdate);
1132
1133       $cust_pkg->setfield('bill', $next_bill );
1134
1135     }
1136
1137     if ( $param{'setup_fee'} ) {
1138       # Add an additional setup fee at the billing stage.
1139       # Used for prorate_defer_bill.
1140       $setup += $param{'setup_fee'};
1141       $unitsetup += $param{'setup_fee'};
1142       $lineitems++;
1143     }
1144
1145     if ( defined $param{'discount_left_setup'} ) {
1146         foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1147             $setup -= $discount_setup;
1148         }
1149     }
1150
1151   }
1152
1153   warn "\$setup is undefined" unless defined($setup);
1154   warn "\$recur is undefined" unless defined($recur);
1155   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1156
1157   ###
1158   # If there's line items, create em cust_bill_pkg records
1159   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1160   ###
1161
1162   if ( $lineitems ) {
1163
1164     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1165       # hmm.. and if just the options are modified in some weird price plan?
1166
1167       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1168         if $DEBUG >1;
1169
1170       my $error = $cust_pkg->replace( $old_cust_pkg,
1171                                       'depend_jobnum'=>$options{depend_jobnum},
1172                                       'options' => { $cust_pkg->options },
1173                                     )
1174         unless $options{no_commit};
1175       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1176         if $error; #just in case
1177     }
1178
1179     $setup = sprintf( "%.2f", $setup );
1180     $recur = sprintf( "%.2f", $recur );
1181     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1182       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1183     }
1184     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1185       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1186     }
1187
1188     my $discount_show_always = $conf->exists('discount-show-always')
1189                                && (    ($setup == 0 && scalar(@setup_discounts))
1190                                     || ($recur == 0 && scalar(@recur_discounts))
1191                                   );
1192
1193     if (    $setup != 0
1194          || $recur != 0
1195          || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1196          || $discount_show_always
1197          || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1198          || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1199        )
1200     {
1201
1202       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1203         if $DEBUG > 1;
1204
1205       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1206       if ( $DEBUG > 1 ) {
1207         warn "      adding customer package invoice detail: $_\n"
1208           foreach @cust_pkg_detail;
1209       }
1210       push @details, @cust_pkg_detail;
1211
1212       my $cust_bill_pkg = new FS::cust_bill_pkg {
1213         'pkgnum'                => $cust_pkg->pkgnum,
1214         'setup'                 => $setup,
1215         'unitsetup'             => $unitsetup,
1216         'setup_billed_currency' => $setup_billed_currency,
1217         'setup_billed_amount'   => $setup_billed_amount,
1218         'recur'                 => $recur,
1219         'unitrecur'             => $unitrecur,
1220         'recur_billed_currency' => $recur_billed_currency,
1221         'recur_billed_amount'   => $recur_billed_amount,
1222         'quantity'              => $cust_pkg->quantity,
1223         'details'               => \@details,
1224         'discounts'             => [ @setup_discounts, @recur_discounts ],
1225         'hidden'                => $part_pkg->hidden,
1226         'freq'                  => $part_pkg->freq,
1227       };
1228
1229       if ( $part_pkg->option('prorate_defer_bill',1)
1230            and !$hash{last_bill} ) {
1231         # both preceding and upcoming, technically
1232         $cust_bill_pkg->sdate( $cust_pkg->setup );
1233         $cust_bill_pkg->edate( $cust_pkg->bill );
1234       } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1235         $cust_bill_pkg->sdate( $hash{last_bill} );
1236         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
1237         $cust_bill_pkg->edate( $time ) if $options{cancel};
1238       } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1239         $cust_bill_pkg->sdate( $sdate );
1240         $cust_bill_pkg->edate( $cust_pkg->bill );
1241         #$cust_bill_pkg->edate( $time ) if $options{cancel};
1242       }
1243
1244       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1245         unless $part_pkg->pkgpart == $real_pkgpart;
1246
1247       $$total_setup += $setup;
1248       $$total_recur += $recur;
1249
1250       ###
1251       # handle taxes
1252       ###
1253
1254       my $error = $tax_engine->add_sale($cust_bill_pkg);
1255       return $error if $error;
1256
1257       $cust_bill_pkg->set_display(
1258         part_pkg     => $part_pkg,
1259         real_pkgpart => $real_pkgpart,
1260       );
1261
1262       push @$cust_bill_pkgs, $cust_bill_pkg;
1263
1264     } #if $setup != 0 || $recur != 0
1265
1266   } #if $line_items
1267
1268   '';
1269
1270 }
1271
1272 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1273
1274 Takes one argument, a cust_pkg object that is being billed.  This will
1275 be called only if the package was created by a package change, and has
1276 not been billed since the package change, and package balance tracking
1277 is enabled.  The second argument can be an alternate package number to
1278 transfer the balance from; this should not be used externally.
1279
1280 Transfers the balance from the previous package (now canceled) to
1281 this package, by crediting one package and creating an invoice item for
1282 the other.  Inserts the credit and returns the invoice item (so that it
1283 can be added to an invoice that's being built).
1284
1285 If the previous package was never billed, and was also created by a package
1286 change, then this will also transfer the balance from I<its> previous
1287 package, and so on, until reaching a package that either has been billed
1288 or was not created by a package change.
1289
1290 =cut
1291
1292 my $balance_transfer_reason;
1293
1294 sub _transfer_balance {
1295   my $self = shift;
1296   my $cust_pkg = shift;
1297   my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1298   my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1299
1300   my @transfers;
1301
1302   # if $from_pkg is not the first package in the chain, and it was never
1303   # billed, walk back
1304   if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1305     @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1306   }
1307
1308   my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1309   if ( $prev_balance != 0 ) {
1310     $balance_transfer_reason ||= FS::reason->new_or_existing(
1311       'reason' => 'Package balance transfer',
1312       'type'   => 'Internal adjustment',
1313       'class'  => 'R'
1314     );
1315
1316     my $credit = FS::cust_credit->new({
1317         'custnum'   => $self->custnum,
1318         'amount'    => abs($prev_balance),
1319         'reasonnum' => $balance_transfer_reason->reasonnum,
1320         '_date'     => $cust_pkg->change_date,
1321     });
1322
1323     my $cust_bill_pkg = FS::cust_bill_pkg->new({
1324         'setup'     => 0,
1325         'recur'     => abs($prev_balance),
1326         #'sdate'     => $from_pkg->last_bill, # not sure about this
1327         #'edate'     => $cust_pkg->change_date,
1328         'itemdesc'  => $self->mt('Previous Balance, [_1]',
1329                                  $from_pkg->part_pkg->pkg),
1330     });
1331
1332     if ( $prev_balance > 0 ) {
1333       # credit the old package, charge the new one
1334       $credit->set('pkgnum', $from_pkgnum);
1335       $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1336     } else {
1337       # the reverse
1338       $credit->set('pkgnum', $cust_pkg->pkgnum);
1339       $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1340     }
1341     my $error = $credit->insert;
1342     die "error transferring package balance from #".$from_pkgnum.
1343         " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1344
1345     push @transfers, $cust_bill_pkg;
1346   } # $prev_balance != 0
1347
1348   return @transfers;
1349 }
1350
1351 #### vestigial code ####
1352
1353 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1354
1355 This is _handle_taxes.  It's called once for each cust_bill_pkg generated
1356 from _make_lines.
1357
1358 TAXLISTHASH is a hashref shared across the entire invoice.  It looks like
1359 this:
1360 {
1361   'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1362   'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1363 }
1364
1365 'cust_main_county' can also be 'tax_rate'.  The first object in the array
1366 is always the cust_main_county or tax_rate identified by the key.
1367
1368 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1369 the 'taxline' method to calculate the amount of the tax.  This doesn't
1370 happen until calculate_taxes, though.
1371
1372 OPTIONS may include:
1373 - part_item: a part_pkg or part_fee object to be used as the package/fee
1374   definition.
1375 - location: a cust_location to be used as the billing location.
1376 - cancel: true if this package is being billed on cancellation.  This
1377   allows tax to be calculated on usage charges only.
1378
1379 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1380 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1381 the customer's default service location).
1382
1383 =cut
1384
1385 sub _handle_taxes {
1386   my $self = shift;
1387   my $taxlisthash = shift;
1388   my $cust_bill_pkg = shift;
1389   my %options = @_;
1390
1391   # at this point I realize that we have enough information to infer all this
1392   # stuff, instead of passing around giant honking argument lists
1393   my $location = $options{location} || $cust_bill_pkg->tax_location;
1394   my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1395
1396   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1397
1398   return if ( $self->payby eq 'COMP' ); #dubious
1399
1400   if ( $conf->exists('enable_taxproducts')
1401        && ( scalar($part_item->part_pkg_taxoverride)
1402             || $part_item->has_taxproduct
1403           )
1404      )
1405     {
1406
1407     # EXTERNAL TAX RATES (via tax_rate)
1408     my %cust_bill_pkg = ();
1409     my %taxes = ();
1410
1411     my @classes;
1412     push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1413     push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1414     push @classes, 'recur' if $cust_bill_pkg->recur and !$options{cancel};
1415
1416     my $exempt = $conf->exists('cust_class-tax_exempt')
1417                    ? ( $self->cust_class ? $self->cust_class->tax : '' )
1418                    : $self->tax;
1419     # standardize this just to be sure
1420     $exempt = ($exempt eq 'Y') ? 'Y' : '';
1421
1422     if ( !$exempt ) {
1423
1424       foreach my $class (@classes) {
1425         my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1426         return $err_or_ref unless ref($err_or_ref);
1427         $taxes{$class} = $err_or_ref;
1428       }
1429
1430       unless (exists $taxes{''}) {
1431         my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1432         return $err_or_ref unless ref($err_or_ref);
1433         $taxes{''} = $err_or_ref;
1434       }
1435
1436     }
1437
1438     my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; # grrr
1439     foreach my $key (keys %tax_cust_bill_pkg) {
1440       # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1441       # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1442       # the line item.
1443       # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1444       # apply to $key-class charges.
1445       my @taxes = @{ $taxes{$key} || [] };
1446       my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1447
1448       my %localtaxlisthash = ();
1449       foreach my $tax ( @taxes ) {
1450
1451         # this is the tax identifier, not the taxname
1452         my $taxname = ref( $tax ). ' '. $tax->taxnum;
1453         # $taxlisthash: keys are "setup", "recur", and usage classes.
1454         # Values are arrayrefs, first the tax object (cust_main_county
1455         # or tax_rate) and then any cust_bill_pkg objects that the
1456         # tax applies to.
1457         $taxlisthash->{ $taxname } ||= [ $tax ];
1458         push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
1459
1460         $localtaxlisthash{ $taxname } ||= [ $tax ];
1461         push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
1462
1463       }
1464
1465       warn "finding taxed taxes...\n" if $DEBUG > 2;
1466       foreach my $tax ( keys %localtaxlisthash ) {
1467         my $tax_object = shift @{ $localtaxlisthash{$tax} };
1468         warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1469           if $DEBUG > 2;
1470         next unless $tax_object->can('tax_on_tax');
1471
1472         foreach my $tot ( $tax_object->tax_on_tax( $location ) ) {
1473           my $totname = ref( $tot ). ' '. $tot->taxnum;
1474
1475           warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1476             if $DEBUG > 2;
1477           next unless exists( $localtaxlisthash{ $totname } ); # only increase
1478                                                                # existing taxes
1479           warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1480           # calculate the tax amount that the tax_on_tax will apply to
1481           my $hashref_or_error =
1482             $tax_object->taxline( $localtaxlisthash{$tax} );
1483           return $hashref_or_error
1484             unless ref($hashref_or_error);
1485
1486           # and append it to the list of taxable items
1487           $taxlisthash->{ $totname } ||= [ $tot ];
1488           push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
1489
1490         }
1491       }
1492     }
1493
1494   } else {
1495
1496     # INTERNAL TAX RATES (cust_main_county)
1497
1498     # We fetch taxes even if the customer is completely exempt,
1499     # because we need to record that fact.
1500
1501     my @loc_keys = qw( district city county state country );
1502     my %taxhash = map { $_ => $location->$_ } @loc_keys;
1503
1504     $taxhash{'taxclass'} = $part_item->taxclass;
1505
1506     warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1507
1508     my @taxes = (); # entries are cust_main_county objects
1509     my %taxhash_elim = %taxhash;
1510     my @elim = qw( district city county state );
1511     do {
1512
1513       #first try a match with taxclass
1514       @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1515
1516       if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1517         #then try a match without taxclass
1518         my %no_taxclass = %taxhash_elim;
1519         $no_taxclass{ 'taxclass' } = '';
1520         @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1521       }
1522
1523       $taxhash_elim{ shift(@elim) } = '';
1524
1525     } while ( !scalar(@taxes) && scalar(@elim) );
1526
1527     foreach (@taxes) {
1528       my $tax_id = 'cust_main_county '.$_->taxnum;
1529       $taxlisthash->{$tax_id} ||= [ $_ ];
1530       push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1531     }
1532
1533   }
1534   '';
1535 }
1536
1537 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1538
1539 Internal method used with vendor-provided tax tables.  PART_ITEM is a part_pkg
1540 or part_fee (which will define the tax eligibility of the product), CLASS is
1541 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1542 location where the service was provided (or billed, depending on
1543 configuration).  Returns an arrayref of L<FS::tax_rate> objects that
1544 can apply to this line item.
1545
1546 =cut
1547
1548 sub _gather_taxes {
1549   my $self = shift;
1550   my $part_item = shift;
1551   my $class = shift;
1552   my $location = shift;
1553
1554   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1555
1556   my $geocode = $location->geocode('cch');
1557
1558   [ $part_item->tax_rates('cch', $geocode, $class) ]
1559
1560 }
1561
1562 #### end vestigial code ####
1563
1564 =item collect [ HASHREF | OPTION => VALUE ... ]
1565
1566 (Attempt to) collect money for this customer's outstanding invoices (see
1567 L<FS::cust_bill>).  Usually used after the bill method.
1568
1569 Actions are now triggered by billing events; see L<FS::part_event> and the
1570 billing events web interface.  Old-style invoice events (see
1571 L<FS::part_bill_event>) have been deprecated.
1572
1573 If there is an error, returns the error, otherwise returns false.
1574
1575 Options are passed as name-value pairs.
1576
1577 Currently available options are:
1578
1579 =over 4
1580
1581 =item invoice_time
1582
1583 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.
1584
1585 =item retry
1586
1587 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1588
1589 =item check_freq
1590
1591 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1592
1593 =item quiet
1594
1595 set true to surpress email card/ACH decline notices.
1596
1597 =item debug
1598
1599 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)
1600
1601 =back
1602
1603 # =item payby
1604 #
1605 # allows for one time override of normal customer billing method
1606
1607 =cut
1608
1609 sub collect {
1610   my( $self, %options ) = @_;
1611
1612   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1613
1614   my $invoice_time = $options{'invoice_time'} || time;
1615
1616   #put below somehow?
1617   local $SIG{HUP} = 'IGNORE';
1618   local $SIG{INT} = 'IGNORE';
1619   local $SIG{QUIT} = 'IGNORE';
1620   local $SIG{TERM} = 'IGNORE';
1621   local $SIG{TSTP} = 'IGNORE';
1622   local $SIG{PIPE} = 'IGNORE';
1623
1624   my $oldAutoCommit = $FS::UID::AutoCommit;
1625   local $FS::UID::AutoCommit = 0;
1626   my $dbh = dbh;
1627
1628   $self->select_for_update; #mutex
1629
1630   if ( $DEBUG ) {
1631     my $balance = $self->balance;
1632     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1633   }
1634
1635   if ( exists($options{'retry_card'}) ) {
1636     carp 'retry_card option passed to collect is deprecated; use retry';
1637     $options{'retry'} ||= $options{'retry_card'};
1638   }
1639   if ( exists($options{'retry'}) && $options{'retry'} ) {
1640     my $error = $self->retry_realtime;
1641     if ( $error ) {
1642       $dbh->rollback if $oldAutoCommit;
1643       return $error;
1644     }
1645   }
1646
1647   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1648
1649   #never want to roll back an event just because it returned an error
1650   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1651
1652   $self->do_cust_event(
1653     'debug'      => ( $options{'debug'} || 0 ),
1654     'time'       => $invoice_time,
1655     'check_freq' => $options{'check_freq'},
1656     'stage'      => 'collect',
1657   );
1658
1659 }
1660
1661 =item retry_realtime
1662
1663 Schedules realtime / batch  credit card / electronic check / LEC billing
1664 events for for retry.  Useful if card information has changed or manual
1665 retry is desired.  The 'collect' method must be called to actually retry
1666 the transaction.
1667
1668 Implementation details: For either this customer, or for each of this
1669 customer's open invoices, changes the status of the first "done" (with
1670 statustext error) realtime processing event to "failed".
1671
1672 =cut
1673
1674 sub retry_realtime {
1675   my $self = shift;
1676
1677   local $SIG{HUP} = 'IGNORE';
1678   local $SIG{INT} = 'IGNORE';
1679   local $SIG{QUIT} = 'IGNORE';
1680   local $SIG{TERM} = 'IGNORE';
1681   local $SIG{TSTP} = 'IGNORE';
1682   local $SIG{PIPE} = 'IGNORE';
1683
1684   my $oldAutoCommit = $FS::UID::AutoCommit;
1685   local $FS::UID::AutoCommit = 0;
1686   my $dbh = dbh;
1687
1688   #a little false laziness w/due_cust_event (not too bad, really)
1689
1690   # I guess this is always as of now?
1691   my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1692   my $order = FS::part_event_condition->order_conditions_sql;
1693   my $mine =
1694   '( '
1695    . join ( ' OR ' , map {
1696     my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1697     my $custnum = FS::part_event->eventtables_custnum->{$_};
1698     "( part_event.eventtable = " . dbh->quote($_)
1699     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1700     . " from $_ $cust_join"
1701     . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1702    } FS::part_event->eventtables)
1703    . ') ';
1704
1705   #here is the agent virtualization
1706   my $agent_virt = " (    part_event.agentnum IS NULL
1707                        OR part_event.agentnum = ". $self->agentnum. ' )';
1708
1709   #XXX this shouldn't be hardcoded, actions should declare it...
1710   my @realtime_events = qw(
1711     cust_bill_realtime_card
1712     cust_bill_realtime_check
1713     cust_bill_realtime_lec
1714     cust_bill_batch
1715   );
1716
1717   my $is_realtime_event =
1718     ' part_event.action IN ( '.
1719         join(',', map "'$_'", @realtime_events ).
1720     ' ) ';
1721
1722   my $batch_or_statustext =
1723     "( part_event.action = 'cust_bill_batch'
1724        OR ( statustext IS NOT NULL AND statustext != '' )
1725      )";
1726
1727
1728   my @cust_event = qsearch({
1729     'table'     => 'cust_event',
1730     'select'    => 'cust_event.*',
1731     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1732     'hashref'   => { 'status' => 'done' },
1733     'extra_sql' => " AND $batch_or_statustext ".
1734                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1735   });
1736
1737   my %seen_invnum = ();
1738   foreach my $cust_event (@cust_event) {
1739
1740     #max one for the customer, one for each open invoice
1741     my $cust_X = $cust_event->cust_X;
1742     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1743                           ? $cust_X->invnum
1744                           : 0
1745                         }++
1746          or $cust_event->part_event->eventtable eq 'cust_bill'
1747             && ! $cust_X->owed;
1748
1749     my $error = $cust_event->retry;
1750     if ( $error ) {
1751       $dbh->rollback if $oldAutoCommit;
1752       return "error scheduling event for retry: $error";
1753     }
1754
1755   }
1756
1757   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1758   '';
1759
1760 }
1761
1762 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1763
1764 Runs billing events; see L<FS::part_event> and the billing events web
1765 interface.
1766
1767 If there is an error, returns the error, otherwise returns false.
1768
1769 Options are passed as name-value pairs.
1770
1771 Currently available options are:
1772
1773 =over 4
1774
1775 =item time
1776
1777 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.
1778
1779 =item check_freq
1780
1781 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1782
1783 =item stage
1784
1785 "collect" (the default) or "pre-bill"
1786
1787 =item quiet
1788
1789 set true to surpress email card/ACH decline notices.
1790
1791 =item debug
1792
1793 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)
1794
1795 =back
1796 =cut
1797
1798 # =item payby
1799 #
1800 # allows for one time override of normal customer billing method
1801
1802 # =item retry
1803 #
1804 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1805
1806 sub do_cust_event {
1807   my( $self, %options ) = @_;
1808
1809   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1810
1811   my $time = $options{'time'} || time;
1812
1813   #put below somehow?
1814   local $SIG{HUP} = 'IGNORE';
1815   local $SIG{INT} = 'IGNORE';
1816   local $SIG{QUIT} = 'IGNORE';
1817   local $SIG{TERM} = 'IGNORE';
1818   local $SIG{TSTP} = 'IGNORE';
1819   local $SIG{PIPE} = 'IGNORE';
1820
1821   my $oldAutoCommit = $FS::UID::AutoCommit;
1822   local $FS::UID::AutoCommit = 0;
1823   my $dbh = dbh;
1824
1825   $self->select_for_update; #mutex
1826
1827   if ( $DEBUG ) {
1828     my $balance = $self->balance;
1829     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1830   }
1831
1832 #  if ( exists($options{'retry_card'}) ) {
1833 #    carp 'retry_card option passed to collect is deprecated; use retry';
1834 #    $options{'retry'} ||= $options{'retry_card'};
1835 #  }
1836 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
1837 #    my $error = $self->retry_realtime;
1838 #    if ( $error ) {
1839 #      $dbh->rollback if $oldAutoCommit;
1840 #      return $error;
1841 #    }
1842 #  }
1843
1844   # false laziness w/pay_batch::import_results
1845
1846   my $due_cust_event = $self->due_cust_event(
1847     'debug'      => ( $options{'debug'} || 0 ),
1848     'time'       => $time,
1849     'check_freq' => $options{'check_freq'},
1850     'stage'      => ( $options{'stage'} || 'collect' ),
1851   );
1852   unless( ref($due_cust_event) ) {
1853     $dbh->rollback if $oldAutoCommit;
1854     return $due_cust_event;
1855   }
1856
1857   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1858   #never want to roll back an event just because it or a different one
1859   # returned an error
1860   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1861
1862   foreach my $cust_event ( @$due_cust_event ) {
1863
1864     #XXX lock event
1865
1866     #re-eval event conditions (a previous event could have changed things)
1867     unless ( $cust_event->test_conditions ) {
1868       #don't leave stray "new/locked" records around
1869       my $error = $cust_event->delete;
1870       return $error if $error;
1871       next;
1872     }
1873
1874     {
1875       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1876         if $options{'quiet'};
1877       warn "  running cust_event ". $cust_event->eventnum. "\n"
1878         if $DEBUG > 1;
1879
1880       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1881       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1882         #XXX wtf is this?  figure out a proper dealio with return value
1883         #from do_event
1884         return $error;
1885       }
1886     }
1887
1888   }
1889
1890   '';
1891
1892 }
1893
1894 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1895
1896 Inserts database records for and returns an ordered listref of new events due
1897 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
1898 events are due, an empty listref is returned.  If there is an error, returns a
1899 scalar error message.
1900
1901 To actually run the events, call each event's test_condition method, and if
1902 still true, call the event's do_event method.
1903
1904 Options are passed as a hashref or as a list of name-value pairs.  Available
1905 options are:
1906
1907 =over 4
1908
1909 =item check_freq
1910
1911 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.
1912
1913 =item stage
1914
1915 "collect" (the default) or "pre-bill"
1916
1917 =item time
1918
1919 "Current time" for the events.
1920
1921 =item debug
1922
1923 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)
1924
1925 =item eventtable
1926
1927 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1928
1929 =item objects
1930
1931 Explicitly pass the objects to be tested (typically used with eventtable).
1932
1933 =item testonly
1934
1935 Set to true to return the objects, but not actually insert them into the
1936 database.
1937
1938 =back
1939
1940 =cut
1941
1942 sub due_cust_event {
1943   my $self = shift;
1944   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1945
1946   #???
1947   #my $DEBUG = $opt{'debug'}
1948   $opt{'debug'} ||= 0; # silence some warnings
1949   local($DEBUG) = $opt{'debug'}
1950     if $opt{'debug'} > $DEBUG;
1951   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1952
1953   warn "$me due_cust_event called with options ".
1954        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1955     if $DEBUG;
1956
1957   $opt{'time'} ||= time;
1958
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     unless $opt{testonly};
1972
1973   ###
1974   # find possible events (initial search)
1975   ###
1976
1977   my @cust_event = ();
1978
1979   my @eventtable = $opt{'eventtable'}
1980                      ? ( $opt{'eventtable'} )
1981                      : FS::part_event->eventtables_runorder;
1982
1983   my $check_freq = $opt{'check_freq'} || '1d';
1984
1985   foreach my $eventtable ( @eventtable ) {
1986
1987     my @objects;
1988     if ( $opt{'objects'} ) {
1989
1990       @objects = @{ $opt{'objects'} };
1991
1992     } elsif ( $eventtable eq 'cust_main' ) {
1993
1994       @objects = ( $self );
1995
1996     } else {
1997
1998       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1999       # linkage not needed here because FS::cust_main->$eventtable will
2000       # already supply it
2001
2002       #some false laziness w/Cron::bill bill_where
2003
2004       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable,
2005         'time' => $opt{'time'});
2006       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2007         'time'=>$opt{'time'},
2008       );
2009       $where = $where ? "AND $where" : '';
2010
2011       my $are_part_event =
2012       "EXISTS ( SELECT 1 FROM part_event $join
2013         WHERE check_freq = '$check_freq'
2014         AND eventtable = '$eventtable'
2015         AND ( disabled = '' OR disabled IS NULL )
2016         $where
2017         )
2018       ";
2019       #eofalse
2020
2021       @objects = $self->$eventtable(
2022         'addl_from' => $cm_join,
2023         'extra_sql' => " AND $are_part_event",
2024       );
2025     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2026
2027     my @e_cust_event = ();
2028
2029     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2030
2031     my $cross = "CROSS JOIN $eventtable $linkage";
2032     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2033       unless $eventtable eq 'cust_main';
2034
2035     foreach my $object ( @objects ) {
2036
2037       #this first search uses the condition_sql magic for optimization.
2038       #the more possible events we can eliminate in this step the better
2039
2040       my $cross_where = '';
2041       my $pkey = $object->primary_key;
2042       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2043
2044       my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2045         'time' => $opt{'time'});
2046       my $extra_sql =
2047         FS::part_event_condition->where_conditions_sql( $eventtable,
2048                                                         'time'=>$opt{'time'}
2049                                                       );
2050       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2051
2052       $extra_sql = "AND $extra_sql" if $extra_sql;
2053
2054       #here is the agent virtualization
2055       $extra_sql .= " AND (    part_event.agentnum IS NULL
2056                             OR part_event.agentnum = ". $self->agentnum. ' )';
2057
2058       $extra_sql .= " $order";
2059
2060       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2061         if $opt{'debug'} > 2;
2062       my @part_event = qsearch( {
2063         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2064         'select'    => 'part_event.*',
2065         'table'     => 'part_event',
2066         'addl_from' => "$cross $join",
2067         'hashref'   => { 'check_freq' => $check_freq,
2068                          'eventtable' => $eventtable,
2069                          'disabled'   => '',
2070                        },
2071         'extra_sql' => "AND $cross_where $extra_sql",
2072       } );
2073
2074       if ( $DEBUG > 2 ) {
2075         my $pkey = $object->primary_key;
2076         warn "      ". scalar(@part_event).
2077              " possible events found for $eventtable ". $object->$pkey(). "\n";
2078       }
2079
2080       push @e_cust_event, map {
2081         $_->new_cust_event($object, 'time' => $opt{'time'})
2082       } @part_event;
2083
2084     }
2085
2086     warn "    ". scalar(@e_cust_event).
2087          " subtotal possible cust events found for $eventtable\n"
2088       if $DEBUG > 1;
2089
2090     push @cust_event, @e_cust_event;
2091
2092   }
2093
2094   warn "  ". scalar(@cust_event).
2095        " total possible cust events found in initial search\n"
2096     if $DEBUG; # > 1;
2097
2098
2099   ##
2100   # test stage
2101   ##
2102
2103   $opt{stage} ||= 'collect';
2104   @cust_event =
2105     grep { my $stage = $_->part_event->event_stage;
2106            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2107          }
2108          @cust_event;
2109
2110   ##
2111   # test conditions
2112   ##
2113
2114   my %unsat = ();
2115
2116   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2117                      @cust_event;
2118
2119   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2120     if $DEBUG; # > 1;
2121
2122   warn "    invalid conditions not eliminated with condition_sql:\n".
2123        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2124     if keys %unsat && $DEBUG; # > 1;
2125
2126   ##
2127   # insert
2128   ##
2129
2130   unless( $opt{testonly} ) {
2131     foreach my $cust_event ( @cust_event ) {
2132
2133       my $error = $cust_event->insert();
2134       if ( $error ) {
2135         $dbh->rollback if $oldAutoCommit;
2136         return $error;
2137       }
2138
2139     }
2140   }
2141
2142   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2143
2144   ##
2145   # return
2146   ##
2147
2148   warn "  returning events: ". Dumper(@cust_event). "\n"
2149     if $DEBUG > 2;
2150
2151   \@cust_event;
2152
2153 }
2154
2155 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2156
2157 Applies unapplied payments and credits.
2158
2159 In most cases, this new method should be used in place of sequential
2160 apply_payments and apply_credits methods.
2161
2162 A hash of optional arguments may be passed.  Currently "manual" is supported.
2163 If true, a payment receipt is sent instead of a statement when
2164 'payment_receipt_email' configuration option is set.
2165
2166 If there is an error, returns the error, otherwise returns false.
2167
2168 =cut
2169
2170 sub apply_payments_and_credits {
2171   my( $self, %options ) = @_;
2172
2173   local $SIG{HUP} = 'IGNORE';
2174   local $SIG{INT} = 'IGNORE';
2175   local $SIG{QUIT} = 'IGNORE';
2176   local $SIG{TERM} = 'IGNORE';
2177   local $SIG{TSTP} = 'IGNORE';
2178   local $SIG{PIPE} = 'IGNORE';
2179
2180   my $oldAutoCommit = $FS::UID::AutoCommit;
2181   local $FS::UID::AutoCommit = 0;
2182   my $dbh = dbh;
2183
2184   $self->select_for_update; #mutex
2185
2186   foreach my $cust_bill ( $self->open_cust_bill ) {
2187     my $error = $cust_bill->apply_payments_and_credits(%options);
2188     if ( $error ) {
2189       $dbh->rollback if $oldAutoCommit;
2190       return "Error applying: $error";
2191     }
2192   }
2193
2194   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2195   ''; #no error
2196
2197 }
2198
2199 =item apply_credits OPTION => VALUE ...
2200
2201 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2202 to outstanding invoice balances in chronological order (or reverse
2203 chronological order if the I<order> option is set to B<newest>) and returns the
2204 value of any remaining unapplied credits available for refund (see
2205 L<FS::cust_refund>).
2206
2207 Dies if there is an error.
2208
2209 =cut
2210
2211 sub apply_credits {
2212   my $self = shift;
2213   my %opt = @_;
2214
2215   local $SIG{HUP} = 'IGNORE';
2216   local $SIG{INT} = 'IGNORE';
2217   local $SIG{QUIT} = 'IGNORE';
2218   local $SIG{TERM} = 'IGNORE';
2219   local $SIG{TSTP} = 'IGNORE';
2220   local $SIG{PIPE} = 'IGNORE';
2221
2222   my $oldAutoCommit = $FS::UID::AutoCommit;
2223   local $FS::UID::AutoCommit = 0;
2224   my $dbh = dbh;
2225
2226   $self->select_for_update; #mutex
2227
2228   unless ( $self->total_unapplied_credits ) {
2229     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2230     return 0;
2231   }
2232
2233   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2234       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2235
2236   my @invoices = $self->open_cust_bill;
2237   @invoices = sort { $b->_date <=> $a->_date } @invoices
2238     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2239
2240   if ( $conf->exists('pkg-balances') ) {
2241     # limit @credits to those w/ a pkgnum grepped from $self
2242     my %pkgnums = ();
2243     foreach my $i (@invoices) {
2244       foreach my $li ( $i->cust_bill_pkg ) {
2245         $pkgnums{$li->pkgnum} = 1;
2246       }
2247     }
2248     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2249   }
2250
2251   my $credit;
2252
2253   foreach my $cust_bill ( @invoices ) {
2254
2255     if ( !defined($credit) || $credit->credited == 0) {
2256       $credit = pop @credits or last;
2257     }
2258
2259     my $owed;
2260     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2261       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2262     } else {
2263       $owed = $cust_bill->owed;
2264     }
2265     unless ( $owed > 0 ) {
2266       push @credits, $credit;
2267       next;
2268     }
2269
2270     my $amount = min( $credit->credited, $owed );
2271
2272     my $cust_credit_bill = new FS::cust_credit_bill ( {
2273       'crednum' => $credit->crednum,
2274       'invnum'  => $cust_bill->invnum,
2275       'amount'  => $amount,
2276     } );
2277     $cust_credit_bill->pkgnum( $credit->pkgnum )
2278       if $conf->exists('pkg-balances') && $credit->pkgnum;
2279     my $error = $cust_credit_bill->insert;
2280     if ( $error ) {
2281       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2282       die $error;
2283     }
2284
2285     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2286
2287   }
2288
2289   my $total_unapplied_credits = $self->total_unapplied_credits;
2290
2291   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2292
2293   return $total_unapplied_credits;
2294 }
2295
2296 =item apply_payments  [ OPTION => VALUE ... ]
2297
2298 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2299 to outstanding invoice balances in chronological order.
2300
2301  #and returns the value of any remaining unapplied payments.
2302
2303 A hash of optional arguments may be passed.  Currently "manual" is supported.
2304 If true, a payment receipt is sent instead of a statement when
2305 'payment_receipt_email' configuration option is set.
2306
2307 Dies if there is an error.
2308
2309 =cut
2310
2311 sub apply_payments {
2312   my( $self, %options ) = @_;
2313
2314   local $SIG{HUP} = 'IGNORE';
2315   local $SIG{INT} = 'IGNORE';
2316   local $SIG{QUIT} = 'IGNORE';
2317   local $SIG{TERM} = 'IGNORE';
2318   local $SIG{TSTP} = 'IGNORE';
2319   local $SIG{PIPE} = 'IGNORE';
2320
2321   my $oldAutoCommit = $FS::UID::AutoCommit;
2322   local $FS::UID::AutoCommit = 0;
2323   my $dbh = dbh;
2324
2325   $self->select_for_update; #mutex
2326
2327   #return 0 unless
2328
2329   my @payments = $self->unapplied_cust_pay;
2330
2331   my @invoices = $self->open_cust_bill;
2332
2333   if ( $conf->exists('pkg-balances') ) {
2334     # limit @payments to those w/ a pkgnum grepped from $self
2335     my %pkgnums = ();
2336     foreach my $i (@invoices) {
2337       foreach my $li ( $i->cust_bill_pkg ) {
2338         $pkgnums{$li->pkgnum} = 1;
2339       }
2340     }
2341     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2342   }
2343
2344   my $payment;
2345
2346   foreach my $cust_bill ( @invoices ) {
2347
2348     if ( !defined($payment) || $payment->unapplied == 0 ) {
2349       $payment = pop @payments or last;
2350     }
2351
2352     my $owed;
2353     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2354       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2355     } else {
2356       $owed = $cust_bill->owed;
2357     }
2358     unless ( $owed > 0 ) {
2359       push @payments, $payment;
2360       next;
2361     }
2362
2363     my $amount = min( $payment->unapplied, $owed );
2364
2365     my $cbp = {
2366       'paynum' => $payment->paynum,
2367       'invnum' => $cust_bill->invnum,
2368       'amount' => $amount,
2369     };
2370     $cbp->{_date} = $payment->_date
2371         if $options{'manual'} && $options{'backdate_application'};
2372     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2373     $cust_bill_pay->pkgnum( $payment->pkgnum )
2374       if $conf->exists('pkg-balances') && $payment->pkgnum;
2375     my $error = $cust_bill_pay->insert(%options);
2376     if ( $error ) {
2377       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2378       die $error;
2379     }
2380
2381     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2382
2383   }
2384
2385   my $total_unapplied_payments = $self->total_unapplied_payments;
2386
2387   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2388
2389   return $total_unapplied_payments;
2390 }
2391
2392 =back
2393
2394 =head1 FLOW
2395
2396   bill_and_collect
2397
2398     cancel_expired_pkgs
2399     suspend_adjourned_pkgs
2400     unsuspend_resumed_pkgs
2401
2402     bill
2403       (do_cust_event pre-bill)
2404       _make_lines
2405       _omit_zero_value_bundles
2406       calculate_taxes
2407
2408     apply_payments_and_credits
2409     collect
2410       do_cust_event
2411         due_cust_event
2412
2413 =head1 BUGS
2414
2415 =head1 SEE ALSO
2416
2417 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2418
2419 =cut
2420
2421 1;