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