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