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