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