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 FS::UID qw( dbh );
   7 use FS::Record qw( qsearch qsearchs );
   8 use FS::cust_bill;
   9 use FS::cust_bill_pkg;
  10 use FS::cust_bill_pkg_display;
  11 use FS::cust_bill_pay;
  12 use FS::cust_credit_bill;
  13 use FS::cust_pkg;
  14 use FS::cust_tax_adjustment;
  15 use FS::tax_rate;
  16 use FS::tax_rate_location;
  17 use FS::cust_bill_pkg_tax_location;
  18 use FS::cust_bill_pkg_tax_rate_location;
  19
  20 # 1 is mostly method/subroutine entry and options
  21 # 2 traces progress of some operations
  22 # 3 is even more information including possibly sensitive data
  23 $DEBUG = 0;
  24 $me = '[FS::cust_main::Billing]';
  25
  26 install_callback FS::UID sub {
  27   $conf = new FS::Conf;
  28   #yes, need it for stuff below (prolly should be cached)
  29 };
  30
  31 =head1 NAME
  32
  33 FS::cust_main::Billing - Billing mixin for cust_main
  34
  35 =head1 SYNOPSIS
  36
  37 =head1 DESCRIPTIONS
  38
  39 These methods are available on FS::cust_main objects.
  40
  41 =head1 METHODS
  42
  43 =over 4
  44
  45 =item bill_and_collect
  46
  47 Cancels and suspends any packages due, generates bills, applies payments and
  48 credits, and applies collection events to run cards, send bills and notices,
  49 etc.
  50
  51 By default, warns on errors and continues with the next operation (but see the
  52 "fatal" flag below).
  53
  54 Options are passed as name-value pairs.  Currently available options are:
  55
  56 =over 4
  57
  58 =item time
  59
  60 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:
  61
  62  use Date::Parse;
  63  ...
  64  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
  65
  66 =item invoice_time
  67
  68 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.
  69
  70 =item check_freq
  71
  72 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
  73
  74 =item resetup
  75
  76 If set true, re-charges setup fees.
  77
  78 =item fatal
  79
  80 If set any errors prevent subsequent operations from continusing.  If set
  81 specifically to "return", returns the error (or false, if there is no error).
  82 Any other true value causes errors to die.
  83
  84 =item debug
  85
  86 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)
  87
  88 =item job
  89
  90 Optional FS::queue entry to receive status updates.
  91
  92 =back
  93
  94 Options are passed to the B<bill> and B<collect> methods verbatim, so all
  95 options of those methods are also available.
  96
  97 =cut
  98
  99 sub bill_and_collect {
 100   my( $self, %options ) = @_;
 101
 102   my $error;
 103
 104   #$options{actual_time} not $options{time} because freeside-daily -d is for
 105   #pre-printing invoices
 106
 107   $options{'actual_time'} ||= time;
 108   my $job = $options{'job'};
 109
 110   $job->update_statustext('0,cleaning expired packages') if $job;
 111   $error = $self->cancel_expired_pkgs( $options{actual_time} );
 112   if ( $error ) {
 113     $error = "Error expiring custnum ". $self->custnum. ": $error";
 114     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 115     elsif ( $options{fatal}                                ) { die    $error; }
 116     else                                                     { warn   $error; }
 117   }
 118
 119   $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
 120   if ( $error ) {
 121     $error = "Error adjourning custnum ". $self->custnum. ": $error";
 122     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 123     elsif ( $options{fatal}                                ) { die    $error; }
 124     else                                                     { warn   $error; }
 125   }
 126
 127   $job->update_statustext('20,billing packages') if $job;
 128   $error = $self->bill( %options );
 129   if ( $error ) {
 130     $error = "Error billing custnum ". $self->custnum. ": $error";
 131     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 132     elsif ( $options{fatal}                                ) { die    $error; }
 133     else                                                     { warn   $error; }
 134   }
 135
 136   $job->update_statustext('50,applying payments and credits') if $job;
 137   $error = $self->apply_payments_and_credits;
 138   if ( $error ) {
 139     $error = "Error applying custnum ". $self->custnum. ": $error";
 140     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
 141     elsif ( $options{fatal}                                ) { die    $error; }
 142     else                                                     { warn   $error; }
 143   }
 144
 145   $job->update_statustext('70,running collection events') if $job;
 146   unless ( $conf->exists('cancelled_cust-noevents')
 147            && ! $self->num_ncancelled_pkgs
 148   ) {
 149     $error = $self->collect( %options );
 150     if ( $error ) {
 151       $error = "Error collecting custnum ". $self->custnum. ": $error";
 152       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
 153       elsif ($options{fatal}                               ) { die    $error; }
 154       else                                                   { warn   $error; }
 155     }
 156   }
 157   $job->update_statustext('100,finished') if $job;
 158
 159   '';
 160
 161 }
 162
 163 sub cancel_expired_pkgs {
 164   my ( $self, $time, %options ) = @_;
 165
 166   my @cancel_pkgs = $self->ncancelled_pkgs( {
 167     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
 168   } );
 169
 170   my @errors = ();
 171
 172   foreach my $cust_pkg ( @cancel_pkgs ) {
 173     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
 174     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
 175                                            'reason_otaker' => $cpr->otaker
 176                                          )
 177                                        : ()
 178                                  );
 179     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 180   }
 181
 182   scalar(@errors) ? join(' / ', @errors) : '';
 183
 184 }
 185
 186 sub suspend_adjourned_pkgs {
 187   my ( $self, $time, %options ) = @_;
 188
 189   my @susp_pkgs = $self->ncancelled_pkgs( {
 190     'extra_sql' =>
 191       " AND ( susp IS NULL OR susp = 0 )
 192         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
 193               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
 194             )
 195       ",
 196   } );
 197
 198   #only because there's no SQL test for is_prepaid :/
 199   @susp_pkgs =
 200     grep {     (    $_->part_pkg->is_prepaid
 201                  && $_->bill
 202                  && $_->bill < $time
 203                )
 204             || (    $_->adjourn
 205                  && $_->adjourn <= $time
 206                )
 207
 208          }
 209          @susp_pkgs;
 210
 211   my @errors = ();
 212
 213   foreach my $cust_pkg ( @susp_pkgs ) {
 214     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
 215       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
 216     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
 217                                             'reason_otaker' => $cpr->otaker
 218                                           )
 219                                         : ()
 220                                   );
 221     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
 222   }
 223
 224   scalar(@errors) ? join(' / ', @errors) : '';
 225
 226 }
 227
 228 =item bill OPTIONS
 229
 230 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 231 conjunction with the collect method by calling B<bill_and_collect>.
 232
 233 If there is an error, returns the error, otherwise returns false.
 234
 235 Options are passed as name-value pairs.  Currently available options are:
 236
 237 =over 4
 238
 239 =item resetup
 240
 241 If set true, re-charges setup fees.
 242
 243 =item time
 244
 245 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:
 246
 247  use Date::Parse;
 248  ...
 249  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
 250
 251 =item pkg_list
 252
 253 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
 254
 255  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
 256
 257 =item not_pkgpart
 258
 259 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
 260
 261 =item invoice_time
 262
 263 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.
 264
 265 =item cancel
 266
 267 This boolean value informs the us that the package is being cancelled.  This
 268 typically might mean not charging the normal recurring fee but only usage
 269 fees since the last billing. Setup charges may be charged.  Not all package
 270 plans support this feature (they tend to charge 0).
 271
 272 =item invoice_terms
 273
 274 Optional terms to be printed on this invoice.  Otherwise, customer-specific
 275 terms or the default terms are used.
 276
 277 =back
 278
 279 =cut
 280
 281 sub bill {
 282   my( $self, %options ) = @_;
 283   return '' if $self->payby eq 'COMP';
 284   warn "$me bill customer ". $self->custnum. "\n"
 285     if $DEBUG;
 286
 287   my $time = $options{'time'} || time;
 288   my $invoice_time = $options{'invoice_time'} || $time;
 289
 290   $options{'not_pkgpart'} ||= {};
 291   $options{'not_pkgpart'} = { map { $_ => 1 }
 292                                   split(/\s*,\s*/, $options{'not_pkgpart'})
 293                             }
 294     unless ref($options{'not_pkgpart'});
 295
 296   local $SIG{HUP} = 'IGNORE';
 297   local $SIG{INT} = 'IGNORE';
 298   local $SIG{QUIT} = 'IGNORE';
 299   local $SIG{TERM} = 'IGNORE';
 300   local $SIG{TSTP} = 'IGNORE';
 301   local $SIG{PIPE} = 'IGNORE';
 302
 303   my $oldAutoCommit = $FS::UID::AutoCommit;
 304   local $FS::UID::AutoCommit = 0;
 305   my $dbh = dbh;
 306
 307   warn "$me acquiring lock on customer ". $self->custnum. "\n"
 308     if $DEBUG;
 309
 310   $self->select_for_update; #mutex
 311
 312   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
 313     if $DEBUG;
 314
 315   my $error = $self->do_cust_event(
 316     'debug'      => ( $options{'debug'} || 0 ),
 317     'time'       => $invoice_time,
 318     'check_freq' => $options{'check_freq'},
 319     'stage'      => 'pre-bill',
 320   );
 321   if ( $error ) {
 322     $dbh->rollback if $oldAutoCommit;
 323     return $error;
 324   }
 325
 326   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
 327     if $DEBUG;
 328
 329   #keep auto-charge and non-auto-charge line items separate
 330   my @passes = ( '', 'no_auto' );
 331
 332   my %cust_bill_pkg = map { $_ => [] } @passes;
 333
 334   ###
 335   # find the packages which are due for billing, find out how much they are
 336   # & generate invoice database.
 337   ###
 338
 339   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
 340   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
 341
 342   my %taxlisthash = map { $_ => {} } @passes;
 343
 344   my @precommit_hooks = ();
 345
 346   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
 347   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
 348
 349     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
 350
 351     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
 352
 353     #? to avoid use of uninitialized value errors... ?
 354     $cust_pkg->setfield('bill', '')
 355       unless defined($cust_pkg->bill);
 356
 357     #my $part_pkg = $cust_pkg->part_pkg;
 358
 359     my $real_pkgpart = $cust_pkg->pkgpart;
 360     my %hash = $cust_pkg->hash;
 361
 362     # we could implement this bit as FS::part_pkg::has_hidden, but we already
 363     # suffer from performance issues
 364     $options{has_hidden} = 0;
 365     my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
 366     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 367
 368     foreach my $part_pkg ( @part_pkg ) {
 369
 370       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
 371
 372       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
 373
 374       my $error =
 375         $self->_make_lines( 'part_pkg'            => $part_pkg,
 376                             'cust_pkg'            => $cust_pkg,
 377                             'precommit_hooks'     => \@precommit_hooks,
 378                             'line_items'          => $cust_bill_pkg{$pass},
 379                             'setup'               => $total_setup{$pass},
 380                             'recur'               => $total_recur{$pass},
 381                             'tax_matrix'          => $taxlisthash{$pass},
 382                             'time'                => $time,
 383                             'real_pkgpart'        => $real_pkgpart,
 384                             'options'             => \%options,
 385                           );
 386       if ($error) {
 387         $dbh->rollback if $oldAutoCommit;
 388         return $error;
 389       }
 390
 391     } #foreach my $part_pkg
 392
 393   } #foreach my $cust_pkg
 394
 395   #if the customer isn't on an automatic payby, everything can go on a single
 396   #invoice anyway?
 397   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
 398     #merge everything into one list
 399   #}
 400
 401   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
 402
 403     my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
 404
 405     next unless @cust_bill_pkg; #don't create an invoice w/o line items
 406
 407     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
 408            !$conf->exists('postal_invoice-recurring_only')
 409        )
 410     {
 411
 412       my $postal_pkg = $self->charge_postal_fee();
 413       if ( $postal_pkg && !ref( $postal_pkg ) ) {
 414
 415         $dbh->rollback if $oldAutoCommit;
 416         return "can't charge postal invoice fee for customer ".
 417           $self->custnum. ": $postal_pkg";
 418
 419       } elsif ( $postal_pkg ) {
 420
 421         my $real_pkgpart = $postal_pkg->pkgpart;
 422         # we could implement this bit as FS::part_pkg::has_hidden, but we already
 423         # suffer from performance issues
 424         $options{has_hidden} = 0;
 425         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
 426         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
 427
 428         foreach my $part_pkg ( @part_pkg ) {
 429           my %postal_options = %options;
 430           delete $postal_options{cancel};
 431           my $error =
 432             $self->_make_lines( 'part_pkg'            => $part_pkg,
 433                                 'cust_pkg'            => $postal_pkg,
 434                                 'precommit_hooks'     => \@precommit_hooks,
 435                                 'line_items'          => \@cust_bill_pkg,
 436                                 'setup'               => $total_setup{$pass},
 437                                 'recur'               => $total_recur{$pass},
 438                                 'tax_matrix'          => $taxlisthash{$pass},
 439                                 'time'                => $time,
 440                                 'real_pkgpart'        => $real_pkgpart,
 441                                 'options'             => \%postal_options,
 442                               );
 443           if ($error) {
 444             $dbh->rollback if $oldAutoCommit;
 445             return $error;
 446           }
 447         }
 448
 449         # it's silly to have a zero value postal_pkg, but....
 450         @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
 451
 452       }
 453
 454     }
 455
 456     my $listref_or_error =
 457       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
 458
 459     unless ( ref( $listref_or_error ) ) {
 460       $dbh->rollback if $oldAutoCommit;
 461       return $listref_or_error;
 462     }
 463
 464     foreach my $taxline ( @$listref_or_error ) {
 465       ${ $total_setup{$pass} } =
 466         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
 467       push @cust_bill_pkg, $taxline;
 468     }
 469
 470     #add tax adjustments
 471     warn "adding tax adjustments...\n" if $DEBUG > 2;
 472     foreach my $cust_tax_adjustment (
 473       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
 474                                        'billpkgnum' => '',
 475                                      }
 476              )
 477     ) {
 478
 479       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
 480
 481       my $itemdesc = $cust_tax_adjustment->taxname;
 482       $itemdesc = '' if $itemdesc eq 'Tax';
 483
 484       push @cust_bill_pkg, new FS::cust_bill_pkg {
 485         'pkgnum'      => 0,
 486         'setup'       => $tax,
 487         'recur'       => 0,
 488         'sdate'       => '',
 489         'edate'       => '',
 490         'itemdesc'    => $itemdesc,
 491         'itemcomment' => $cust_tax_adjustment->comment,
 492         'cust_tax_adjustment' => $cust_tax_adjustment,
 493         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 494       };
 495
 496     }
 497
 498     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
 499
 500     my @cust_bill = $self->cust_bill;
 501     my $balance = $self->balance;
 502     my $previous_balance = scalar(@cust_bill)
 503                              ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
 504                              : 0;
 505
 506     $previous_balance += $cust_bill[$#cust_bill]->charged
 507       if scalar(@cust_bill);
 508     #my $balance_adjustments =
 509     #  sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
 510
 511     #create the new invoice
 512     my $cust_bill = new FS::cust_bill ( {
 513       'custnum'             => $self->custnum,
 514       '_date'               => ( $invoice_time ),
 515       'charged'             => $charged,
 516       'billing_balance'     => $balance,
 517       'previous_balance'    => $previous_balance,
 518       'invoice_terms'       => $options{'invoice_terms'},
 519     } );
 520     $error = $cust_bill->insert;
 521     if ( $error ) {
 522       $dbh->rollback if $oldAutoCommit;
 523       return "can't create invoice for customer #". $self->custnum. ": $error";
 524     }
 525
 526     foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
 527       $cust_bill_pkg->invnum($cust_bill->invnum);
 528       my $error = $cust_bill_pkg->insert;
 529       if ( $error ) {
 530         $dbh->rollback if $oldAutoCommit;
 531         return "can't create invoice line item: $error";
 532       }
 533     }
 534
 535   } #foreach my $pass ( keys %cust_bill_pkg )
 536
 537   foreach my $hook ( @precommit_hooks ) {
 538     eval {
 539       &{$hook}; #($self) ?
 540     };
 541     if ( $@ ) {
 542       $dbh->rollback if $oldAutoCommit;
 543       return "$@ running precommit hook $hook\n";
 544     }
 545   }
 546
 547   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 548   ''; #no error
 549 }
 550
 551 #discard bundled packages of 0 value
 552 sub _omit_zero_value_bundles {
 553
 554   my @cust_bill_pkg = ();
 555   my @cust_bill_pkg_bundle = ();
 556   my $sum = 0;
 557
 558   foreach my $cust_bill_pkg ( @_ ) {
 559     if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
 560       push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
 561       @cust_bill_pkg_bundle = ();
 562       $sum = 0;
 563     }
 564     $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
 565     push @cust_bill_pkg_bundle, $cust_bill_pkg;
 566   }
 567   push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
 568
 569   (@cust_bill_pkg);
 570
 571 }
 572
 573 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
 574
 575 This is a weird one.  Perhaps it should not even be exposed.
 576
 577 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
 578 Usually used internally by bill method B<bill>.
 579
 580 If there is an error, returns the error, otherwise returns reference to a
 581 list of line items suitable for insertion.
 582
 583 =over 4
 584
 585 =item LINEITEMREF
 586
 587 An array ref of the line items being billed.
 588
 589 =item TAXHASHREF
 590
 591 A strange beast.  The keys to this hash are internal identifiers consisting
 592 of the name of the tax object type, a space, and its unique identifier ( e.g.
 593  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
 594 item in the list is the tax object.  The remaining items are either line
 595 items or floating point values (currency amounts).
 596
 597 The taxes are calculated on this entity.  Calculated exemption records are
 598 transferred to the LINEITEMREF items on the assumption that they are related.
 599
 600 Read the source.
 601
 602 =item INVOICE_TIME
 603
 604 This specifies the date appearing on the associated invoice.  Some
 605 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
 606
 607 =back
 608
 609 =cut
 610 sub calculate_taxes {
 611   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
 612
 613   my @tax_line_items = ();
 614
 615   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
 616
 617   # keys are tax names (as printed on invoices / itemdesc )
 618   # values are listrefs of taxlisthash keys (internal identifiers)
 619   my %taxname = ();
 620
 621   # keys are taxlisthash keys (internal identifiers)
 622   # values are (cumulative) amounts
 623   my %tax = ();
 624
 625   # keys are taxlisthash keys (internal identifiers)
 626   # values are listrefs of cust_bill_pkg_tax_location hashrefs
 627   my %tax_location = ();
 628
 629   # keys are taxlisthash keys (internal identifiers)
 630   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
 631   my %tax_rate_location = ();
 632
 633   foreach my $tax ( keys %$taxlisthash ) {
 634     my $tax_object = shift @{ $taxlisthash->{$tax} };
 635     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
 636     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
 637     my $hashref_or_error =
 638       $tax_object->taxline( $taxlisthash->{$tax},
 639                             'custnum'      => $self->custnum,
 640                             'invoice_time' => $invoice_time
 641                           );
 642     return $hashref_or_error unless ref($hashref_or_error);
 643
 644     unshift @{ $taxlisthash->{$tax} }, $tax_object;
 645
 646     my $name   = $hashref_or_error->{'name'};
 647     my $amount = $hashref_or_error->{'amount'};
 648
 649     #warn "adding $amount as $name\n";
 650     $taxname{ $name } ||= [];
 651     push @{ $taxname{ $name } }, $tax;
 652
 653     $tax{ $tax } += $amount;
 654
 655     $tax_location{ $tax } ||= [];
 656     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
 657       push @{ $tax_location{ $tax }  },
 658         {
 659           'taxnum'      => $tax_object->taxnum,
 660           'taxtype'     => ref($tax_object),
 661           'pkgnum'      => $tax_object->get('pkgnum'),
 662           'locationnum' => $tax_object->get('locationnum'),
 663           'amount'      => sprintf('%.2f', $amount ),
 664         };
 665     }
 666
 667     $tax_rate_location{ $tax } ||= [];
 668     if ( ref($tax_object) eq 'FS::tax_rate' ) {
 669       my $taxratelocationnum =
 670         $tax_object->tax_rate_location->taxratelocationnum;
 671       push @{ $tax_rate_location{ $tax }  },
 672         {
 673           'taxnum'             => $tax_object->taxnum,
 674           'taxtype'            => ref($tax_object),
 675           'amount'             => sprintf('%.2f', $amount ),
 676           'locationtaxid'      => $tax_object->location,
 677           'taxratelocationnum' => $taxratelocationnum,
 678         };
 679     }
 680
 681   }
 682
 683   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
 684   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
 685   foreach my $tax ( keys %$taxlisthash ) {
 686     foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
 687       next unless ref($_) eq 'FS::cust_bill_pkg';
 688
 689       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
 690         splice( @{ $_->_cust_tax_exempt_pkg } );
 691     }
 692   }
 693
 694   #consolidate and create tax line items
 695   warn "consolidating and generating...\n" if $DEBUG > 2;
 696   foreach my $taxname ( keys %taxname ) {
 697     my $tax = 0;
 698     my %seen = ();
 699     my @cust_bill_pkg_tax_location = ();
 700     my @cust_bill_pkg_tax_rate_location = ();
 701     warn "adding $taxname\n" if $DEBUG > 1;
 702     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
 703       next if $seen{$taxitem}++;
 704       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
 705       $tax += $tax{$taxitem};
 706       push @cust_bill_pkg_tax_location,
 707         map { new FS::cust_bill_pkg_tax_location $_ }
 708             @{ $tax_location{ $taxitem } };
 709       push @cust_bill_pkg_tax_rate_location,
 710         map { new FS::cust_bill_pkg_tax_rate_location $_ }
 711             @{ $tax_rate_location{ $taxitem } };
 712     }
 713     next unless $tax;
 714
 715     $tax = sprintf('%.2f', $tax );
 716
 717     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
 718                                                    'disabled'     => '',
 719                                                  },
 720                                );
 721
 722     my @display = ();
 723     if ( $pkg_category and
 724          $conf->config('invoice_latexsummary') ||
 725          $conf->config('invoice_htmlsummary')
 726        )
 727     {
 728
 729       my %hash = (  'section' => $pkg_category->categoryname );
 730       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
 731
 732     }
 733
 734     push @tax_line_items, new FS::cust_bill_pkg {
 735       'pkgnum'   => 0,
 736       'setup'    => $tax,
 737       'recur'    => 0,
 738       'sdate'    => '',
 739       'edate'    => '',
 740       'itemdesc' => $taxname,
 741       'display'  => \@display,
 742       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
 743       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
 744     };
 745
 746   }
 747
 748   \@tax_line_items;
 749 }
 750
 751 sub _make_lines {
 752   my ($self, %params) = @_;
 753
 754   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
 755   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
 756   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
 757   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
 758   my $total_setup = $params{setup} or die "no setup accumulator specified";
 759   my $total_recur = $params{recur} or die "no recur accumulator specified";
 760   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
 761   my $time = $params{'time'} or die "no time specified";
 762   my (%options) = %{$params{options}};
 763
 764   my $dbh = dbh;
 765   my $real_pkgpart = $params{real_pkgpart};
 766   my %hash = $cust_pkg->hash;
 767   my $old_cust_pkg = new FS::cust_pkg \%hash;
 768
 769   my @details = ();
 770   my @discounts = ();
 771   my $lineitems = 0;
 772
 773   $cust_pkg->pkgpart($part_pkg->pkgpart);
 774
 775   ###
 776   # bill setup
 777   ###
 778
 779   my $setup = 0;
 780   my $unitsetup = 0;
 781   if ( $options{'resetup'}
 782        || ( ! $cust_pkg->setup
 783             && ( ! $cust_pkg->start_date
 784                  || $cust_pkg->start_date <= $time
 785                )
 786             && ( ! $conf->exists('disable_setup_suspended_pkgs')
 787                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
 788                       ! $cust_pkg->getfield('susp')
 789                     )
 790                )
 791           )
 792     )
 793   {
 794
 795     warn "    bill setup\n" if $DEBUG > 1;
 796     $lineitems++;
 797
 798     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
 799     return "$@ running calc_setup for $cust_pkg\n"
 800       if $@;
 801
 802     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
 803
 804     $cust_pkg->setfield('setup', $time)
 805       unless $cust_pkg->setup;
 806           #do need it, but it won't get written to the db
 807           #|| $cust_pkg->pkgpart != $real_pkgpart;
 808
 809     $cust_pkg->setfield('start_date', '')
 810       if $cust_pkg->start_date;
 811
 812   }
 813
 814   ###
 815   # bill recurring fee
 816   ###
 817
 818   #XXX unit stuff here too
 819   my $recur = 0;
 820   my $unitrecur = 0;
 821   my $sdate;
 822   if (     ! $cust_pkg->get('susp')
 823        and ! $cust_pkg->get('start_date')
 824        and ( $part_pkg->getfield('freq') ne '0'
 825              && ( $cust_pkg->getfield('bill') || 0 ) <= $time
 826            )
 827         || ( $part_pkg->plan eq 'voip_cdr'
 828               && $part_pkg->option('bill_every_call')
 829            )
 830         || ( $options{cancel} )
 831   ) {
 832
 833     # XXX should this be a package event?  probably.  events are called
 834     # at collection time at the moment, though...
 835     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
 836       if $part_pkg->can('reset_usage');
 837       #don't want to reset usage just cause we want a line item??
 838       #&& $part_pkg->pkgpart == $real_pkgpart;
 839
 840     warn "    bill recur\n" if $DEBUG > 1;
 841     $lineitems++;
 842
 843     # XXX shared with $recur_prog
 844     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
 845              || $cust_pkg->setup
 846              || $time;
 847
 848     #over two params!  lets at least switch to a hashref for the rest...
 849     my $increment_next_bill = ( $part_pkg->freq ne '0'
 850                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
 851                                 && !$options{cancel}
 852                               );
 853     my %param = ( 'precommit_hooks'     => $precommit_hooks,
 854                   'increment_next_bill' => $increment_next_bill,
 855                   'discounts'           => \@discounts,
 856                   'real_pkgpart'        => $real_pkgpart,
 857                 );
 858
 859     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
 860     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
 861     return "$@ running $method for $cust_pkg\n"
 862       if ( $@ );
 863
 864     if ( $increment_next_bill ) {
 865
 866       my $next_bill = $part_pkg->add_freq($sdate);
 867       return "unparsable frequency: ". $part_pkg->freq
 868         if $next_bill == -1;
 869
 870       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
 871       # only for figuring next bill date, nothing else, so, reset $sdate again
 872       # here
 873       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 874       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
 875       $cust_pkg->last_bill($sdate);
 876
 877       $cust_pkg->setfield('bill', $next_bill );
 878
 879     }
 880
 881   }
 882
 883   warn "\$setup is undefined" unless defined($setup);
 884   warn "\$recur is undefined" unless defined($recur);
 885   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
 886
 887   ###
 888   # If there's line items, create em cust_bill_pkg records
 889   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
 890   ###
 891
 892   if ( $lineitems || $options{has_hidden} ) {
 893
 894     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
 895       # hmm.. and if just the options are modified in some weird price plan?
 896
 897       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
 898         if $DEBUG >1;
 899
 900       my $error = $cust_pkg->replace( $old_cust_pkg,
 901                                       'options' => { $cust_pkg->options },
 902                                     );
 903       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
 904         if $error; #just in case
 905     }
 906
 907     $setup = sprintf( "%.2f", $setup );
 908     $recur = sprintf( "%.2f", $recur );
 909     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
 910       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
 911     }
 912     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
 913       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
 914     }
 915
 916     if ( $setup != 0 ||
 917          $recur != 0 ||
 918          !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
 919     {
 920
 921       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
 922         if $DEBUG > 1;
 923
 924       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
 925       if ( $DEBUG > 1 ) {
 926         warn "      adding customer package invoice detail: $_\n"
 927           foreach @cust_pkg_detail;
 928       }
 929       push @details, @cust_pkg_detail;
 930
 931       my $cust_bill_pkg = new FS::cust_bill_pkg {
 932         'pkgnum'    => $cust_pkg->pkgnum,
 933         'setup'     => $setup,
 934         'unitsetup' => $unitsetup,
 935         'recur'     => $recur,
 936         'unitrecur' => $unitrecur,
 937         'quantity'  => $cust_pkg->quantity,
 938         'details'   => \@details,
 939         'discounts' => \@discounts,
 940         'hidden'    => $part_pkg->hidden,
 941       };
 942
 943       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
 944         $cust_bill_pkg->sdate( $hash{last_bill} );
 945         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
 946         $cust_bill_pkg->edate( $time ) if $options{cancel};
 947       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
 948         $cust_bill_pkg->sdate( $sdate );
 949         $cust_bill_pkg->edate( $cust_pkg->bill );
 950         #$cust_bill_pkg->edate( $time ) if $options{cancel};
 951       }
 952
 953       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
 954         unless $part_pkg->pkgpart == $real_pkgpart;
 955
 956       $$total_setup += $setup;
 957       $$total_recur += $recur;
 958
 959       ###
 960       # handle taxes
 961       ###
 962
 963       my $error =
 964         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
 965       return $error if $error;
 966
 967       push @$cust_bill_pkgs, $cust_bill_pkg;
 968
 969     } #if $setup != 0 || $recur != 0
 970
 971   } #if $line_items
 972
 973   '';
 974
 975 }
 976
 977 sub _handle_taxes {
 978   my $self = shift;
 979   my $part_pkg = shift;
 980   my $taxlisthash = shift;
 981   my $cust_bill_pkg = shift;
 982   my $cust_pkg = shift;
 983   my $invoice_time = shift;
 984   my $real_pkgpart = shift;
 985   my $options = shift;
 986
 987   my %cust_bill_pkg = ();
 988   my %taxes = ();
 989
 990   my @classes;
 991   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
 992   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
 993   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
 994   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
 995
 996   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
 997
 998     if ( $conf->exists('enable_taxproducts')
 999          && ( scalar($part_pkg->part_pkg_taxoverride)
1000               || $part_pkg->has_taxproduct
1001             )
1002        )
1003     {
1004
1005       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1006         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
1007       }
1008
1009       foreach my $class (@classes) {
1010         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
1011         return $err_or_ref unless ref($err_or_ref);
1012         $taxes{$class} = $err_or_ref;
1013       }
1014
1015       unless (exists $taxes{''}) {
1016         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
1017         return $err_or_ref unless ref($err_or_ref);
1018         $taxes{''} = $err_or_ref;
1019       }
1020
1021     } else {
1022
1023       my @loc_keys = qw( city county state country );
1024       my %taxhash;
1025       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1026         my $cust_location = $cust_pkg->cust_location;
1027         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
1028       } else {
1029         my $prefix =
1030           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1031           ? 'ship_'
1032           : '';
1033         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
1034       }
1035
1036       $taxhash{'taxclass'} = $part_pkg->taxclass;
1037
1038       my @taxes = ();
1039       my %taxhash_elim = %taxhash;
1040       my @elim = qw( city county state );
1041       do {
1042
1043         #first try a match with taxclass
1044         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1045
1046         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1047           #then try a match without taxclass
1048           my %no_taxclass = %taxhash_elim;
1049           $no_taxclass{ 'taxclass' } = '';
1050           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1051         }
1052
1053         $taxhash_elim{ shift(@elim) } = '';
1054
1055       } while ( !scalar(@taxes) && scalar(@elim) );
1056
1057       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
1058                     @taxes
1059         if $self->cust_main_exemption; #just to be safe
1060
1061       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1062         foreach (@taxes) {
1063           $_->set('pkgnum',      $cust_pkg->pkgnum );
1064           $_->set('locationnum', $cust_pkg->locationnum );
1065         }
1066       }
1067
1068       $taxes{''} = [ @taxes ];
1069       $taxes{'setup'} = [ @taxes ];
1070       $taxes{'recur'} = [ @taxes ];
1071       $taxes{$_} = [ @taxes ] foreach (@classes);
1072
1073       # # maybe eliminate this entirely, along with all the 0% records
1074       # unless ( @taxes ) {
1075       #   return
1076       #     "fatal: can't find tax rate for state/county/country/taxclass ".
1077       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
1078       # }
1079
1080     } #if $conf->exists('enable_taxproducts') ...
1081
1082   }
1083
1084   my @display = ();
1085   my $separate = $conf->exists('separate_usage');
1086   my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
1087   my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
1088   my $section = $temp_pkg->part_pkg->categoryname;
1089   if ( $separate || $section || $usage_mandate ) {
1090
1091     my %hash = ( 'section' => $section );
1092
1093     $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
1094     my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
1095     if ( $separate ) {
1096       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1097       push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
1098     } else {
1099       push @display, new FS::cust_bill_pkg_display
1100                        { type => '',
1101                          %hash,
1102                          ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
1103                        };
1104     }
1105
1106     if ($separate && $section && $summary) {
1107       push @display, new FS::cust_bill_pkg_display { type    => 'U',
1108                                                      summary => 'Y',
1109                                                      %hash,
1110                                                    };
1111     }
1112     if ($usage_mandate || $section && $summary) {
1113       $hash{post_total} = 'Y';
1114     }
1115
1116     if ($separate || $usage_mandate) {
1117       $hash{section} = $section if ($separate || $usage_mandate);
1118       push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
1119     }
1120
1121   }
1122   $cust_bill_pkg->set('display', \@display);
1123
1124   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1125   foreach my $key (keys %tax_cust_bill_pkg) {
1126     my @taxes = @{ $taxes{$key} || [] };
1127     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1128
1129     my %localtaxlisthash = ();
1130     foreach my $tax ( @taxes ) {
1131
1132       my $taxname = ref( $tax ). ' '. $tax->taxnum;
1133 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
1134 #                  ' locationnum'. $cust_pkg->locationnum
1135 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
1136
1137       $taxlisthash->{ $taxname } ||= [ $tax ];
1138       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
1139
1140       $localtaxlisthash{ $taxname } ||= [ $tax ];
1141       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
1142
1143     }
1144
1145     warn "finding taxed taxes...\n" if $DEBUG > 2;
1146     foreach my $tax ( keys %localtaxlisthash ) {
1147       my $tax_object = shift @{ $localtaxlisthash{$tax} };
1148       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1149         if $DEBUG > 2;
1150       next unless $tax_object->can('tax_on_tax');
1151
1152       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1153         my $totname = ref( $tot ). ' '. $tot->taxnum;
1154
1155         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1156           if $DEBUG > 2;
1157         next unless exists( $localtaxlisthash{ $totname } ); # only increase
1158                                                              # existing taxes
1159         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1160         my $hashref_or_error =
1161           $tax_object->taxline( $localtaxlisthash{$tax},
1162                                 'custnum'      => $self->custnum,
1163                                 'invoice_time' => $invoice_time,
1164                               );
1165         return $hashref_or_error
1166           unless ref($hashref_or_error);
1167
1168         $taxlisthash->{ $totname } ||= [ $tot ];
1169         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
1170
1171       }
1172     }
1173
1174   }
1175
1176   '';
1177 }
1178
1179 sub _gather_taxes {
1180   my $self = shift;
1181   my $part_pkg = shift;
1182   my $class = shift;
1183
1184   my @taxes = ();
1185   my $geocode = $self->geocode('cch');
1186
1187   my @taxclassnums = map { $_->taxclassnum }
1188                      $part_pkg->part_pkg_taxoverride($class);
1189
1190   unless (@taxclassnums) {
1191     @taxclassnums = map { $_->taxclassnum }
1192                     grep { $_->taxable eq 'Y' }
1193                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1194   }
1195   warn "Found taxclassnum values of ". join(',', @taxclassnums)
1196     if $DEBUG;
1197
1198   my $extra_sql =
1199     "AND (".
1200     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1201
1202   @taxes = qsearch({ 'table' => 'tax_rate',
1203                      'hashref' => { 'geocode' => $geocode, },
1204                      'extra_sql' => $extra_sql,
1205                   })
1206     if scalar(@taxclassnums);
1207
1208   warn "Found taxes ".
1209        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1210    if $DEBUG;
1211
1212   [ @taxes ];
1213
1214 }
1215
1216 =item collect [ HASHREF | OPTION => VALUE ... ]
1217
1218 (Attempt to) collect money for this customer's outstanding invoices (see
1219 L<FS::cust_bill>).  Usually used after the bill method.
1220
1221 Actions are now triggered by billing events; see L<FS::part_event> and the
1222 billing events web interface.  Old-style invoice events (see
1223 L<FS::part_bill_event>) have been deprecated.
1224
1225 If there is an error, returns the error, otherwise returns false.
1226
1227 Options are passed as name-value pairs.
1228
1229 Currently available options are:
1230
1231 =over 4
1232
1233 =item invoice_time
1234
1235 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.
1236
1237 =item retry
1238
1239 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1240
1241 =item check_freq
1242
1243 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1244
1245 =item quiet
1246
1247 set true to surpress email card/ACH decline notices.
1248
1249 =item debug
1250
1251 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)
1252
1253 =back
1254
1255 # =item payby
1256 #
1257 # allows for one time override of normal customer billing method
1258
1259 =cut
1260
1261 sub collect {
1262   my( $self, %options ) = @_;
1263   my $invoice_time = $options{'invoice_time'} || time;
1264
1265   #put below somehow?
1266   local $SIG{HUP} = 'IGNORE';
1267   local $SIG{INT} = 'IGNORE';
1268   local $SIG{QUIT} = 'IGNORE';
1269   local $SIG{TERM} = 'IGNORE';
1270   local $SIG{TSTP} = 'IGNORE';
1271   local $SIG{PIPE} = 'IGNORE';
1272
1273   my $oldAutoCommit = $FS::UID::AutoCommit;
1274   local $FS::UID::AutoCommit = 0;
1275   my $dbh = dbh;
1276
1277   $self->select_for_update; #mutex
1278
1279   if ( $DEBUG ) {
1280     my $balance = $self->balance;
1281     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1282   }
1283
1284   if ( exists($options{'retry_card'}) ) {
1285     carp 'retry_card option passed to collect is deprecated; use retry';
1286     $options{'retry'} ||= $options{'retry_card'};
1287   }
1288   if ( exists($options{'retry'}) && $options{'retry'} ) {
1289     my $error = $self->retry_realtime;
1290     if ( $error ) {
1291       $dbh->rollback if $oldAutoCommit;
1292       return $error;
1293     }
1294   }
1295
1296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1297
1298   #never want to roll back an event just because it returned an error
1299   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1300
1301   $self->do_cust_event(
1302     'debug'      => ( $options{'debug'} || 0 ),
1303     'time'       => $invoice_time,
1304     'check_freq' => $options{'check_freq'},
1305     'stage'      => 'collect',
1306   );
1307
1308 }
1309
1310
1311 =item apply_payments_and_credits [ OPTION => VALUE ... ]
1312
1313 Applies unapplied payments and credits.
1314
1315 In most cases, this new method should be used in place of sequential
1316 apply_payments and apply_credits methods.
1317
1318 A hash of optional arguments may be passed.  Currently "manual" is supported.
1319 If true, a payment receipt is sent instead of a statement when
1320 'payment_receipt_email' configuration option is set.
1321
1322 If there is an error, returns the error, otherwise returns false.
1323
1324 =cut
1325
1326 sub apply_payments_and_credits {
1327   my( $self, %options ) = @_;
1328
1329   local $SIG{HUP} = 'IGNORE';
1330   local $SIG{INT} = 'IGNORE';
1331   local $SIG{QUIT} = 'IGNORE';
1332   local $SIG{TERM} = 'IGNORE';
1333   local $SIG{TSTP} = 'IGNORE';
1334   local $SIG{PIPE} = 'IGNORE';
1335
1336   my $oldAutoCommit = $FS::UID::AutoCommit;
1337   local $FS::UID::AutoCommit = 0;
1338   my $dbh = dbh;
1339
1340   $self->select_for_update; #mutex
1341
1342   foreach my $cust_bill ( $self->open_cust_bill ) {
1343     my $error = $cust_bill->apply_payments_and_credits(%options);
1344     if ( $error ) {
1345       $dbh->rollback if $oldAutoCommit;
1346       return "Error applying: $error";
1347     }
1348   }
1349
1350   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1351   ''; #no error
1352
1353 }
1354
1355 =item apply_credits OPTION => VALUE ...
1356
1357 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1358 to outstanding invoice balances in chronological order (or reverse
1359 chronological order if the I<order> option is set to B<newest>) and returns the
1360 value of any remaining unapplied credits available for refund (see
1361 L<FS::cust_refund>).
1362
1363 Dies if there is an error.
1364
1365 =cut
1366
1367 sub apply_credits {
1368   my $self = shift;
1369   my %opt = @_;
1370
1371   local $SIG{HUP} = 'IGNORE';
1372   local $SIG{INT} = 'IGNORE';
1373   local $SIG{QUIT} = 'IGNORE';
1374   local $SIG{TERM} = 'IGNORE';
1375   local $SIG{TSTP} = 'IGNORE';
1376   local $SIG{PIPE} = 'IGNORE';
1377
1378   my $oldAutoCommit = $FS::UID::AutoCommit;
1379   local $FS::UID::AutoCommit = 0;
1380   my $dbh = dbh;
1381
1382   $self->select_for_update; #mutex
1383
1384   unless ( $self->total_unapplied_credits ) {
1385     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1386     return 0;
1387   }
1388
1389   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1390       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1391
1392   my @invoices = $self->open_cust_bill;
1393   @invoices = sort { $b->_date <=> $a->_date } @invoices
1394     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
1395
1396   if ( $conf->exists('pkg-balances') ) {
1397     # limit @credits to those w/ a pkgnum grepped from $self
1398     my %pkgnums = ();
1399     foreach my $i (@invoices) {
1400       foreach my $li ( $i->cust_bill_pkg ) {
1401         $pkgnums{$li->pkgnum} = 1;
1402       }
1403     }
1404     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
1405   }
1406
1407   my $credit;
1408
1409   foreach my $cust_bill ( @invoices ) {
1410
1411     if ( !defined($credit) || $credit->credited == 0) {
1412       $credit = pop @credits or last;
1413     }
1414
1415     my $owed;
1416     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
1417       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
1418     } else {
1419       $owed = $cust_bill->owed;
1420     }
1421     unless ( $owed > 0 ) {
1422       push @credits, $credit;
1423       next;
1424     }
1425
1426     my $amount = min( $credit->credited, $owed );
1427
1428     my $cust_credit_bill = new FS::cust_credit_bill ( {
1429       'crednum' => $credit->crednum,
1430       'invnum'  => $cust_bill->invnum,
1431       'amount'  => $amount,
1432     } );
1433     $cust_credit_bill->pkgnum( $credit->pkgnum )
1434       if $conf->exists('pkg-balances') && $credit->pkgnum;
1435     my $error = $cust_credit_bill->insert;
1436     if ( $error ) {
1437       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1438       die $error;
1439     }
1440
1441     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
1442
1443   }
1444
1445   my $total_unapplied_credits = $self->total_unapplied_credits;
1446
1447   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1448
1449   return $total_unapplied_credits;
1450 }
1451
1452 =item apply_payments  [ OPTION => VALUE ... ]
1453
1454 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
1455 to outstanding invoice balances in chronological order.
1456
1457  #and returns the value of any remaining unapplied payments.
1458
1459 A hash of optional arguments may be passed.  Currently "manual" is supported.
1460 If true, a payment receipt is sent instead of a statement when
1461 'payment_receipt_email' configuration option is set.
1462
1463 Dies if there is an error.
1464
1465 =cut
1466
1467 sub apply_payments {
1468   my( $self, %options ) = @_;
1469
1470   local $SIG{HUP} = 'IGNORE';
1471   local $SIG{INT} = 'IGNORE';
1472   local $SIG{QUIT} = 'IGNORE';
1473   local $SIG{TERM} = 'IGNORE';
1474   local $SIG{TSTP} = 'IGNORE';
1475   local $SIG{PIPE} = 'IGNORE';
1476
1477   my $oldAutoCommit = $FS::UID::AutoCommit;
1478   local $FS::UID::AutoCommit = 0;
1479   my $dbh = dbh;
1480
1481   $self->select_for_update; #mutex
1482
1483   #return 0 unless
1484
1485   my @payments = sort { $b->_date <=> $a->_date }
1486                  grep { $_->unapplied > 0 }
1487                  $self->cust_pay;
1488
1489   my @invoices = sort { $a->_date <=> $b->_date}
1490                  grep { $_->owed > 0 }
1491                  $self->cust_bill;
1492
1493   if ( $conf->exists('pkg-balances') ) {
1494     # limit @payments to those w/ a pkgnum grepped from $self
1495     my %pkgnums = ();
1496     foreach my $i (@invoices) {
1497       foreach my $li ( $i->cust_bill_pkg ) {
1498         $pkgnums{$li->pkgnum} = 1;
1499       }
1500     }
1501     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
1502   }
1503
1504   my $payment;
1505
1506   foreach my $cust_bill ( @invoices ) {
1507
1508     if ( !defined($payment) || $payment->unapplied == 0 ) {
1509       $payment = pop @payments or last;
1510     }
1511
1512     my $owed;
1513     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
1514       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
1515     } else {
1516       $owed = $cust_bill->owed;
1517     }
1518     unless ( $owed > 0 ) {
1519       push @payments, $payment;
1520       next;
1521     }
1522
1523     my $amount = min( $payment->unapplied, $owed );
1524
1525     my $cust_bill_pay = new FS::cust_bill_pay ( {
1526       'paynum' => $payment->paynum,
1527       'invnum' => $cust_bill->invnum,
1528       'amount' => $amount,
1529     } );
1530     $cust_bill_pay->pkgnum( $payment->pkgnum )
1531       if $conf->exists('pkg-balances') && $payment->pkgnum;
1532     my $error = $cust_bill_pay->insert(%options);
1533     if ( $error ) {
1534       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
1535       die $error;
1536     }
1537
1538     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
1539
1540   }
1541
1542   my $total_unapplied_payments = $self->total_unapplied_payments;
1543
1544   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1545
1546   return $total_unapplied_payments;
1547 }
1548
1549 1;