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