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 This is a weird one.  Perhaps it should not even be exposed.
 691
 692 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
 693 Usually used internally by bill method B<bill>.
 694
 695 If there is an error, returns the error, otherwise returns reference to a
 696 list of line items suitable for insertion.
 697
 698 =over 4
 699
 700 =item LINEITEMREF
 701
 702 An array ref of the line items being billed.
 703
 704 =item TAXHASHREF
 705
 706 A strange beast.  The keys to this hash are internal identifiers consisting
 707 of the name of the tax object type, a space, and its unique identifier ( e.g.
 708  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
 709 item in the list is the tax object.  The remaining items are either line
 710 items or floating point values (currency amounts).
 711
 712 The taxes are calculated on this entity.  Calculated exemption records are
 713 transferred to the LINEITEMREF items on the assumption that they are related.
 714
 715 Read the source.
 716
 717 =item INVOICE_TIME
 718
 719 This specifies the date appearing on the associated invoice.  Some
 720 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
 721
 722 =back
 723
 724 =cut
 725
 726 sub calculate_taxes {
 727   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
 728
 729   # $taxlisthash is a hashref
 730   # keys are identifiers, values are arrayrefs
 731   # each arrayref starts with a tax object (cust_main_county or tax_rate)
 732   # then any cust_bill_pkg objects the tax applies to
 733
 734   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 735
 736   warn "$me calculate_taxes\n"
 737        #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
 738     if $DEBUG > 2;
 739
 740   my @tax_line_items = ();
 741
 742   # keys are tax names (as printed on invoices / itemdesc )
 743   # values are arrayrefs of taxlisthash keys (internal identifiers)
 744   my %taxname = ();
 745
 746   # keys are taxlisthash keys (internal identifiers)
 747   # values are (cumulative) amounts
 748   my %tax_amount = ();
 749
 750   # keys are taxlisthash keys (internal identifiers)
 751   # values are arrayrefs of cust_bill_pkg_tax_location hashrefs
 752   my %tax_location = ();
 753
 754   # keys are taxlisthash keys (internal identifiers)
 755   # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs
 756   my %tax_rate_location = ();
 757
 758   # keys are taxnums (not internal identifiers!)
 759   # values are arrayrefs of cust_tax_exempt_pkg objects
 760   my %tax_exemption;
 761
 762   foreach my $tax ( keys %$taxlisthash ) {
 763     # $tax is a tax identifier
 764     my $tax_object = shift @{ $taxlisthash->{$tax} };
 765     # $tax_object is a cust_main_county or tax_rate
 766     # (with pkgnum and locationnum set)
 767     # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg objects
 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_object->taxnum} ||= [];
 777     my $hashref_or_error =
 778       $tax_object->taxline( $taxables,
 779                             'custnum'      => $self->custnum,
 780                             'invoice_time' => $invoice_time,
 781                             'exemptions'   => $exemptions,
 782                           );
 783     return $hashref_or_error unless ref($hashref_or_error);
 784
 785     # then collect any new exemptions generated for this tax
 786     push @$exemptions, @{ $_->cust_tax_exempt_pkg }
 787       foreach @$taxables;
 788
 789     unshift @{ $taxlisthash->{$tax} }, $tax_object;
 790
 791     my $name   = $hashref_or_error->{'name'};
 792     my $amount = $hashref_or_error->{'amount'};
 793
 794     #warn "adding $amount as $name\n";
 795     $taxname{ $name } ||= [];
 796     push @{ $taxname{ $name } }, $tax;
 797
 798     $tax_amount{ $tax } += $amount;
 799
 800     # link records between cust_main_county/tax_rate and cust_location
 801     $tax_location{ $tax } ||= [];
 802     $tax_rate_location{ $tax } ||= [];
 803     if ( ref($tax_object) eq 'FS::cust_main_county' ) {
 804       push @{ $tax_location{ $tax }  },
 805         {
 806           'taxnum'      => $tax_object->taxnum,
 807           'taxtype'     => ref($tax_object),
 808           'pkgnum'      => $tax_object->get('pkgnum'),
 809           'locationnum' => $tax_object->get('locationnum'),
 810           'amount'      => sprintf('%.2f', $amount ),
 811         };
 812     }
 813     elsif ( ref($tax_object) eq 'FS::tax_rate' ) {
 814       my $taxratelocationnum =
 815         $tax_object->tax_rate_location->taxratelocationnum;
 816       push @{ $tax_rate_location{ $tax }  },
 817         {
 818           'taxnum'             => $tax_object->taxnum,
 819           'taxtype'            => ref($tax_object),
 820           'amount'             => sprintf('%.2f', $amount ),
 821           'locationtaxid'      => $tax_object->location,
 822           'taxratelocationnum' => $taxratelocationnum,
 823         };
 824     }
 825
 826   }
 827
 828   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
 829   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
 830   foreach my $tax ( keys %$taxlisthash ) {
 831     my $taxables = $taxlisthash->{$tax};
 832     my $tax_object = shift @$taxables; # the rest are line items
 833     foreach my $cust_bill_pkg ( @$taxables ) {
 834       next unless ref($cust_bill_pkg) eq 'FS::cust_bill_pkg';
 835
 836       my @cust_tax_exempt_pkg = splice @{ $cust_bill_pkg->cust_tax_exempt_pkg };
 837
 838       next unless @cust_tax_exempt_pkg;
 839       # get the non-disintegrated version
 840       my $real_cust_bill_pkg = $packagemap{$cust_bill_pkg->pkgnum}
 841         or die "can't distribute tax exemptions: no line item for ".
 842           Dumper($_). " in packagemap ".
 843           join(',', sort {$a<=>$b} keys %packagemap). "\n";
 844
 845       push @{ $real_cust_bill_pkg->cust_tax_exempt_pkg },
 846            @cust_tax_exempt_pkg;
 847     }
 848   }
 849
 850   #consolidate and create tax line items
 851   warn "consolidating and generating...\n" if $DEBUG > 2;
 852   foreach my $taxname ( keys %taxname ) {
 853     my $tax_total = 0;
 854     my %seen = ();
 855     my @cust_bill_pkg_tax_location = ();
 856     my @cust_bill_pkg_tax_rate_location = ();
 857     warn "adding $taxname\n" if $DEBUG > 1;
 858     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
 859       next if $seen{$taxitem}++;
 860       warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1;
 861       $tax_total += $tax_amount{$taxitem};
 862       push @cust_bill_pkg_tax_location,
 863         map { new FS::cust_bill_pkg_tax_location $_ }
 864             @{ $tax_location{ $taxitem } };
 865       push @cust_bill_pkg_tax_rate_location,
 866         map { new FS::cust_bill_pkg_tax_rate_location $_ }
 867             @{ $tax_rate_location{ $taxitem } };
 868     }
 869     next unless $tax_total;
 870
 871     $tax_total = sprintf('%.2f', $tax_total );
 872
 873     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
 874                                                    'disabled'     => '',
 875                                                  },
 876                                );
 877
 878     my @display = ();
 879     if ( $pkg_category and
 880          $conf->config('invoice_latexsummary') ||
 881          $conf->config('invoice_htmlsummary')
 882        )
 883     {
 884
 885       my %hash = (  'section' => $pkg_category->categoryname );
 886       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
 887
 888     }
 889
 890     push @tax_line_items, new FS::cust_bill_pkg {
 891       'pkgnum'   => 0,
 892       'setup'    => $tax_total,
 893       'recur'    => 0,
 894       'sdate'    => '',
 895       'edate'    => '',
 896       'itemdesc' => $taxname,
 897       'display'  => \@display,
 898       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 899       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
 900     };
 901
 902   }
 903
 904   \@tax_line_items;
 905 }
 906
 907 sub _make_lines {
 908   my ($self, %params) = @_;
 909
 910   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 911
 912   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 913   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 914   my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
 915   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 916   my $total_setup = $params{setup} or die "no setup accumulator specified";
 917   my $total_recur = $params{recur} or die "no recur accumulator specified";
 918   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
 919   my $time = $params{'time'} or die "no time specified";
 920   my (%options) = %{$params{options}};
 921
 922   if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
 923     # this should never happen
 924     die 'freq_override billing attempted on non-monthly package '.
 925       $cust_pkg->pkgnum;
 926   }
 927
 928   my $dbh = dbh;
 929   my $real_pkgpart = $params{real_pkgpart};
 930   my %hash = $cust_pkg->hash;
 931   my $old_cust_pkg = new FS::cust_pkg \%hash;
 932
 933   my @details = ();
 934   my $lineitems = 0;
 935
 936   $cust_pkg->pkgpart($part_pkg->pkgpart);
 937
 938   ###
 939   # bill setup
 940   ###
 941
 942   my $setup = 0;
 943   my $unitsetup = 0;
 944   my @setup_discounts = ();
 945   my %setup_param = ( 'discounts' => \@setup_discounts );
 946   if (     ! $options{recurring_only}
 947        and ! $options{cancel}
 948        and ( $options{'resetup'}
 949              || ( ! $cust_pkg->setup
 950                   && ( ! $cust_pkg->start_date
 951                        || $cust_pkg->start_date <= day_end($time)
 952                      )
 953                   && ( ! $conf->exists('disable_setup_suspended_pkgs')
 954                        || ( $conf->exists('disable_setup_suspended_pkgs') &&
 955                             ! $cust_pkg->getfield('susp')
 956                           )
 957                      )
 958                 )
 959            )
 960      )
 961   {
 962
 963     warn "    bill setup\n" if $DEBUG > 1;
 964
 965     unless ( $cust_pkg->waive_setup ) {
 966         $lineitems++;
 967
 968         $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
 969         return "$@ running calc_setup for $cust_pkg\n"
 970           if $@;
 971
 972         $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
 973     }
 974
 975     $cust_pkg->setfield('setup', $time)
 976       unless $cust_pkg->setup;
 977           #do need it, but it won't get written to the db
 978           #|| $cust_pkg->pkgpart != $real_pkgpart;
 979
 980     $cust_pkg->setfield('start_date', '')
 981       if $cust_pkg->start_date;
 982
 983   }
 984
 985   ###
 986   # bill recurring fee
 987   ###
 988
 989   my $recur = 0;
 990   my $unitrecur = 0;
 991   my @recur_discounts = ();
 992   my $sdate;
 993   if (     ! $cust_pkg->start_date
 994        and ( ! $cust_pkg->susp || $cust_pkg->option('suspend_bill',1)
 995                                || ( $part_pkg->option('suspend_bill', 1) )
 996                                      && ! $cust_pkg->option('no_suspend_bill',1)
 997                                   )
 998        and
 999             ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) )
