FS/FS/cust_main/Billing.pm

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