1 package FS::cust_main::Billing;
4 use vars qw( $conf $DEBUG $me );
7 use List::Util qw( min );
9 use FS::Record qw( qsearch qsearchs dbdef );
10 use FS::Misc::DateTime qw( day_end );
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;
18 use FS::tax_rate_location;
19 use FS::cust_bill_pkg_tax_location;
20 use FS::cust_bill_pkg_tax_rate_location;
22 use FS::part_event_condition;
24 use FS::cust_event_fee;
27 # 1 is mostly method/subroutine entry and options
28 # 2 traces progress of some operations
29 # 3 is even more information including possibly sensitive data
31 $me = '[FS::cust_main::Billing]';
33 install_callback FS::UID sub {
35 #yes, need it for stuff below (prolly should be cached)
40 FS::cust_main::Billing - Billing mixin for cust_main
46 These methods are available on FS::cust_main objects.
52 =item bill_and_collect
54 Cancels and suspends any packages due, generates bills, applies payments and
55 credits, and applies collection events to run cards, send bills and notices,
58 By default, warns on errors and continues with the next operation (but see the
61 Options are passed as name-value pairs. Currently available options are:
67 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:
71 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
75 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.
79 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
83 If set true, re-charges setup fees.
87 If set any errors prevent subsequent operations from continusing. If set
88 specifically to "return", returns the error (or false, if there is no error).
89 Any other true value causes errors to die.
93 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)
97 Optional FS::queue entry to receive status updates.
101 Options are passed to the B<bill> and B<collect> methods verbatim, so all
102 options of those methods are also available.
106 sub bill_and_collect {
107 my( $self, %options ) = @_;
109 my $log = FS::Log->new('bill_and_collect');
110 $log->debug('start', object => $self, agentnum => $self->agentnum);
114 #$options{actual_time} not $options{time} because freeside-daily -d is for
115 #pre-printing invoices
117 $options{'actual_time'} ||= time;
118 my $job = $options{'job'};
120 my $actual_time = ( $conf->exists('next-bill-ignore-time')
121 ? day_end( $options{actual_time} )
122 : $options{actual_time}
125 $job->update_statustext('0,cleaning expired packages') if $job;
126 $error = $self->cancel_expired_pkgs( $actual_time );
128 $error = "Error expiring custnum ". $self->custnum. ": $error";
129 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
130 elsif ( $options{fatal} ) { die $error; }
131 else { warn $error; }
134 $error = $self->suspend_adjourned_pkgs( $actual_time );
136 $error = "Error adjourning custnum ". $self->custnum. ": $error";
137 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
138 elsif ( $options{fatal} ) { die $error; }
139 else { warn $error; }
142 $error = $self->unsuspend_resumed_pkgs( $actual_time );
144 $error = "Error resuming custnum ".$self->custnum. ": $error";
145 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
146 elsif ( $options{fatal} ) { die $error; }
147 else { warn $error; }
150 $job->update_statustext('20,billing packages') if $job;
151 $error = $self->bill( %options );
153 $error = "Error billing custnum ". $self->custnum. ": $error";
154 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
155 elsif ( $options{fatal} ) { die $error; }
156 else { warn $error; }
159 $job->update_statustext('50,applying payments and credits') if $job;
160 $error = $self->apply_payments_and_credits;
162 $error = "Error applying custnum ". $self->custnum. ": $error";
163 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
164 elsif ( $options{fatal} ) { die $error; }
165 else { warn $error; }
168 $job->update_statustext('70,running collection events') if $job;
169 unless ( $conf->exists('cancelled_cust-noevents')
170 && ! $self->num_ncancelled_pkgs
172 $error = $self->collect( %options );
174 $error = "Error collecting custnum ". $self->custnum. ": $error";
175 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
176 elsif ($options{fatal} ) { die $error; }
177 else { warn $error; }
180 $job->update_statustext('100,finished') if $job;
181 $log->debug('finish', object => $self, agentnum => $self->agentnum);
187 sub cancel_expired_pkgs {
188 my ( $self, $time, %options ) = @_;
190 my @cancel_pkgs = $self->ncancelled_pkgs( {
191 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
196 CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
197 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
200 if ( $cust_pkg->change_to_pkgnum ) {
202 my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
204 push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
205 $cust_pkg->change_to_pkgnum.'; not expiring';
208 $error = $cust_pkg->change( 'cust_pkg' => $new_pkg,
209 'unprotect_svcs' => 1 );
210 $error = '' if ref $error eq 'FS::cust_pkg';
212 } else { # just cancel it
213 $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
214 'reason_otaker' => $cpr->otaker,
220 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
223 join(' / ', @errors);
227 sub suspend_adjourned_pkgs {
228 my ( $self, $time, %options ) = @_;
230 my @susp_pkgs = $self->ncancelled_pkgs( {
232 " AND ( susp IS NULL OR susp = 0 )
233 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
234 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
239 #only because there's no SQL test for is_prepaid :/
241 grep { ( $_->part_pkg->is_prepaid
246 && $_->adjourn <= $time
254 foreach my $cust_pkg ( @susp_pkgs ) {
255 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
256 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
257 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
258 'reason_otaker' => $cpr->otaker
262 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
265 join(' / ', @errors);
269 sub unsuspend_resumed_pkgs {
270 my ( $self, $time, %options ) = @_;
272 my @unsusp_pkgs = $self->ncancelled_pkgs( {
273 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
278 foreach my $cust_pkg ( @unsusp_pkgs ) {
279 my $error = $cust_pkg->unsuspend( 'time' => $time );
280 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
283 join(' / ', @errors);
289 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
290 conjunction with the collect method by calling B<bill_and_collect>.
292 If there is an error, returns the error, otherwise returns false.
294 Options are passed as name-value pairs. Currently available options are:
300 If set true, re-charges setup fees.
304 If set true then only bill recurring charges, not setup, usage, one time
309 If set, then override the normal frequency and look for a part_pkg_discount
310 to take at that frequency. This is appropriate only when the normal
311 frequency for all packages is monthly, and is an error otherwise. Use
312 C<pkg_list> to limit the set of packages included in billing.
316 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:
320 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
324 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
326 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
330 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
334 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.
338 This boolean value informs the us that the package is being cancelled. This
339 typically might mean not charging the normal recurring fee but only usage
340 fees since the last billing. Setup charges may be charged. Not all package
341 plans support this feature (they tend to charge 0).
345 Prevent the resetting of usage limits during this call.
349 Do not save the generated bill in the database. Useful with return_bill
353 A list reference on which the generated bill(s) will be returned.
357 Optional terms to be printed on this invoice. Otherwise, customer-specific
358 terms or the default terms are used.
365 my( $self, %options ) = @_;
367 return '' if $self->payby eq 'COMP';
369 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
371 warn "$me bill customer ". $self->custnum. "\n"
374 my $time = $options{'time'} || time;
375 my $invoice_time = $options{'invoice_time'} || $time;
377 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
382 $options{'not_pkgpart'} ||= {};
383 $options{'not_pkgpart'} = { map { $_ => 1 }
384 split(/\s*,\s*/, $options{'not_pkgpart'})
386 unless ref($options{'not_pkgpart'});
388 local $SIG{HUP} = 'IGNORE';
389 local $SIG{INT} = 'IGNORE';
390 local $SIG{QUIT} = 'IGNORE';
391 local $SIG{TERM} = 'IGNORE';
392 local $SIG{TSTP} = 'IGNORE';
393 local $SIG{PIPE} = 'IGNORE';
395 my $oldAutoCommit = $FS::UID::AutoCommit;
396 local $FS::UID::AutoCommit = 0;
399 warn "$me acquiring lock on customer ". $self->custnum. "\n"
402 $self->select_for_update; #mutex
404 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
407 my $error = $self->do_cust_event(
408 'debug' => ( $options{'debug'} || 0 ),
409 'time' => $invoice_time,
410 'check_freq' => $options{'check_freq'},
411 'stage' => 'pre-bill',
413 unless $options{no_commit};
415 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
419 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
422 #keep auto-charge and non-auto-charge line items separate
423 my @passes = ( '', 'no_auto' );
425 my %cust_bill_pkg = map { $_ => [] } @passes;
428 # find the packages which are due for billing, find out how much they are
429 # & generate invoice database.
432 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
433 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
435 my %taxlisthash = map { $_ => {} } @passes;
437 my @precommit_hooks = ();
439 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
441 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
443 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
445 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
447 #? to avoid use of uninitialized value errors... ?
448 $cust_pkg->setfield('bill', '')
449 unless defined($cust_pkg->bill);
451 #my $part_pkg = $cust_pkg->part_pkg;
453 my $real_pkgpart = $cust_pkg->pkgpart;
454 my %hash = $cust_pkg->hash;
456 # we could implement this bit as FS::part_pkg::has_hidden, but we already
457 # suffer from performance issues
458 $options{has_hidden} = 0;
459 my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
460 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
462 # if this package was changed from another package,
463 # and it hasn't been billed since then,
464 # and package balances are enabled,
465 if ( $cust_pkg->change_pkgnum
466 and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
467 and $cust_pkg->change_date < $invoice_time
468 and $conf->exists('pkg-balances') )
470 # _transfer_balance will also create the appropriate credit
471 my @transfer_items = $self->_transfer_balance($cust_pkg);
472 # $part_pkg[0] is the "real" part_pkg
473 my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
475 push @{ $cust_bill_pkg{$pass} }, @transfer_items;
476 # treating this as recur, just because most charges are recur...
477 ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
480 foreach my $part_pkg ( @part_pkg ) {
482 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
484 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
486 my $next_bill = $cust_pkg->getfield('bill') || 0;
488 # let this run once if this is the last bill upon cancellation
489 while ( $next_bill <= $cmp_time or $options{cancel} ) {
491 $self->_make_lines( 'part_pkg' => $part_pkg,
492 'cust_pkg' => $cust_pkg,
493 'precommit_hooks' => \@precommit_hooks,
494 'line_items' => $cust_bill_pkg{$pass},
495 'setup' => $total_setup{$pass},
496 'recur' => $total_recur{$pass},
497 'tax_matrix' => $taxlisthash{$pass},
499 'real_pkgpart' => $real_pkgpart,
500 'options' => \%options,
503 # Stop if anything goes wrong
506 # or if we're not incrementing the bill date.
507 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
509 # or if we're letting it run only once
510 last if $options{cancel};
512 $next_bill = $cust_pkg->getfield('bill') || 0;
514 #stop if -o was passed to freeside-daily
515 last if $options{'one_recur'};
518 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
522 } #foreach my $part_pkg
524 } #foreach my $cust_pkg
526 #if the customer isn't on an automatic payby, everything can go on a single
528 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
529 #merge everything into one list
532 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
534 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
536 warn "$me billing pass $pass\n"
537 #.Dumper(\@cust_bill_pkg)."\n"
544 my @pending_event_fees = FS::cust_event_fee->by_cust($self->custnum,
545 hashref => { 'billpkgnum' => '' }
547 warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n"
548 if @pending_event_fees and $DEBUG > 1;
550 # determine whether to generate an invoice
551 my $generate_bill = scalar(@cust_bill_pkg) > 0;
553 foreach my $event_fee (@pending_event_fees) {
554 $generate_bill = 1 unless $event_fee->nextbill;
557 # don't create an invoice with no line items, or where the only line
558 # items are fees that are supposed to be held until the next invoice
559 next if !$generate_bill;
563 foreach my $event_fee (@pending_event_fees) {
564 my $object = $event_fee->cust_event->cust_X;
565 my $part_fee = $event_fee->part_fee;
567 if ( $object->isa('FS::cust_main') ) {
568 # Not the real cust_bill object that will be inserted--in particular
569 # there are no taxes yet. If you want to charge a fee on the total
570 # invoice amount including taxes, you have to put the fee on the next
572 $cust_bill = FS::cust_bill->new({
573 'custnum' => $self->custnum,
574 'cust_bill_pkg' => \@cust_bill_pkg,
575 'charged' => ${ $total_setup{$pass} } +
576 ${ $total_recur{$pass} },
578 } elsif ( $object->isa('FS::cust_bill') ) {
579 # simple case: applying the fee to a previous invoice (late fee,
581 $cust_bill = $object;
583 # if the fee def belongs to a different agent, don't charge the fee.
584 # event conditions should prevent this, but just in case they don't,
586 if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
587 warn "tried to charge fee#".$part_fee->feepart .
588 " on customer#".$self->custnum." from a different agent.\n";
591 # also skip if it's disabled
592 next if $part_fee->disabled eq 'Y';
594 my $fee_item = $event_fee->part_fee->lineitem($cust_bill);
595 # link this so that we can clear the marker on inserting the line item
596 $fee_item->set('cust_event_fee', $event_fee);
597 push @fee_items, $fee_item;
601 # add fees to the invoice
602 foreach my $fee_item (@fee_items) {
604 push @cust_bill_pkg, $fee_item;
605 ${ $total_setup{$pass} } += $fee_item->setup;
606 ${ $total_recur{$pass} } += $fee_item->recur;
608 my $part_fee = $fee_item->part_fee;
609 my $fee_location = $self->ship_location; # I think?
611 my $error = $self->_handle_taxes(
614 location => $fee_location
616 return $error if $error;
620 # XXX implementation of fees is supposed to make this go away...
621 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
622 !$conf->exists('postal_invoice-recurring_only')
626 my $postal_pkg = $self->charge_postal_fee();
627 if ( $postal_pkg && !ref( $postal_pkg ) ) {
629 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
630 return "can't charge postal invoice fee for customer ".
631 $self->custnum. ": $postal_pkg";
633 } elsif ( $postal_pkg ) {
635 my $real_pkgpart = $postal_pkg->pkgpart;
636 # we could implement this bit as FS::part_pkg::has_hidden, but we already
637 # suffer from performance issues
638 $options{has_hidden} = 0;
639 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
640 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
642 foreach my $part_pkg ( @part_pkg ) {
643 my %postal_options = %options;
644 delete $postal_options{cancel};
646 $self->_make_lines( 'part_pkg' => $part_pkg,
647 'cust_pkg' => $postal_pkg,
648 'precommit_hooks' => \@precommit_hooks,
649 'line_items' => \@cust_bill_pkg,
650 'setup' => $total_setup{$pass},
651 'recur' => $total_recur{$pass},
652 'tax_matrix' => $taxlisthash{$pass},
654 'real_pkgpart' => $real_pkgpart,
655 'options' => \%postal_options,
658 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
663 # it's silly to have a zero value postal_pkg, but....
664 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
670 my $listref_or_error =
671 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
673 unless ( ref( $listref_or_error ) ) {
674 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
675 return $listref_or_error;
678 foreach my $taxline ( @$listref_or_error ) {
679 ${ $total_setup{$pass} } =
680 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
681 push @cust_bill_pkg, $taxline;
685 warn "adding tax adjustments...\n" if $DEBUG > 2;
686 foreach my $cust_tax_adjustment (
687 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
693 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
695 my $itemdesc = $cust_tax_adjustment->taxname;
696 $itemdesc = '' if $itemdesc eq 'Tax';
698 push @cust_bill_pkg, new FS::cust_bill_pkg {
704 'itemdesc' => $itemdesc,
705 'itemcomment' => $cust_tax_adjustment->comment,
706 'cust_tax_adjustment' => $cust_tax_adjustment,
707 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
712 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
714 my @cust_bill = $self->cust_bill;
715 my $balance = $self->balance;
716 my $previous_bill = $cust_bill[-1] if @cust_bill;
717 my $previous_balance = 0;
718 if ( $previous_bill ) {
719 $previous_balance = $previous_bill->billing_balance
720 + $previous_bill->charged;
723 warn "creating the new invoice\n" if $DEBUG;
724 #create the new invoice
725 my $cust_bill = new FS::cust_bill ( {
726 'custnum' => $self->custnum,
727 '_date' => $invoice_time,
728 'charged' => $charged,
729 'billing_balance' => $balance,
730 'previous_balance' => $previous_balance,
731 'invoice_terms' => $options{'invoice_terms'},
732 'cust_bill_pkg' => \@cust_bill_pkg,
734 $error = $cust_bill->insert unless $options{no_commit};
736 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
737 return "can't create invoice for customer #". $self->custnum. ": $error";
739 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
741 } #foreach my $pass ( keys %cust_bill_pkg )
743 foreach my $hook ( @precommit_hooks ) {
746 } unless $options{no_commit};
748 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
749 return "$@ running precommit hook $hook\n";
753 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
758 #discard bundled packages of 0 value
759 sub _omit_zero_value_bundles {
762 my @cust_bill_pkg = ();
763 my @cust_bill_pkg_bundle = ();
765 my $discount_show_always = 0;
767 foreach my $cust_bill_pkg ( @in ) {
769 $discount_show_always = ($cust_bill_pkg->get('discounts')
770 && scalar(@{$cust_bill_pkg->get('discounts')})
771 && $conf->exists('discount-show-always'));
773 warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
774 "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
775 "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
778 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
779 push @cust_bill_pkg, @cust_bill_pkg_bundle
781 || ($sum == 0 && ( $discount_show_always
782 || grep {$_->recur_show_zero || $_->setup_show_zero}
783 @cust_bill_pkg_bundle
786 @cust_bill_pkg_bundle = ();
790 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
791 push @cust_bill_pkg_bundle, $cust_bill_pkg;
795 push @cust_bill_pkg, @cust_bill_pkg_bundle
797 || ($sum == 0 && ( $discount_show_always
798 || grep {$_->recur_show_zero || $_->setup_show_zero}
799 @cust_bill_pkg_bundle
803 warn " _omit_zero_value_bundles: ". scalar(@in).
804 '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
811 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
813 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
814 Usually used internally by bill method B<bill>.
816 If there is an error, returns the error, otherwise returns reference to a
817 list of line items suitable for insertion.
823 An array ref of the line items being billed.
827 A strange beast. The keys to this hash are internal identifiers consisting
828 of the name of the tax object type, a space, and its unique identifier ( e.g.
829 'cust_main_county 23' ). The values of the hash are listrefs. The first
830 item in the list is the tax object. The remaining items are either line
831 items or floating point values (currency amounts).
833 The taxes are calculated on this entity. Calculated exemption records are
834 transferred to the LINEITEMREF items on the assumption that they are related.
840 This specifies the date appearing on the associated invoice. Some
841 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
847 sub calculate_taxes {
848 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
850 # $taxlisthash is a hashref
851 # keys are identifiers, values are arrayrefs
852 # each arrayref starts with a tax object (cust_main_county or tax_rate)
853 # then any cust_bill_pkg objects the tax applies to
855 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
857 warn "$me calculate_taxes\n"
858 #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
861 my @tax_line_items = ();
863 # keys are tax names (as printed on invoices / itemdesc )
864 # values are arrayrefs of taxlisthash keys (internal identifiers)
867 # keys are taxlisthash keys (internal identifiers)
868 # values are (cumulative) amounts
871 # keys are taxlisthash keys (internal identifiers)
872 # values are arrayrefs of cust_bill_pkg_tax_location hashrefs
873 my %tax_location = ();
875 # keys are taxlisthash keys (internal identifiers)
876 # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs
877 my %tax_rate_location = ();
879 # keys are taxlisthash keys (internal identifiers!)
880 # values are arrayrefs of cust_tax_exempt_pkg objects
883 foreach my $tax ( keys %$taxlisthash ) {
884 # $tax is a tax identifier (intersection of a tax definition record
885 # and a cust_bill_pkg record)
886 my $tax_object = shift @{ $taxlisthash->{$tax} };
887 # $tax_object is a cust_main_county or tax_rate
888 # (with billpkgnum, pkgnum, locationnum set)
889 # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg component objects
890 # (setup, recurring, usage classes)
891 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
892 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
893 # taxline calculates the tax on all cust_bill_pkgs in the
894 # first (arrayref) argument, and returns a hashref of 'name'
895 # (the line item description) and 'amount'.
896 # It also calculates exemptions and attaches them to the cust_bill_pkgs
898 my $taxables = $taxlisthash->{$tax};
899 my $exemptions = $tax_exemption{$tax} ||= [];
900 my $taxline = $tax_object->taxline(
902 'custnum' => $self->custnum,
903 'invoice_time' => $invoice_time,
904 'exemptions' => $exemptions,
906 return $taxline unless ref($taxline);
908 unshift @{ $taxlisthash->{$tax} }, $tax_object;
910 if ( $tax_object->isa('FS::cust_main_county') ) {
911 # then $taxline is a real line item
912 push @{ $taxname{ $taxline->itemdesc } }, $taxline;
915 # leave this as is for now
917 my $name = $taxline->{'name'};
918 my $amount = $taxline->{'amount'};
920 #warn "adding $amount as $name\n";
921 $taxname{ $name } ||= [];
922 push @{ $taxname{ $name } }, $tax;
924 $tax_amount{ $tax } += $amount;
926 # link records between cust_main_county/tax_rate and cust_location
927 $tax_rate_location{ $tax } ||= [];
928 my $taxratelocationnum =
929 $tax_object->tax_rate_location->taxratelocationnum;
930 push @{ $tax_rate_location{ $tax } },
932 'taxnum' => $tax_object->taxnum,
933 'taxtype' => ref($tax_object),
934 'amount' => sprintf('%.2f', $amount ),
935 'locationtaxid' => $tax_object->location,
936 'taxratelocationnum' => $taxratelocationnum,
938 } #if ref($tax_object)...
939 } #foreach keys %$taxlisthash
941 #consolidate and create tax line items
942 warn "consolidating and generating...\n" if $DEBUG > 2;
943 foreach my $taxname ( keys %taxname ) {
944 my @cust_bill_pkg_tax_location;
945 my @cust_bill_pkg_tax_rate_location;
946 my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({
951 'itemdesc' => $taxname,
952 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
953 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
958 warn "adding $taxname\n" if $DEBUG > 1;
959 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
960 if ( ref($taxitem) eq 'FS::cust_bill_pkg' ) {
961 # then we need to transfer the amount and the links from the
962 # line item to the new one we're creating.
963 $tax_total += $taxitem->setup;
964 foreach my $link ( @{ $taxitem->get('cust_bill_pkg_tax_location') } ) {
965 $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg);
966 push @cust_bill_pkg_tax_location, $link;
970 next if $seen{$taxitem}++;
971 warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1;
972 $tax_total += $tax_amount{$taxitem};
973 push @cust_bill_pkg_tax_rate_location,
974 map { new FS::cust_bill_pkg_tax_rate_location $_ }
975 @{ $tax_rate_location{ $taxitem } };
978 next unless $tax_total;
980 # we should really neverround this up...I guess it's okay if taxline
981 # already returns amounts with 2 decimal places
982 $tax_total = sprintf('%.2f', $tax_total );
983 $tax_cust_bill_pkg->set('setup', $tax_total);
985 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
991 if ( $pkg_category and
992 $conf->config('invoice_latexsummary') ||
993 $conf->config('invoice_htmlsummary')
997 my %hash = ( 'section' => $pkg_category->categoryname );
998 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1001 $tax_cust_bill_pkg->set('display', \@display);
1003 push @tax_line_items, $tax_cust_bill_pkg;
1010 my ($self, %params) = @_;
1012 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1014 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
1015 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
1016 my $cust_location = $cust_pkg->tax_location;
1017 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
1018 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
1019 my $total_setup = $params{setup} or die "no setup accumulator specified";
1020 my $total_recur = $params{recur} or die "no recur accumulator specified";
1021 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
1022 my $time = $params{'time'} or die "no time specified";
1023 my (%options) = %{$params{options}};
1025 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
1026 # this should never happen
1027 die 'freq_override billing attempted on non-monthly package '.
1032 my $real_pkgpart = $params{real_pkgpart};
1033 my %hash = $cust_pkg->hash;
1034 my $old_cust_pkg = new FS::cust_pkg \%hash;
1039 $cust_pkg->pkgpart($part_pkg->pkgpart);
1041 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1052 my @setup_discounts = ();
1053 my %setup_param = ( 'discounts' => \@setup_discounts );
1054 if ( ! $options{recurring_only}
1055 and ! $options{cancel}
1056 and ( $options{'resetup'}
1057 || ( ! $cust_pkg->setup
1058 && ( ! $cust_pkg->start_date
1059 || $cust_pkg->start_date <= $cmp_time
1061 && ( ! $conf->exists('disable_setup_suspended_pkgs')
1062 || ( $conf->exists('disable_setup_suspended_pkgs') &&
1063 ! $cust_pkg->getfield('susp')
1071 warn " bill setup\n" if $DEBUG > 1;
1073 unless ( $cust_pkg->waive_setup ) {
1076 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1077 return "$@ running calc_setup for $cust_pkg\n"
1080 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
1083 $cust_pkg->setfield('setup', $time)
1084 unless $cust_pkg->setup;
1085 #do need it, but it won't get written to the db
1086 #|| $cust_pkg->pkgpart != $real_pkgpart;
1088 $cust_pkg->setfield('start_date', '')
1089 if $cust_pkg->start_date;
1094 # bill recurring fee
1099 my @recur_discounts = ();
1101 if ( ! $cust_pkg->start_date
1102 and ( ! $cust_pkg->susp || $cust_pkg->option('suspend_bill',1)
1103 || ( $part_pkg->option('suspend_bill', 1) )
1104 && ! $cust_pkg->option('no_suspend_bill',1)
1107 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1108 || ( $part_pkg->plan eq 'voip_cdr'
1109 && $part_pkg->option('bill_every_call')
1114 # XXX should this be a package event? probably. events are called
1115 # at collection time at the moment, though...
1116 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1117 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1118 #don't want to reset usage just cause we want a line item??
1119 #&& $part_pkg->pkgpart == $real_pkgpart;
1121 warn " bill recur\n" if $DEBUG > 1;
1124 # XXX shared with $recur_prog
1125 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1129 #over two params! lets at least switch to a hashref for the rest...
1130 my $increment_next_bill = ( $part_pkg->freq ne '0'
1131 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1132 && !$options{cancel}
1134 my %param = ( %setup_param,
1135 'precommit_hooks' => $precommit_hooks,
1136 'increment_next_bill' => $increment_next_bill,
1137 'discounts' => \@recur_discounts,
1138 'real_pkgpart' => $real_pkgpart,
1139 'freq_override' => $options{freq_override} || '',
1143 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1145 # There may be some part_pkg for which this is wrong. Only those
1146 # which can_discount are supported.
1147 # (the UI should prevent adding discounts to these at the moment)
1149 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1150 " for pkgpart ". $cust_pkg->pkgpart.
1151 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1154 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1155 return "$@ running $method for $cust_pkg\n"
1159 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1161 if ( $increment_next_bill ) {
1165 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1166 # supplemental package
1167 # to keep in sync with the main package, simulate billing at
1169 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1170 my $supp_pkg_freq = $part_pkg->freq;
1171 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1172 if ( $ratio != int($ratio) ) {
1173 # the UI should prevent setting up packages like this, but just
1175 return "supplemental package period is not an integer multiple of main package period";
1177 $next_bill = $sdate;
1179 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1184 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1185 return "unparsable frequency: ". $part_pkg->freq
1186 if $next_bill == -1;
1189 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1190 # only for figuring next bill date, nothing else, so, reset $sdate again
1192 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1193 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1194 $cust_pkg->last_bill($sdate);
1196 $cust_pkg->setfield('bill', $next_bill );
1200 if ( $param{'setup_fee'} ) {
1201 # Add an additional setup fee at the billing stage.
1202 # Used for prorate_defer_bill.
1203 $setup += $param{'setup_fee'};
1204 $unitsetup += $param{'setup_fee'};
1208 if ( defined $param{'discount_left_setup'} ) {
1209 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1210 $setup -= $discount_setup;
1216 warn "\$setup is undefined" unless defined($setup);
1217 warn "\$recur is undefined" unless defined($recur);
1218 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1221 # If there's line items, create em cust_bill_pkg records
1222 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1227 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1228 # hmm.. and if just the options are modified in some weird price plan?
1230 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1233 my $error = $cust_pkg->replace( $old_cust_pkg,
1234 'depend_jobnum'=>$options{depend_jobnum},
1235 'options' => { $cust_pkg->options },
1237 unless $options{no_commit};
1238 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1239 if $error; #just in case
1242 $setup = sprintf( "%.2f", $setup );
1243 $recur = sprintf( "%.2f", $recur );
1244 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1245 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1247 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1248 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1251 my $discount_show_always = $conf->exists('discount-show-always')
1252 && ( ($setup == 0 && scalar(@setup_discounts))
1253 || ($recur == 0 && scalar(@recur_discounts))
1258 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1259 || $discount_show_always
1260 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1261 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1265 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1268 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1270 warn " adding customer package invoice detail: $_\n"
1271 foreach @cust_pkg_detail;
1273 push @details, @cust_pkg_detail;
1275 my $cust_bill_pkg = new FS::cust_bill_pkg {
1276 'pkgnum' => $cust_pkg->pkgnum,
1278 'unitsetup' => $unitsetup,
1280 'unitrecur' => $unitrecur,
1281 'quantity' => $cust_pkg->quantity,
1282 'details' => \@details,
1283 'discounts' => [ @setup_discounts, @recur_discounts ],
1284 'hidden' => $part_pkg->hidden,
1285 'freq' => $part_pkg->freq,
1288 if ( $part_pkg->option('prorate_defer_bill',1)
1289 and !$hash{last_bill} ) {
1290 # both preceding and upcoming, technically
1291 $cust_bill_pkg->sdate( $cust_pkg->setup );
1292 $cust_bill_pkg->edate( $cust_pkg->bill );
1293 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1294 $cust_bill_pkg->sdate( $hash{last_bill} );
1295 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1296 $cust_bill_pkg->edate( $time ) if $options{cancel};
1297 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1298 $cust_bill_pkg->sdate( $sdate );
1299 $cust_bill_pkg->edate( $cust_pkg->bill );
1300 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1303 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1304 unless $part_pkg->pkgpart == $real_pkgpart;
1306 $$total_setup += $setup;
1307 $$total_recur += $recur;
1313 my $error = $self->_handle_taxes( $taxlisthash, $cust_bill_pkg );
1314 return $error if $error;
1316 $cust_bill_pkg->set_display(
1317 part_pkg => $part_pkg,
1318 real_pkgpart => $real_pkgpart,
1321 push @$cust_bill_pkgs, $cust_bill_pkg;
1323 } #if $setup != 0 || $recur != 0
1331 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1333 Takes one argument, a cust_pkg object that is being billed. This will
1334 be called only if the package was created by a package change, and has
1335 not been billed since the package change, and package balance tracking
1336 is enabled. The second argument can be an alternate package number to
1337 transfer the balance from; this should not be used externally.
1339 Transfers the balance from the previous package (now canceled) to
1340 this package, by crediting one package and creating an invoice item for
1341 the other. Inserts the credit and returns the invoice item (so that it
1342 can be added to an invoice that's being built).
1344 If the previous package was never billed, and was also created by a package
1345 change, then this will also transfer the balance from I<its> previous
1346 package, and so on, until reaching a package that either has been billed
1347 or was not created by a package change.
1351 my $balance_transfer_reason;
1353 sub _transfer_balance {
1355 my $cust_pkg = shift;
1356 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1357 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1361 # if $from_pkg is not the first package in the chain, and it was never
1363 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1364 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1367 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1368 if ( $prev_balance != 0 ) {
1369 $balance_transfer_reason ||= FS::reason->new_or_existing(
1370 'reason' => 'Package balance transfer',
1371 'type' => 'Internal adjustment',
1375 my $credit = FS::cust_credit->new({
1376 'custnum' => $self->custnum,
1377 'amount' => abs($prev_balance),
1378 'reasonnum' => $balance_transfer_reason->reasonnum,
1379 '_date' => $cust_pkg->change_date,
1382 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1384 'recur' => abs($prev_balance),
1385 #'sdate' => $from_pkg->last_bill, # not sure about this
1386 #'edate' => $cust_pkg->change_date,
1387 'itemdesc' => $self->mt('Previous Balance, [_1]',
1388 $from_pkg->part_pkg->pkg),
1391 if ( $prev_balance > 0 ) {
1392 # credit the old package, charge the new one
1393 $credit->set('pkgnum', $from_pkgnum);
1394 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1397 $credit->set('pkgnum', $cust_pkg->pkgnum);
1398 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1400 my $error = $credit->insert;
1401 die "error transferring package balance from #".$from_pkgnum.
1402 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1404 push @transfers, $cust_bill_pkg;
1405 } # $prev_balance != 0
1410 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1412 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1415 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1418 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1419 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1422 'cust_main_county' can also be 'tax_rate'. The first object in the array
1423 is always the cust_main_county or tax_rate identified by the key.
1425 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1426 the 'taxline' method to calculate the amount of the tax. This doesn't
1427 happen until calculate_taxes, though.
1429 OPTIONS may include:
1430 - part_item: a part_pkg or part_fee object to be used as the package/fee
1432 - location: a cust_location to be used as the billing location.
1434 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1435 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1436 the customer's default service location).
1442 my $taxlisthash = shift;
1443 my $cust_bill_pkg = shift;
1446 # at this point I realize that we have enough information to infer all this
1447 # stuff, instead of passing around giant honking argument lists
1448 my $location = $options{location} || $cust_bill_pkg->tax_location;
1449 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1451 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1453 return if ( $self->payby eq 'COMP' ); #dubious
1455 if ( $conf->exists('enable_taxproducts')
1456 && ( scalar($part_item->part_pkg_taxoverride)
1457 || $part_item->has_taxproduct
1462 # EXTERNAL TAX RATES (via tax_rate)
1463 my %cust_bill_pkg = ();
1467 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1468 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1469 push @classes, 'setup' if $cust_bill_pkg->setup;
1470 push @classes, 'recur' if $cust_bill_pkg->recur;
1472 my $exempt = $conf->exists('cust_class-tax_exempt')
1473 ? ( $self->cust_class ? $self->cust_class->tax : '' )
1475 # standardize this just to be sure
1476 $exempt = ($exempt eq 'Y') ? 'Y' : '';
1480 foreach my $class (@classes) {
1481 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1482 return $err_or_ref unless ref($err_or_ref);
1483 $taxes{$class} = $err_or_ref;
1486 unless (exists $taxes{''}) {
1487 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1488 return $err_or_ref unless ref($err_or_ref);
1489 $taxes{''} = $err_or_ref;
1494 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; # grrr
1495 foreach my $key (keys %tax_cust_bill_pkg) {
1496 # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1497 # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1499 # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1500 # apply to $key-class charges.
1501 my @taxes = @{ $taxes{$key} || [] };
1502 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1504 my %localtaxlisthash = ();
1505 foreach my $tax ( @taxes ) {
1507 # this is the tax identifier, not the taxname
1508 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1509 # $taxlisthash: keys are "setup", "recur", and usage classes.
1510 # Values are arrayrefs, first the tax object (cust_main_county
1511 # or tax_rate) and then any cust_bill_pkg objects that the
1513 $taxlisthash->{ $taxname } ||= [ $tax ];
1514 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1516 $localtaxlisthash{ $taxname } ||= [ $tax ];
1517 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1521 warn "finding taxed taxes...\n" if $DEBUG > 2;
1522 foreach my $tax ( keys %localtaxlisthash ) {
1523 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1524 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1526 next unless $tax_object->can('tax_on_tax');
1528 foreach my $tot ( $tax_object->tax_on_tax( $location ) ) {
1529 my $totname = ref( $tot ). ' '. $tot->taxnum;
1531 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1533 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1535 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1536 # calculate the tax amount that the tax_on_tax will apply to
1537 my $hashref_or_error =
1538 $tax_object->taxline( $localtaxlisthash{$tax} );
1539 return $hashref_or_error
1540 unless ref($hashref_or_error);
1542 # and append it to the list of taxable items
1543 $taxlisthash->{ $totname } ||= [ $tot ];
1544 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1552 # INTERNAL TAX RATES (cust_main_county)
1554 # We fetch taxes even if the customer is completely exempt,
1555 # because we need to record that fact.
1557 my @loc_keys = qw( district city county state country );
1558 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1560 $taxhash{'taxclass'} = $part_item->taxclass;
1562 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1564 my @taxes = (); # entries are cust_main_county objects
1565 my %taxhash_elim = %taxhash;
1566 my @elim = qw( district city county state );
1569 #first try a match with taxclass
1570 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1572 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1573 #then try a match without taxclass
1574 my %no_taxclass = %taxhash_elim;
1575 $no_taxclass{ 'taxclass' } = '';
1576 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1579 $taxhash_elim{ shift(@elim) } = '';
1581 } while ( !scalar(@taxes) && scalar(@elim) );
1584 my $tax_id = 'cust_main_county '.$_->taxnum;
1585 $taxlisthash->{$tax_id} ||= [ $_ ];
1586 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1593 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1595 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1596 or part_fee (which will define the tax eligibility of the product), CLASS is
1597 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1598 location where the service was provided (or billed, depending on
1599 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1600 can apply to this line item.
1606 my $part_item = shift;
1608 my $location = shift;
1610 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1612 my $geocode = $location->geocode('cch');
1614 [ $part_item->tax_rates('cch', $geocode, $class) ]
1618 =item collect [ HASHREF | OPTION => VALUE ... ]
1620 (Attempt to) collect money for this customer's outstanding invoices (see
1621 L<FS::cust_bill>). Usually used after the bill method.
1623 Actions are now triggered by billing events; see L<FS::part_event> and the
1624 billing events web interface. Old-style invoice events (see
1625 L<FS::part_bill_event>) have been deprecated.
1627 If there is an error, returns the error, otherwise returns false.
1629 Options are passed as name-value pairs.
1631 Currently available options are:
1637 Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
1641 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1645 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1649 set true to surpress email card/ACH decline notices.
1653 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1659 # allows for one time override of normal customer billing method
1664 my( $self, %options ) = @_;
1666 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1668 my $invoice_time = $options{'invoice_time'} || time;
1671 local $SIG{HUP} = 'IGNORE';
1672 local $SIG{INT} = 'IGNORE';
1673 local $SIG{QUIT} = 'IGNORE';
1674 local $SIG{TERM} = 'IGNORE';
1675 local $SIG{TSTP} = 'IGNORE';
1676 local $SIG{PIPE} = 'IGNORE';
1678 my $oldAutoCommit = $FS::UID::AutoCommit;
1679 local $FS::UID::AutoCommit = 0;
1682 $self->select_for_update; #mutex
1685 my $balance = $self->balance;
1686 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1689 if ( exists($options{'retry_card'}) ) {
1690 carp 'retry_card option passed to collect is deprecated; use retry';
1691 $options{'retry'} ||= $options{'retry_card'};
1693 if ( exists($options{'retry'}) && $options{'retry'} ) {
1694 my $error = $self->retry_realtime;
1696 $dbh->rollback if $oldAutoCommit;
1701 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1703 #never want to roll back an event just because it returned an error
1704 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1706 $self->do_cust_event(
1707 'debug' => ( $options{'debug'} || 0 ),
1708 'time' => $invoice_time,
1709 'check_freq' => $options{'check_freq'},
1710 'stage' => 'collect',
1715 =item retry_realtime
1717 Schedules realtime / batch credit card / electronic check / LEC billing
1718 events for for retry. Useful if card information has changed or manual
1719 retry is desired. The 'collect' method must be called to actually retry
1722 Implementation details: For either this customer, or for each of this
1723 customer's open invoices, changes the status of the first "done" (with
1724 statustext error) realtime processing event to "failed".
1728 sub retry_realtime {
1731 local $SIG{HUP} = 'IGNORE';
1732 local $SIG{INT} = 'IGNORE';
1733 local $SIG{QUIT} = 'IGNORE';
1734 local $SIG{TERM} = 'IGNORE';
1735 local $SIG{TSTP} = 'IGNORE';
1736 local $SIG{PIPE} = 'IGNORE';
1738 my $oldAutoCommit = $FS::UID::AutoCommit;
1739 local $FS::UID::AutoCommit = 0;
1742 #a little false laziness w/due_cust_event (not too bad, really)
1744 my $join = FS::part_event_condition->join_conditions_sql;
1745 my $order = FS::part_event_condition->order_conditions_sql;
1748 . join ( ' OR ' , map {
1749 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1750 my $custnum = FS::part_event->eventtables_custnum->{$_};
1751 "( part_event.eventtable = " . dbh->quote($_)
1752 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1753 . " from $_ $cust_join"
1754 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1755 } FS::part_event->eventtables)
1758 #here is the agent virtualization
1759 my $agent_virt = " ( part_event.agentnum IS NULL
1760 OR part_event.agentnum = ". $self->agentnum. ' )';
1762 #XXX this shouldn't be hardcoded, actions should declare it...
1763 my @realtime_events = qw(
1764 cust_bill_realtime_card
1765 cust_bill_realtime_check
1766 cust_bill_realtime_lec
1770 my $is_realtime_event =
1771 ' part_event.action IN ( '.
1772 join(',', map "'$_'", @realtime_events ).
1775 my $batch_or_statustext =
1776 "( part_event.action = 'cust_bill_batch'
1777 OR ( statustext IS NOT NULL AND statustext != '' )
1781 my @cust_event = qsearch({
1782 'table' => 'cust_event',
1783 'select' => 'cust_event.*',
1784 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1785 'hashref' => { 'status' => 'done' },
1786 'extra_sql' => " AND $batch_or_statustext ".
1787 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1790 my %seen_invnum = ();
1791 foreach my $cust_event (@cust_event) {
1793 #max one for the customer, one for each open invoice
1794 my $cust_X = $cust_event->cust_X;
1795 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1799 or $cust_event->part_event->eventtable eq 'cust_bill'
1802 my $error = $cust_event->retry;
1804 $dbh->rollback if $oldAutoCommit;
1805 return "error scheduling event for retry: $error";
1810 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1815 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1817 Runs billing events; see L<FS::part_event> and the billing events web
1820 If there is an error, returns the error, otherwise returns false.
1822 Options are passed as name-value pairs.
1824 Currently available options are:
1830 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.
1834 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1838 "collect" (the default) or "pre-bill"
1842 set true to surpress email card/ACH decline notices.
1846 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)
1853 # allows for one time override of normal customer billing method
1857 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1860 my( $self, %options ) = @_;
1862 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1864 my $time = $options{'time'} || time;
1867 local $SIG{HUP} = 'IGNORE';
1868 local $SIG{INT} = 'IGNORE';
1869 local $SIG{QUIT} = 'IGNORE';
1870 local $SIG{TERM} = 'IGNORE';
1871 local $SIG{TSTP} = 'IGNORE';
1872 local $SIG{PIPE} = 'IGNORE';
1874 my $oldAutoCommit = $FS::UID::AutoCommit;
1875 local $FS::UID::AutoCommit = 0;
1878 $self->select_for_update; #mutex
1881 my $balance = $self->balance;
1882 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1885 # if ( exists($options{'retry_card'}) ) {
1886 # carp 'retry_card option passed to collect is deprecated; use retry';
1887 # $options{'retry'} ||= $options{'retry_card'};
1889 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1890 # my $error = $self->retry_realtime;
1892 # $dbh->rollback if $oldAutoCommit;
1897 # false laziness w/pay_batch::import_results
1899 my $due_cust_event = $self->due_cust_event(
1900 'debug' => ( $options{'debug'} || 0 ),
1902 'check_freq' => $options{'check_freq'},
1903 'stage' => ( $options{'stage'} || 'collect' ),
1905 unless( ref($due_cust_event) ) {
1906 $dbh->rollback if $oldAutoCommit;
1907 return $due_cust_event;
1910 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1911 #never want to roll back an event just because it or a different one
1913 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1915 foreach my $cust_event ( @$due_cust_event ) {
1919 #re-eval event conditions (a previous event could have changed things)
1920 unless ( $cust_event->test_conditions ) {
1921 #don't leave stray "new/locked" records around
1922 my $error = $cust_event->delete;
1923 return $error if $error;
1928 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1929 if $options{'quiet'};
1930 warn " running cust_event ". $cust_event->eventnum. "\n"
1933 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1934 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1935 #XXX wtf is this? figure out a proper dealio with return value
1947 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1949 Inserts database records for and returns an ordered listref of new events due
1950 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1951 events are due, an empty listref is returned. If there is an error, returns a
1952 scalar error message.
1954 To actually run the events, call each event's test_condition method, and if
1955 still true, call the event's do_event method.
1957 Options are passed as a hashref or as a list of name-value pairs. Available
1964 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.
1968 "collect" (the default) or "pre-bill"
1972 "Current time" for the events.
1976 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)
1980 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1984 Explicitly pass the objects to be tested (typically used with eventtable).
1988 Set to true to return the objects, but not actually insert them into the
1995 sub due_cust_event {
1997 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2000 #my $DEBUG = $opt{'debug'}
2001 $opt{'debug'} ||= 0; # silence some warnings
2002 local($DEBUG) = $opt{'debug'}
2003 if $opt{'debug'} > $DEBUG;
2004 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2006 warn "$me due_cust_event called with options ".
2007 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2010 $opt{'time'} ||= time;
2012 local $SIG{HUP} = 'IGNORE';
2013 local $SIG{INT} = 'IGNORE';
2014 local $SIG{QUIT} = 'IGNORE';
2015 local $SIG{TERM} = 'IGNORE';
2016 local $SIG{TSTP} = 'IGNORE';
2017 local $SIG{PIPE} = 'IGNORE';
2019 my $oldAutoCommit = $FS::UID::AutoCommit;
2020 local $FS::UID::AutoCommit = 0;
2023 $self->select_for_update #mutex
2024 unless $opt{testonly};
2027 # find possible events (initial search)
2030 my @cust_event = ();
2032 my @eventtable = $opt{'eventtable'}
2033 ? ( $opt{'eventtable'} )
2034 : FS::part_event->eventtables_runorder;
2036 my $check_freq = $opt{'check_freq'} || '1d';
2038 foreach my $eventtable ( @eventtable ) {
2041 if ( $opt{'objects'} ) {
2043 @objects = @{ $opt{'objects'} };
2045 } elsif ( $eventtable eq 'cust_main' ) {
2047 @objects = ( $self );
2051 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2052 # linkage not needed here because FS::cust_main->$eventtable will
2055 #some false laziness w/Cron::bill bill_where
2057 my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
2058 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2059 'time'=>$opt{'time'},
2061 $where = $where ? "AND $where" : '';
2063 my $are_part_event =
2064 "EXISTS ( SELECT 1 FROM part_event $join
2065 WHERE check_freq = '$check_freq'
2066 AND eventtable = '$eventtable'
2067 AND ( disabled = '' OR disabled IS NULL )
2073 @objects = $self->$eventtable(
2074 'addl_from' => $cm_join,
2075 'extra_sql' => " AND $are_part_event",
2077 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2079 my @e_cust_event = ();
2081 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2083 my $cross = "CROSS JOIN $eventtable $linkage";
2084 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2085 unless $eventtable eq 'cust_main';
2087 foreach my $object ( @objects ) {
2089 #this first search uses the condition_sql magic for optimization.
2090 #the more possible events we can eliminate in this step the better
2092 my $cross_where = '';
2093 my $pkey = $object->primary_key;
2094 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2096 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2098 FS::part_event_condition->where_conditions_sql( $eventtable,
2099 'time'=>$opt{'time'}
2101 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2103 $extra_sql = "AND $extra_sql" if $extra_sql;
2105 #here is the agent virtualization
2106 $extra_sql .= " AND ( part_event.agentnum IS NULL
2107 OR part_event.agentnum = ". $self->agentnum. ' )';
2109 $extra_sql .= " $order";
2111 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2112 if $opt{'debug'} > 2;
2113 my @part_event = qsearch( {
2114 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2115 'select' => 'part_event.*',
2116 'table' => 'part_event',
2117 'addl_from' => "$cross $join",
2118 'hashref' => { 'check_freq' => $check_freq,
2119 'eventtable' => $eventtable,
2122 'extra_sql' => "AND $cross_where $extra_sql",
2126 my $pkey = $object->primary_key;
2127 warn " ". scalar(@part_event).
2128 " possible events found for $eventtable ". $object->$pkey(). "\n";
2131 push @e_cust_event, map {
2132 $_->new_cust_event($object, 'time' => $opt{'time'})
2137 warn " ". scalar(@e_cust_event).
2138 " subtotal possible cust events found for $eventtable\n"
2141 push @cust_event, @e_cust_event;
2145 warn " ". scalar(@cust_event).
2146 " total possible cust events found in initial search\n"
2154 $opt{stage} ||= 'collect';
2156 grep { my $stage = $_->part_event->event_stage;
2157 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2167 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2170 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2173 warn " invalid conditions not eliminated with condition_sql:\n".
2174 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2175 if keys %unsat && $DEBUG; # > 1;
2181 unless( $opt{testonly} ) {
2182 foreach my $cust_event ( @cust_event ) {
2184 my $error = $cust_event->insert();
2186 $dbh->rollback if $oldAutoCommit;
2193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2199 warn " returning events: ". Dumper(@cust_event). "\n"
2206 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2208 Applies unapplied payments and credits.
2210 In most cases, this new method should be used in place of sequential
2211 apply_payments and apply_credits methods.
2213 A hash of optional arguments may be passed. Currently "manual" is supported.
2214 If true, a payment receipt is sent instead of a statement when
2215 'payment_receipt_email' configuration option is set.
2217 If there is an error, returns the error, otherwise returns false.
2221 sub apply_payments_and_credits {
2222 my( $self, %options ) = @_;
2224 local $SIG{HUP} = 'IGNORE';
2225 local $SIG{INT} = 'IGNORE';
2226 local $SIG{QUIT} = 'IGNORE';
2227 local $SIG{TERM} = 'IGNORE';
2228 local $SIG{TSTP} = 'IGNORE';
2229 local $SIG{PIPE} = 'IGNORE';
2231 my $oldAutoCommit = $FS::UID::AutoCommit;
2232 local $FS::UID::AutoCommit = 0;
2235 $self->select_for_update; #mutex
2237 foreach my $cust_bill ( $self->open_cust_bill ) {
2238 my $error = $cust_bill->apply_payments_and_credits(%options);
2240 $dbh->rollback if $oldAutoCommit;
2241 return "Error applying: $error";
2245 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2250 =item apply_credits OPTION => VALUE ...
2252 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2253 to outstanding invoice balances in chronological order (or reverse
2254 chronological order if the I<order> option is set to B<newest>) and returns the
2255 value of any remaining unapplied credits available for refund (see
2256 L<FS::cust_refund>).
2258 Dies if there is an error.
2266 local $SIG{HUP} = 'IGNORE';
2267 local $SIG{INT} = 'IGNORE';
2268 local $SIG{QUIT} = 'IGNORE';
2269 local $SIG{TERM} = 'IGNORE';
2270 local $SIG{TSTP} = 'IGNORE';
2271 local $SIG{PIPE} = 'IGNORE';
2273 my $oldAutoCommit = $FS::UID::AutoCommit;
2274 local $FS::UID::AutoCommit = 0;
2277 $self->select_for_update; #mutex
2279 unless ( $self->total_unapplied_credits ) {
2280 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2284 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2285 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2287 my @invoices = $self->open_cust_bill;
2288 @invoices = sort { $b->_date <=> $a->_date } @invoices
2289 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2291 if ( $conf->exists('pkg-balances') ) {
2292 # limit @credits to those w/ a pkgnum grepped from $self
2294 foreach my $i (@invoices) {
2295 foreach my $li ( $i->cust_bill_pkg ) {
2296 $pkgnums{$li->pkgnum} = 1;
2299 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2304 foreach my $cust_bill ( @invoices ) {
2306 if ( !defined($credit) || $credit->credited == 0) {
2307 $credit = pop @credits or last;
2311 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2312 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2314 $owed = $cust_bill->owed;
2316 unless ( $owed > 0 ) {
2317 push @credits, $credit;
2321 my $amount = min( $credit->credited, $owed );
2323 my $cust_credit_bill = new FS::cust_credit_bill ( {
2324 'crednum' => $credit->crednum,
2325 'invnum' => $cust_bill->invnum,
2326 'amount' => $amount,
2328 $cust_credit_bill->pkgnum( $credit->pkgnum )
2329 if $conf->exists('pkg-balances') && $credit->pkgnum;
2330 my $error = $cust_credit_bill->insert;
2332 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2336 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2340 my $total_unapplied_credits = $self->total_unapplied_credits;
2342 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2344 return $total_unapplied_credits;
2347 =item apply_payments [ OPTION => VALUE ... ]
2349 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2350 to outstanding invoice balances in chronological order.
2352 #and returns the value of any remaining unapplied payments.
2354 A hash of optional arguments may be passed. Currently "manual" is supported.
2355 If true, a payment receipt is sent instead of a statement when
2356 'payment_receipt_email' configuration option is set.
2358 Dies if there is an error.
2362 sub apply_payments {
2363 my( $self, %options ) = @_;
2365 local $SIG{HUP} = 'IGNORE';
2366 local $SIG{INT} = 'IGNORE';
2367 local $SIG{QUIT} = 'IGNORE';
2368 local $SIG{TERM} = 'IGNORE';
2369 local $SIG{TSTP} = 'IGNORE';
2370 local $SIG{PIPE} = 'IGNORE';
2372 my $oldAutoCommit = $FS::UID::AutoCommit;
2373 local $FS::UID::AutoCommit = 0;
2376 $self->select_for_update; #mutex
2380 my @payments = sort { $b->_date <=> $a->_date }
2381 grep { $_->unapplied > 0 }
2384 my @invoices = sort { $a->_date <=> $b->_date}
2385 grep { $_->owed > 0 }
2388 if ( $conf->exists('pkg-balances') ) {
2389 # limit @payments to those w/ a pkgnum grepped from $self
2391 foreach my $i (@invoices) {
2392 foreach my $li ( $i->cust_bill_pkg ) {
2393 $pkgnums{$li->pkgnum} = 1;
2396 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2401 foreach my $cust_bill ( @invoices ) {
2403 if ( !defined($payment) || $payment->unapplied == 0 ) {
2404 $payment = pop @payments or last;
2408 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2409 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2411 $owed = $cust_bill->owed;
2413 unless ( $owed > 0 ) {
2414 push @payments, $payment;
2418 my $amount = min( $payment->unapplied, $owed );
2421 'paynum' => $payment->paynum,
2422 'invnum' => $cust_bill->invnum,
2423 'amount' => $amount,
2425 $cbp->{_date} = $payment->_date
2426 if $options{'manual'} && $options{'backdate_application'};
2427 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2428 $cust_bill_pay->pkgnum( $payment->pkgnum )
2429 if $conf->exists('pkg-balances') && $payment->pkgnum;
2430 my $error = $cust_bill_pay->insert(%options);
2432 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2436 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2440 my $total_unapplied_payments = $self->total_unapplied_payments;
2442 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2444 return $total_unapplied_payments;
2454 suspend_adjourned_pkgs
2455 unsuspend_resumed_pkgs
2458 (do_cust_event pre-bill)
2461 (vendor-only) _gather_taxes
2462 _omit_zero_value_bundles
2463 _handle_taxes (for fees)
2466 apply_payments_and_credits
2475 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>