1 package FS::cust_main::Billing;
5 use vars qw( $conf $DEBUG $me );
8 use List::Util qw( min );
10 use FS::Record qw( qsearch qsearchs dbdef );
11 use FS::Misc::DateTime qw( day_end );
14 use FS::cust_bill_pkg;
15 use FS::cust_bill_pkg_display;
16 use FS::cust_bill_pay;
17 use FS::cust_credit_bill;
18 use FS::cust_tax_adjustment;
20 use FS::tax_rate_location;
21 use FS::cust_bill_pkg_tax_location;
22 use FS::cust_bill_pkg_tax_rate_location;
24 use FS::part_event_condition;
26 use FS::FeeOrigin_Mixin;
29 use FS::Misc::Savepoint;
31 # 1 is mostly method/subroutine entry and options
32 # 2 traces progress of some operations
33 # 3 is even more information including possibly sensitive data
35 $me = '[FS::cust_main::Billing]';
37 install_callback FS::UID sub {
39 #yes, need it for stuff below (prolly should be cached)
44 FS::cust_main::Billing - Billing mixin for cust_main
50 These methods are available on FS::cust_main objects.
56 =item bill_and_collect
58 Cancels and suspends any packages due, generates bills, applies payments and
59 credits, and applies collection events to run cards, send bills and notices,
62 Any errors prevent subsequent operations from continuing and die (but see the
65 Options are passed as name-value pairs. Currently available options are:
71 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:
75 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
79 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.
83 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
87 If set true, re-charges setup fees.
91 If set any errors prevent subsequent operations from continusing. If set
92 specifically to "return", returns the error (or false, if there is no error).
93 Any other true value causes errors to die.
97 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)
101 Optional FS::queue entry to receive status updates.
105 Options are passed to the B<bill> and B<collect> methods verbatim, so all
106 options of those methods are also available.
110 sub bill_and_collect {
111 my( $self, %options ) = @_;
113 my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
114 my %logopt = (object => $self);
115 $log->debug('start', %logopt);
119 #$options{actual_time} not $options{time} because freeside-daily -d is for
120 #pre-printing invoices
122 $options{'actual_time'} ||= time;
123 my $job = $options{'job'};
125 my $actual_time = ( $conf->exists('next-bill-ignore-time')
126 ? day_end( $options{actual_time} )
127 : $options{actual_time}
130 $job->update_statustext('0,cleaning expired packages') if $job;
131 $log->debug('canceling expired packages', %logopt);
132 $error = $self->cancel_expired_pkgs( $actual_time );
134 $error = "Error expiring custnum ". $self->custnum. ": $error";
135 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
139 $log->debug('suspending adjourned packages', %logopt);
140 $error = $self->suspend_adjourned_pkgs( $actual_time );
142 $error = "Error adjourning custnum ". $self->custnum. ": $error";
143 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
147 $log->debug('unsuspending resumed packages', %logopt);
148 $error = $self->unsuspend_resumed_pkgs( $actual_time );
150 $error = "Error resuming custnum ".$self->custnum. ": $error";
151 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
155 $job->update_statustext('20,billing packages') if $job;
156 $log->debug('billing packages', %logopt);
157 $error = $self->bill( %options );
159 $error = "Error billing custnum ". $self->custnum. ": $error";
160 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
164 $job->update_statustext('50,applying payments and credits') if $job;
165 $log->debug('applying payments and credits', %logopt);
166 $error = $self->apply_payments_and_credits;
168 $error = "Error applying custnum ". $self->custnum. ": $error";
169 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
173 # In a batch tax environment, do not run collection if any pending
174 # invoices were created. Collection will run after the next tax batch.
175 state $is_batch_tax = FS::TaxEngine->new->info->{batch} ? 1 : 0;
176 if ( $is_batch_tax && $self->pending_invoice_count ) {
177 warn "skipped collection for custnum ".$self->custnum.
178 " due to pending invoices\n" if $DEBUG;
179 } elsif ( $conf->exists('cancelled_cust-noevents')
180 && ! $self->num_ncancelled_pkgs )
182 warn "skipped collection for custnum ".$self->custnum.
183 " because they have no active packages\n" if $DEBUG;
185 # run collection normally
186 $job->update_statustext('70,running collection events') if $job;
187 $log->debug('running collection events', %logopt);
188 $error = $self->collect( %options );
190 $error = "Error collecting custnum ". $self->custnum. ": $error";
191 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
196 $job->update_statustext('100,finished') if $job;
197 $log->debug('finish', %logopt);
203 sub cancel_expired_pkgs {
204 my ( $self, $time, %options ) = @_;
206 my @cancel_pkgs = $self->ncancelled_pkgs( {
207 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
212 my @really_cancel_pkgs = ();
213 my @cancel_reasons = ();
215 CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
216 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
218 if ( $cust_pkg->change_to_pkgnum ) {
220 my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
222 push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
223 $cust_pkg->change_to_pkgnum.'; not expiring';
226 my $error = $cust_pkg->change( 'cust_pkg' => $new_pkg,
227 'unprotect_svcs' => 1,
229 push @errors, $error if $error && ref($error) ne 'FS::cust_pkg';
231 } else { # just cancel it
233 push @really_cancel_pkgs, $cust_pkg;
234 push @cancel_reasons, $cpr;
239 if (@really_cancel_pkgs) {
241 my %cancel_opt = ( 'cust_pkg' => \@really_cancel_pkgs,
242 'cust_pkg_reason' => \@cancel_reasons,
246 push @errors, $self->cancel_pkgs(%cancel_opt);
250 join(' / ', @errors);
254 sub suspend_adjourned_pkgs {
255 my ( $self, $time, %options ) = @_;
257 my @susp_pkgs = $self->ncancelled_pkgs( {
259 " AND ( susp IS NULL OR susp = 0 )
260 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
261 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
266 #only because there's no SQL test for is_prepaid :/
268 grep { ( $_->part_pkg->is_prepaid
273 && $_->adjourn <= $time
281 foreach my $cust_pkg ( @susp_pkgs ) {
282 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
283 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
284 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
285 'reason_otaker' => $cpr->otaker
289 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
292 join(' / ', @errors);
296 sub unsuspend_resumed_pkgs {
297 my ( $self, $time, %options ) = @_;
299 my @unsusp_pkgs = $self->ncancelled_pkgs( {
300 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
305 foreach my $cust_pkg ( @unsusp_pkgs ) {
306 my $error = $cust_pkg->unsuspend( 'time' => $time );
307 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
310 join(' / ', @errors);
316 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
317 conjunction with the collect method by calling B<bill_and_collect>.
319 If there is an error, returns the error, otherwise returns false.
321 Options are passed as name-value pairs. Currently available options are:
327 If set true, re-charges setup fees.
331 If set true then only bill recurring charges, not setup, usage, one time
336 If set, then override the normal frequency and look for a part_pkg_discount
337 to take at that frequency. This is appropriate only when the normal
338 frequency for all packages is monthly, and is an error otherwise. Use
339 C<pkg_list> to limit the set of packages included in billing.
343 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:
347 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
351 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
353 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
357 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
361 Do not bill prepaid packages. Used by freeside-daily.
365 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.
369 This boolean value informs the us that the package is being cancelled. This
370 typically might mean not charging the normal recurring fee but only usage
371 fees since the last billing. Setup charges may be charged. Not all package
372 plans support this feature (they tend to charge 0).
376 Prevent the resetting of usage limits during this call.
380 Do not save the generated bill in the database. Useful with return_bill
384 A list reference on which the generated bill(s) will be returned.
388 Boolean value; indicates that this is an estimate rather than a "tax invoice".
389 This will be passed through to the tax engine, as online tax services
390 sometimes need to know it for reporting purposes. Otherwise it has no effect.
394 Optional terms to be printed on this invoice. Otherwise, customer-specific
395 terms or the default terms are used.
402 my( $self, %options ) = @_;
404 return '' if $self->complimentary eq 'Y';
406 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
407 my $log = FS::Log->new('FS::cust_main::Billing::bill');
408 my %logopt = (object => $self);
410 $log->debug('start', %logopt);
411 warn "$me bill customer ". $self->custnum. "\n"
414 my $time = $options{'time'} || time;
415 my $invoice_time = $options{'invoice_time'} || $time;
417 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
422 $options{'not_pkgpart'} ||= {};
423 $options{'not_pkgpart'} = { map { $_ => 1 }
424 split(/\s*,\s*/, $options{'not_pkgpart'})
426 unless ref($options{'not_pkgpart'});
428 local $SIG{HUP} = 'IGNORE';
429 local $SIG{INT} = 'IGNORE';
430 local $SIG{QUIT} = 'IGNORE';
431 local $SIG{TERM} = 'IGNORE';
432 local $SIG{TSTP} = 'IGNORE';
433 local $SIG{PIPE} = 'IGNORE';
435 my $oldAutoCommit = $FS::UID::AutoCommit;
436 local $FS::UID::AutoCommit = 0;
439 $log->debug('acquiring lock', %logopt);
440 warn "$me acquiring lock on customer ". $self->custnum. "\n"
443 $self->select_for_update; #mutex
445 $log->debug('running pre-bill events', %logopt);
446 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
449 my $error = $self->do_cust_event(
450 'debug' => ( $options{'debug'} || 0 ),
451 'time' => $invoice_time,
452 'check_freq' => $options{'check_freq'},
453 'stage' => 'pre-bill',
455 unless $options{no_commit};
457 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
461 $log->debug('done running pre-bill events', %logopt);
462 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
465 #keep auto-charge and non-auto-charge line items separate
466 my @passes = ( '', 'no_auto' );
468 my %cust_bill_pkg = map { $_ => [] } @passes;
471 # find the packages which are due for billing, find out how much they are
472 # & generate invoice database.
475 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
476 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
478 my @precommit_hooks = ();
480 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
483 my $tax_is_batch = '';
485 $tax_engines{$_} = FS::TaxEngine->new(cust_main => $self,
486 invoice_time => $invoice_time,
487 cancel => $options{cancel},
488 estimate => $options{estimate},
490 $tax_is_batch ||= $tax_engines{$_}->info->{batch};
493 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
495 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
497 my $part_pkg = $cust_pkg->part_pkg;
499 next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
501 $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
502 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
504 #? to avoid use of uninitialized value errors... ?
505 $cust_pkg->setfield('bill', '')
506 unless defined($cust_pkg->bill);
508 my $real_pkgpart = $cust_pkg->pkgpart;
509 my %hash = $cust_pkg->hash;
511 # we could implement this bit as FS::part_pkg::has_hidden, but we already
512 # suffer from performance issues
513 $options{has_hidden} = 0;
514 my @part_pkg = $part_pkg->self_and_bill_linked;
515 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
517 # if this package was changed from another package,
518 # and it hasn't been billed since then,
519 # and package balances are enabled,
520 if ( $cust_pkg->change_pkgnum
521 and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
522 and $cust_pkg->change_date < $invoice_time
523 and $conf->exists('pkg-balances') )
525 # _transfer_balance will also create the appropriate credit
526 my @transfer_items = $self->_transfer_balance($cust_pkg);
527 # $part_pkg[0] is the "real" part_pkg
528 my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
530 push @{ $cust_bill_pkg{$pass} }, @transfer_items;
531 # treating this as recur, just because most charges are recur...
532 ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
534 # currently not considering separate_bill here, as it's for
535 # one-time charges only
538 foreach my $part_pkg ( @part_pkg ) {
540 my $this_cust_pkg = $cust_pkg;
541 # for add-on packages, copy the object to avoid leaking changes back to
542 # the caller if pkg_list is in use; see RT#73607
543 if ( $part_pkg->get('pkgpart') != $real_pkgpart ) {
544 $this_cust_pkg = FS::cust_pkg->new({ %hash });
548 if ( $this_cust_pkg->separate_bill ) {
549 # if no_auto is also set, that's fine. we just need to not have
550 # invoices that are both auto and no_auto, and since the package
551 # gets an invoice all to itself, it will only be one or the other.
552 $pass = $this_cust_pkg->pkgnum;
553 if (!exists $cust_bill_pkg{$pass}) { # it may not exist yet
555 $total_setup{$pass} = do { my $z = 0; \$z };
556 $total_recur{$pass} = do { my $z = 0; \$z };
557 # it also needs its own tax context
558 $tax_engines{$pass} = FS::TaxEngine->new(
560 invoice_time => $invoice_time,
561 cancel => $options{cancel},
562 estimate => $options{estimate},
564 $cust_bill_pkg{$pass} = [];
566 } elsif ( ($this_cust_pkg->no_auto || $part_pkg->no_auto) ) {
570 my $next_bill = $this_cust_pkg->getfield('bill') || 0;
572 # let this run once if this is the last bill upon cancellation
573 while ( $next_bill <= $cmp_time or $options{cancel} ) {
575 $self->_make_lines( 'part_pkg' => $part_pkg,
576 'cust_pkg' => $this_cust_pkg,
577 'precommit_hooks' => \@precommit_hooks,
578 'line_items' => $cust_bill_pkg{$pass},
579 'setup' => $total_setup{$pass},
580 'recur' => $total_recur{$pass},
581 'tax_engine' => $tax_engines{$pass},
583 'real_pkgpart' => $real_pkgpart,
584 'options' => \%options,
587 # Stop if anything goes wrong
590 # or if we're not incrementing the bill date.
591 last if ($this_cust_pkg->getfield('bill') || 0) == $next_bill;
593 # or if we're letting it run only once
594 last if $options{cancel};
596 $next_bill = $this_cust_pkg->getfield('bill') || 0;
598 #stop if -o was passed to freeside-daily
599 last if $options{'one_recur'};
602 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
606 } #foreach my $part_pkg
608 } #foreach my $cust_pkg
610 foreach my $pass (@passes) { # keys %cust_bill_pkg )
612 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
614 warn "$me billing pass $pass\n"
615 #.Dumper(\@cust_bill_pkg)."\n"
622 my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
623 hashref => { 'billpkgnum' => '' }
625 warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
626 if @pending_fees and $DEBUG > 1;
628 # determine whether to generate an invoice
629 my $generate_bill = scalar(@cust_bill_pkg) > 0;
631 foreach my $fee (@pending_fees) {
632 $generate_bill = 1 unless $fee->nextbill;
635 # don't create an invoice with no line items, or where the only line
636 # items are fees that are supposed to be held until the next invoice
637 next if !$generate_bill;
641 foreach my $fee_origin (@pending_fees) {
642 my $part_fee = $fee_origin->part_fee;
644 # check whether the fee is applicable before doing anything expensive:
646 # if the fee def belongs to a different agent, don't charge the fee.
647 # event conditions should prevent this, but just in case they don't,
649 if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
650 warn "tried to charge fee#".$part_fee->feepart .
651 " on customer#".$self->custnum." from a different agent.\n";
654 # also skip if it's disabled
655 next if $part_fee->disabled eq 'Y';
657 # Decide which invoice to base the fee on.
658 my $cust_bill = $fee_origin->cust_bill;
660 # Then link it to the current invoice. This isn't the real cust_bill
661 # object that will be inserted--in particular there are no taxes yet.
662 # If you want to charge a fee on the total invoice amount including
663 # taxes, you have to put the fee on the next invoice.
664 $cust_bill = FS::cust_bill->new({
665 'custnum' => $self->custnum,
666 'cust_bill_pkg' => \@cust_bill_pkg,
667 'charged' => ${ $total_setup{$pass} } +
668 ${ $total_recur{$pass} },
671 # If the origin is for a specific package, then only apply the fee to
672 # line items from that package.
673 if ( my $cust_pkg = $fee_origin->cust_pkg ) {
674 my @charge_fee_on_item;
675 my $charge_fee_on_amount = 0;
676 foreach (@cust_bill_pkg) {
677 if ($_->pkgnum == $cust_pkg->pkgnum) {
678 push @charge_fee_on_item, $_;
679 $charge_fee_on_amount += $_->setup + $_->recur;
682 $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
683 $cust_bill->set('charged', $charge_fee_on_amount);
686 } # $cust_bill is now set
688 my $fee_item = $part_fee->lineitem($cust_bill) or next;
689 # link this so that we can clear the marker on inserting the line item
690 $fee_item->set('fee_origin', $fee_origin);
691 push @fee_items, $fee_item;
695 # add fees to the invoice
696 foreach my $fee_item (@fee_items) {
698 push @cust_bill_pkg, $fee_item;
699 ${ $total_setup{$pass} } += $fee_item->setup;
700 ${ $total_recur{$pass} } += $fee_item->recur;
702 my $part_fee = $fee_item->part_fee;
703 my $fee_location = $self->ship_location; # I think?
705 my $error = $tax_engines{''}->add_sale($fee_item);
707 return $error if $error;
711 # XXX implementation of fees is supposed to make this go away...
712 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
713 !$conf->exists('postal_invoice-recurring_only')
717 my $postal_pkg = $self->charge_postal_fee();
718 if ( $postal_pkg && !ref( $postal_pkg ) ) {
720 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
721 return "can't charge postal invoice fee for customer ".
722 $self->custnum. ": $postal_pkg";
724 } elsif ( $postal_pkg ) {
726 my $real_pkgpart = $postal_pkg->pkgpart;
727 # we could implement this bit as FS::part_pkg::has_hidden, but we already
728 # suffer from performance issues
729 $options{has_hidden} = 0;
730 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
731 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
733 foreach my $part_pkg ( @part_pkg ) {
734 my %postal_options = %options;
735 delete $postal_options{cancel};
737 $self->_make_lines( 'part_pkg' => $part_pkg,
738 'cust_pkg' => $postal_pkg,
739 'precommit_hooks' => \@precommit_hooks,
740 'line_items' => \@cust_bill_pkg,
741 'setup' => $total_setup{$pass},
742 'recur' => $total_recur{$pass},
743 'tax_engine' => $tax_engines{$pass},
745 'real_pkgpart' => $real_pkgpart,
746 'options' => \%postal_options,
749 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
754 # it's silly to have a zero value postal_pkg, but....
755 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
762 #XXX does this work with batch tax engines?
763 warn "adding tax adjustments...\n" if $DEBUG > 2;
764 foreach my $cust_tax_adjustment (
765 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
771 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
773 my $itemdesc = $cust_tax_adjustment->taxname;
774 $itemdesc = '' if $itemdesc eq 'Tax';
776 push @cust_bill_pkg, new FS::cust_bill_pkg {
782 'itemdesc' => $itemdesc,
783 'itemcomment' => $cust_tax_adjustment->comment,
784 'cust_tax_adjustment' => $cust_tax_adjustment,
785 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
790 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
792 my $balance = $self->balance;
794 my $previous_bill = qsearchs({ 'table' => 'cust_bill',
795 'hashref' => { custnum=>$self->custnum },
796 'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
798 my $previous_balance =
800 ? ( $previous_bill->billing_balance + $previous_bill->charged )
803 $log->debug('creating the new invoice', %logopt);
804 warn "creating the new invoice\n" if $DEBUG;
805 #create the new invoice
806 my $cust_bill = new FS::cust_bill ( {
807 'custnum' => $self->custnum,
808 '_date' => $invoice_time,
809 'charged' => $charged,
810 'billing_balance' => $balance,
811 'previous_balance' => $previous_balance,
812 'invoice_terms' => $options{'invoice_terms'},
813 'cust_bill_pkg' => \@cust_bill_pkg,
814 'pending' => 'Y', # clear this after doing taxes
817 if (!$options{no_commit}) {
818 # probably we ought to insert it as pending, and then rollback
819 # without ever un-pending it
820 $error = $cust_bill->insert;
822 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
823 return "can't create invoice for customer #". $self->custnum. ": $error";
828 # calculate and append taxes
829 if ( ! $tax_is_batch) {
831 my $arrayref = eval { $tax_engines{$pass}->calculate_taxes($cust_bill) };
834 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
838 # or should this be in TaxEngine?
840 foreach my $taxline ( @$arrayref ) {
841 $total_tax += $taxline->setup;
842 $taxline->set('invnum' => $cust_bill->invnum); # just to be sure
843 push @cust_bill_pkg, $taxline; # for return_bill
845 if (!$options{no_commit}) {
846 my $error = $taxline->insert;
848 $dbh->rollback if $oldAutoCommit;
855 # add tax to the invoice amount and finalize it
856 ${ $total_setup{$pass} } = sprintf('%.2f', ${ $total_setup{$pass} } + $total_tax);
857 $charged = sprintf('%.2f', $charged + $total_tax);
858 $cust_bill->set('charged', $charged);
859 $cust_bill->set('pending', '');
861 if (!$options{no_commit}) {
862 my $error = $cust_bill->replace;
864 $dbh->rollback if $oldAutoCommit;
869 } # if !$tax_is_batch
870 # if it IS batch, then we'll do all this in process_tax_batch
872 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
874 } #foreach my $pass ( keys %cust_bill_pkg )
876 foreach my $hook ( @precommit_hooks ) {
879 } unless $options{no_commit};
881 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
882 return "$@ running precommit hook $hook\n";
886 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
891 #discard bundled packages of 0 value
892 # XXX we should reconsider whether we even need this
893 sub _omit_zero_value_bundles {
898 my $discount_show_always = $conf->exists('discount-show-always');
901 # Sort @in the same way we do during invoice rendering, so we can identify
902 # bundles. See FS::Template_Mixin::_items_nontax.
903 @in = sort { $a->pkgnum <=> $b->pkgnum or
904 $a->sdate <=> $b->sdate or
905 ($a->pkgpart_override ? 0 : -1) or
906 ($b->pkgpart_override ? 0 : 1) or
907 $b->hidden cmp $a->hidden or
908 $a->pkgpart_override <=> $b->pkgpart_override
911 # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg
912 # _without_ pkgpart_override, that's the start of the new bundle. if there's
913 # an existing bundle, and it contains a nonzero amount (or a zero amount
914 # that's displayable anyway), push all line items in the bundle.
915 foreach my $cust_bill_pkg ( @in ) {
917 if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) {
918 # ship out this bundle and reset it
926 # add this item to the current bundle
927 push @bundle, $cust_bill_pkg;
929 # determine if it makes the bundle displayable
930 if ( $cust_bill_pkg->setup > 0
931 or $cust_bill_pkg->recur > 0
932 or $cust_bill_pkg->setup_show_zero
933 or $cust_bill_pkg->recur_show_zero
934 or ($discount_show_always
935 and scalar(@{ $cust_bill_pkg->get('discounts')})
947 warn " _omit_zero_value_bundles: ". scalar(@in).
948 '->'. scalar(@out). "\n" #. Dumper(@out). "\n"
955 my ($self, %params) = @_;
957 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
959 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
960 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
961 my $cust_location = $cust_pkg->tax_location;
962 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
963 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
964 my $total_setup = $params{setup} or die "no setup accumulator specified";
965 my $total_recur = $params{recur} or die "no recur accumulator specified";
966 my $time = $params{'time'} or die "no time specified";
967 my (%options) = %{$params{options}};
969 my $tax_engine = $params{tax_engine};
971 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
972 # this should never happen
973 die 'freq_override billing attempted on non-monthly package '.
978 my $real_pkgpart = $params{real_pkgpart};
979 my %hash = $cust_pkg->hash;
980 my $old_cust_pkg = new FS::cust_pkg \%hash;
985 $cust_pkg->pkgpart($part_pkg->pkgpart);
987 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
998 my @setup_discounts = ();
999 my %setup_param = ( 'discounts' => \@setup_discounts,
1000 'real_pkgpart' => $params{real_pkgpart}
1002 my $setup_billed_currency = '';
1003 my $setup_billed_amount = 0;
1004 # Conditions for setting setup date and charging the setup fee:
1005 # - this is not a recurring-only billing run
1006 # - and the package is not currently being canceled
1007 # - and, unless we're specifically told otherwise via 'resetup':
1008 # - it doesn't already HAVE a setup date
1009 # - or a start date in the future
1010 # - and it's not suspended
1011 # - and it doesn't have an expire date in the past
1013 # The "disable_setup_suspended" option is now obsolete; we never set the
1014 # setup date on a suspended package.
1015 if ( ! $options{recurring_only}
1016 and ! $options{cancel}
1017 and ( $options{'resetup'}
1018 || ( ! $cust_pkg->setup
1019 && ( ! $cust_pkg->start_date
1020 || $cust_pkg->start_date <= $cmp_time
1022 && ( ! $cust_pkg->getfield('susp') )
1025 and ( ! $cust_pkg->expire
1026 || $cust_pkg->expire > $cmp_time )
1030 warn " bill setup\n" if $DEBUG > 1;
1032 unless ( $cust_pkg->waive_setup ) {
1035 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1036 return "$@ running calc_setup for $cust_pkg\n"
1039 # Only increment unitsetup here if there IS a setup fee.
1040 # prorate_defer_bill may cause calc_setup on a setup-stage package
1041 # to return zero, and the setup fee to be charged later. (This happens
1042 # when it's first billed on the prorate cutoff day. RT#31276.)
1044 $unitsetup = $cust_pkg->base_setup()
1048 if ( $setup_param{'billed_currency'} ) {
1049 $setup_billed_currency = delete $setup_param{'billed_currency'};
1050 $setup_billed_amount = delete $setup_param{'billed_amount'};
1055 if $cust_pkg->waive_setup && $part_pkg->can('prorate_setup') && $part_pkg->prorate_setup($cust_pkg, $time);
1057 if ( $cust_pkg->get('setup') ) {
1059 } elsif ( $cust_pkg->get('start_date') ) {
1060 # this allows start_date to be used to set the first bill date
1061 $cust_pkg->set('setup', $cust_pkg->get('start_date'));
1063 # if unspecified, start it right now
1064 $cust_pkg->set('setup', $time);
1067 $cust_pkg->setfield('start_date', '')
1068 if $cust_pkg->start_date;
1073 # bill recurring fee
1078 my @recur_discounts = ();
1079 my $recur_billed_currency = '';
1080 my $recur_billed_amount = 0;
1083 my $override_quantity;
1085 # Conditions for billing the recurring fee:
1086 # - the package doesn't have a future start date
1087 # - and it's not suspended
1088 # - unless suspend_bill is enabled on the package or package def
1089 # - but still not, if the package is on hold
1090 # - or it's suspended for a delayed cancellation
1091 # - and its next bill date is in the past
1092 # - or it doesn't have a next bill date yet
1093 # - or it's a one-time charge
1094 # - or it's a CDR plan with the "bill_every_call" option
1095 # - or it's being canceled
1096 # - and it doesn't have an expire date in the past (this can happen with
1098 # - again, unless it's being canceled
1099 if ( ! $cust_pkg->start_date
1102 || ( $cust_pkg->susp != $cust_pkg->order_date
1103 && ( $cust_pkg->option('suspend_bill',1)
1104 || ( $part_pkg->option('suspend_bill', 1)
1105 && ! $cust_pkg->option('no_suspend_bill',1)
1109 || $cust_pkg->is_status_delay_cancel
1112 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1113 || ( $part_pkg->plan eq 'voip_cdr'
1114 && $part_pkg->option('bill_every_call')
1119 ( ! $cust_pkg->expire
1120 || $cust_pkg->expire > $cmp_time
1125 # XXX should this be a package event? probably. events are called
1126 # at collection time at the moment, though...
1127 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1128 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1129 #don't want to reset usage just cause we want a line item??
1130 #&& $part_pkg->pkgpart == $real_pkgpart;
1132 warn " bill recur\n" if $DEBUG > 1;
1135 # XXX shared with $recur_prog
1136 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1140 #over two params! lets at least switch to a hashref for the rest...
1141 my $increment_next_bill = ( $part_pkg->freq ne '0'
1142 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1143 && !$options{cancel}
1145 my %param = ( %setup_param,
1146 'precommit_hooks' => $precommit_hooks,
1147 'increment_next_bill' => $increment_next_bill,
1148 'discounts' => \@recur_discounts,
1149 'real_pkgpart' => $real_pkgpart,
1150 'freq_override' => $options{freq_override} || '',
1154 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1156 # There may be some part_pkg for which this is wrong. Only those
1157 # which can_discount are supported.
1158 # (the UI should prevent adding discounts to these at the moment)
1160 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1161 " for pkgpart ". $cust_pkg->pkgpart.
1162 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1165 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1166 return "$@ running $method for $cust_pkg\n"
1169 if ($recur eq 'NOTHING') {
1170 # then calc_cancel (or calc_recur but that's not used) has declined to
1171 # generate a recurring lineitem at all. treat this as zero, but also
1172 # try not to generate a lineitem.
1178 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1180 if ( $param{'billed_currency'} ) {
1181 $recur_billed_currency = delete $param{'billed_currency'};
1182 $recur_billed_amount = delete $param{'billed_amount'};
1185 if ( $param{'override_quantity'} ) {
1186 $override_quantity = $param{'override_quantity'};
1187 $unitrecur = $recur / $override_quantity;
1190 if ( $increment_next_bill ) {
1194 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1195 # supplemental package
1196 # to keep in sync with the main package, simulate billing at
1198 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1199 my $supp_pkg_freq = $part_pkg->freq;
1200 if ( $supp_pkg_freq == 0 or $main_pkg_freq == 0 ) {
1201 # the UI should prevent setting up packages like this, but just
1203 return "unable to calculate supplemental package period ratio";
1205 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1206 if ( $ratio == int($ratio) ) {
1207 # simple case: main package is X months, supp package is X*A months,
1208 # advance supp package to where the main package will be in A cycles.
1209 $next_bill = $sdate;
1211 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1214 # harder case: main package is X months, supp package is Y months.
1215 # advance supp package by Y months. then if they're within half a
1216 # month of each other, resync them. this may result in the period
1217 # not being exactly Y months.
1218 $next_bill = $part_pkg->add_freq( $sdate, $supp_pkg_freq );
1219 my $main_next_bill = $main_pkg->bill;
1220 if ( $main_pkg->bill <= $time ) {
1221 # then the main package has not yet been billed on this cycle;
1222 # predict what its bill date will be.
1224 $part_pkg->add_freq( $main_next_bill, $main_pkg_freq );
1226 if ( abs($main_next_bill - $next_bill) < 86400*15 ) {
1227 $next_bill = $main_next_bill;
1232 # the normal case, not a supplemental package
1233 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1234 return "unparsable frequency: ".
1235 ($options{freq_override} || $part_pkg->freq)
1236 if $next_bill == -1;
1239 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1240 # only for figuring next bill date, nothing else, so, reset $sdate again
1242 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1243 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1244 $cust_pkg->last_bill($sdate);
1246 $cust_pkg->setfield('bill', $next_bill );
1250 if ( $param{'setup_fee'} ) {
1251 # Add an additional setup fee at the billing stage.
1252 # Used for prorate_defer_bill.
1253 $setup += $param{'setup_fee'};
1254 $unitsetup = $cust_pkg->base_setup();
1258 if ( defined $param{'discount_left_setup'} ) {
1259 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1260 $setup -= $discount_setup;
1264 } # end of recurring fee
1266 warn "\$setup is undefined" unless defined($setup);
1267 warn "\$recur is undefined" unless defined($recur);
1268 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1271 # If there's line items, create em cust_bill_pkg records
1272 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1277 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1278 # hmm.. and if just the options are modified in some weird price plan?
1280 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1283 my $error = $cust_pkg->replace( $old_cust_pkg,
1284 'depend_jobnum'=>$options{depend_jobnum},
1285 'options' => { $cust_pkg->options },
1287 unless $options{no_commit};
1288 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1289 if $error; #just in case
1292 $setup = sprintf( "%.2f", $setup );
1293 $recur = sprintf( "%.2f", $recur );
1294 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1295 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1297 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1298 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1301 my $discount_show_always = $conf->exists('discount-show-always')
1302 && ( ($setup == 0 && scalar(@setup_discounts))
1303 || ($recur == 0 && scalar(@recur_discounts))
1308 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1309 || $discount_show_always
1310 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1311 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1315 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1318 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1320 warn " adding customer package invoice detail: $_\n"
1321 foreach @cust_pkg_detail;
1323 push @details, @cust_pkg_detail;
1325 my $cust_bill_pkg = new FS::cust_bill_pkg {
1326 'pkgnum' => $cust_pkg->pkgnum,
1328 'unitsetup' => sprintf('%.2f', $unitsetup),
1329 'setup_billed_currency' => $setup_billed_currency,
1330 'setup_billed_amount' => $setup_billed_amount,
1332 'unitrecur' => sprintf('%.2f', $unitrecur),
1333 'recur_billed_currency' => $recur_billed_currency,
1334 'recur_billed_amount' => $recur_billed_amount,
1335 'quantity' => $override_quantity || $cust_pkg->quantity,
1336 'details' => \@details,
1337 'discounts' => [ @setup_discounts, @recur_discounts ],
1338 'hidden' => $part_pkg->hidden,
1339 'freq' => $part_pkg->freq,
1342 if ( $part_pkg->option('prorate_defer_bill',1)
1343 and !$hash{last_bill} ) {
1344 # both preceding and upcoming, technically
1345 $cust_bill_pkg->sdate( $cust_pkg->setup );
1346 $cust_bill_pkg->edate( $cust_pkg->bill );
1347 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1348 $cust_bill_pkg->sdate( $hash{last_bill} );
1349 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1350 $cust_bill_pkg->edate( $time ) if $options{cancel};
1351 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1352 $cust_bill_pkg->sdate( $sdate );
1353 $cust_bill_pkg->edate( $cust_pkg->bill );
1354 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1357 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1358 unless $part_pkg->pkgpart == $real_pkgpart;
1360 $$total_setup += $setup;
1361 $$total_recur += $recur;
1367 my $error = $tax_engine->add_sale($cust_bill_pkg);
1368 return $error if $error;
1370 $cust_bill_pkg->set_display(
1371 part_pkg => $part_pkg,
1372 real_pkgpart => $real_pkgpart,
1375 push @$cust_bill_pkgs, $cust_bill_pkg;
1377 } #if $setup != 0 || $recur != 0
1385 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1387 Takes one argument, a cust_pkg object that is being billed. This will
1388 be called only if the package was created by a package change, and has
1389 not been billed since the package change, and package balance tracking
1390 is enabled. The second argument can be an alternate package number to
1391 transfer the balance from; this should not be used externally.
1393 Transfers the balance from the previous package (now canceled) to
1394 this package, by crediting one package and creating an invoice item for
1395 the other. Inserts the credit and returns the invoice item (so that it
1396 can be added to an invoice that's being built).
1398 If the previous package was never billed, and was also created by a package
1399 change, then this will also transfer the balance from I<its> previous
1400 package, and so on, until reaching a package that either has been billed
1401 or was not created by a package change.
1405 my $balance_transfer_reason;
1407 sub _transfer_balance {
1409 my $cust_pkg = shift;
1410 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1411 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1415 # if $from_pkg is not the first package in the chain, and it was never
1417 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1418 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1421 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1422 if ( $prev_balance != 0 ) {
1423 $balance_transfer_reason ||= FS::reason->new_or_existing(
1424 'reason' => 'Package balance transfer',
1425 'type' => 'Internal adjustment',
1429 my $credit = FS::cust_credit->new({
1430 'custnum' => $self->custnum,
1431 'amount' => abs($prev_balance),
1432 'reasonnum' => $balance_transfer_reason->reasonnum,
1433 '_date' => $cust_pkg->change_date,
1436 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1438 'recur' => abs($prev_balance),
1439 #'sdate' => $from_pkg->last_bill, # not sure about this
1440 #'edate' => $cust_pkg->change_date,
1441 'itemdesc' => $self->mt('Previous Balance, [_1]',
1442 $from_pkg->part_pkg->pkg),
1445 if ( $prev_balance > 0 ) {
1446 # credit the old package, charge the new one
1447 $credit->set('pkgnum', $from_pkgnum);
1448 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1451 $credit->set('pkgnum', $cust_pkg->pkgnum);
1452 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1454 my $error = $credit->insert;
1455 die "error transferring package balance from #".$from_pkgnum.
1456 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1458 push @transfers, $cust_bill_pkg;
1459 } # $prev_balance != 0
1464 #### vestigial code ####
1466 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1468 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1471 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1474 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1475 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1478 'cust_main_county' can also be 'tax_rate'. The first object in the array
1479 is always the cust_main_county or tax_rate identified by the key.
1481 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1482 the 'taxline' method to calculate the amount of the tax. This doesn't
1483 happen until calculate_taxes, though.
1485 OPTIONS may include:
1486 - part_item: a part_pkg or part_fee object to be used as the package/fee
1488 - location: a cust_location to be used as the billing location.
1489 - cancel: true if this package is being billed on cancellation. This
1490 allows tax to be calculated on usage charges only.
1492 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1493 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1494 the customer's default service location).
1496 This method will also calculate exemptions for any taxes that apply to the
1497 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1498 attach them. This is the only place C<set_exemptions> is called in normal
1505 my $taxlisthash = shift;
1506 my $cust_bill_pkg = shift;
1509 # at this point I realize that we have enough information to infer all this
1510 # stuff, instead of passing around giant honking argument lists
1511 my $location = $options{location} || $cust_bill_pkg->tax_location;
1512 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1514 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1516 return if ( $self->payby eq 'COMP' ); #dubious
1518 if ( $conf->config('enable_taxproducts')
1519 && ( scalar($part_item->part_pkg_taxoverride)
1520 || $part_item->has_taxproduct
1525 # EXTERNAL TAX RATES (via tax_rate)
1526 my %cust_bill_pkg = ();
1530 my $usage = $cust_bill_pkg->usage || 0;
1531 push @classes, $cust_bill_pkg->usage_classes if $usage;
1532 push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1533 push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1534 and !$options{cancel};
1535 # that's better--probably don't even need $options{cancel} now
1536 # but leave it for now, just to be safe
1538 # About $options{cancel}: This protects against charging per-line or
1539 # per-customer or other flat-rate surcharges on a package that's being
1540 # billed on cancellation (which is an out-of-cycle bill and should only
1541 # have usage charges). See RT#29443.
1543 # customer exemption is now handled in the 'taxline' method
1544 #my $exempt = $conf->exists('cust_class-tax_exempt')
1545 # ? ( $self->cust_class ? $self->cust_class->tax : '' )
1547 # standardize this just to be sure
1548 #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1552 unless (exists $taxes{''}) {
1553 # unsure what purpose this serves, but last time I deleted something
1554 # from here just because I didn't see the point, it actually did
1555 # something important.
1556 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1557 return $err_or_ref unless ref($err_or_ref);
1558 $taxes{''} = $err_or_ref;
1561 # NO DISINTEGRATIONS.
1562 # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1564 # do not call taxline() with any argument except the entire set of
1565 # cust_bill_pkgs on an invoice that are eligible for the tax.
1567 # only calculate exemptions once for each tax rate, even if it's used
1568 # for multiple classes
1571 foreach my $class (@classes) {
1572 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1573 return $err_or_ref unless ref($err_or_ref);
1574 my @taxes = @$err_or_ref;
1578 foreach my $tax ( @taxes ) {
1580 my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1581 # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1582 # Values are arrayrefs, first the tax object (cust_main_county
1583 # or tax_rate), then the cust_bill_pkg object that the
1584 # tax applies to, then the tax class (setup, recur, usage classnum).
1585 $taxlisthash->{ $tax_id } ||= [ $tax ];
1586 push @{ $taxlisthash->{ $tax_id } }, $cust_bill_pkg, $class;
1588 # determine any exemptions that apply
1589 if (!$tax_seen{$tax_id}) {
1590 $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1591 $tax_seen{$tax_id} = 1;
1594 # tax on tax will be done later, when we actually create the tax
1602 # INTERNAL TAX RATES (cust_main_county)
1604 # We fetch taxes even if the customer is completely exempt,
1605 # because we need to record that fact.
1607 my @loc_keys = qw( district city county state country );
1608 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1610 $taxhash{'taxclass'} = $part_item->taxclass;
1612 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1614 my @taxes = (); # entries are cust_main_county objects
1615 my %taxhash_elim = %taxhash;
1616 my @elim = qw( district city county state );
1619 #first try a match with taxclass
1620 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1622 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1623 #then try a match without taxclass
1624 my %no_taxclass = %taxhash_elim;
1625 $no_taxclass{ 'taxclass' } = '';
1626 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1629 $taxhash_elim{ shift(@elim) } = '';
1631 } while ( !scalar(@taxes) && scalar(@elim) );
1634 my $tax_id = 'cust_main_county '.$_->taxnum;
1635 $taxlisthash->{$tax_id} ||= [ $_ ];
1636 $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1637 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1644 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1646 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1647 or part_fee (which will define the tax eligibility of the product), CLASS is
1648 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1649 location where the service was provided (or billed, depending on
1650 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1651 can apply to this line item.
1657 my $part_item = shift;
1659 my $location = shift;
1661 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1663 my $geocode = $location->geocode('cch');
1665 [ $part_item->tax_rates('cch', $geocode, $class) ]
1669 #### end vestigial code ####
1671 =item collect [ HASHREF | OPTION => VALUE ... ]
1673 (Attempt to) collect money for this customer's outstanding invoices (see
1674 L<FS::cust_bill>). Usually used after the bill method.
1676 Actions are now triggered by billing events; see L<FS::part_event> and the
1677 billing events web interface. Old-style invoice events (see
1678 L<FS::part_bill_event>) have been deprecated.
1680 If there is an error, returns the error, otherwise returns false.
1682 Options are passed as name-value pairs.
1684 Currently available options are:
1690 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.
1694 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1698 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1702 set true to surpress email card/ACH decline notices.
1706 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)
1712 # allows for one time override of normal customer billing method
1717 my( $self, %options ) = @_;
1719 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1721 my $invoice_time = $options{'invoice_time'} || time;
1724 local $SIG{HUP} = 'IGNORE';
1725 local $SIG{INT} = 'IGNORE';
1726 local $SIG{QUIT} = 'IGNORE';
1727 local $SIG{TERM} = 'IGNORE';
1728 local $SIG{TSTP} = 'IGNORE';
1729 local $SIG{PIPE} = 'IGNORE';
1731 my $oldAutoCommit = $FS::UID::AutoCommit;
1732 local $FS::UID::AutoCommit = 0;
1735 $self->select_for_update; #mutex
1738 my $balance = $self->balance;
1739 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1742 if ( exists($options{'retry_card'}) ) {
1743 carp 'retry_card option passed to collect is deprecated; use retry';
1744 $options{'retry'} ||= $options{'retry_card'};
1746 if ( exists($options{'retry'}) && $options{'retry'} ) {
1747 my $error = $self->retry_realtime;
1749 $dbh->rollback if $oldAutoCommit;
1754 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1756 #never want to roll back an event just because it returned an error
1757 # unless $FS::UID::ForceObeyAutoCommit is set
1758 local $FS::UID::AutoCommit = 1
1759 unless !$oldAutoCommit
1760 && $FS::UID::ForceObeyAutoCommit;
1762 $self->do_cust_event(
1763 'debug' => ( $options{'debug'} || 0 ),
1764 'time' => $invoice_time,
1765 'check_freq' => $options{'check_freq'},
1766 'stage' => 'collect',
1771 =item retry_realtime
1773 Schedules realtime / batch credit card / electronic check / LEC billing
1774 events for for retry. Useful if card information has changed or manual
1775 retry is desired. The 'collect' method must be called to actually retry
1778 Implementation details: For either this customer, or for each of this
1779 customer's open invoices, changes the status of the first "done" (with
1780 statustext error) realtime processing event to "failed".
1784 sub retry_realtime {
1787 local $SIG{HUP} = 'IGNORE';
1788 local $SIG{INT} = 'IGNORE';
1789 local $SIG{QUIT} = 'IGNORE';
1790 local $SIG{TERM} = 'IGNORE';
1791 local $SIG{TSTP} = 'IGNORE';
1792 local $SIG{PIPE} = 'IGNORE';
1794 my $oldAutoCommit = $FS::UID::AutoCommit;
1795 local $FS::UID::AutoCommit = 0;
1798 #a little false laziness w/due_cust_event (not too bad, really)
1800 # I guess this is always as of now?
1801 my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1802 my $order = FS::part_event_condition->order_conditions_sql;
1805 . join ( ' OR ' , map {
1806 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1807 my $custnum = FS::part_event->eventtables_custnum->{$_};
1808 "( part_event.eventtable = " . dbh->quote($_)
1809 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1810 . " from $_ $cust_join"
1811 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1812 } FS::part_event->eventtables)
1815 #here is the agent virtualization
1816 my $agent_virt = " ( part_event.agentnum IS NULL
1817 OR part_event.agentnum = ". $self->agentnum. ' )';
1819 #XXX this shouldn't be hardcoded, actions should declare it...
1820 my @realtime_events = qw(
1821 cust_bill_realtime_card
1822 cust_bill_realtime_check
1823 cust_bill_realtime_lec
1827 my $is_realtime_event =
1828 ' part_event.action IN ( '.
1829 join(',', map "'$_'", @realtime_events ).
1832 my $batch_or_statustext =
1833 "( part_event.action = 'cust_bill_batch'
1834 OR ( statustext IS NOT NULL AND statustext != '' )
1838 my @cust_event = qsearch({
1839 'table' => 'cust_event',
1840 'select' => 'cust_event.*',
1841 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1842 'hashref' => { 'status' => 'done' },
1843 'extra_sql' => " AND $batch_or_statustext ".
1844 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1847 my %seen_invnum = ();
1848 foreach my $cust_event (@cust_event) {
1850 #max one for the customer, one for each open invoice
1851 my $cust_X = $cust_event->cust_X;
1852 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1856 or $cust_event->part_event->eventtable eq 'cust_bill'
1859 my $error = $cust_event->retry;
1861 $dbh->rollback if $oldAutoCommit;
1862 return "error scheduling event for retry: $error";
1867 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1872 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1874 Runs billing events; see L<FS::part_event> and the billing events web
1877 If there is an error, returns the error, otherwise returns false.
1879 Options are passed as name-value pairs.
1881 Currently available options are:
1887 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.
1891 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1895 "collect" (the default) or "pre-bill"
1899 set true to surpress email card/ACH decline notices.
1903 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)
1910 # allows for one time override of normal customer billing method
1914 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1917 my( $self, %options ) = @_;
1919 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1921 my $time = $options{'time'} || time;
1924 local $SIG{HUP} = 'IGNORE';
1925 local $SIG{INT} = 'IGNORE';
1926 local $SIG{QUIT} = 'IGNORE';
1927 local $SIG{TERM} = 'IGNORE';
1928 local $SIG{TSTP} = 'IGNORE';
1929 local $SIG{PIPE} = 'IGNORE';
1931 my $oldAutoCommit = $FS::UID::AutoCommit;
1932 local $FS::UID::AutoCommit = 0;
1935 $self->select_for_update; #mutex
1938 my $balance = $self->balance;
1939 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1942 # if ( exists($options{'retry_card'}) ) {
1943 # carp 'retry_card option passed to collect is deprecated; use retry';
1944 # $options{'retry'} ||= $options{'retry_card'};
1946 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1947 # my $error = $self->retry_realtime;
1949 # $dbh->rollback if $oldAutoCommit;
1954 # false laziness w/pay_batch::import_results
1956 my $due_cust_event = $self->due_cust_event(
1957 'debug' => ( $options{'debug'} || 0 ),
1959 'check_freq' => $options{'check_freq'},
1960 'stage' => ( $options{'stage'} || 'collect' ),
1962 unless( ref($due_cust_event) ) {
1963 $dbh->rollback if $oldAutoCommit;
1964 return $due_cust_event;
1967 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1969 #never want to roll back an event just because it or a different one
1971 # unless $FS::UID::ForceObeyAutoCommit is set
1972 local $FS::UID::AutoCommit = 1
1973 unless !$oldAutoCommit
1974 && $FS::UID::ForceObeyAutoCommit;
1976 foreach my $cust_event ( @$due_cust_event ) {
1980 #re-eval event conditions (a previous event could have changed things)
1981 unless ( $cust_event->test_conditions ) {
1982 #don't leave stray "new/locked" records around
1983 my $error = $cust_event->delete;
1984 return $error if $error;
1989 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1990 if $options{'quiet'};
1991 warn " running cust_event ". $cust_event->eventnum. "\n"
1994 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1995 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1996 #XXX wtf is this? figure out a proper dealio with return value
2008 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2010 Inserts database records for and returns an ordered listref of new events due
2011 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2012 events are due, an empty listref is returned. If there is an error, returns a
2013 scalar error message.
2015 To actually run the events, call each event's test_condition method, and if
2016 still true, call the event's do_event method.
2018 Options are passed as a hashref or as a list of name-value pairs. Available
2025 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.
2029 "collect" (the default) or "pre-bill"
2033 "Current time" for the events.
2037 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)
2041 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2045 Explicitly pass the objects to be tested (typically used with eventtable).
2049 Set to true to return the objects, but not actually insert them into the
2056 sub due_cust_event {
2058 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2061 #my $DEBUG = $opt{'debug'}
2062 $opt{'debug'} ||= 0; # silence some warnings
2063 local($DEBUG) = $opt{'debug'}
2064 if $opt{'debug'} > $DEBUG;
2065 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2067 warn "$me due_cust_event called with options ".
2068 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2071 $opt{'time'} ||= time;
2073 local $SIG{HUP} = 'IGNORE';
2074 local $SIG{INT} = 'IGNORE';
2075 local $SIG{QUIT} = 'IGNORE';
2076 local $SIG{TERM} = 'IGNORE';
2077 local $SIG{TSTP} = 'IGNORE';
2078 local $SIG{PIPE} = 'IGNORE';
2080 my $oldAutoCommit = $FS::UID::AutoCommit;
2081 local $FS::UID::AutoCommit = 0;
2084 $self->select_for_update #mutex
2085 unless $opt{testonly};
2088 # find possible events (initial search)
2091 my @cust_event = ();
2093 my @eventtable = $opt{'eventtable'}
2094 ? ( $opt{'eventtable'} )
2095 : FS::part_event->eventtables_runorder;
2097 my $check_freq = $opt{'check_freq'} || '1d';
2099 foreach my $eventtable ( @eventtable ) {
2102 if ( $opt{'objects'} ) {
2104 @objects = @{ $opt{'objects'} };
2106 } elsif ( $eventtable eq 'cust_main' ) {
2108 @objects = ( $self );
2112 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2113 # linkage not needed here because FS::cust_main->$eventtable will
2116 #some false laziness w/Cron::bill bill_where
2118 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2119 'time' => $opt{'time'});
2120 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2121 'time'=>$opt{'time'},
2123 $where = $where ? "AND $where" : '';
2125 my $are_part_event =
2126 "EXISTS ( SELECT 1 FROM part_event $join
2127 WHERE check_freq = '$check_freq'
2128 AND eventtable = '$eventtable'
2129 AND ( disabled = '' OR disabled IS NULL )
2135 @objects = $self->$eventtable(
2136 'addl_from' => $cm_join,
2137 'extra_sql' => " AND $are_part_event",
2139 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2141 my @e_cust_event = ();
2143 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2145 my $cross = "CROSS JOIN $eventtable $linkage";
2146 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2147 unless $eventtable eq 'cust_main';
2149 foreach my $object ( @objects ) {
2151 #this first search uses the condition_sql magic for optimization.
2152 #the more possible events we can eliminate in this step the better
2154 my $cross_where = '';
2155 my $pkey = $object->primary_key;
2156 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2158 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2159 'time' => $opt{'time'});
2161 FS::part_event_condition->where_conditions_sql( $eventtable,
2162 'time'=>$opt{'time'}
2164 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2166 $extra_sql = "AND $extra_sql" if $extra_sql;
2168 #here is the agent virtualization
2169 $extra_sql .= " AND ( part_event.agentnum IS NULL
2170 OR part_event.agentnum = ". $self->agentnum. ' )';
2172 $extra_sql .= " $order";
2174 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2175 if $opt{'debug'} > 2;
2176 my @part_event = qsearch( {
2177 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2178 'select' => 'part_event.*',
2179 'table' => 'part_event',
2180 'addl_from' => "$cross $join",
2181 'hashref' => { 'check_freq' => $check_freq,
2182 'eventtable' => $eventtable,
2185 'extra_sql' => "AND $cross_where $extra_sql",
2189 my $pkey = $object->primary_key;
2190 warn " ". scalar(@part_event).
2191 " possible events found for $eventtable ". $object->$pkey(). "\n";
2194 push @e_cust_event, map {
2195 $_->new_cust_event($object, 'time' => $opt{'time'})
2200 warn " ". scalar(@e_cust_event).
2201 " subtotal possible cust events found for $eventtable\n"
2204 push @cust_event, @e_cust_event;
2208 warn " ". scalar(@cust_event).
2209 " total possible cust events found in initial search\n"
2217 $opt{stage} ||= 'collect';
2219 grep { my $stage = $_->part_event->event_stage;
2220 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2230 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2233 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2236 warn " invalid conditions not eliminated with condition_sql:\n".
2237 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2238 if keys %unsat && $DEBUG; # > 1;
2244 unless( $opt{testonly} ) {
2245 foreach my $cust_event ( @cust_event ) {
2247 my $error = $cust_event->insert();
2249 $dbh->rollback if $oldAutoCommit;
2256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2262 warn " returning events: ". Dumper(@cust_event). "\n"
2269 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2271 Applies unapplied payments and credits.
2272 Payments with the no_auto_apply flag set will not be applied.
2274 In most cases, this new method should be used in place of sequential
2275 apply_payments and apply_credits methods.
2277 A hash of optional arguments may be passed. Currently "manual" is supported.
2278 If true, a payment receipt is sent instead of a statement when
2279 'payment_receipt_email' configuration option is set.
2281 If there is an error, returns the error, otherwise returns false.
2285 sub apply_payments_and_credits {
2286 my( $self, %options ) = @_;
2288 local $SIG{HUP} = 'IGNORE';
2289 local $SIG{INT} = 'IGNORE';
2290 local $SIG{QUIT} = 'IGNORE';
2291 local $SIG{TERM} = 'IGNORE';
2292 local $SIG{TSTP} = 'IGNORE';
2293 local $SIG{PIPE} = 'IGNORE';
2295 my $oldAutoCommit = $FS::UID::AutoCommit;
2296 local $FS::UID::AutoCommit = 0;
2299 my $savepoint_label = 'Billing__apply_payments_and_credits';
2300 savepoint_create( $savepoint_label );
2302 $self->select_for_update; #mutex
2304 foreach my $cust_bill ( $self->open_cust_bill ) {
2305 my $error = $cust_bill->apply_payments_and_credits(%options);
2307 savepoint_rollback_and_release( $savepoint_label );
2308 $dbh->rollback if $oldAutoCommit;
2309 return "Error applying: $error";
2313 savepoint_release( $savepoint_label );
2314 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2319 =item apply_credits OPTION => VALUE ...
2321 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2322 to outstanding invoice balances in chronological order (or reverse
2323 chronological order if the I<order> option is set to B<newest>) and returns the
2324 value of any remaining unapplied credits available for refund (see
2325 L<FS::cust_refund>).
2327 Dies if there is an error.
2335 local $SIG{HUP} = 'IGNORE';
2336 local $SIG{INT} = 'IGNORE';
2337 local $SIG{QUIT} = 'IGNORE';
2338 local $SIG{TERM} = 'IGNORE';
2339 local $SIG{TSTP} = 'IGNORE';
2340 local $SIG{PIPE} = 'IGNORE';
2342 my $oldAutoCommit = $FS::UID::AutoCommit;
2343 local $FS::UID::AutoCommit = 0;
2346 $self->select_for_update; #mutex
2348 unless ( $self->total_unapplied_credits ) {
2349 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2353 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2354 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2356 my @invoices = $self->open_cust_bill;
2357 @invoices = sort { $b->_date <=> $a->_date } @invoices
2358 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2360 if ( $conf->exists('pkg-balances') ) {
2361 # limit @credits to those w/ a pkgnum grepped from $self
2363 foreach my $i (@invoices) {
2364 foreach my $li ( $i->cust_bill_pkg ) {
2365 $pkgnums{$li->pkgnum} = 1;
2368 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2373 foreach my $cust_bill ( @invoices ) {
2375 if ( !defined($credit) || $credit->credited == 0) {
2376 $credit = pop @credits or last;
2380 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2381 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2383 $owed = $cust_bill->owed;
2385 unless ( $owed > 0 ) {
2386 push @credits, $credit;
2390 my $amount = min( $credit->credited, $owed );
2392 my $cust_credit_bill = new FS::cust_credit_bill ( {
2393 'crednum' => $credit->crednum,
2394 'invnum' => $cust_bill->invnum,
2395 'amount' => $amount,
2397 $cust_credit_bill->pkgnum( $credit->pkgnum )
2398 if $conf->exists('pkg-balances') && $credit->pkgnum;
2399 my $error = $cust_credit_bill->insert;
2401 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2405 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2409 my $total_unapplied_credits = $self->total_unapplied_credits;
2411 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2413 return $total_unapplied_credits;
2416 =item apply_payments [ OPTION => VALUE ... ]
2418 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2419 to outstanding invoice balances in chronological order.
2420 Payments with the no_auto_apply flag set will not be applied.
2422 #and returns the value of any remaining unapplied payments.
2424 A hash of optional arguments may be passed. Currently "manual" is supported.
2425 If true, a payment receipt is sent instead of a statement when
2426 'payment_receipt_email' configuration option is set.
2428 Dies if there is an error.
2432 sub apply_payments {
2433 my( $self, %options ) = @_;
2435 local $SIG{HUP} = 'IGNORE';
2436 local $SIG{INT} = 'IGNORE';
2437 local $SIG{QUIT} = 'IGNORE';
2438 local $SIG{TERM} = 'IGNORE';
2439 local $SIG{TSTP} = 'IGNORE';
2440 local $SIG{PIPE} = 'IGNORE';
2442 my $oldAutoCommit = $FS::UID::AutoCommit;
2443 local $FS::UID::AutoCommit = 0;
2446 $self->select_for_update; #mutex
2450 my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay;
2452 my @invoices = $self->open_cust_bill;
2454 if ( $conf->exists('pkg-balances') ) {
2455 # limit @payments to those w/ a pkgnum grepped from $self
2457 foreach my $i (@invoices) {
2458 foreach my $li ( $i->cust_bill_pkg ) {
2459 $pkgnums{$li->pkgnum} = 1;
2462 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2467 foreach my $cust_bill ( @invoices ) {
2469 if ( !defined($payment) || $payment->unapplied == 0 ) {
2470 $payment = pop @payments or last;
2474 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2475 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2477 $owed = $cust_bill->owed;
2479 unless ( $owed > 0 ) {
2480 push @payments, $payment;
2484 my $amount = min( $payment->unapplied, $owed );
2487 'paynum' => $payment->paynum,
2488 'invnum' => $cust_bill->invnum,
2489 'amount' => $amount,
2491 $cbp->{_date} = $payment->_date
2492 if $options{'manual'} && $options{'backdate_application'};
2493 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2494 $cust_bill_pay->pkgnum( $payment->pkgnum )
2495 if $conf->exists('pkg-balances') && $payment->pkgnum;
2496 my $error = $cust_bill_pay->insert(%options);
2498 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2502 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2506 my $total_unapplied_payments = $self->total_unapplied_payments;
2508 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2510 return $total_unapplied_payments;
2520 suspend_adjourned_pkgs
2521 unsuspend_resumed_pkgs
2524 (do_cust_event pre-bill)
2526 _omit_zero_value_bundles
2529 apply_payments_and_credits
2538 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>