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