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