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