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