FS/FS/cust_main/Billing.pm

   1 package FS::cust_main::Billing;
   2
   3 use strict;
   4 use vars qw( $conf $DEBUG $me );
   5 use Carp;
   6 use Data::Dumper;
   7 use List::Util qw( min );
   8 use FS::UID qw( dbh );
   9 use FS::Record qw( qsearch qsearchs dbdef );
  10 use FS::Misc::DateTime qw( day_end );
  11 use FS::cust_bill;
  12 use FS::cust_bill_pkg;
  13 use FS::cust_bill_pkg_display;
  14 use FS::cust_bill_pay;
  15 use FS::cust_credit_bill;
  16 use FS::cust_tax_adjustment;
  17 use FS::tax_rate;
  18 use FS::tax_rate_location;
  19 use FS::cust_bill_pkg_tax_location;
  20 use FS::cust_bill_pkg_tax_rate_location;
  21 use FS::part_event;
  22 use FS::part_event_condition;
  23 use FS::pkg_category;
  24 use FS::cust_event_fee;
  25 use FS::Log;
  26
  27 # 1 is mostly method/subroutine entry and options
  28 # 2 traces progress of some operations
  29 # 3 is even more information including possibly sensitive data
  30 $DEBUG = 0;
  31 $me = '[FS::cust_main::Billing]';
  32
  33 install_callback FS::UID sub {
  34   $conf = new FS::Conf;
  35   #yes, need it for stuff below (prolly should be cached)
  36 };
  37
  38 =head1 NAME
  39
  40 FS::cust_main::Billing - Billing mixin for cust_main
  41
  42 =head1 SYNOPSIS
  43
  44 =head1 DESCRIPTION
  45
  46 These methods are available on FS::cust_main objects.
  47
  48 =head1 METHODS
  49
  50 =over 4
  51
  52 =item bill_and_collect
  53
  54 Cancels and suspends any packages due, generates bills, applies payments and
  55 credits, and applies collection events to run cards, send bills and notices,
  56 etc.
  57
  58 By default, warns on errors and continues with the next operation (but see the
  59 "fatal" flag below).
  60
  61 Options are passed as name-value pairs.  Currently available options are:
  62
  63 =over 4
  64
  65 =item time
  66
  67 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
  68
  69  use Date::Parse;
  70  ...
  71  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  72
  73 =item invoice_time
  74
  75 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
  76
  77 =item check_freq
  78
  79 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
  80
  81 =item resetup
  82
  83 If set true, re-charges setup fees.
  84
  85 =item fatal
  86
  87 If set any errors prevent subsequent operations from continusing.  If set
  88 specifically to "return", returns the error (or false, if there is no error).
  89 Any other true value causes errors to die.
  90
  91 =item debug
  92
  93 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
  94
  95 =item job
  96
  97 Optional FS::queue entry to receive status updates.
  98
  99 =back
 100
 101 Options are passed to the B<bill> and B<collect> methods verbatim, so all
 102 options of those methods are also available.
 103
 104 =cut
 105
 106 sub bill_and_collect {
 107   my( $self, %options ) = @_;
 108
 109   my $log = FS::Log->new('bill_and_collect');
 110   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
 383   warn "$me bill customer ". $self->custnum. "\n"
 384     if $DEBUG;
 385
 386   my $time = $options{'time'} || time;
 387   my $invoice_time = $options{'invoice_time'} || $time;
 388
 389   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
 390                      ? day_end( $time )
 391                      : $time
 392                  );
 393
 394   $options{'not_pkgpart'} ||= {};
 395   $options{'not_pkgpart'} = { map { $_ => 1 }
 396                                   split(/\s*,\s*/, $options{'not_pkgpart'})
 397                             }
 398     unless ref($options{'not_pkgpart'});
 399
 400   local $SIG{HUP} = 'IGNORE';
 401   local $SIG{INT} = 'IGNORE';
 402   local $SIG{QUIT} = 'IGNORE';
 403   local $SIG{TERM} = 'IGNORE';
 404   local $SIG{TSTP} = 'IGNORE';
 405   local $SIG{PIPE} = 'IGNORE';
 406
 407   my $oldAutoCommit = $FS::UID::AutoCommit;
 408   local $FS::UID::AutoCommit = 0;
 409   my $dbh = dbh;
 410
 411   warn "$me acquiring lock on customer ". $self->custnum. "\n"
 412     if $DEBUG;
 413
 414   $self->select_for_update; #mutex
 415
 416   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
 417     if $DEBUG;
 418
 419   my $error = $self->do_cust_event(
 420     'debug'      => ( $options{'debug'} || 0 ),
 421     'time'       => $invoice_time,
 422     'check_freq' => $options{'check_freq'},
 423     'stage'      => 'pre-bill',
 424   )
 425     unless $options{no_commit};
 426   if ( $error ) {
 427     $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 428     return $error;
 429   }
 430
 431   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
 432     if $DEBUG;
 433
 434   #keep auto-charge and non-auto-charge line items separate
 435   my @passes = ( '', 'no_auto' );
 436
 437   my %cust_bill_pkg = map { $_ => [] } @passes;
 438
 439   ###
 440   # find the packages which are due for billing, find out how much they are
 441   # & generate invoice database.
 442   ###
 443
 444   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
 445   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
 446
 447   my %taxlisthash = map { $_ => {} } @passes;
 448
 449   my @precommit_hooks = ();
 450
 451   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
 452
 453   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
 454
 455     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
 456
 457     my $part_pkg = $cust_pkg->part_pkg;
 458
 459     next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
 460
 461     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
 462
 463     #? to avoid use of uninitialized value errors... ?
 464     $cust_pkg->setfield('bill', '')
 465       unless defined($cust_pkg->bill);
 466
 467     my $real_pkgpart = $cust_pkg->pkgpart;
 468     my %hash = $cust_pkg->hash;
 469
 470     # we could implement this bit as FS::part_pkg::has_hidden, but we already
 471     # suffer from performance issues
 472     $options{has_hidden} = 0;
 473     my @part_pkg = $part_pkg->self_and_bill_linked;
 474     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 475
 476     # if this package was changed from another package,
 477     # and it hasn't been billed since then,
 478     # and package balances are enabled,
 479     if ( $cust_pkg->change_pkgnum
 480         and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
 481         and $cust_pkg->change_date <  $invoice_time
 482       and $conf->exists('pkg-balances') )
 483     {
 484       # _transfer_balance will also create the appropriate credit
 485       my @transfer_items = $self->_transfer_balance($cust_pkg);
 486       # $part_pkg[0] is the "real" part_pkg
 487       my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
 488                   'no_auto' : '';
 489       push @{ $cust_bill_pkg{$pass} }, @transfer_items;
 490       # treating this as recur, just because most charges are recur...
 491       ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
 492     }
 493
 494     foreach my $part_pkg ( @part_pkg ) {
 495
 496       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
 497
 498       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
 499
 500       my $next_bill = $cust_pkg->getfield('bill') || 0;
 501       my $error;
 502       # let this run once if this is the last bill upon cancellation
 503       while ( $next_bill <= $cmp_time or $options{cancel} ) {
 504         $error =
 505           $self->_make_lines( 'part_pkg'            => $part_pkg,
 506                               'cust_pkg'            => $cust_pkg,
 507                               'precommit_hooks'     => \@precommit_hooks,
 508                               'line_items'          => $cust_bill_pkg{$pass},
 509                               'setup'               => $total_setup{$pass},
 510                               'recur'               => $total_recur{$pass},
 511                               'tax_matrix'          => $taxlisthash{$pass},
 512                               'time'                => $time,
 513                               'real_pkgpart'        => $real_pkgpart,
 514                               'options'             => \%options,
 515                             );
 516
 517         # Stop if anything goes wrong
 518         last if $error;
 519
 520         # or if we're not incrementing the bill date.
 521         last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
 522
 523         # or if we're letting it run only once
 524         last if $options{cancel};
 525
 526         $next_bill = $cust_pkg->getfield('bill') || 0;
 527
 528         #stop if -o was passed to freeside-daily
 529         last if $options{'one_recur'};
 530       }
 531       if ($error) {
 532         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 533         return $error;
 534       }
 535
 536     } #foreach my $part_pkg
 537
 538   } #foreach my $cust_pkg
 539
 540   #if the customer isn't on an automatic payby, everything can go on a single
 541   #invoice anyway?
 542   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
 543     #merge everything into one list
 544   #}
 545
 546   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
 547
 548     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
 549
 550     warn "$me billing pass $pass\n"
 551            #.Dumper(\@cust_bill_pkg)."\n"
 552       if $DEBUG > 2;
 553
 554     ###
 555     # process fees
 556     ###
 557
 558     my @pending_event_fees = FS::cust_event_fee->by_cust($self->custnum,
 559       hashref => { 'billpkgnum' => '' }
 560     );
 561     warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n"
 562       if @pending_event_fees and $DEBUG > 1;
 563
 564     # determine whether to generate an invoice
 565     my $generate_bill = scalar(@cust_bill_pkg) > 0;
 566
 567     foreach my $event_fee (@pending_event_fees) {
 568       $generate_bill = 1 unless $event_fee->nextbill;
 569     }
 570
 571     # don't create an invoice with no line items, or where the only line
 572     # items are fees that are supposed to be held until the next invoice
 573     next if !$generate_bill;
 574
 575     # calculate fees...
 576     my @fee_items;
 577     foreach my $event_fee (@pending_event_fees) {
 578       my $object = $event_fee->cust_event->cust_X;
 579       my $part_fee = $event_fee->part_fee;
 580       my $cust_bill;
 581       if ( $object->isa('FS::cust_main')
 582            or $object->isa('FS::cust_pkg')
 583            or $object->isa('FS::cust_pay_batch') )
 584       {
 585         # Not the real cust_bill object that will be inserted--in particular
 586         # there are no taxes yet.  If you want to charge a fee on the total
 587         # invoice amount including taxes, you have to put the fee on the next
 588         # invoice.
 589         $cust_bill = FS::cust_bill->new({
 590             'custnum'       => $self->custnum,
 591             'cust_bill_pkg' => \@cust_bill_pkg,
 592             'charged'       => ${ $total_setup{$pass} } +
 593                                ${ $total_recur{$pass} },
 594         });
 595
 596         # If this is a package event, only apply the fee to line items
 597         # from that package.
 598         if ($object->isa('FS::cust_pkg')) {
 599           $cust_bill->set('cust_bill_pkg',
 600             [ grep  { $_->pkgnum == $object->pkgnum } @cust_bill_pkg ]
 601           );
 602         }
 603
 604       } elsif ( $object->isa('FS::cust_bill') ) {
 605         # simple case: applying the fee to a previous invoice (late fee,
 606         # etc.)
 607         $cust_bill = $object;
 608       }
 609       # if the fee def belongs to a different agent, don't charge the fee.
 610       # event conditions should prevent this, but just in case they don't,
 611       # skip the fee.
 612       if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
 613         warn "tried to charge fee#".$part_fee->feepart .
 614              " on customer#".$self->custnum." from a different agent.\n";
 615         next;
 616       }
 617       # also skip if it's disabled
 618       next if $part_fee->disabled eq 'Y';
 619       # calculate the fee
 620       my $fee_item = $part_fee->lineitem($cust_bill) or next;
 621       # link this so that we can clear the marker on inserting the line item
 622       $fee_item->set('cust_event_fee', $event_fee);
 623       push @fee_items, $fee_item;
 624
 625     }
 626
 627     # add fees to the invoice
 628     foreach my $fee_item (@fee_items) {
 629
 630       push @cust_bill_pkg, $fee_item;
 631       ${ $total_setup{$pass} } += $fee_item->setup;
 632       ${ $total_recur{$pass} } += $fee_item->recur;
 633
 634       my $part_fee = $fee_item->part_fee;
 635       my $fee_location = $self->ship_location; # I think?
 636
 637       my $error = $self->_handle_taxes(
 638         $taxlisthash{$pass},
 639         $fee_item,
 640         location => $fee_location
 641         # probably not right to pass cancel => 1 for fees
 642       );
 643       return $error if $error;
 644
 645     }
 646
 647     # XXX implementation of fees is supposed to make this go away...
 648     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 649            !$conf->exists('postal_invoice-recurring_only')
 650        )
 651     {
 652
 653       my $postal_pkg = $self->charge_postal_fee();
 654       if ( $postal_pkg && !ref( $postal_pkg ) ) {
 655
 656         $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 657         return "can't charge postal invoice fee for customer ".
 658           $self->custnum. ": $postal_pkg";
 659
 660       } elsif ( $postal_pkg ) {
 661
 662         my $real_pkgpart = $postal_pkg->pkgpart;
 663         # we could implement this bit as FS::part_pkg::has_hidden, but we already
 664         # suffer from performance issues
 665         $options{has_hidden} = 0;
 666         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
 667         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 668
 669         foreach my $part_pkg ( @part_pkg ) {
 670           my %postal_options = %options;
 671           delete $postal_options{cancel};
 672           my $error =
 673             $self->_make_lines( 'part_pkg'            => $part_pkg,
 674                                 'cust_pkg'            => $postal_pkg,
 675                                 'precommit_hooks'     => \@precommit_hooks,
 676                                 'line_items'          => \@cust_bill_pkg,
 677                                 'setup'               => $total_setup{$pass},
 678                                 'recur'               => $total_recur{$pass},
 679                                 'tax_matrix'          => $taxlisthash{$pass},
 680                                 'time'                => $time,
 681                                 'real_pkgpart'        => $real_pkgpart,
 682                                 'options'             => \%postal_options,
 683                               );
 684           if ($error) {
 685             $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 686             return $error;
 687           }
 688         }
 689
 690         # it's silly to have a zero value postal_pkg, but....
 691         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
 692
 693       }
 694
 695     }
 696
 697     my $listref_or_error =
 698       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
 699
 700     unless ( ref( $listref_or_error ) ) {
 701       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 702       return $listref_or_error;
 703     }
 704
 705     foreach my $taxline ( @$listref_or_error ) {
 706       ${ $total_setup{$pass} } =
 707         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
 708       push @cust_bill_pkg, $taxline;
 709     }
 710
 711     #add tax adjustments
 712     warn "adding tax adjustments...\n" if $DEBUG > 2;
 713     foreach my $cust_tax_adjustment (
 714       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
 715                                        'billpkgnum' => '',
 716                                      }
 717              )
 718     ) {
 719
 720       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
 721
 722       my $itemdesc = $cust_tax_adjustment->taxname;
 723       $itemdesc = '' if $itemdesc eq 'Tax';
 724
 725       push @cust_bill_pkg, new FS::cust_bill_pkg {
 726         'pkgnum'      => 0,
 727         'setup'       => $tax,
 728         'recur'       => 0,
 729         'sdate'       => '',
 730         'edate'       => '',
 731         'itemdesc'    => $itemdesc,
 732         'itemcomment' => $cust_tax_adjustment->comment,
 733         'cust_tax_adjustment' => $cust_tax_adjustment,
 734         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 735       };
 736
 737     }
 738
 739     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
 740
 741     my $balance = $self->balance;
 742
 743     my $previous_bill = qsearchs({ 'table'     => 'cust_bill',
 744                                    'hashref'   => { custnum=>$self->custnum },
 745                                    'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
 746                                 });
 747     my $previous_balance =
 748       $previous_bill
 749         ? ( $previous_bill->billing_balance + $previous_bill->charged )
 750         : 0;
 751
 752     warn "creating the new invoice\n" if $DEBUG;
 753     #create the new invoice
 754     my $cust_bill = new FS::cust_bill ( {
 755       'custnum'             => $self->custnum,
 756       '_date'               => $invoice_time,
 757       'charged'             => $charged,
 758       'billing_balance'     => $balance,
 759       'previous_balance'    => $previous_balance,
 760       'invoice_terms'       => $options{'invoice_terms'},
 761       'cust_bill_pkg'       => \@cust_bill_pkg,
 762     } );
 763     $error = $cust_bill->insert unless $options{no_commit};
 764     if ( $error ) {
 765       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 766       return "can't create invoice for customer #". $self->custnum. ": $error";
 767     }
 768     push @{$options{return_bill}}, $cust_bill if $options{return_bill};
 769
 770   } #foreach my $pass ( keys %cust_bill_pkg )
 771
 772   foreach my $hook ( @precommit_hooks ) {
 773     eval {
 774       &{$hook}; #($self) ?
 775     } unless $options{no_commit};
 776     if ( $@ ) {
 777       $dbh->rollback if $oldAutoCommit && !$options{no_commit};
 778       return "$@ running precommit hook $hook\n";
 779     }
 780   }
 781
 782   $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
 783
 784   ''; #no error
 785 }
 786
 787 #discard bundled packages of 0 value
 788 sub _omit_zero_value_bundles {
 789   my @in = @_;
 790
 791   my @cust_bill_pkg = ();
 792   my @cust_bill_pkg_bundle = ();
 793   my $sum = 0;
 794   my $discount_show_always = 0;
 795
 796   foreach my $cust_bill_pkg ( @in ) {
 797
 798     $discount_show_always = ($cust_bill_pkg->get('discounts')
 799                                 && scalar(@{$cust_bill_pkg->get('discounts')})
 800                                 && $conf->exists('discount-show-always'));
 801
 802     warn "  pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
 803          "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
 804          "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
 805       if $DEBUG > 0;
 806
 807     if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
 808       push @cust_bill_pkg, @cust_bill_pkg_bundle
 809         if $sum > 0
 810         || ($sum == 0 && (    $discount_show_always
 811                            || grep {$_->recur_show_zero || $_->setup_show_zero}
 812                                    @cust_bill_pkg_bundle
 813                          )
 814            );
 815       @cust_bill_pkg_bundle = ();
 816       $sum = 0;
 817     }
 818
 819     $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
 820     push @cust_bill_pkg_bundle, $cust_bill_pkg;
 821
 822   }
 823
 824   push @cust_bill_pkg, @cust_bill_pkg_bundle
 825     if $sum > 0
 826     || ($sum == 0 && (    $discount_show_always
 827                        || grep {$_->recur_show_zero || $_->setup_show_zero}
 828                                @cust_bill_pkg_bundle
 829                      )
 830        );
 831
 832   warn "  _omit_zero_value_bundles: ". scalar(@in).
 833        '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
 834     if $DEBUG > 2;
 835
 836   (@cust_bill_pkg);
 837
 838 }
 839
 840 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
 841
 842 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
 843 Usually used internally by bill method B<bill>.
 844
 845 If there is an error, returns the error, otherwise returns reference to a
 846 list of line items suitable for insertion.
 847
 848 =over 4
 849
 850 =item LINEITEMREF
 851
 852 An array ref of the line items being billed.
 853
 854 =item TAXHASHREF
 855
 856 A strange beast.  The keys to this hash are internal identifiers consisting
 857 of the name of the tax object type, a space, and its unique identifier ( e.g.
 858  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
 859 item in the list is the tax object.  The remaining items are either line
 860 items or floating point values (currency amounts).
 861
 862 The taxes are calculated on this entity.  Calculated exemption records are
 863 transferred to the LINEITEMREF items on the assumption that they are related.
 864
 865 Read the source.
 866
 867 =item INVOICE_TIME
 868
 869 This specifies the date appearing on the associated invoice.  Some
 870 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
 871
 872 =back
 873
 874 =cut
 875
 876 sub calculate_taxes {
 877   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
 878
 879   # $taxlisthash is a hashref
 880   # keys are identifiers, values are arrayrefs
 881   # each arrayref starts with a tax object (cust_main_county or tax_rate)
 882   # then any cust_bill_pkg objects the tax applies to
 883
 884   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 885
 886   warn "$me calculate_taxes\n"
 887        #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
 888     if $DEBUG > 2;
 889
 890   my @tax_line_items = ();
 891
 892   # keys are tax names (as printed on invoices / itemdesc )
 893   # values are arrayrefs of taxlisthash keys (internal identifiers)
 894   my %taxname = ();
 895
 896   # keys are taxlisthash keys (internal identifiers)
 897   # values are (cumulative) amounts
 898   my %tax_amount = ();
 899
 900   # keys are taxlisthash keys (internal identifiers)
 901   # values are arrayrefs of cust_bill_pkg_tax_location hashrefs
 902   my %tax_location = ();
 903
 904   # keys are taxlisthash keys (internal identifiers)
 905   # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs
 906   my %tax_rate_location = ();
 907
 908   # keys are taxlisthash keys (internal identifiers!)
 909   # values are arrayrefs of cust_tax_exempt_pkg objects
 910   my %tax_exemption;
 911
 912   foreach my $tax ( keys %$taxlisthash ) {
 913     # $tax is a tax identifier (intersection of a tax definition record
 914     # and a cust_bill_pkg record)
 915     my $tax_object = shift @{ $taxlisthash->{$tax} };
 916     # $tax_object is a cust_main_county or tax_rate
 917     # (with billpkgnum, pkgnum, locationnum set)
 918     # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg component objects
 919     # (setup, recurring, usage classes)
 920     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
 921     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
 922     # taxline calculates the tax on all cust_bill_pkgs in the
 923     # first (arrayref) argument, and returns a hashref of 'name'
 924     # (the line item description) and 'amount'.
 925     # It also calculates exemptions and attaches them to the cust_bill_pkgs
 926     # in the argument.
 927     my $taxables = $taxlisthash->{$tax};
 928     my $exemptions = $tax_exemption{$tax} ||= [];
 929     my $taxline = $tax_object->taxline(
 930                             $taxables,
 931                             'custnum'      => $self->custnum,
 932                             'invoice_time' => $invoice_time,
 933                             'exemptions'   => $exemptions,
 934                           );
 935     return $taxline unless ref($taxline);
 936
 937     unshift @{ $taxlisthash->{$tax} }, $tax_object;
 938
 939     if ( $tax_object->isa('FS::cust_main_county') ) {
 940       # then $taxline is a real line item
 941       push @{ $taxname{ $taxline->itemdesc } }, $taxline;
 942
 943     } else {
 944       # leave this as is for now
 945
 946       my $name   = $taxline->{'name'};
 947       my $amount = $taxline->{'amount'};
 948
 949       #warn "adding $amount as $name\n";
 950       $taxname{ $name } ||= [];
 951       push @{ $taxname{ $name } }, $tax;
 952
 953       $tax_amount{ $tax } += $amount;
 954
 955       # link records between cust_main_county/tax_rate and cust_location
 956       $tax_rate_location{ $tax } ||= [];
 957       my $taxratelocationnum =
 958         $tax_object->tax_rate_location->taxratelocationnum;
 959       push @{ $tax_rate_location{ $tax }  },
 960         {
 961           'taxnum'             => $tax_object->taxnum,
 962           'taxtype'            => ref($tax_object),
 963           'amount'             => sprintf('%.2f', $amount ),
 964           'locationtaxid'      => $tax_object->location,
 965           'taxratelocationnum' => $taxratelocationnum,
 966         };
 967     } #if ref($tax_object)...
 968   } #foreach keys %$taxlisthash
 969
 970   #consolidate and create tax line items
 971   warn "consolidating and generating...\n" if $DEBUG > 2;
 972   foreach my $taxname ( keys %taxname ) {
 973     my @cust_bill_pkg_tax_location;
 974     my @cust_bill_pkg_tax_rate_location;
 975     my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({
 976         'pkgnum'    => 0,
 977         'recur'     => 0,
 978         'sdate'     => '',
 979         'edate'     => '',
 980         'itemdesc'  => $taxname,
 981         'cust_bill_pkg_tax_location'      => \@cust_bill_pkg_tax_location,
 982         'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
 983     });
 984
 985     my $tax_total = 0;
 986     my %seen = ();
 987     warn "adding $taxname\n" if $DEBUG > 1;
 988     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
 989       if ( ref($taxitem) eq 'FS::cust_bill_pkg' ) {
 990         # then we need to transfer the amount and the links from the
 991         # line item to the new one we're creating.
 992         $tax_total += $taxitem->setup;
 993         foreach my $link ( @{ $taxitem->get('cust_bill_pkg_tax_location') } ) {
 994           $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg);
 995           push @cust_bill_pkg_tax_location, $link;
 996         }
 997       } else {
 998         # the tax_rate way
 999         next if $seen{$taxitem}++;
1000         warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1;
1001         $tax_total += $tax_amount{$taxitem};
1002         push @cust_bill_pkg_tax_rate_location,
1003           map { new FS::cust_bill_pkg_tax_rate_location $_ }
1004               @{ $tax_rate_location{ $taxitem } };
1005       }
1006     }
1007     next unless $tax_total;
1008
1009     # we should really neverround this up...I guess it's okay if taxline
1010     # already returns amounts with 2 decimal places
1011     $tax_total = sprintf('%.2f', $tax_total );
1012     $tax_cust_bill_pkg->set('setup', $tax_total);
1013
1014     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
1015                                                    'disabled'     => '',
1016                                                  },
1017                                );
1018
1019     my @display = ();
1020     if ( $pkg_category and
1021          $conf->config('invoice_latexsummary') ||
1022          $conf->config('invoice_htmlsummary')
1023        )
1024     {
1025
1026       my %hash = (  'section' => $pkg_category->categoryname );
1027       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1028
1029     }
1030     $tax_cust_bill_pkg->set('display', \@display);
1031
1032     push @tax_line_items, $tax_cust_bill_pkg;
1033   }
1034
1035   \@tax_line_items;
1036 }
1037
1038 sub _make_lines {
1039   my ($self, %params) = @_;
1040
1041   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1042
1043   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
1044   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
1045   my $cust_location = $cust_pkg->tax_location;
1046   my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
1047   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
1048   my $total_setup = $params{setup} or die "no setup accumulator specified";
1049   my $total_recur = $params{recur} or die "no recur accumulator specified";
1050   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
1051   my $time = $params{'time'} or die "no time specified";
1052   my (%options) = %{$params{options}};
1053
1054   if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
1055     # this should never happen
1056     die 'freq_override billing attempted on non-monthly package '.
1057       $cust_pkg->pkgnum;
1058   }
1059
1060   my $dbh = dbh;
1061   my $real_pkgpart = $params{real_pkgpart};
1062   my %hash = $cust_pkg->hash;
1063   my $old_cust_pkg = new FS::cust_pkg \%hash;
1064
1065   my @details = ();
1066   my $lineitems = 0;
1067
1068   $cust_pkg->pkgpart($part_pkg->pkgpart);
1069
1070   my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1071                      ? day_end( $time )
1072                      : $time
1073                  );
1074
1075   ###
1076   # bill setup
1077   ###
1078
1079   my $setup = 0;
1080   my $unitsetup = 0;
1081   my @setup_discounts = ();
1082   my %setup_param = ( 'discounts' => \@setup_discounts );
1083   my $setup_billed_currency = '';
1084   my $setup_billed_amount = 0;
1085   if (     ! $options{recurring_only}
1086        and ! $options{cancel}
1087        and ( $options{'resetup'}
1088              || ( ! $cust_pkg->setup
1089                   && ( ! $cust_pkg->start_date
1090                        || $cust_pkg->start_date <= $cmp_time
1091                      )
1092                   && ( ! $conf->exists('disable_setup_suspended_pkgs')
1093                        || ( $conf->exists('disable_setup_suspended_pkgs') &&
1094                             ! $cust_pkg->getfield('susp')
1095                           )
1096                      )
1097                 )
1098            )
1099      )
1100   {
1101
1102     warn "    bill setup\n" if $DEBUG > 1;
1103
1104     unless ( $cust_pkg->waive_setup ) {
1105         $lineitems++;
1106
1107         $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1108         return "$@ running calc_setup for $cust_pkg\n"
1109           if $@;
1110
1111         $unitsetup = $cust_pkg->base_setup()
1112                        || $setup; #XXX uuh
1113
1114         if ( $setup_param{'billed_currency'} ) {
1115           $setup_billed_currency = delete $setup_param{'billed_currency'};
1116           $setup_billed_amount   = delete $setup_param{'billed_amount'};
1117         }
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 $recur_billed_currency = '';
1138   my $recur_billed_amount = 0;
1139   my $sdate;
1140   if (     ! $cust_pkg->start_date
1141        and
1142            ( ! $cust_pkg->susp
1143                || ( $cust_pkg->susp != $cust_pkg->order_date
1144                       && (    $cust_pkg->option('suspend_bill',1)
1145                            || ( $part_pkg->option('suspend_bill', 1)
1146                                  && ! $cust_pkg->option('no_suspend_bill',1)
1147                               )
1148                          )
1149                   )
1150            )
1151        and
1152             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1153          || ( $part_pkg->plan eq 'voip_cdr'
1154                && $part_pkg->option('bill_every_call')
1155             )
1156          || $options{cancel}
1157   ) {
1158
1159     # XXX should this be a package event?  probably.  events are called
1160     # at collection time at the moment, though...
1161     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1162       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1163       #don't want to reset usage just cause we want a line item??
1164       #&& $part_pkg->pkgpart == $real_pkgpart;
1165
1166     warn "    bill recur\n" if $DEBUG > 1;
1167     $lineitems++;
1168
1169     # XXX shared with $recur_prog
1170     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1171              || $cust_pkg->setup
1172              || $time;
1173
1174     #over two params!  lets at least switch to a hashref for the rest...
1175     my $increment_next_bill = ( $part_pkg->freq ne '0'
1176                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1177                                 && !$options{cancel}
1178                               );
1179     my %param = ( %setup_param,
1180                   'precommit_hooks'     => $precommit_hooks,
1181                   'increment_next_bill' => $increment_next_bill,
1182                   'discounts'           => \@recur_discounts,
1183                   'real_pkgpart'        => $real_pkgpart,
1184                   'freq_override'       => $options{freq_override} || '',
1185                   'setup_fee'           => 0,
1186                 );
1187
1188     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1189
1190     # There may be some part_pkg for which this is wrong.  Only those
1191     # which can_discount are supported.
1192     # (the UI should prevent adding discounts to these at the moment)
1193
1194     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1195          " for pkgpart ". $cust_pkg->pkgpart.
1196          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1197       if $DEBUG > 2;
1198
1199     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1200     return "$@ running $method for $cust_pkg\n"
1201       if ( $@ );
1202
1203     #base_cancel???
1204     $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1205
1206     if ( $param{'billed_currency'} ) {
1207       $recur_billed_currency = delete $param{'billed_currency'};
1208       $recur_billed_amount   = delete $param{'billed_amount'};
1209     }
1210
1211     if ( $increment_next_bill ) {
1212
1213       my $next_bill;
1214
1215       if ( my $main_pkg = $cust_pkg->main_pkg ) {
1216         # supplemental package
1217         # to keep in sync with the main package, simulate billing at
1218         # its frequency
1219         my $main_pkg_freq = $main_pkg->part_pkg->freq;
1220         my $supp_pkg_freq = $part_pkg->freq;
1221         my $ratio = $supp_pkg_freq / $main_pkg_freq;
1222         if ( $ratio != int($ratio) ) {
1223           # the UI should prevent setting up packages like this, but just
1224           # in case
1225           return "supplemental package period is not an integer multiple of main  package period";
1226         }
1227         $next_bill = $sdate;
1228         for (1..$ratio) {
1229           $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1230         }
1231
1232       } else {
1233         # the normal case
1234       $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1235       return "unparsable frequency: ". $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 += $param{'setup_fee'};
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   }
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'             => $unitsetup,
1329         'setup_billed_currency' => $setup_billed_currency,
1330         'setup_billed_amount'   => $setup_billed_amount,
1331         'recur'                 => $recur,
1332         'unitrecur'             => $unitrecur,
1333         'recur_billed_currency' => $recur_billed_currency,
1334         'recur_billed_amount'   => $recur_billed_amount,
1335         '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 = $self->_handle_taxes( $taxlisthash, $cust_bill_pkg,
1368         cancel => $options{cancel} );
1369       return $error if $error;
1370
1371       $cust_bill_pkg->set_display(
1372         part_pkg     => $part_pkg,
1373         real_pkgpart => $real_pkgpart,
1374       );
1375
1376       push @$cust_bill_pkgs, $cust_bill_pkg;
1377
1378     } #if $setup != 0 || $recur != 0
1379
1380   } #if $line_items
1381
1382   '';
1383
1384 }
1385
1386 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1387
1388 Takes one argument, a cust_pkg object that is being billed.  This will
1389 be called only if the package was created by a package change, and has
1390 not been billed since the package change, and package balance tracking
1391 is enabled.  The second argument can be an alternate package number to
1392 transfer the balance from; this should not be used externally.
1393
1394 Transfers the balance from the previous package (now canceled) to
1395 this package, by crediting one package and creating an invoice item for
1396 the other.  Inserts the credit and returns the invoice item (so that it
1397 can be added to an invoice that's being built).
1398
1399 If the previous package was never billed, and was also created by a package
1400 change, then this will also transfer the balance from I<its> previous
1401 package, and so on, until reaching a package that either has been billed
1402 or was not created by a package change.
1403
1404 =cut
1405
1406 my $balance_transfer_reason;
1407
1408 sub _transfer_balance {
1409   my $self = shift;
1410   my $cust_pkg = shift;
1411   my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1412   my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1413
1414   my @transfers;
1415
1416   # if $from_pkg is not the first package in the chain, and it was never
1417   # billed, walk back
1418   if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1419     @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1420   }
1421
1422   my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1423   if ( $prev_balance != 0 ) {
1424     $balance_transfer_reason ||= FS::reason->new_or_existing(
1425       'reason' => 'Package balance transfer',
1426       'type'   => 'Internal adjustment',
1427       'class'  => 'R'
1428     );
1429
1430     my $credit = FS::cust_credit->new({
1431         'custnum'   => $self->custnum,
1432         'amount'    => abs($prev_balance),
1433         'reasonnum' => $balance_transfer_reason->reasonnum,
1434         '_date'     => $cust_pkg->change_date,
1435     });
1436
1437     my $cust_bill_pkg = FS::cust_bill_pkg->new({
1438         'setup'     => 0,
1439         'recur'     => abs($prev_balance),
1440         #'sdate'     => $from_pkg->last_bill, # not sure about this
1441         #'edate'     => $cust_pkg->change_date,
1442         'itemdesc'  => $self->mt('Previous Balance, [_1]',
1443                                  $from_pkg->part_pkg->pkg),
1444     });
1445
1446     if ( $prev_balance > 0 ) {
1447       # credit the old package, charge the new one
1448       $credit->set('pkgnum', $from_pkgnum);
1449       $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1450     } else {
1451       # the reverse
1452       $credit->set('pkgnum', $cust_pkg->pkgnum);
1453       $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1454     }
1455     my $error = $credit->insert;
1456     die "error transferring package balance from #".$from_pkgnum.
1457         " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1458
1459     push @transfers, $cust_bill_pkg;
1460   } # $prev_balance != 0
1461
1462   return @transfers;
1463 }
1464
1465 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1466
1467 This is _handle_taxes.  It's called once for each cust_bill_pkg generated
1468 from _make_lines.
1469
1470 TAXLISTHASH is a hashref shared across the entire invoice.  It looks like
1471 this:
1472 {
1473   'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1474   'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1475 }
1476
1477 'cust_main_county' can also be 'tax_rate'.  The first object in the array
1478 is always the cust_main_county or tax_rate identified by the key.
1479
1480 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1481 the 'taxline' method to calculate the amount of the tax.  This doesn't
1482 happen until calculate_taxes, though.
1483
1484 OPTIONS may include:
1485 - part_item: a part_pkg or part_fee object to be used as the package/fee
1486   definition.
1487 - location: a cust_location to be used as the billing location.
1488 - cancel: true if this package is being billed on cancellation.  This
1489   allows tax to be calculated on usage charges only.
1490
1491 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1492 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1493 the customer's default service location).
1494
1495 =cut
1496
1497 sub _handle_taxes {
1498   my $self = shift;
1499   my $taxlisthash = shift;
1500   my $cust_bill_pkg = shift;
1501   my %options = @_;
1502
1503   # at this point I realize that we have enough information to infer all this
1504   # stuff, instead of passing around giant honking argument lists
1505   my $location = $options{location} || $cust_bill_pkg->tax_location;
1506   my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1507
1508   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1509
1510   return if ( $self->payby eq 'COMP' ); #dubious
1511
1512   if ( $conf->exists('enable_taxproducts')
1513        && ( scalar($part_item->part_pkg_taxoverride)
1514             || $part_item->has_taxproduct
1515           )
1516      )
1517     {
1518
1519     # EXTERNAL TAX RATES (via tax_rate)
1520     my %cust_bill_pkg = ();
1521     my %taxes = ();
1522
1523     my @classes;
1524     push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1525     push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1526     push @classes, 'recur' if $cust_bill_pkg->recur and !$options{cancel};
1527
1528     my $exempt = $conf->exists('cust_class-tax_exempt')
1529                    ? ( $self->cust_class ? $self->cust_class->tax : '' )
1530                    : $self->tax;
1531     # standardize this just to be sure
1532     $exempt = ($exempt eq 'Y') ? 'Y' : '';
1533
1534     if ( !$exempt ) {
1535
1536       foreach my $class (@classes) {
1537         my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1538         return $err_or_ref unless ref($err_or_ref);
1539         $taxes{$class} = $err_or_ref;
1540       }
1541
1542       unless (exists $taxes{''}) {
1543         my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1544         return $err_or_ref unless ref($err_or_ref);
1545         $taxes{''} = $err_or_ref;
1546       }
1547
1548     }
1549
1550     my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; # grrr
1551     foreach my $key (keys %tax_cust_bill_pkg) {
1552       # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1553       # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1554       # the line item.
1555       # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1556       # apply to $key-class charges.
1557       my @taxes = @{ $taxes{$key} || [] };
1558       my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1559
1560       my %localtaxlisthash = ();
1561       foreach my $tax ( @taxes ) {
1562
1563         # this is the tax identifier, not the taxname
1564         my $taxname = ref( $tax ). ' '. $tax->taxnum;
1565         # $taxlisthash: keys are "setup", "recur", and usage classes.
1566         # Values are arrayrefs, first the tax object (cust_main_county
1567         # or tax_rate) and then any cust_bill_pkg objects that the
1568         # tax applies to.
1569         $taxlisthash->{ $taxname } ||= [ $tax ];
1570         push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
1571
1572         $localtaxlisthash{ $taxname } ||= [ $tax ];
1573         push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
1574
1575       }
1576
1577       warn "finding taxed taxes...\n" if $DEBUG > 2;
1578       foreach my $tax ( keys %localtaxlisthash ) {
1579         my $tax_object = shift @{ $localtaxlisthash{$tax} };
1580         warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1581           if $DEBUG > 2;
1582         next unless $tax_object->can('tax_on_tax');
1583
1584         foreach my $tot ( $tax_object->tax_on_tax( $location ) ) {
1585           my $totname = ref( $tot ). ' '. $tot->taxnum;
1586
1587           warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1588             if $DEBUG > 2;
1589           next unless exists( $localtaxlisthash{ $totname } ); # only increase
1590                                                                # existing taxes
1591           warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1592           # calculate the tax amount that the tax_on_tax will apply to
1593           my $hashref_or_error =
1594             $tax_object->taxline( $localtaxlisthash{$tax} );
1595           return $hashref_or_error
1596             unless ref($hashref_or_error);
1597
1598           # and append it to the list of taxable items
1599           $taxlisthash->{ $totname } ||= [ $tot ];
1600           push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
1601
1602         }
1603       }
1604     }
1605
1606   } else {
1607
1608     # INTERNAL TAX RATES (cust_main_county)
1609
1610     # We fetch taxes even if the customer is completely exempt,
1611     # because we need to record that fact.
1612
1613     my @loc_keys = qw( district city county state country );
1614     my %taxhash = map { $_ => $location->$_ } @loc_keys;
1615
1616     $taxhash{'taxclass'} = $part_item->taxclass;
1617
1618     warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1619
1620     my @taxes = (); # entries are cust_main_county objects
1621     my %taxhash_elim = %taxhash;
1622     my @elim = qw( district city county state );
1623     do {
1624
1625       #first try a match with taxclass
1626       @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1627
1628       if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1629         #then try a match without taxclass
1630         my %no_taxclass = %taxhash_elim;
1631         $no_taxclass{ 'taxclass' } = '';
1632         @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1633       }
1634
1635       $taxhash_elim{ shift(@elim) } = '';
1636
1637     } while ( !scalar(@taxes) && scalar(@elim) );
1638
1639     foreach (@taxes) {
1640       my $tax_id = 'cust_main_county '.$_->taxnum;
1641       $taxlisthash->{$tax_id} ||= [ $_ ];
1642       push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1643     }
1644
1645   }
1646   '';
1647 }
1648
1649 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1650
1651 Internal method used with vendor-provided tax tables.  PART_ITEM is a part_pkg
1652 or part_fee (which will define the tax eligibility of the product), CLASS is
1653 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1654 location where the service was provided (or billed, depending on
1655 configuration).  Returns an arrayref of L<FS::tax_rate> objects that
1656 can apply to this line item.
1657
1658 =cut
1659
1660 sub _gather_taxes {
1661   my $self = shift;
1662   my $part_item = shift;
1663   my $class = shift;
1664   my $location = shift;
1665
1666   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1667
1668   my $geocode = $location->geocode('cch');
1669
1670   [ $part_item->tax_rates('cch', $geocode, $class) ]
1671
1672 }
1673
1674 =item collect [ HASHREF | OPTION => VALUE ... ]
1675
1676 (Attempt to) collect money for this customer's outstanding invoices (see
1677 L<FS::cust_bill>).  Usually used after the bill method.
1678
1679 Actions are now triggered by billing events; see L<FS::part_event> and the
1680 billing events web interface.  Old-style invoice events (see
1681 L<FS::part_bill_event>) have been deprecated.
1682
1683 If there is an error, returns the error, otherwise returns false.
1684
1685 Options are passed as name-value pairs.
1686
1687 Currently available options are:
1688
1689 =over 4
1690
1691 =item invoice_time
1692
1693 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.
1694
1695 =item retry
1696
1697 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1698
1699 =item check_freq
1700
1701 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1702
1703 =item quiet
1704
1705 set true to surpress email card/ACH decline notices.
1706
1707 =item debug
1708
1709 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)
1710
1711 =back
1712
1713 # =item payby
1714 #
1715 # allows for one time override of normal customer billing method
1716
1717 =cut
1718
1719 sub collect {
1720   my( $self, %options ) = @_;
1721
1722   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1723
1724   my $invoice_time = $options{'invoice_time'} || time;
1725
1726   #put below somehow?
1727   local $SIG{HUP} = 'IGNORE';
1728   local $SIG{INT} = 'IGNORE';
1729   local $SIG{QUIT} = 'IGNORE';
1730   local $SIG{TERM} = 'IGNORE';
1731   local $SIG{TSTP} = 'IGNORE';
1732   local $SIG{PIPE} = 'IGNORE';
1733
1734   my $oldAutoCommit = $FS::UID::AutoCommit;
1735   local $FS::UID::AutoCommit = 0;
1736   my $dbh = dbh;
1737
1738   $self->select_for_update; #mutex
1739
1740   if ( $DEBUG ) {
1741     my $balance = $self->balance;
1742     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1743   }
1744
1745   if ( exists($options{'retry_card'}) ) {
1746     carp 'retry_card option passed to collect is deprecated; use retry';
1747     $options{'retry'} ||= $options{'retry_card'};
1748   }
1749   if ( exists($options{'retry'}) && $options{'retry'} ) {
1750     my $error = $self->retry_realtime;
1751     if ( $error ) {
1752       $dbh->rollback if $oldAutoCommit;
1753       return $error;
1754     }
1755   }
1756
1757   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1758
1759   #never want to roll back an event just because it returned an error
1760   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
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   #never want to roll back an event just because it or a different one
1969   # returned an error
1970   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1971
1972   foreach my $cust_event ( @$due_cust_event ) {
1973
1974     #XXX lock event
1975
1976     #re-eval event conditions (a previous event could have changed things)
1977     unless ( $cust_event->test_conditions ) {
1978       #don't leave stray "new/locked" records around
1979       my $error = $cust_event->delete;
1980       return $error if $error;
1981       next;
1982     }
1983
1984     {
1985       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1986         if $options{'quiet'};
1987       warn "  running cust_event ". $cust_event->eventnum. "\n"
1988         if $DEBUG > 1;
1989
1990       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1991       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1992         #XXX wtf is this?  figure out a proper dealio with return value
1993         #from do_event
1994         return $error;
1995       }
1996     }
1997
1998   }
1999
2000   '';
2001
2002 }
2003
2004 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2005
2006 Inserts database records for and returns an ordered listref of new events due
2007 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2008 events are due, an empty listref is returned.  If there is an error, returns a
2009 scalar error message.
2010
2011 To actually run the events, call each event's test_condition method, and if
2012 still true, call the event's do_event method.
2013
2014 Options are passed as a hashref or as a list of name-value pairs.  Available
2015 options are:
2016
2017 =over 4
2018
2019 =item check_freq
2020
2021 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.
2022
2023 =item stage
2024
2025 "collect" (the default) or "pre-bill"
2026
2027 =item time
2028
2029 "Current time" for the events.
2030
2031 =item debug
2032
2033 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)
2034
2035 =item eventtable
2036
2037 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2038
2039 =item objects
2040
2041 Explicitly pass the objects to be tested (typically used with eventtable).
2042
2043 =item testonly
2044
2045 Set to true to return the objects, but not actually insert them into the
2046 database.
2047
2048 =back
2049
2050 =cut
2051
2052 sub due_cust_event {
2053   my $self = shift;
2054   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2055
2056   #???
2057   #my $DEBUG = $opt{'debug'}
2058   $opt{'debug'} ||= 0; # silence some warnings
2059   local($DEBUG) = $opt{'debug'}
2060     if $opt{'debug'} > $DEBUG;
2061   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2062
2063   warn "$me due_cust_event called with options ".
2064        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2065     if $DEBUG;
2066
2067   $opt{'time'} ||= time;
2068
2069   local $SIG{HUP} = 'IGNORE';
2070   local $SIG{INT} = 'IGNORE';
2071   local $SIG{QUIT} = 'IGNORE';
2072   local $SIG{TERM} = 'IGNORE';
2073   local $SIG{TSTP} = 'IGNORE';
2074   local $SIG{PIPE} = 'IGNORE';
2075
2076   my $oldAutoCommit = $FS::UID::AutoCommit;
2077   local $FS::UID::AutoCommit = 0;
2078   my $dbh = dbh;
2079
2080   $self->select_for_update #mutex
2081     unless $opt{testonly};
2082
2083   ###
2084   # find possible events (initial search)
2085   ###
2086
2087   my @cust_event = ();
2088
2089   my @eventtable = $opt{'eventtable'}
2090                      ? ( $opt{'eventtable'} )
2091                      : FS::part_event->eventtables_runorder;
2092
2093   my $check_freq = $opt{'check_freq'} || '1d';
2094
2095   foreach my $eventtable ( @eventtable ) {
2096
2097     my @objects;
2098     if ( $opt{'objects'} ) {
2099
2100       @objects = @{ $opt{'objects'} };
2101
2102     } elsif ( $eventtable eq 'cust_main' ) {
2103
2104       @objects = ( $self );
2105
2106     } else {
2107
2108       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2109       # linkage not needed here because FS::cust_main->$eventtable will
2110       # already supply it
2111
2112       #some false laziness w/Cron::bill bill_where
2113
2114       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable,
2115         'time' => $opt{'time'});
2116       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2117         'time'=>$opt{'time'},
2118       );
2119       $where = $where ? "AND $where" : '';
2120
2121       my $are_part_event =
2122       "EXISTS ( SELECT 1 FROM part_event $join
2123         WHERE check_freq = '$check_freq'
2124         AND eventtable = '$eventtable'
2125         AND ( disabled = '' OR disabled IS NULL )
2126         $where
2127         )
2128       ";
2129       #eofalse
2130
2131       @objects = $self->$eventtable(
2132         'addl_from' => $cm_join,
2133         'extra_sql' => " AND $are_part_event",
2134       );
2135     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2136
2137     my @e_cust_event = ();
2138
2139     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2140
2141     my $cross = "CROSS JOIN $eventtable $linkage";
2142     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2143       unless $eventtable eq 'cust_main';
2144
2145     foreach my $object ( @objects ) {
2146
2147       #this first search uses the condition_sql magic for optimization.
2148       #the more possible events we can eliminate in this step the better
2149
2150       my $cross_where = '';
2151       my $pkey = $object->primary_key;
2152       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2153
2154       my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2155         'time' => $opt{'time'});
2156       my $extra_sql =
2157         FS::part_event_condition->where_conditions_sql( $eventtable,
2158                                                         'time'=>$opt{'time'}
2159                                                       );
2160       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2161
2162       $extra_sql = "AND $extra_sql" if $extra_sql;
2163
2164       #here is the agent virtualization
2165       $extra_sql .= " AND (    part_event.agentnum IS NULL
2166                             OR part_event.agentnum = ". $self->agentnum. ' )';
2167
2168       $extra_sql .= " $order";
2169
2170       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2171         if $opt{'debug'} > 2;
2172       my @part_event = qsearch( {
2173         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2174         'select'    => 'part_event.*',
2175         'table'     => 'part_event',
2176         'addl_from' => "$cross $join",
2177         'hashref'   => { 'check_freq' => $check_freq,
2178                          'eventtable' => $eventtable,
2179                          'disabled'   => '',
2180                        },
2181         'extra_sql' => "AND $cross_where $extra_sql",
2182       } );
2183
2184       if ( $DEBUG > 2 ) {
2185         my $pkey = $object->primary_key;
2186         warn "      ". scalar(@part_event).
2187              " possible events found for $eventtable ". $object->$pkey(). "\n";
2188       }
2189
2190       push @e_cust_event, map {
2191         $_->new_cust_event($object, 'time' => $opt{'time'})
2192       } @part_event;
2193
2194     }
2195
2196     warn "    ". scalar(@e_cust_event).
2197          " subtotal possible cust events found for $eventtable\n"
2198       if $DEBUG > 1;
2199
2200     push @cust_event, @e_cust_event;
2201
2202   }
2203
2204   warn "  ". scalar(@cust_event).
2205        " total possible cust events found in initial search\n"
2206     if $DEBUG; # > 1;
2207
2208
2209   ##
2210   # test stage
2211   ##
2212
2213   $opt{stage} ||= 'collect';
2214   @cust_event =
2215     grep { my $stage = $_->part_event->event_stage;
2216            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2217          }
2218          @cust_event;
2219
2220   ##
2221   # test conditions
2222   ##
2223
2224   my %unsat = ();
2225
2226   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2227                      @cust_event;
2228
2229   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2230     if $DEBUG; # > 1;
2231
2232   warn "    invalid conditions not eliminated with condition_sql:\n".
2233        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2234     if keys %unsat && $DEBUG; # > 1;
2235
2236   ##
2237   # insert
2238   ##
2239
2240   unless( $opt{testonly} ) {
2241     foreach my $cust_event ( @cust_event ) {
2242
2243       my $error = $cust_event->insert();
2244       if ( $error ) {
2245         $dbh->rollback if $oldAutoCommit;
2246         return $error;
2247       }
2248
2249     }
2250   }
2251
2252   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2253
2254   ##
2255   # return
2256   ##
2257
2258   warn "  returning events: ". Dumper(@cust_event). "\n"
2259     if $DEBUG > 2;
2260
2261   \@cust_event;
2262
2263 }
2264
2265 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2266
2267 Applies unapplied payments and credits.
2268
2269 In most cases, this new method should be used in place of sequential
2270 apply_payments and apply_credits methods.
2271
2272 A hash of optional arguments may be passed.  Currently "manual" is supported.
2273 If true, a payment receipt is sent instead of a statement when
2274 'payment_receipt_email' configuration option is set.
2275
2276 If there is an error, returns the error, otherwise returns false.
2277
2278 =cut
2279
2280 sub apply_payments_and_credits {
2281   my( $self, %options ) = @_;
2282
2283   local $SIG{HUP} = 'IGNORE';
2284   local $SIG{INT} = 'IGNORE';
2285   local $SIG{QUIT} = 'IGNORE';
2286   local $SIG{TERM} = 'IGNORE';
2287   local $SIG{TSTP} = 'IGNORE';
2288   local $SIG{PIPE} = 'IGNORE';
2289
2290   my $oldAutoCommit = $FS::UID::AutoCommit;
2291   local $FS::UID::AutoCommit = 0;
2292   my $dbh = dbh;
2293
2294   $self->select_for_update; #mutex
2295
2296   foreach my $cust_bill ( $self->open_cust_bill ) {
2297     my $error = $cust_bill->apply_payments_and_credits(%options);
2298     if ( $error ) {
2299       $dbh->rollback if $oldAutoCommit;
2300       return "Error applying: $error";
2301     }
2302   }
2303
2304   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2305   ''; #no error
2306
2307 }
2308
2309 =item apply_credits OPTION => VALUE ...
2310
2311 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2312 to outstanding invoice balances in chronological order (or reverse
2313 chronological order if the I<order> option is set to B<newest>) and returns the
2314 value of any remaining unapplied credits available for refund (see
2315 L<FS::cust_refund>).
2316
2317 Dies if there is an error.
2318
2319 =cut
2320
2321 sub apply_credits {
2322   my $self = shift;
2323   my %opt = @_;
2324
2325   local $SIG{HUP} = 'IGNORE';
2326   local $SIG{INT} = 'IGNORE';
2327   local $SIG{QUIT} = 'IGNORE';
2328   local $SIG{TERM} = 'IGNORE';
2329   local $SIG{TSTP} = 'IGNORE';
2330   local $SIG{PIPE} = 'IGNORE';
2331
2332   my $oldAutoCommit = $FS::UID::AutoCommit;
2333   local $FS::UID::AutoCommit = 0;
2334   my $dbh = dbh;
2335
2336   $self->select_for_update; #mutex
2337
2338   unless ( $self->total_unapplied_credits ) {
2339     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2340     return 0;
2341   }
2342
2343   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2344       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2345
2346   my @invoices = $self->open_cust_bill;
2347   @invoices = sort { $b->_date <=> $a->_date } @invoices
2348     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2349
2350   if ( $conf->exists('pkg-balances') ) {
2351     # limit @credits to those w/ a pkgnum grepped from $self
2352     my %pkgnums = ();
2353     foreach my $i (@invoices) {
2354       foreach my $li ( $i->cust_bill_pkg ) {
2355         $pkgnums{$li->pkgnum} = 1;
2356       }
2357     }
2358     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2359   }
2360
2361   my $credit;
2362
2363   foreach my $cust_bill ( @invoices ) {
2364
2365     if ( !defined($credit) || $credit->credited == 0) {
2366       $credit = pop @credits or last;
2367     }
2368
2369     my $owed;
2370     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2371       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2372     } else {
2373       $owed = $cust_bill->owed;
2374     }
2375     unless ( $owed > 0 ) {
2376       push @credits, $credit;
2377       next;
2378     }
2379
2380     my $amount = min( $credit->credited, $owed );
2381
2382     my $cust_credit_bill = new FS::cust_credit_bill ( {
2383       'crednum' => $credit->crednum,
2384       'invnum'  => $cust_bill->invnum,
2385       'amount'  => $amount,
2386     } );
2387     $cust_credit_bill->pkgnum( $credit->pkgnum )
2388       if $conf->exists('pkg-balances') && $credit->pkgnum;
2389     my $error = $cust_credit_bill->insert;
2390     if ( $error ) {
2391       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2392       die $error;
2393     }
2394
2395     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2396
2397   }
2398
2399   my $total_unapplied_credits = $self->total_unapplied_credits;
2400
2401   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2402
2403   return $total_unapplied_credits;
2404 }
2405
2406 =item apply_payments  [ OPTION => VALUE ... ]
2407
2408 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2409 to outstanding invoice balances in chronological order.
2410
2411  #and returns the value of any remaining unapplied payments.
2412
2413 A hash of optional arguments may be passed.  Currently "manual" is supported.
2414 If true, a payment receipt is sent instead of a statement when
2415 'payment_receipt_email' configuration option is set.
2416
2417 Dies if there is an error.
2418
2419 =cut
2420
2421 sub apply_payments {
2422   my( $self, %options ) = @_;
2423
2424   local $SIG{HUP} = 'IGNORE';
2425   local $SIG{INT} = 'IGNORE';
2426   local $SIG{QUIT} = 'IGNORE';
2427   local $SIG{TERM} = 'IGNORE';
2428   local $SIG{TSTP} = 'IGNORE';
2429   local $SIG{PIPE} = 'IGNORE';
2430
2431   my $oldAutoCommit = $FS::UID::AutoCommit;
2432   local $FS::UID::AutoCommit = 0;
2433   my $dbh = dbh;
2434
2435   $self->select_for_update; #mutex
2436
2437   #return 0 unless
2438
2439   my @payments = $self->unapplied_cust_pay;
2440
2441   my @invoices = $self->open_cust_bill;
2442
2443   if ( $conf->exists('pkg-balances') ) {
2444     # limit @payments to those w/ a pkgnum grepped from $self
2445     my %pkgnums = ();
2446     foreach my $i (@invoices) {
2447       foreach my $li ( $i->cust_bill_pkg ) {
2448         $pkgnums{$li->pkgnum} = 1;
2449       }
2450     }
2451     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2452   }
2453
2454   my $payment;
2455
2456   foreach my $cust_bill ( @invoices ) {
2457
2458     if ( !defined($payment) || $payment->unapplied == 0 ) {
2459       $payment = pop @payments or last;
2460     }
2461
2462     my $owed;
2463     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2464       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2465     } else {
2466       $owed = $cust_bill->owed;
2467     }
2468     unless ( $owed > 0 ) {
2469       push @payments, $payment;
2470       next;
2471     }
2472
2473     my $amount = min( $payment->unapplied, $owed );
2474
2475     my $cbp = {
2476       'paynum' => $payment->paynum,
2477       'invnum' => $cust_bill->invnum,
2478       'amount' => $amount,
2479     };
2480     $cbp->{_date} = $payment->_date
2481         if $options{'manual'} && $options{'backdate_application'};
2482     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2483     $cust_bill_pay->pkgnum( $payment->pkgnum )
2484       if $conf->exists('pkg-balances') && $payment->pkgnum;
2485     my $error = $cust_bill_pay->insert(%options);
2486     if ( $error ) {
2487       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2488       die $error;
2489     }
2490
2491     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2492
2493   }
2494
2495   my $total_unapplied_payments = $self->total_unapplied_payments;
2496
2497   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2498
2499   return $total_unapplied_payments;
2500 }
2501
2502 =back
2503
2504 =head1 FLOW
2505
2506   bill_and_collect
2507
2508     cancel_expired_pkgs
2509     suspend_adjourned_pkgs
2510     unsuspend_resumed_pkgs
2511
2512     bill
2513       (do_cust_event pre-bill)
2514       _make_lines
2515         _handle_taxes
2516           (vendor-only) _gather_taxes
2517       _omit_zero_value_bundles
2518       _handle_taxes (for fees)
2519       calculate_taxes
2520
2521     apply_payments_and_credits
2522     collect
2523       do_cust_event
2524         due_cust_event
2525
2526 =head1 BUGS
2527
2528 =head1 SEE ALSO
2529
2530 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2531
2532 =cut
2533
2534 1;