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