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