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