1000          || ( $part_pkg->plan eq 'voip_cdr'
1001                && $part_pkg->option('bill_every_call')
1002             )
1003          || $options{cancel}
1004   ) {
1005
1006     # XXX should this be a package event?  probably.  events are called
1007     # at collection time at the moment, though...
1008     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1009       if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1010       #don't want to reset usage just cause we want a line item??
1011       #&& $part_pkg->pkgpart == $real_pkgpart;
1012
1013     warn "    bill recur\n" if $DEBUG > 1;
1014     $lineitems++;
1015
1016     # XXX shared with $recur_prog
1017     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1018              || $cust_pkg->setup
1019              || $time;
1020
1021     #over two params!  lets at least switch to a hashref for the rest...
1022     my $increment_next_bill = ( $part_pkg->freq ne '0'
1023                                 && ( $cust_pkg->getfield('bill') || 0 ) <= day_end($time)
1024                                 && !$options{cancel}
1025                               );
1026     my %param = ( %setup_param,
1027                   'precommit_hooks'     => $precommit_hooks,
1028                   'increment_next_bill' => $increment_next_bill,
1029                   'discounts'           => \@recur_discounts,
1030                   'real_pkgpart'        => $real_pkgpart,
1031                   'freq_override'       => $options{freq_override} || '',
1032                   'setup_fee'           => 0,
1033                 );
1034
1035     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1036
1037     # There may be some part_pkg for which this is wrong.  Only those
1038     # which can_discount are supported.
1039     # (the UI should prevent adding discounts to these at the moment)
1040
1041     warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1042          " for pkgpart ". $cust_pkg->pkgpart.
1043          " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1044       if $DEBUG > 2;
1045
1046     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1047     return "$@ running $method for $cust_pkg\n"
1048       if ( $@ );
1049
1050     #base_cancel???
1051     $unitrecur = $cust_pkg->part_pkg->base_recur || $recur; #XXX uuh
1052
1053     if ( $increment_next_bill ) {
1054
1055       my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1056       return "unparsable frequency: ". $part_pkg->freq
1057         if $next_bill == -1;
1058
1059       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1060       # only for figuring next bill date, nothing else, so, reset $sdate again
1061       # here
1062       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1063       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1064       $cust_pkg->last_bill($sdate);
1065
1066       $cust_pkg->setfield('bill', $next_bill );
1067
1068     }
1069
1070     if ( $param{'setup_fee'} ) {
1071       # Add an additional setup fee at the billing stage.
1072       # Used for prorate_defer_bill.
1073       $setup += $param{'setup_fee'};
1074       $unitsetup += $param{'setup_fee'};
1075       $lineitems++;
1076     }
1077
1078     if ( defined $param{'discount_left_setup'} ) {
1079         foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1080             $setup -= $discount_setup;
1081         }
1082     }
1083
1084   }
1085
1086   warn "\$setup is undefined" unless defined($setup);
1087   warn "\$recur is undefined" unless defined($recur);
1088   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1089
1090   ###
1091   # If there's line items, create em cust_bill_pkg records
1092   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1093   ###
1094
1095   if ( $lineitems ) {
1096
1097     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1098       # hmm.. and if just the options are modified in some weird price plan?
1099
1100       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
1101         if $DEBUG >1;
1102
1103       my $error = $cust_pkg->replace( $old_cust_pkg,
1104                                       'depend_jobnum'=>$options{depend_jobnum},
1105                                       'options' => { $cust_pkg->options },
1106                                     )
1107         unless $options{no_commit};
1108       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1109         if $error; #just in case
1110     }
1111
1112     $setup = sprintf( "%.2f", $setup );
1113     $recur = sprintf( "%.2f", $recur );
1114     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1115       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1116     }
1117     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1118       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1119     }
1120
1121     my $discount_show_always = $conf->exists('discount-show-always')
1122                                && (    ($setup == 0 && scalar(@setup_discounts))
1123                                     || ($recur == 0 && scalar(@recur_discounts))
1124                                   );
1125
1126     if (    $setup != 0
1127          || $recur != 0
1128          || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1129          || $discount_show_always
1130          || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1131          || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1132        )
1133     {
1134
1135       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
1136         if $DEBUG > 1;
1137
1138       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1139       if ( $DEBUG > 1 ) {
1140         warn "      adding customer package invoice detail: $_\n"
1141           foreach @cust_pkg_detail;
1142       }
1143       push @details, @cust_pkg_detail;
1144
1145       my $cust_bill_pkg = new FS::cust_bill_pkg {
1146         'pkgnum'    => $cust_pkg->pkgnum,
1147         'setup'     => $setup,
1148         'unitsetup' => $unitsetup,
1149         'recur'     => $recur,
1150         'unitrecur' => $unitrecur,
1151         'quantity'  => $cust_pkg->quantity,
1152         'details'   => \@details,
1153         'discounts' => [ @setup_discounts, @recur_discounts ],
1154         'hidden'    => $part_pkg->hidden,
1155         'freq'      => $part_pkg->freq,
1156       };
1157
1158       if ( $part_pkg->option('prorate_defer_bill',1)
1159            and !$hash{last_bill} ) {
1160         # both preceding and upcoming, technically
1161         $cust_bill_pkg->sdate( $cust_pkg->setup );
1162         $cust_bill_pkg->edate( $cust_pkg->bill );
1163       } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1164         $cust_bill_pkg->sdate( $hash{last_bill} );
1165         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
1166         $cust_bill_pkg->edate( $time ) if $options{cancel};
1167       } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1168         $cust_bill_pkg->sdate( $sdate );
1169         $cust_bill_pkg->edate( $cust_pkg->bill );
1170         #$cust_bill_pkg->edate( $time ) if $options{cancel};
1171       }
1172
1173       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1174         unless $part_pkg->pkgpart == $real_pkgpart;
1175
1176       $$total_setup += $setup;
1177       $$total_recur += $recur;
1178
1179       ###
1180       # handle taxes
1181       ###
1182
1183       unless ( $discount_show_always ) {
1184           my $error =
1185             $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
1186           return $error if $error;
1187       }
1188
1189       push @$cust_bill_pkgs, $cust_bill_pkg;
1190
1191     } #if $setup != 0 || $recur != 0
1192
1193   } #if $line_items
1194
1195   '';
1196
1197 }
1198
1199 sub _handle_taxes {
1200   my $self = shift;
1201   my $part_pkg = shift;
1202   my $taxlisthash = shift;
1203   my $cust_bill_pkg = shift;
1204   my $cust_pkg = shift;
1205   my $invoice_time = shift;
1206   my $real_pkgpart = shift;
1207   my $options = shift;
1208
1209   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1210
1211   my %cust_bill_pkg = ();
1212   my %taxes = ();
1213
1214   my @classes;
1215   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1216   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1217   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1218   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1219
1220   my $exempt = $conf->exists('cust_class-tax_exempt')
1221                  ? ( $self->cust_class ? $self->cust_class->tax : '' )
1222                  : $self->tax;
1223   # standardize this just to be sure
1224   $exempt = ($exempt eq 'Y') ? 'Y' : '';
1225
1226   #if ( $exempt !~ /Y/i && $self->payby ne 'COMP' ) {
1227   if ( $self->payby ne 'COMP' ) {
1228
1229     if ( $conf->exists('enable_taxproducts')
1230          && ( scalar($part_pkg->part_pkg_taxoverride)
1231               || $part_pkg->has_taxproduct
1232             )
1233        )
1234     {
1235
1236       if ( !$exempt ) {
1237
1238         foreach my $class (@classes) {
1239           my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
1240           return $err_or_ref unless ref($err_or_ref);
1241           $taxes{$class} = $err_or_ref;
1242         }
1243
1244         unless (exists $taxes{''}) {
1245           my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
1246           return $err_or_ref unless ref($err_or_ref);
1247           $taxes{''} = $err_or_ref;
1248         }
1249
1250       }
1251
1252     } else { # cust_main_county tax system
1253
1254       # We fetch taxes even if the customer is completely exempt,
1255       # because we need to record that fact.
1256
1257       my @loc_keys = qw( district city county state country );
1258       my $location = $cust_pkg->tax_location;
1259       my %taxhash = map { $_ => $location->$_ } @loc_keys;
1260
1261       $taxhash{'taxclass'} = $part_pkg->taxclass;
1262
1263       warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1264
1265       my @taxes = (); # entries are cust_main_county objects
1266       my %taxhash_elim = %taxhash;
1267       my @elim = qw( district city county state );
1268       do {
1269
1270         #first try a match with taxclass
1271         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1272
1273         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1274           #then try a match without taxclass
1275           my %no_taxclass = %taxhash_elim;
1276           $no_taxclass{ 'taxclass' } = '';
1277           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1278         }
1279
1280         $taxhash_elim{ shift(@elim) } = '';
1281
1282       } while ( !scalar(@taxes) && scalar(@elim) );
1283
1284       foreach (@taxes) {
1285         # These could become cust_bill_pkg_tax_location records,
1286         # or cust_tax_exempt_pkg.  We'll decide later.
1287         $_->set('pkgnum',       $cust_pkg->pkgnum);
1288         $_->set('locationnum',  $cust_pkg->tax_locationnum);
1289       }
1290
1291       $taxes{''} = [ @taxes ];
1292       $taxes{'setup'} = [ @taxes ];
1293       $taxes{'recur'} = [ @taxes ];
1294       $taxes{$_} = [ @taxes ] foreach (@classes);
1295
1296       # # maybe eliminate this entirely, along with all the 0% records
1297       # unless ( @taxes ) {
1298       #   return
1299       #     "fatal: can't find tax rate for state/county/country/taxclass ".
1300       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
1301       # }
1302
1303     } #if $conf->exists('enable_taxproducts') ...
1304
1305   } # if $self->payby eq 'COMP'
1306
1307   #what's this doing in the middle of _handle_taxes?  probably should split
1308   #this into three parts above in _make_lines
1309   $cust_bill_pkg->set_display(   part_pkg     => $part_pkg,
1310                                  real_pkgpart => $real_pkgpart,
1311                              );
1312
1313   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1314   foreach my $key (keys %tax_cust_bill_pkg) {
1315     # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1316     # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1317     # the line item.
1318     # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1319     # apply to $key-class charges.
1320     my @taxes = @{ $taxes{$key} || [] };
1321     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1322
1323     my %localtaxlisthash = ();
1324     foreach my $tax ( @taxes ) {
1325
1326       # this is the tax identifier, not the taxname
1327       my $taxname = ref( $tax ). ' '. $tax->taxnum;
1328       $taxname .= ' pkgnum'. $cust_pkg->pkgnum;
1329       # We need to create a separate $taxlisthash entry for each pkgnum
1330       # on the invoice, so that cust_bill_pkg_tax_location records will
1331       # be linked correctly.
1332
1333       # $taxlisthash: keys are "setup", "recur", and usage classes.
1334       # Values are arrayrefs, first the tax object (cust_main_county
1335       # or tax_rate) and then any cust_bill_pkg objects that the
1336       # tax applies to.
1337       $taxlisthash->{ $taxname } ||= [ $tax ];
1338       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
1339
1340       $localtaxlisthash{ $taxname } ||= [ $tax ];
1341       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
1342
1343     }
1344
1345     warn "finding taxed taxes...\n" if $DEBUG > 2;
1346     foreach my $tax ( keys %localtaxlisthash ) {
1347       my $tax_object = shift @{ $localtaxlisthash{$tax} };
1348       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1349         if $DEBUG > 2;
1350       next unless $tax_object->can('tax_on_tax');
1351
1352       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1353         my $totname = ref( $tot ). ' '. $tot->taxnum;
1354
1355         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1356           if $DEBUG > 2;
1357         next unless exists( $localtaxlisthash{ $totname } ); # only increase
1358                                                              # existing taxes
1359         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1360         my $hashref_or_error =
1361           $tax_object->taxline( $localtaxlisthash{$tax},
1362                                 'custnum'      => $self->custnum,
1363                                 'invoice_time' => $invoice_time,
1364                               );
1365         return $hashref_or_error
1366           unless ref($hashref_or_error);
1367
1368         $taxlisthash->{ $totname } ||= [ $tot ];
1369         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
1370
1371       }
1372     }
1373
1374   }
1375
1376   '';
1377 }
1378
1379 sub _gather_taxes {
1380   my $self = shift;
1381   my $part_pkg = shift;
1382   my $class = shift;
1383   my $cust_pkg = shift;
1384
1385   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1386
1387   my $geocode;
1388   if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
1389     $geocode = $cust_pkg->cust_location->geocode('cch');
1390   } else {
1391     $geocode = $self->geocode('cch');
1392   }
1393
1394   my @taxes = ();
1395
1396   my @taxclassnums = map { $_->taxclassnum }
1397                      $part_pkg->part_pkg_taxoverride($class);
1398
1399   unless (@taxclassnums) {
1400     @taxclassnums = map { $_->taxclassnum }
1401                     grep { $_->taxable eq 'Y' }
1402                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1403   }
1404   warn "Found taxclassnum values of ". join(',', @taxclassnums)
1405     if $DEBUG;
1406
1407   my $extra_sql =
1408     "AND (".
1409     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1410
1411   @taxes = qsearch({ 'table' => 'tax_rate',
1412                      'hashref' => { 'geocode' => $geocode, },
1413                      'extra_sql' => $extra_sql,
1414                   })
1415     if scalar(@taxclassnums);
1416
1417   warn "Found taxes ".
1418        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1419    if $DEBUG;
1420
1421   [ @taxes ];
1422
1423 }
1424
1425 =item collect [ HASHREF | OPTION => VALUE ... ]
1426
1427 (Attempt to) collect money for this customer's outstanding invoices (see
1428 L<FS::cust_bill>).  Usually used after the bill method.
1429
1430 Actions are now triggered by billing events; see L<FS::part_event> and the
1431 billing events web interface.  Old-style invoice events (see
1432 L<FS::part_bill_event>) have been deprecated.
1433
1434 If there is an error, returns the error, otherwise returns false.
1435
1436 Options are passed as name-value pairs.
1437
1438 Currently available options are:
1439
1440 =over 4
1441
1442 =item invoice_time
1443
1444 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.
1445
1446 =item retry
1447
1448 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1449
1450 =item check_freq
1451
1452 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1453
1454 =item quiet
1455
1456 set true to surpress email card/ACH decline notices.
1457
1458 =item debug
1459
1460 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)
1461
1462 =back
1463
1464 # =item payby
1465 #
1466 # allows for one time override of normal customer billing method
1467
1468 =cut
1469
1470 sub collect {
1471   my( $self, %options ) = @_;
1472
1473   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1474
1475   my $invoice_time = $options{'invoice_time'} || time;
1476
1477   #put below somehow?
1478   local $SIG{HUP} = 'IGNORE';
1479   local $SIG{INT} = 'IGNORE';
1480   local $SIG{QUIT} = 'IGNORE';
1481   local $SIG{TERM} = 'IGNORE';
1482   local $SIG{TSTP} = 'IGNORE';
1483   local $SIG{PIPE} = 'IGNORE';
1484
1485   my $oldAutoCommit = $FS::UID::AutoCommit;
1486   local $FS::UID::AutoCommit = 0;
1487   my $dbh = dbh;
1488
1489   $self->select_for_update; #mutex
1490
1491   if ( $DEBUG ) {
1492     my $balance = $self->balance;
1493     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1494   }
1495
1496   if ( exists($options{'retry_card'}) ) {
1497     carp 'retry_card option passed to collect is deprecated; use retry';
1498     $options{'retry'} ||= $options{'retry_card'};
1499   }
1500   if ( exists($options{'retry'}) && $options{'retry'} ) {
1501     my $error = $self->retry_realtime;
1502     if ( $error ) {
1503       $dbh->rollback if $oldAutoCommit;
1504       return $error;
1505     }
1506   }
1507
1508   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1509
1510   #never want to roll back an event just because it returned an error
1511   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1512
1513   $self->do_cust_event(
1514     'debug'      => ( $options{'debug'} || 0 ),
1515     'time'       => $invoice_time,
1516     'check_freq' => $options{'check_freq'},
1517     'stage'      => 'collect',
1518   );
1519
1520 }
1521
1522 =item retry_realtime
1523
1524 Schedules realtime / batch  credit card / electronic check / LEC billing
1525 events for for retry.  Useful if card information has changed or manual
1526 retry is desired.  The 'collect' method must be called to actually retry
1527 the transaction.
1528
1529 Implementation details: For either this customer, or for each of this
1530 customer's open invoices, changes the status of the first "done" (with
1531 statustext error) realtime processing event to "failed".
1532
1533 =cut
1534
1535 sub retry_realtime {
1536   my $self = shift;
1537
1538   local $SIG{HUP} = 'IGNORE';
1539   local $SIG{INT} = 'IGNORE';
1540   local $SIG{QUIT} = 'IGNORE';
1541   local $SIG{TERM} = 'IGNORE';
1542   local $SIG{TSTP} = 'IGNORE';
1543   local $SIG{PIPE} = 'IGNORE';
1544
1545   my $oldAutoCommit = $FS::UID::AutoCommit;
1546   local $FS::UID::AutoCommit = 0;
1547   my $dbh = dbh;
1548
1549   #a little false laziness w/due_cust_event (not too bad, really)
1550
1551   my $join = FS::part_event_condition->join_conditions_sql;
1552   my $order = FS::part_event_condition->order_conditions_sql;
1553   my $mine =
1554   '( '
1555    . join ( ' OR ' , map {
1556     my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1557     my $custnum = FS::part_event->eventtables_custnum->{$_};
1558     "( part_event.eventtable = " . dbh->quote($_)
1559     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1560     . " from $_ $cust_join"
1561     . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1562    } FS::part_event->eventtables)
1563    . ') ';
1564
1565   #here is the agent virtualization
1566   my $agent_virt = " (    part_event.agentnum IS NULL
1567                        OR part_event.agentnum = ". $self->agentnum. ' )';
1568
1569   #XXX this shouldn't be hardcoded, actions should declare it...
1570   my @realtime_events = qw(
1571     cust_bill_realtime_card
1572     cust_bill_realtime_check
1573     cust_bill_realtime_lec
1574     cust_bill_batch
1575   );
1576
1577   my $is_realtime_event =
1578     ' part_event.action IN ( '.
1579         join(',', map "'$_'", @realtime_events ).
1580     ' ) ';
1581
1582   my $batch_or_statustext =
1583     "( part_event.action = 'cust_bill_batch'
1584        OR ( statustext IS NOT NULL AND statustext != '' )
1585      )";
1586
1587
1588   my @cust_event = qsearch({
1589     'table'     => 'cust_event',
1590     'select'    => 'cust_event.*',
1591     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1592     'hashref'   => { 'status' => 'done' },
1593     'extra_sql' => " AND $batch_or_statustext ".
1594                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1595   });
1596
1597   my %seen_invnum = ();
1598   foreach my $cust_event (@cust_event) {
1599
1600     #max one for the customer, one for each open invoice
1601     my $cust_X = $cust_event->cust_X;
1602     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1603                           ? $cust_X->invnum
1604                           : 0
1605                         }++
1606          or $cust_event->part_event->eventtable eq 'cust_bill'
1607             && ! $cust_X->owed;
1608
1609     my $error = $cust_event->retry;
1610     if ( $error ) {
1611       $dbh->rollback if $oldAutoCommit;
1612       return "error scheduling event for retry: $error";
1613     }
1614
1615   }
1616
1617   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1618   '';
1619
1620 }
1621
1622 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1623
1624 Runs billing events; see L<FS::part_event> and the billing events web
1625 interface.
1626
1627 If there is an error, returns the error, otherwise returns false.
1628
1629 Options are passed as name-value pairs.
1630
1631 Currently available options are:
1632
1633 =over 4
1634
1635 =item time
1636
1637 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.
1638
1639 =item check_freq
1640
1641 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1642
1643 =item stage
1644
1645 "collect" (the default) or "pre-bill"
1646
1647 =item quiet
1648
1649 set true to surpress email card/ACH decline notices.
1650
1651 =item debug
1652
1653 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)
1654
1655 =back
1656 =cut
1657
1658 # =item payby
1659 #
1660 # allows for one time override of normal customer billing method
1661
1662 # =item retry
1663 #
1664 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1665
1666 sub do_cust_event {
1667   my( $self, %options ) = @_;
1668
1669   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1670
1671   my $time = $options{'time'} || time;
1672
1673   #put below somehow?
1674   local $SIG{HUP} = 'IGNORE';
1675   local $SIG{INT} = 'IGNORE';
1676   local $SIG{QUIT} = 'IGNORE';
1677   local $SIG{TERM} = 'IGNORE';
1678   local $SIG{TSTP} = 'IGNORE';
1679   local $SIG{PIPE} = 'IGNORE';
1680
1681   my $oldAutoCommit = $FS::UID::AutoCommit;
1682   local $FS::UID::AutoCommit = 0;
1683   my $dbh = dbh;
1684
1685   $self->select_for_update; #mutex
1686
1687   if ( $DEBUG ) {
1688     my $balance = $self->balance;
1689     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1690   }
1691
1692 #  if ( exists($options{'retry_card'}) ) {
1693 #    carp 'retry_card option passed to collect is deprecated; use retry';
1694 #    $options{'retry'} ||= $options{'retry_card'};
1695 #  }
1696 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
1697 #    my $error = $self->retry_realtime;
1698 #    if ( $error ) {
1699 #      $dbh->rollback if $oldAutoCommit;
1700 #      return $error;
1701 #    }
1702 #  }
1703
1704   # false laziness w/pay_batch::import_results
1705
1706   my $due_cust_event = $self->due_cust_event(
1707     'debug'      => ( $options{'debug'} || 0 ),
1708     'time'       => $time,
1709     'check_freq' => $options{'check_freq'},
1710     'stage'      => ( $options{'stage'} || 'collect' ),
1711   );
1712   unless( ref($due_cust_event) ) {
1713     $dbh->rollback if $oldAutoCommit;
1714     return $due_cust_event;
1715   }
1716
1717   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1718   #never want to roll back an event just because it or a different one
1719   # returned an error
1720   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1721
1722   foreach my $cust_event ( @$due_cust_event ) {
1723
1724     #XXX lock event
1725
1726     #re-eval event conditions (a previous event could have changed things)
1727     unless ( $cust_event->test_conditions ) {
1728       #don't leave stray "new/locked" records around
1729       my $error = $cust_event->delete;
1730       return $error if $error;
1731       next;
1732     }
1733
1734     {
1735       local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1736         if $options{'quiet'};
1737       warn "  running cust_event ". $cust_event->eventnum. "\n"
1738         if $DEBUG > 1;
1739
1740       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1741       if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1742         #XXX wtf is this?  figure out a proper dealio with return value
1743         #from do_event
1744         return $error;
1745       }
1746     }
1747
1748   }
1749
1750   '';
1751
1752 }
1753
1754 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1755
1756 Inserts database records for and returns an ordered listref of new events due
1757 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
1758 events are due, an empty listref is returned.  If there is an error, returns a
1759 scalar error message.
1760
1761 To actually run the events, call each event's test_condition method, and if
1762 still true, call the event's do_event method.
1763
1764 Options are passed as a hashref or as a list of name-value pairs.  Available
1765 options are:
1766
1767 =over 4
1768
1769 =item check_freq
1770
1771 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.
1772
1773 =item stage
1774
1775 "collect" (the default) or "pre-bill"
1776
1777 =item time
1778
1779 "Current time" for the events.
1780
1781 =item debug
1782
1783 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)
1784
1785 =item eventtable
1786
1787 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1788
1789 =item objects
1790
1791 Explicitly pass the objects to be tested (typically used with eventtable).
1792
1793 =item testonly
1794
1795 Set to true to return the objects, but not actually insert them into the
1796 database.
1797
1798 =back
1799
1800 =cut
1801
1802 sub due_cust_event {
1803   my $self = shift;
1804   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1805
1806   #???
1807   #my $DEBUG = $opt{'debug'}
1808   local($DEBUG) = $opt{'debug'}
1809     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1810   $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1811
1812   warn "$me due_cust_event called with options ".
1813        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1814     if $DEBUG;
1815
1816   $opt{'time'} ||= time;
1817
1818   local $SIG{HUP} = 'IGNORE';
1819   local $SIG{INT} = 'IGNORE';
1820   local $SIG{QUIT} = 'IGNORE';
1821   local $SIG{TERM} = 'IGNORE';
1822   local $SIG{TSTP} = 'IGNORE';
1823   local $SIG{PIPE} = 'IGNORE';
1824
1825   my $oldAutoCommit = $FS::UID::AutoCommit;
1826   local $FS::UID::AutoCommit = 0;
1827   my $dbh = dbh;
1828
1829   $self->select_for_update #mutex
1830     unless $opt{testonly};
1831
1832   ###
1833   # find possible events (initial search)
1834   ###
1835
1836   my @cust_event = ();
1837
1838   my @eventtable = $opt{'eventtable'}
1839                      ? ( $opt{'eventtable'} )
1840                      : FS::part_event->eventtables_runorder;
1841
1842   my $check_freq = $opt{'check_freq'} || '1d';
1843
1844   foreach my $eventtable ( @eventtable ) {
1845
1846     my @objects;
1847     if ( $opt{'objects'} ) {
1848
1849       @objects = @{ $opt{'objects'} };
1850
1851     } elsif ( $eventtable eq 'cust_main' ) {
1852
1853       @objects = ( $self );
1854
1855     } else {
1856
1857       my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1858       # linkage not needed here because FS::cust_main->$eventtable will
1859       # already supply it
1860
1861       #some false laziness w/Cron::bill bill_where
1862
1863       my $join  = FS::part_event_condition->join_conditions_sql( $eventtable);
1864       my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1865         'time'=>$opt{'time'},
1866       );
1867       $where = $where ? "AND $where" : '';
1868
1869       my $are_part_event =
1870       "EXISTS ( SELECT 1 FROM part_event $join
1871         WHERE check_freq = '$check_freq'
1872         AND eventtable = '$eventtable'
1873         AND ( disabled = '' OR disabled IS NULL )
1874         $where
1875         )
1876       ";
1877       #eofalse
1878
1879       @objects = $self->$eventtable(
1880         'addl_from' => $cm_join,
1881         'extra_sql' => " AND $are_part_event",
1882       );
1883     } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
1884
1885     my @e_cust_event = ();
1886
1887     my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
1888
1889     my $cross = "CROSS JOIN $eventtable $linkage";
1890     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1891       unless $eventtable eq 'cust_main';
1892
1893     foreach my $object ( @objects ) {
1894
1895       #this first search uses the condition_sql magic for optimization.
1896       #the more possible events we can eliminate in this step the better
1897
1898       my $cross_where = '';
1899       my $pkey = $object->primary_key;
1900       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1901
1902       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1903       my $extra_sql =
1904         FS::part_event_condition->where_conditions_sql( $eventtable,
1905                                                         'time'=>$opt{'time'}
1906                                                       );
1907       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1908
1909       $extra_sql = "AND $extra_sql" if $extra_sql;
1910
1911       #here is the agent virtualization
1912       $extra_sql .= " AND (    part_event.agentnum IS NULL
1913                             OR part_event.agentnum = ". $self->agentnum. ' )';
1914
1915       $extra_sql .= " $order";
1916
1917       warn "searching for events for $eventtable ". $object->$pkey. "\n"
1918         if $opt{'debug'} > 2;
1919       my @part_event = qsearch( {
1920         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
1921         'select'    => 'part_event.*',
1922         'table'     => 'part_event',
1923         'addl_from' => "$cross $join",
1924         'hashref'   => { 'check_freq' => $check_freq,
1925                          'eventtable' => $eventtable,
1926                          'disabled'   => '',
1927                        },
1928         'extra_sql' => "AND $cross_where $extra_sql",
1929       } );
1930
1931       if ( $DEBUG > 2 ) {
1932         my $pkey = $object->primary_key;
1933         warn "      ". scalar(@part_event).
1934              " possible events found for $eventtable ". $object->$pkey(). "\n";
1935       }
1936
1937       push @e_cust_event, map {
1938         $_->new_cust_event($object, 'time' => $opt{'time'})
1939       } @part_event;
1940
1941     }
1942
1943     warn "    ". scalar(@e_cust_event).
1944          " subtotal possible cust events found for $eventtable\n"
1945       if $DEBUG > 1;
1946
1947     push @cust_event, @e_cust_event;
1948
1949   }
1950
1951   warn "  ". scalar(@cust_event).
1952        " total possible cust events found in initial search\n"
1953     if $DEBUG; # > 1;
1954
1955
1956   ##
1957   # test stage
1958   ##
1959
1960   $opt{stage} ||= 'collect';
1961   @cust_event =
1962     grep { my $stage = $_->part_event->event_stage;
1963            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1964          }
1965          @cust_event;
1966
1967   ##
1968   # test conditions
1969   ##
1970
1971   my %unsat = ();
1972
1973   @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
1974                      @cust_event;
1975
1976   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
1977     if $DEBUG; # > 1;
1978
1979   warn "    invalid conditions not eliminated with condition_sql:\n".
1980        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
1981     if keys %unsat && $DEBUG; # > 1;
1982
1983   ##
1984   # insert
1985   ##
1986
1987   unless( $opt{testonly} ) {
1988     foreach my $cust_event ( @cust_event ) {
1989
1990       my $error = $cust_event->insert();
1991       if ( $error ) {
1992         $dbh->rollback if $oldAutoCommit;
1993         return $error;
1994       }
1995
1996     }
1997   }
1998
1999   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2000
2001   ##
2002   # return
2003   ##
2004
2005   warn "  returning events: ". Dumper(@cust_event). "\n"
2006     if $DEBUG > 2;
2007
2008   \@cust_event;
2009
2010 }
2011
2012 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2013
2014 Applies unapplied payments and credits.
2015
2016 In most cases, this new method should be used in place of sequential
2017 apply_payments and apply_credits methods.
2018
2019 A hash of optional arguments may be passed.  Currently "manual" is supported.
2020 If true, a payment receipt is sent instead of a statement when
2021 'payment_receipt_email' configuration option is set.
2022
2023 If there is an error, returns the error, otherwise returns false.
2024
2025 =cut
2026
2027 sub apply_payments_and_credits {
2028   my( $self, %options ) = @_;
2029
2030   local $SIG{HUP} = 'IGNORE';
2031   local $SIG{INT} = 'IGNORE';
2032   local $SIG{QUIT} = 'IGNORE';
2033   local $SIG{TERM} = 'IGNORE';
2034   local $SIG{TSTP} = 'IGNORE';
2035   local $SIG{PIPE} = 'IGNORE';
2036
2037   my $oldAutoCommit = $FS::UID::AutoCommit;
2038   local $FS::UID::AutoCommit = 0;
2039   my $dbh = dbh;
2040
2041   $self->select_for_update; #mutex
2042
2043   foreach my $cust_bill ( $self->open_cust_bill ) {
2044     my $error = $cust_bill->apply_payments_and_credits(%options);
2045     if ( $error ) {
2046       $dbh->rollback if $oldAutoCommit;
2047       return "Error applying: $error";
2048     }
2049   }
2050
2051   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2052   ''; #no error
2053
2054 }
2055
2056 =item apply_credits OPTION => VALUE ...
2057
2058 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2059 to outstanding invoice balances in chronological order (or reverse
2060 chronological order if the I<order> option is set to B<newest>) and returns the
2061 value of any remaining unapplied credits available for refund (see
2062 L<FS::cust_refund>).
2063
2064 Dies if there is an error.
2065
2066 =cut
2067
2068 sub apply_credits {
2069   my $self = shift;
2070   my %opt = @_;
2071
2072   local $SIG{HUP} = 'IGNORE';
2073   local $SIG{INT} = 'IGNORE';
2074   local $SIG{QUIT} = 'IGNORE';
2075   local $SIG{TERM} = 'IGNORE';
2076   local $SIG{TSTP} = 'IGNORE';
2077   local $SIG{PIPE} = 'IGNORE';
2078
2079   my $oldAutoCommit = $FS::UID::AutoCommit;
2080   local $FS::UID::AutoCommit = 0;
2081   my $dbh = dbh;
2082
2083   $self->select_for_update; #mutex
2084
2085   unless ( $self->total_unapplied_credits ) {
2086     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2087     return 0;
2088   }
2089
2090   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2091       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2092
2093   my @invoices = $self->open_cust_bill;
2094   @invoices = sort { $b->_date <=> $a->_date } @invoices
2095     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2096
2097   if ( $conf->exists('pkg-balances') ) {
2098     # limit @credits to those w/ a pkgnum grepped from $self
2099     my %pkgnums = ();
2100     foreach my $i (@invoices) {
2101       foreach my $li ( $i->cust_bill_pkg ) {
2102         $pkgnums{$li->pkgnum} = 1;
2103       }
2104     }
2105     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2106   }
2107
2108   my $credit;
2109
2110   foreach my $cust_bill ( @invoices ) {
2111
2112     if ( !defined($credit) || $credit->credited == 0) {
2113       $credit = pop @credits or last;
2114     }
2115
2116     my $owed;
2117     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2118       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2119     } else {
2120       $owed = $cust_bill->owed;
2121     }
2122     unless ( $owed > 0 ) {
2123       push @credits, $credit;
2124       next;
2125     }
2126
2127     my $amount = min( $credit->credited, $owed );
2128
2129     my $cust_credit_bill = new FS::cust_credit_bill ( {
2130       'crednum' => $credit->crednum,
2131       'invnum'  => $cust_bill->invnum,
2132       'amount'  => $amount,
2133     } );
2134     $cust_credit_bill->pkgnum( $credit->pkgnum )
2135       if $conf->exists('pkg-balances') && $credit->pkgnum;
2136     my $error = $cust_credit_bill->insert;
2137     if ( $error ) {
2138       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2139       die $error;
2140     }
2141
2142     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2143
2144   }
2145
2146   my $total_unapplied_credits = $self->total_unapplied_credits;
2147
2148   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2149
2150   return $total_unapplied_credits;
2151 }
2152
2153 =item apply_payments  [ OPTION => VALUE ... ]
2154
2155 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2156 to outstanding invoice balances in chronological order.
2157
2158  #and returns the value of any remaining unapplied payments.
2159
2160 A hash of optional arguments may be passed.  Currently "manual" is supported.
2161 If true, a payment receipt is sent instead of a statement when
2162 'payment_receipt_email' configuration option is set.
2163
2164 Dies if there is an error.
2165
2166 =cut
2167
2168 sub apply_payments {
2169   my( $self, %options ) = @_;
2170
2171   local $SIG{HUP} = 'IGNORE';
2172   local $SIG{INT} = 'IGNORE';
2173   local $SIG{QUIT} = 'IGNORE';
2174   local $SIG{TERM} = 'IGNORE';
2175   local $SIG{TSTP} = 'IGNORE';
2176   local $SIG{PIPE} = 'IGNORE';
2177
2178   my $oldAutoCommit = $FS::UID::AutoCommit;
2179   local $FS::UID::AutoCommit = 0;
2180   my $dbh = dbh;
2181
2182   $self->select_for_update; #mutex
2183
2184   #return 0 unless
2185
2186   my @payments = sort { $b->_date <=> $a->_date }
2187                  grep { $_->unapplied > 0 }
2188                  $self->cust_pay;
2189
2190   my @invoices = sort { $a->_date <=> $b->_date}
2191                  grep { $_->owed > 0 }
2192                  $self->cust_bill;
2193
2194   if ( $conf->exists('pkg-balances') ) {
2195     # limit @payments to those w/ a pkgnum grepped from $self
2196     my %pkgnums = ();
2197     foreach my $i (@invoices) {
2198       foreach my $li ( $i->cust_bill_pkg ) {
2199         $pkgnums{$li->pkgnum} = 1;
2200       }
2201     }
2202     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2203   }
2204
2205   my $payment;
2206
2207   foreach my $cust_bill ( @invoices ) {
2208
2209     if ( !defined($payment) || $payment->unapplied == 0 ) {
2210       $payment = pop @payments or last;
2211     }
2212
2213     my $owed;
2214     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2215       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2216     } else {
2217       $owed = $cust_bill->owed;
2218     }
2219     unless ( $owed > 0 ) {
2220       push @payments, $payment;
2221       next;
2222     }
2223
2224     my $amount = min( $payment->unapplied, $owed );
2225
2226     my $cbp = {
2227       'paynum' => $payment->paynum,
2228       'invnum' => $cust_bill->invnum,
2229       'amount' => $amount,
2230     };
2231     $cbp->{_date} = $payment->_date
2232         if $options{'manual'} && $options{'backdate_application'};
2233     my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2234     $cust_bill_pay->pkgnum( $payment->pkgnum )
2235       if $conf->exists('pkg-balances') && $payment->pkgnum;
2236     my $error = $cust_bill_pay->insert(%options);
2237     if ( $error ) {
2238       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2239       die $error;
2240     }
2241
2242     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2243
2244   }
2245
2246   my $total_unapplied_payments = $self->total_unapplied_payments;
2247
2248   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2249
2250   return $total_unapplied_payments;
2251 }
2252
2253 =back
2254
2255 =head1 FLOW
2256
2257   bill_and_collect
2258
2259     cancel_expired_pkgs
2260     suspend_adjourned_pkgs
2261     unsuspend_resumed_pkgs
2262
2263     bill
2264       (do_cust_event pre-bill)
2265       _make_lines
2266         _handle_taxes
2267           (vendor-only) _gather_taxes
2268       _omit_zero_value_bundles
2269       calculate_taxes
2270
2271     apply_payments_and_credits
2272     collect
2273       do_cust_event
2274         due_cust_event
2275
2276 =head1 BUGS
2277
2278 =head1 SEE ALSO
2279
2280 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
2281
2282 =cut
2283
2284 1;