FS/FS/cust_main/Billing.pm

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