FS/FS/cust_main/Billing.pm

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