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