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