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 );
13 use FS::cust_bill_pkg;
14 use FS::cust_bill_pkg_display;
15 use FS::cust_bill_pay;
16 use FS::cust_credit_bill;
17 use FS::cust_tax_adjustment;
19 use FS::tax_rate_location;
20 use FS::cust_bill_pkg_tax_location;
21 use FS::cust_bill_pkg_tax_rate_location;
23 use FS::part_event_condition;
25 use FS::FeeOrigin_Mixin;
29 # 1 is mostly method/subroutine entry and options
30 # 2 traces progress of some operations
31 # 3 is even more information including possibly sensitive data
33 $me = '[FS::cust_main::Billing]';
35 install_callback FS::UID sub {
37 #yes, need it for stuff below (prolly should be cached)
42 FS::cust_main::Billing - Billing mixin for cust_main
48 These methods are available on FS::cust_main objects.
54 =item bill_and_collect
56 Cancels and suspends any packages due, generates bills, applies payments and
57 credits, and applies collection events to run cards, send bills and notices,
60 By default, warns on errors and continues with the next operation (but see the
63 Options are passed as name-value pairs. Currently available options are:
69 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:
73 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
77 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.
81 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
85 If set true, re-charges setup fees.
89 If set any errors prevent subsequent operations from continusing. If set
90 specifically to "return", returns the error (or false, if there is no error).
91 Any other true value causes errors to die.
95 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)
99 Optional FS::queue entry to receive status updates.
103 Options are passed to the B<bill> and B<collect> methods verbatim, so all
104 options of those methods are also available.
108 sub bill_and_collect {
109 my( $self, %options ) = @_;
111 my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
112 my %logopt = (object => $self);
113 $log->debug('start', %logopt);
117 #$options{actual_time} not $options{time} because freeside-daily -d is for
118 #pre-printing invoices
120 $options{'actual_time'} ||= time;
121 my $job = $options{'job'};
123 my $actual_time = ( $conf->exists('next-bill-ignore-time')
124 ? day_end( $options{actual_time} )
125 : $options{actual_time}
128 $job->update_statustext('0,cleaning expired packages') if $job;
129 $log->debug('canceling expired packages', %logopt);
130 $error = $self->cancel_expired_pkgs( $actual_time );
132 $error = "Error expiring custnum ". $self->custnum. ": $error";
133 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
134 elsif ( $options{fatal} ) { die $error; }
135 else { warn $error; }
138 $log->debug('suspending adjourned packages', %logopt);
139 $error = $self->suspend_adjourned_pkgs( $actual_time );
141 $error = "Error adjourning custnum ". $self->custnum. ": $error";
142 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
143 elsif ( $options{fatal} ) { die $error; }
144 else { warn $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; }
152 elsif ( $options{fatal} ) { die $error; }
153 else { warn $error; }
156 $job->update_statustext('20,billing packages') if $job;
157 $log->debug('billing packages', %logopt);
158 $error = $self->bill( %options );
160 $error = "Error billing custnum ". $self->custnum. ": $error";
161 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
162 elsif ( $options{fatal} ) { die $error; }
163 else { warn $error; }
166 $job->update_statustext('50,applying payments and credits') if $job;
167 $log->debug('applying payments and credits', %logopt);
168 $error = $self->apply_payments_and_credits;
170 $error = "Error applying custnum ". $self->custnum. ": $error";
171 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
172 elsif ( $options{fatal} ) { die $error; }
173 else { warn $error; }
176 # In a batch tax environment, do not run collection if any pending
177 # invoices were created. Collection will run after the next tax batch.
178 my $tax = FS::TaxEngine->new;
179 if ( $tax->info->{batch} and
180 qsearch('cust_bill', { custnum => $self->custnum, pending => 'Y' })
183 warn "skipped collection for custnum ".$self->custnum.
184 " due to pending invoices\n" if $DEBUG;
185 } elsif ( $conf->exists('cancelled_cust-noevents')
186 && ! $self->num_ncancelled_pkgs )
188 warn "skipped collection for custnum ".$self->custnum.
189 " because they have no active packages\n" if $DEBUG;
191 # run collection normally
192 $job->update_statustext('70,running collection events') if $job;
193 $log->debug('running collection events', %logopt);
194 $error = $self->collect( %options );
196 $error = "Error collecting custnum ". $self->custnum. ": $error";
197 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
198 elsif ($options{fatal} ) { die $error; }
199 else { warn $error; }
203 $job->update_statustext('100,finished') if $job;
204 $log->debug('finish', %logopt);
210 sub cancel_expired_pkgs {
211 my ( $self, $time, %options ) = @_;
213 my @cancel_pkgs = $self->ncancelled_pkgs( {
214 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
219 my @really_cancel_pkgs;
222 CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
223 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
226 if ( $cust_pkg->change_to_pkgnum ) {
228 my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
230 push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
231 $cust_pkg->change_to_pkgnum.'; not expiring';
234 $error = $cust_pkg->change( 'cust_pkg' => $new_pkg,
235 'unprotect_svcs' => 1 );
236 $error = '' if ref $error eq 'FS::cust_pkg';
238 } else { # just cancel it
240 push @really_cancel_pkgs, $cust_pkg;
241 push @cancel_reasons, $cpr;
246 if (@really_cancel_pkgs) {
248 my %cancel_opt = ( 'cust_pkg' => \@really_cancel_pkgs,
249 'cust_pkg_reason' => \@cancel_reasons,
253 push @errors, $self->cancel_pkgs(%cancel_opt);
257 join(' / ', @errors);
261 sub suspend_adjourned_pkgs {
262 my ( $self, $time, %options ) = @_;
264 my @susp_pkgs = $self->ncancelled_pkgs( {
266 " AND ( susp IS NULL OR susp = 0 )
267 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
268 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
273 #only because there's no SQL test for is_prepaid :/
275 grep { ( $_->part_pkg->is_prepaid
280 && $_->adjourn <= $time
288 foreach my $cust_pkg ( @susp_pkgs ) {
289 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
290 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
291 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
292 'reason_otaker' => $cpr->otaker
296 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
299 join(' / ', @errors);
303 sub unsuspend_resumed_pkgs {
304 my ( $self, $time, %options ) = @_;
306 my @unsusp_pkgs = $self->ncancelled_pkgs( {
307 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
312 foreach my $cust_pkg ( @unsusp_pkgs ) {
313 my $error = $cust_pkg->unsuspend( 'time' => $time );
314 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
317 join(' / ', @errors);
323 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
324 conjunction with the collect method by calling B<bill_and_collect>.
326 If there is an error, returns the error, otherwise returns false.
328 Options are passed as name-value pairs. Currently available options are:
334 If set true, re-charges setup fees.
338 If set true then only bill recurring charges, not setup, usage, one time
343 If set, then override the normal frequency and look for a part_pkg_discount
344 to take at that frequency. This is appropriate only when the normal
345 frequency for all packages is monthly, and is an error otherwise. Use
346 C<pkg_list> to limit the set of packages included in billing.
350 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:
354 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
358 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
360 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
364 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
368 Do not bill prepaid packages. Used by freeside-daily.
372 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.
376 This boolean value informs the us that the package is being cancelled. This
377 typically might mean not charging the normal recurring fee but only usage
378 fees since the last billing. Setup charges may be charged. Not all package
379 plans support this feature (they tend to charge 0).
383 Prevent the resetting of usage limits during this call.
387 Do not save the generated bill in the database. Useful with return_bill
391 A list reference on which the generated bill(s) will be returned.
395 Boolean value; indicates that this is an estimate rather than a "tax invoice".
396 This will be passed through to the tax engine, as online tax services
397 sometimes need to know it for reporting purposes. Otherwise it has no effect.
401 Optional terms to be printed on this invoice. Otherwise, customer-specific
402 terms or the default terms are used.
409 my( $self, %options ) = @_;
411 return '' if $self->complimentary eq 'Y';
413 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
414 my $log = FS::Log->new('FS::cust_main::Billing::bill');
415 my %logopt = (object => $self);
417 $log->debug('start', %logopt);
418 warn "$me bill customer ". $self->custnum. "\n"
421 my $time = $options{'time'} || time;
422 my $invoice_time = $options{'invoice_time'} || $time;
424 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
429 $options{'not_pkgpart'} ||= {};
430 $options{'not_pkgpart'} = { map { $_ => 1 }
431 split(/\s*,\s*/, $options{'not_pkgpart'})
433 unless ref($options{'not_pkgpart'});
435 local $SIG{HUP} = 'IGNORE';
436 local $SIG{INT} = 'IGNORE';
437 local $SIG{QUIT} = 'IGNORE';
438 local $SIG{TERM} = 'IGNORE';
439 local $SIG{TSTP} = 'IGNORE';
440 local $SIG{PIPE} = 'IGNORE';
442 my $oldAutoCommit = $FS::UID::AutoCommit;
443 local $FS::UID::AutoCommit = 0;
446 $log->debug('acquiring lock', %logopt);
447 warn "$me acquiring lock on customer ". $self->custnum. "\n"
450 $self->select_for_update; #mutex
452 $log->debug('running pre-bill events', %logopt);
453 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
456 my $error = $self->do_cust_event(
457 'debug' => ( $options{'debug'} || 0 ),
458 'time' => $invoice_time,
459 'check_freq' => $options{'check_freq'},
460 'stage' => 'pre-bill',
462 unless $options{no_commit};
464 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
468 $log->debug('done running pre-bill events', %logopt);
469 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
472 #keep auto-charge and non-auto-charge line items separate
473 my @passes = ( '', 'no_auto' );
475 my %cust_bill_pkg = map { $_ => [] } @passes;
478 # find the packages which are due for billing, find out how much they are
479 # & generate invoice database.
482 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
483 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
485 my @precommit_hooks = ();
487 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
490 my $tax_is_batch = '';
492 $tax_engines{$_} = FS::TaxEngine->new(cust_main => $self,
493 invoice_time => $invoice_time,
494 cancel => $options{cancel},
495 estimate => $options{estimate},
497 $tax_is_batch ||= $tax_engines{$_}->info->{batch};
500 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
502 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
504 my $part_pkg = $cust_pkg->part_pkg;
506 next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
508 $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
509 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
511 #? to avoid use of uninitialized value errors... ?
512 $cust_pkg->setfield('bill', '')
513 unless defined($cust_pkg->bill);
515 my $real_pkgpart = $cust_pkg->pkgpart;
516 my %hash = $cust_pkg->hash;
518 # we could implement this bit as FS::part_pkg::has_hidden, but we already
519 # suffer from performance issues
520 $options{has_hidden} = 0;
521 my @part_pkg = $part_pkg->self_and_bill_linked;
522 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
524 # if this package was changed from another package,
525 # and it hasn't been billed since then,
526 # and package balances are enabled,
527 if ( $cust_pkg->change_pkgnum
528 and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
529 and $cust_pkg->change_date < $invoice_time
530 and $conf->exists('pkg-balances') )
532 # _transfer_balance will also create the appropriate credit
533 my @transfer_items = $self->_transfer_balance($cust_pkg);
534 # $part_pkg[0] is the "real" part_pkg
535 my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
537 push @{ $cust_bill_pkg{$pass} }, @transfer_items;
538 # treating this as recur, just because most charges are recur...
539 ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
541 # currently not considering separate_bill here, as it's for
542 # one-time charges only
545 foreach my $part_pkg ( @part_pkg ) {
547 my $this_cust_pkg = $cust_pkg;
548 # for add-on packages, copy the object to avoid leaking changes back to
549 # the caller if pkg_list is in use; see RT#73607
550 if ( $part_pkg->get('pkgpart') != $real_pkgpart ) {
551 $this_cust_pkg = FS::cust_pkg->new({ %hash });
555 if ( $this_cust_pkg->separate_bill ) {
556 # if no_auto is also set, that's fine. we just need to not have
557 # invoices that are both auto and no_auto, and since the package
558 # gets an invoice all to itself, it will only be one or the other.
559 $pass = $this_cust_pkg->pkgnum;
560 if (!exists $cust_bill_pkg{$pass}) { # it may not exist yet
562 $total_setup{$pass} = do { my $z = 0; \$z };
563 $total_recur{$pass} = do { my $z = 0; \$z };
564 # it also needs its own tax context
565 $tax_engines{$pass} = FS::TaxEngine->new(
567 invoice_time => $invoice_time,
568 cancel => $options{cancel},
569 estimate => $options{estimate},
571 $cust_bill_pkg{$pass} = [];
573 } elsif ( ($this_cust_pkg->no_auto || $part_pkg->no_auto) ) {
577 my $next_bill = $this_cust_pkg->getfield('bill') || 0;
579 # let this run once if this is the last bill upon cancellation
580 while ( $next_bill <= $cmp_time or $options{cancel} ) {
582 $self->_make_lines( 'part_pkg' => $part_pkg,
583 'cust_pkg' => $this_cust_pkg,
584 'precommit_hooks' => \@precommit_hooks,
585 'line_items' => $cust_bill_pkg{$pass},
586 'setup' => $total_setup{$pass},
587 'recur' => $total_recur{$pass},
588 'tax_engine' => $tax_engines{$pass},
590 'real_pkgpart' => $real_pkgpart,
591 'options' => \%options,
594 # Stop if anything goes wrong
597 # or if we're not incrementing the bill date.
598 last if ($this_cust_pkg->getfield('bill') || 0) == $next_bill;
600 # or if we're letting it run only once
601 last if $options{cancel};
603 $next_bill = $this_cust_pkg->getfield('bill') || 0;
605 #stop if -o was passed to freeside-daily
606 last if $options{'one_recur'};
609 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
613 } #foreach my $part_pkg
615 } #foreach my $cust_pkg
617 foreach my $pass (@passes) { # keys %cust_bill_pkg )
619 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
621 warn "$me billing pass $pass\n"
622 #.Dumper(\@cust_bill_pkg)."\n"
629 my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
630 hashref => { 'billpkgnum' => '' }
632 warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
633 if @pending_fees and $DEBUG > 1;
635 # determine whether to generate an invoice
636 my $generate_bill = scalar(@cust_bill_pkg) > 0;
638 foreach my $fee (@pending_fees) {
639 $generate_bill = 1 unless $fee->nextbill;
642 # don't create an invoice with no line items, or where the only line
643 # items are fees that are supposed to be held until the next invoice
644 next if !$generate_bill;
648 foreach my $fee_origin (@pending_fees) {
649 my $part_fee = $fee_origin->part_fee;
651 # check whether the fee is applicable before doing anything expensive:
653 # if the fee def belongs to a different agent, don't charge the fee.
654 # event conditions should prevent this, but just in case they don't,
656 if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
657 warn "tried to charge fee#".$part_fee->feepart .
658 " on customer#".$self->custnum." from a different agent.\n";
661 # also skip if it's disabled
662 next if $part_fee->disabled eq 'Y';
664 # Decide which invoice to base the fee on.
665 my $cust_bill = $fee_origin->cust_bill;
667 # Then link it to the current invoice. This isn't the real cust_bill
668 # object that will be inserted--in particular there are no taxes yet.
669 # If you want to charge a fee on the total invoice amount including
670 # taxes, you have to put the fee on the next invoice.
671 $cust_bill = FS::cust_bill->new({
672 'custnum' => $self->custnum,
673 'cust_bill_pkg' => \@cust_bill_pkg,
674 'charged' => ${ $total_setup{$pass} } +
675 ${ $total_recur{$pass} },
678 # If the origin is for a specific package, then only apply the fee to
679 # line items from that package.
680 if ( my $cust_pkg = $fee_origin->cust_pkg ) {
681 my @charge_fee_on_item;
682 my $charge_fee_on_amount = 0;
683 foreach (@cust_bill_pkg) {
684 if ($_->pkgnum == $cust_pkg->pkgnum) {
685 push @charge_fee_on_item, $_;
686 $charge_fee_on_amount += $_->setup + $_->recur;
689 $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
690 $cust_bill->set('charged', $charge_fee_on_amount);
693 } # $cust_bill is now set
695 my $fee_item = $part_fee->lineitem($cust_bill) or next;
696 # link this so that we can clear the marker on inserting the line item
697 $fee_item->set('fee_origin', $fee_origin);
698 push @fee_items, $fee_item;
702 # add fees to the invoice
703 foreach my $fee_item (@fee_items) {
705 push @cust_bill_pkg, $fee_item;
706 ${ $total_setup{$pass} } += $fee_item->setup;
707 ${ $total_recur{$pass} } += $fee_item->recur;
709 my $part_fee = $fee_item->part_fee;
710 my $fee_location = $self->ship_location; # I think?
712 my $error = $tax_engines{''}->add_sale($fee_item);
714 return $error if $error;
718 # XXX implementation of fees is supposed to make this go away...
719 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
720 !$conf->exists('postal_invoice-recurring_only')
724 my $postal_pkg = $self->charge_postal_fee();
725 if ( $postal_pkg && !ref( $postal_pkg ) ) {
727 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
728 return "can't charge postal invoice fee for customer ".
729 $self->custnum. ": $postal_pkg";
731 } elsif ( $postal_pkg ) {
733 my $real_pkgpart = $postal_pkg->pkgpart;
734 # we could implement this bit as FS::part_pkg::has_hidden, but we already
735 # suffer from performance issues
736 $options{has_hidden} = 0;
737 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
738 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
740 foreach my $part_pkg ( @part_pkg ) {
741 my %postal_options = %options;
742 delete $postal_options{cancel};
744 $self->_make_lines( 'part_pkg' => $part_pkg,
745 'cust_pkg' => $postal_pkg,
746 'precommit_hooks' => \@precommit_hooks,
747 'line_items' => \@cust_bill_pkg,
748 'setup' => $total_setup{$pass},
749 'recur' => $total_recur{$pass},
750 'tax_engine' => $tax_engines{$pass},
752 'real_pkgpart' => $real_pkgpart,
753 'options' => \%postal_options,
756 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
761 # it's silly to have a zero value postal_pkg, but....
762 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
769 #XXX does this work with batch tax engines?
770 warn "adding tax adjustments...\n" if $DEBUG > 2;
771 foreach my $cust_tax_adjustment (
772 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
778 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
780 my $itemdesc = $cust_tax_adjustment->taxname;
781 $itemdesc = '' if $itemdesc eq 'Tax';
783 push @cust_bill_pkg, new FS::cust_bill_pkg {
789 'itemdesc' => $itemdesc,
790 'itemcomment' => $cust_tax_adjustment->comment,
791 'cust_tax_adjustment' => $cust_tax_adjustment,
792 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
797 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
799 my $balance = $self->balance;
801 my $previous_bill = qsearchs({ 'table' => 'cust_bill',
802 'hashref' => { custnum=>$self->custnum },
803 'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
805 my $previous_balance =
807 ? ( $previous_bill->billing_balance + $previous_bill->charged )
810 $log->debug('creating the new invoice', %logopt);
811 warn "creating the new invoice\n" if $DEBUG;
812 #create the new invoice
813 my $cust_bill = new FS::cust_bill ( {
814 'custnum' => $self->custnum,
815 '_date' => $invoice_time,
816 'charged' => $charged,
817 'billing_balance' => $balance,
818 'previous_balance' => $previous_balance,
819 'invoice_terms' => $options{'invoice_terms'},
820 'cust_bill_pkg' => \@cust_bill_pkg,
821 'pending' => 'Y', # clear this after doing taxes
824 if (!$options{no_commit}) {
825 # probably we ought to insert it as pending, and then rollback
826 # without ever un-pending it
827 $error = $cust_bill->insert;
829 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
830 return "can't create invoice for customer #". $self->custnum. ": $error";
835 # calculate and append taxes
836 if ( ! $tax_is_batch) {
838 my $arrayref = eval { $tax_engines{$pass}->calculate_taxes($cust_bill) };
841 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
845 # or should this be in TaxEngine?
847 foreach my $taxline ( @$arrayref ) {
848 $total_tax += $taxline->setup;
849 $taxline->set('invnum' => $cust_bill->invnum); # just to be sure
850 push @cust_bill_pkg, $taxline; # for return_bill
852 if (!$options{no_commit}) {
853 my $error = $taxline->insert;
855 $dbh->rollback if $oldAutoCommit;
862 # add tax to the invoice amount and finalize it
863 ${ $total_setup{$pass} } = sprintf('%.2f', ${ $total_setup{$pass} } + $total_tax);
864 $charged = sprintf('%.2f', $charged + $total_tax);
865 $cust_bill->set('charged', $charged);
866 $cust_bill->set('pending', '');
868 if (!$options{no_commit}) {
869 my $error = $cust_bill->replace;
871 $dbh->rollback if $oldAutoCommit;
876 } # if !$tax_is_batch
877 # if it IS batch, then we'll do all this in process_tax_batch
879 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
881 } #foreach my $pass ( keys %cust_bill_pkg )
883 foreach my $hook ( @precommit_hooks ) {
886 } unless $options{no_commit};
888 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
889 return "$@ running precommit hook $hook\n";
893 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
898 #discard bundled packages of 0 value
899 # XXX we should reconsider whether we even need this
900 sub _omit_zero_value_bundles {
905 my $discount_show_always = $conf->exists('discount-show-always');
908 # Sort @in the same way we do during invoice rendering, so we can identify
909 # bundles. See FS::Template_Mixin::_items_nontax.
910 @in = sort { $a->pkgnum <=> $b->pkgnum or
911 $a->sdate <=> $b->sdate or
912 ($a->pkgpart_override ? 0 : -1) or
913 ($b->pkgpart_override ? 0 : 1) or
914 $b->hidden cmp $a->hidden or
915 $a->pkgpart_override <=> $b->pkgpart_override
918 # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg
919 # _without_ pkgpart_override, that's the start of the new bundle. if there's
920 # an existing bundle, and it contains a nonzero amount (or a zero amount
921 # that's displayable anyway), push all line items in the bundle.
922 foreach my $cust_bill_pkg ( @in ) {
924 if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) {
925 # ship out this bundle and reset it
933 # add this item to the current bundle
934 push @bundle, $cust_bill_pkg;
936 # determine if it makes the bundle displayable
937 if ( $cust_bill_pkg->setup > 0
938 or $cust_bill_pkg->recur > 0
939 or $cust_bill_pkg->setup_show_zero
940 or $cust_bill_pkg->recur_show_zero
941 or ($discount_show_always
942 and scalar(@{ $cust_bill_pkg->get('discounts')})
954 warn " _omit_zero_value_bundles: ". scalar(@in).
955 '->'. scalar(@out). "\n" #. Dumper(@out). "\n"
962 my ($self, %params) = @_;
964 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
966 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
967 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
968 my $cust_location = $cust_pkg->tax_location;
969 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
970 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
971 my $total_setup = $params{setup} or die "no setup accumulator specified";
972 my $total_recur = $params{recur} or die "no recur accumulator specified";
973 my $time = $params{'time'} or die "no time specified";
974 my (%options) = %{$params{options}};
976 my $tax_engine = $params{tax_engine};
978 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
979 # this should never happen
980 die 'freq_override billing attempted on non-monthly package '.
985 my $real_pkgpart = $params{real_pkgpart};
986 my %hash = $cust_pkg->hash;
987 my $old_cust_pkg = new FS::cust_pkg \%hash;
992 $cust_pkg->pkgpart($part_pkg->pkgpart);
994 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1005 my @setup_discounts = ();
1006 my %setup_param = ( 'discounts' => \@setup_discounts,
1007 'real_pkgpart' => $params{real_pkgpart}
1009 my $setup_billed_currency = '';
1010 my $setup_billed_amount = 0;
1011 # Conditions for setting setup date and charging the setup fee:
1012 # - this is not a recurring-only billing run
1013 # - and the package is not currently being canceled
1014 # - and, unless we're specifically told otherwise via 'resetup':
1015 # - it doesn't already HAVE a setup date
1016 # - or a start date in the future
1017 # - and it's not suspended
1018 # - and it doesn't have an expire date in the past
1020 # The "disable_setup_suspended" option is now obsolete; we never set the
1021 # setup date on a suspended package.
1022 if ( ! $options{recurring_only}
1023 and ! $options{cancel}
1024 and ( $options{'resetup'}
1025 || ( ! $cust_pkg->setup
1026 && ( ! $cust_pkg->start_date
1027 || $cust_pkg->start_date <= $cmp_time
1029 && ( ! $cust_pkg->getfield('susp') )
1032 and ( ! $cust_pkg->expire
1033 || $cust_pkg->expire > $cmp_time )
1037 warn " bill setup\n" if $DEBUG > 1;
1039 unless ( $cust_pkg->waive_setup ) {
1042 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1043 return "$@ running calc_setup for $cust_pkg\n"
1046 # Only increment unitsetup here if there IS a setup fee.
1047 # prorate_defer_bill may cause calc_setup on a setup-stage package
1048 # to return zero, and the setup fee to be charged later. (This happens
1049 # when it's first billed on the prorate cutoff day. RT#31276.)
1051 $unitsetup = $cust_pkg->base_setup()
1055 if ( $setup_param{'billed_currency'} ) {
1056 $setup_billed_currency = delete $setup_param{'billed_currency'};
1057 $setup_billed_amount = delete $setup_param{'billed_amount'};
1061 if ( $cust_pkg->get('setup') ) {
1063 } elsif ( $cust_pkg->get('start_date') ) {
1064 # this allows start_date to be used to set the first bill date
1065 $cust_pkg->set('setup', $cust_pkg->get('start_date'));
1067 # if unspecified, start it right now
1068 $cust_pkg->set('setup', $time);
1071 $cust_pkg->setfield('start_date', '')
1072 if $cust_pkg->start_date;
1077 # bill recurring fee
1082 my @recur_discounts = ();
1083 my $recur_billed_currency = '';
1084 my $recur_billed_amount = 0;
1087 my $override_quantity;
1089 # Conditions for billing the recurring fee:
1090 # - the package doesn't have a future start date
1091 # - and it's not suspended
1092 # - unless suspend_bill is enabled on the package or package def
1093 # - but still not, if the package is on hold
1094 # - or it's suspended for a delayed cancellation
1095 # - and its next bill date is in the past
1096 # - or it doesn't have a next bill date yet
1097 # - or it's a one-time charge
1098 # - or it's a CDR plan with the "bill_every_call" option
1099 # - or it's being canceled
1100 # - and it doesn't have an expire date in the past (this can happen with
1102 # - again, unless it's being canceled
1103 if ( ! $cust_pkg->start_date
1106 || ( $cust_pkg->susp != $cust_pkg->order_date
1107 && ( $cust_pkg->option('suspend_bill',1)
1108 || ( $part_pkg->option('suspend_bill', 1)
1109 && ! $cust_pkg->option('no_suspend_bill',1)
1113 || $cust_pkg->is_status_delay_cancel
1116 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1117 || ( $part_pkg->plan eq 'voip_cdr'
1118 && $part_pkg->option('bill_every_call')
1123 ( ! $cust_pkg->expire
1124 || $cust_pkg->expire > $cmp_time
1129 # XXX should this be a package event? probably. events are called
1130 # at collection time at the moment, though...
1131 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1132 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1133 #don't want to reset usage just cause we want a line item??
1134 #&& $part_pkg->pkgpart == $real_pkgpart;
1136 warn " bill recur\n" if $DEBUG > 1;
1139 # XXX shared with $recur_prog
1140 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1144 #over two params! lets at least switch to a hashref for the rest...
1145 my $increment_next_bill = ( $part_pkg->freq ne '0'
1146 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1147 && !$options{cancel}
1149 my %param = ( %setup_param,
1150 'precommit_hooks' => $precommit_hooks,
1151 'increment_next_bill' => $increment_next_bill,
1152 'discounts' => \@recur_discounts,
1153 'real_pkgpart' => $real_pkgpart,
1154 'freq_override' => $options{freq_override} || '',
1158 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1160 # There may be some part_pkg for which this is wrong. Only those
1161 # which can_discount are supported.
1162 # (the UI should prevent adding discounts to these at the moment)
1164 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1165 " for pkgpart ". $cust_pkg->pkgpart.
1166 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1169 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1170 return "$@ running $method for $cust_pkg\n"
1173 if ($recur eq 'NOTHING') {
1174 # then calc_cancel (or calc_recur but that's not used) has declined to
1175 # generate a recurring lineitem at all. treat this as zero, but also
1176 # try not to generate a lineitem.
1182 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1184 if ( $param{'billed_currency'} ) {
1185 $recur_billed_currency = delete $param{'billed_currency'};
1186 $recur_billed_amount = delete $param{'billed_amount'};
1189 if ( $param{'override_quantity'} ) {
1190 $override_quantity = $param{'override_quantity'};
1191 $unitrecur = $recur / $override_quantity;
1194 if ( $increment_next_bill ) {
1198 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1199 # supplemental package
1200 # to keep in sync with the main package, simulate billing at
1202 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1203 my $supp_pkg_freq = $part_pkg->freq;
1204 if ( $supp_pkg_freq == 0 or $main_pkg_freq == 0 ) {
1205 # the UI should prevent setting up packages like this, but just
1207 return "unable to calculate supplemental package period ratio";
1209 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1210 if ( $ratio == int($ratio) ) {
1211 # simple case: main package is X months, supp package is X*A months,
1212 # advance supp package to where the main package will be in A cycles.
1213 $next_bill = $sdate;
1215 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1218 # harder case: main package is X months, supp package is Y months.
1219 # advance supp package by Y months. then if they're within half a
1220 # month of each other, resync them. this may result in the period
1221 # not being exactly Y months.
1222 $next_bill = $part_pkg->add_freq( $sdate, $supp_pkg_freq );
1223 my $main_next_bill = $main_pkg->bill;
1224 if ( $main_pkg->bill <= $time ) {
1225 # then the main package has not yet been billed on this cycle;
1226 # predict what its bill date will be.
1228 $part_pkg->add_freq( $main_next_bill, $main_pkg_freq );
1230 if ( abs($main_next_bill - $next_bill) < 86400*15 ) {
1231 $next_bill = $main_next_bill;
1236 # the normal case, not a supplemental package
1237 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1238 return "unparsable frequency: ".
1239 ($options{freq_override} || $part_pkg->freq)
1240 if $next_bill == -1;
1243 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1244 # only for figuring next bill date, nothing else, so, reset $sdate again
1246 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1247 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1248 $cust_pkg->last_bill($sdate);
1250 $cust_pkg->setfield('bill', $next_bill );
1254 if ( $param{'setup_fee'} ) {
1255 # Add an additional setup fee at the billing stage.
1256 # Used for prorate_defer_bill.
1257 $setup += $param{'setup_fee'};
1258 $unitsetup = $cust_pkg->base_setup();
1262 if ( defined $param{'discount_left_setup'} ) {
1263 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1264 $setup -= $discount_setup;
1268 } # end of recurring fee
1270 warn "\$setup is undefined" unless defined($setup);
1271 warn "\$recur is undefined" unless defined($recur);
1272 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1275 # If there's line items, create em cust_bill_pkg records
1276 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1281 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1282 # hmm.. and if just the options are modified in some weird price plan?
1284 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1287 my $error = $cust_pkg->replace( $old_cust_pkg,
1288 'depend_jobnum'=>$options{depend_jobnum},
1289 'options' => { $cust_pkg->options },
1291 unless $options{no_commit};
1292 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1293 if $error; #just in case
1296 $setup = sprintf( "%.2f", $setup );
1297 $recur = sprintf( "%.2f", $recur );
1298 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1299 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1301 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1302 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1305 my $discount_show_always = $conf->exists('discount-show-always')
1306 && ( ($setup == 0 && scalar(@setup_discounts))
1307 || ($recur == 0 && scalar(@recur_discounts))
1312 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1313 || $discount_show_always
1314 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1315 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1319 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1322 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1324 warn " adding customer package invoice detail: $_\n"
1325 foreach @cust_pkg_detail;
1327 push @details, @cust_pkg_detail;
1329 my $cust_bill_pkg = new FS::cust_bill_pkg {
1330 'pkgnum' => $cust_pkg->pkgnum,
1332 'unitsetup' => sprintf('%.2f', $unitsetup),
1333 'setup_billed_currency' => $setup_billed_currency,
1334 'setup_billed_amount' => $setup_billed_amount,
1336 'unitrecur' => sprintf('%.2f', $unitrecur),
1337 'recur_billed_currency' => $recur_billed_currency,
1338 'recur_billed_amount' => $recur_billed_amount,
1339 'quantity' => $override_quantity || $cust_pkg->quantity,
1340 'details' => \@details,
1341 'discounts' => [ @setup_discounts, @recur_discounts ],
1342 'hidden' => $part_pkg->hidden,
1343 'freq' => $part_pkg->freq,
1346 if ( $part_pkg->option('prorate_defer_bill',1)
1347 and !$hash{last_bill} ) {
1348 # both preceding and upcoming, technically
1349 $cust_bill_pkg->sdate( $cust_pkg->setup );
1350 $cust_bill_pkg->edate( $cust_pkg->bill );
1351 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1352 $cust_bill_pkg->sdate( $hash{last_bill} );
1353 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1354 $cust_bill_pkg->edate( $time ) if $options{cancel};
1355 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1356 $cust_bill_pkg->sdate( $sdate );
1357 $cust_bill_pkg->edate( $cust_pkg->bill );
1358 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1361 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1362 unless $part_pkg->pkgpart == $real_pkgpart;
1364 $$total_setup += $setup;
1365 $$total_recur += $recur;
1371 my $error = $tax_engine->add_sale($cust_bill_pkg);
1372 return $error if $error;
1374 $cust_bill_pkg->set_display(
1375 part_pkg => $part_pkg,
1376 real_pkgpart => $real_pkgpart,
1379 push @$cust_bill_pkgs, $cust_bill_pkg;
1381 } #if $setup != 0 || $recur != 0
1389 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1391 Takes one argument, a cust_pkg object that is being billed. This will
1392 be called only if the package was created by a package change, and has
1393 not been billed since the package change, and package balance tracking
1394 is enabled. The second argument can be an alternate package number to
1395 transfer the balance from; this should not be used externally.
1397 Transfers the balance from the previous package (now canceled) to
1398 this package, by crediting one package and creating an invoice item for
1399 the other. Inserts the credit and returns the invoice item (so that it
1400 can be added to an invoice that's being built).
1402 If the previous package was never billed, and was also created by a package
1403 change, then this will also transfer the balance from I<its> previous
1404 package, and so on, until reaching a package that either has been billed
1405 or was not created by a package change.
1409 my $balance_transfer_reason;
1411 sub _transfer_balance {
1413 my $cust_pkg = shift;
1414 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1415 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1419 # if $from_pkg is not the first package in the chain, and it was never
1421 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1422 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1425 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1426 if ( $prev_balance != 0 ) {
1427 $balance_transfer_reason ||= FS::reason->new_or_existing(
1428 'reason' => 'Package balance transfer',
1429 'type' => 'Internal adjustment',
1433 my $credit = FS::cust_credit->new({
1434 'custnum' => $self->custnum,
1435 'amount' => abs($prev_balance),
1436 'reasonnum' => $balance_transfer_reason->reasonnum,
1437 '_date' => $cust_pkg->change_date,
1440 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1442 'recur' => abs($prev_balance),
1443 #'sdate' => $from_pkg->last_bill, # not sure about this
1444 #'edate' => $cust_pkg->change_date,
1445 'itemdesc' => $self->mt('Previous Balance, [_1]',
1446 $from_pkg->part_pkg->pkg),
1449 if ( $prev_balance > 0 ) {
1450 # credit the old package, charge the new one
1451 $credit->set('pkgnum', $from_pkgnum);
1452 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1455 $credit->set('pkgnum', $cust_pkg->pkgnum);
1456 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1458 my $error = $credit->insert;
1459 die "error transferring package balance from #".$from_pkgnum.
1460 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1462 push @transfers, $cust_bill_pkg;
1463 } # $prev_balance != 0
1468 #### vestigial code ####
1470 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1472 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1475 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1478 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1479 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1482 'cust_main_county' can also be 'tax_rate'. The first object in the array
1483 is always the cust_main_county or tax_rate identified by the key.
1485 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1486 the 'taxline' method to calculate the amount of the tax. This doesn't
1487 happen until calculate_taxes, though.
1489 OPTIONS may include:
1490 - part_item: a part_pkg or part_fee object to be used as the package/fee
1492 - location: a cust_location to be used as the billing location.
1493 - cancel: true if this package is being billed on cancellation. This
1494 allows tax to be calculated on usage charges only.
1496 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1497 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1498 the customer's default service location).
1500 This method will also calculate exemptions for any taxes that apply to the
1501 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1502 attach them. This is the only place C<set_exemptions> is called in normal
1509 my $taxlisthash = shift;
1510 my $cust_bill_pkg = shift;
1513 # at this point I realize that we have enough information to infer all this
1514 # stuff, instead of passing around giant honking argument lists
1515 my $location = $options{location} || $cust_bill_pkg->tax_location;
1516 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1518 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1520 return if ( $self->payby eq 'COMP' ); #dubious
1522 if ( $conf->config('enable_taxproducts')
1523 && ( scalar($part_item->part_pkg_taxoverride)
1524 || $part_item->has_taxproduct
1529 # EXTERNAL TAX RATES (via tax_rate)
1530 my %cust_bill_pkg = ();
1534 my $usage = $cust_bill_pkg->usage || 0;
1535 push @classes, $cust_bill_pkg->usage_classes if $usage;
1536 push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1537 push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1538 and !$options{cancel};
1539 # that's better--probably don't even need $options{cancel} now
1540 # but leave it for now, just to be safe
1542 # About $options{cancel}: This protects against charging per-line or
1543 # per-customer or other flat-rate surcharges on a package that's being
1544 # billed on cancellation (which is an out-of-cycle bill and should only
1545 # have usage charges). See RT#29443.
1547 # customer exemption is now handled in the 'taxline' method
1548 #my $exempt = $conf->exists('cust_class-tax_exempt')
1549 # ? ( $self->cust_class ? $self->cust_class->tax : '' )
1551 # standardize this just to be sure
1552 #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1556 unless (exists $taxes{''}) {
1557 # unsure what purpose this serves, but last time I deleted something
1558 # from here just because I didn't see the point, it actually did
1559 # something important.
1560 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1561 return $err_or_ref unless ref($err_or_ref);
1562 $taxes{''} = $err_or_ref;
1565 # NO DISINTEGRATIONS.
1566 # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1568 # do not call taxline() with any argument except the entire set of
1569 # cust_bill_pkgs on an invoice that are eligible for the tax.
1571 # only calculate exemptions once for each tax rate, even if it's used
1572 # for multiple classes
1575 foreach my $class (@classes) {
1576 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1577 return $err_or_ref unless ref($err_or_ref);
1578 my @taxes = @$err_or_ref;
1582 foreach my $tax ( @taxes ) {
1584 my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1585 # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1586 # Values are arrayrefs, first the tax object (cust_main_county
1587 # or tax_rate), then the cust_bill_pkg object that the
1588 # tax applies to, then the tax class (setup, recur, usage classnum).
1589 $taxlisthash->{ $tax_id } ||= [ $tax ];
1590 push @{ $taxlisthash->{ $tax_id } }, $cust_bill_pkg, $class;
1592 # determine any exemptions that apply
1593 if (!$tax_seen{$tax_id}) {
1594 $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1595 $tax_seen{$tax_id} = 1;
1598 # tax on tax will be done later, when we actually create the tax
1606 # INTERNAL TAX RATES (cust_main_county)
1608 # We fetch taxes even if the customer is completely exempt,
1609 # because we need to record that fact.
1611 my @loc_keys = qw( district city county state country );
1612 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1614 $taxhash{'taxclass'} = $part_item->taxclass;
1616 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1618 my @taxes = (); # entries are cust_main_county objects
1619 my %taxhash_elim = %taxhash;
1620 my @elim = qw( district city county state );
1623 #first try a match with taxclass
1624 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1626 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1627 #then try a match without taxclass
1628 my %no_taxclass = %taxhash_elim;
1629 $no_taxclass{ 'taxclass' } = '';
1630 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1633 $taxhash_elim{ shift(@elim) } = '';
1635 } while ( !scalar(@taxes) && scalar(@elim) );
1638 my $tax_id = 'cust_main_county '.$_->taxnum;
1639 $taxlisthash->{$tax_id} ||= [ $_ ];
1640 $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1641 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1648 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1650 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1651 or part_fee (which will define the tax eligibility of the product), CLASS is
1652 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1653 location where the service was provided (or billed, depending on
1654 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1655 can apply to this line item.
1661 my $part_item = shift;
1663 my $location = shift;
1665 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1667 my $geocode = $location->geocode('cch');
1669 [ $part_item->tax_rates('cch', $geocode, $class) ]
1673 #### end vestigial code ####
1675 =item collect [ HASHREF | OPTION => VALUE ... ]
1677 (Attempt to) collect money for this customer's outstanding invoices (see
1678 L<FS::cust_bill>). Usually used after the bill method.
1680 Actions are now triggered by billing events; see L<FS::part_event> and the
1681 billing events web interface. Old-style invoice events (see
1682 L<FS::part_bill_event>) have been deprecated.
1684 If there is an error, returns the error, otherwise returns false.
1686 Options are passed as name-value pairs.
1688 Currently available options are:
1694 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.
1698 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1702 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1706 set true to surpress email card/ACH decline notices.
1710 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)
1716 # allows for one time override of normal customer billing method
1721 my( $self, %options ) = @_;
1723 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1725 my $invoice_time = $options{'invoice_time'} || time;
1728 local $SIG{HUP} = 'IGNORE';
1729 local $SIG{INT} = 'IGNORE';
1730 local $SIG{QUIT} = 'IGNORE';
1731 local $SIG{TERM} = 'IGNORE';
1732 local $SIG{TSTP} = 'IGNORE';
1733 local $SIG{PIPE} = 'IGNORE';
1735 my $oldAutoCommit = $FS::UID::AutoCommit;
1736 local $FS::UID::AutoCommit = 0;
1739 $self->select_for_update; #mutex
1742 my $balance = $self->balance;
1743 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1746 if ( exists($options{'retry_card'}) ) {
1747 carp 'retry_card option passed to collect is deprecated; use retry';
1748 $options{'retry'} ||= $options{'retry_card'};
1750 if ( exists($options{'retry'}) && $options{'retry'} ) {
1751 my $error = $self->retry_realtime;
1753 $dbh->rollback if $oldAutoCommit;
1758 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1760 #never want to roll back an event just because it returned an error
1761 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1763 $self->do_cust_event(
1764 'debug' => ( $options{'debug'} || 0 ),
1765 'time' => $invoice_time,
1766 'check_freq' => $options{'check_freq'},
1767 'stage' => 'collect',
1772 =item retry_realtime
1774 Schedules realtime / batch credit card / electronic check / LEC billing
1775 events for for retry. Useful if card information has changed or manual
1776 retry is desired. The 'collect' method must be called to actually retry
1779 Implementation details: For either this customer, or for each of this
1780 customer's open invoices, changes the status of the first "done" (with
1781 statustext error) realtime processing event to "failed".
1785 sub retry_realtime {
1788 local $SIG{HUP} = 'IGNORE';
1789 local $SIG{INT} = 'IGNORE';
1790 local $SIG{QUIT} = 'IGNORE';
1791 local $SIG{TERM} = 'IGNORE';
1792 local $SIG{TSTP} = 'IGNORE';
1793 local $SIG{PIPE} = 'IGNORE';
1795 my $oldAutoCommit = $FS::UID::AutoCommit;
1796 local $FS::UID::AutoCommit = 0;
1799 #a little false laziness w/due_cust_event (not too bad, really)
1801 # I guess this is always as of now?
1802 my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1803 my $order = FS::part_event_condition->order_conditions_sql;
1806 . join ( ' OR ' , map {
1807 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1808 my $custnum = FS::part_event->eventtables_custnum->{$_};
1809 "( part_event.eventtable = " . dbh->quote($_)
1810 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1811 . " from $_ $cust_join"
1812 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1813 } FS::part_event->eventtables)
1816 #here is the agent virtualization
1817 my $agent_virt = " ( part_event.agentnum IS NULL
1818 OR part_event.agentnum = ". $self->agentnum. ' )';
1820 #XXX this shouldn't be hardcoded, actions should declare it...
1821 my @realtime_events = qw(
1822 cust_bill_realtime_card
1823 cust_bill_realtime_check
1824 cust_bill_realtime_lec
1828 my $is_realtime_event =
1829 ' part_event.action IN ( '.
1830 join(',', map "'$_'", @realtime_events ).
1833 my $batch_or_statustext =
1834 "( part_event.action = 'cust_bill_batch'
1835 OR ( statustext IS NOT NULL AND statustext != '' )
1839 my @cust_event = qsearch({
1840 'table' => 'cust_event',
1841 'select' => 'cust_event.*',
1842 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1843 'hashref' => { 'status' => 'done' },
1844 'extra_sql' => " AND $batch_or_statustext ".
1845 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1848 my %seen_invnum = ();
1849 foreach my $cust_event (@cust_event) {
1851 #max one for the customer, one for each open invoice
1852 my $cust_X = $cust_event->cust_X;
1853 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1857 or $cust_event->part_event->eventtable eq 'cust_bill'
1860 my $error = $cust_event->retry;
1862 $dbh->rollback if $oldAutoCommit;
1863 return "error scheduling event for retry: $error";
1868 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1873 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1875 Runs billing events; see L<FS::part_event> and the billing events web
1878 If there is an error, returns the error, otherwise returns false.
1880 Options are passed as name-value pairs.
1882 Currently available options are:
1888 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.
1892 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1896 "collect" (the default) or "pre-bill"
1900 set true to surpress email card/ACH decline notices.
1904 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)
1911 # allows for one time override of normal customer billing method
1915 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1918 my( $self, %options ) = @_;
1920 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1922 my $time = $options{'time'} || time;
1925 local $SIG{HUP} = 'IGNORE';
1926 local $SIG{INT} = 'IGNORE';
1927 local $SIG{QUIT} = 'IGNORE';
1928 local $SIG{TERM} = 'IGNORE';
1929 local $SIG{TSTP} = 'IGNORE';
1930 local $SIG{PIPE} = 'IGNORE';
1932 my $oldAutoCommit = $FS::UID::AutoCommit;
1933 local $FS::UID::AutoCommit = 0;
1936 $self->select_for_update; #mutex
1939 my $balance = $self->balance;
1940 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1943 # if ( exists($options{'retry_card'}) ) {
1944 # carp 'retry_card option passed to collect is deprecated; use retry';
1945 # $options{'retry'} ||= $options{'retry_card'};
1947 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1948 # my $error = $self->retry_realtime;
1950 # $dbh->rollback if $oldAutoCommit;
1955 # false laziness w/pay_batch::import_results
1957 my $due_cust_event = $self->due_cust_event(
1958 'debug' => ( $options{'debug'} || 0 ),
1960 'check_freq' => $options{'check_freq'},
1961 'stage' => ( $options{'stage'} || 'collect' ),
1963 unless( ref($due_cust_event) ) {
1964 $dbh->rollback if $oldAutoCommit;
1965 return $due_cust_event;
1968 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1969 #never want to roll back an event just because it or a different one
1971 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1973 foreach my $cust_event ( @$due_cust_event ) {
1977 #re-eval event conditions (a previous event could have changed things)
1978 unless ( $cust_event->test_conditions ) {
1979 #don't leave stray "new/locked" records around
1980 my $error = $cust_event->delete;
1981 return $error if $error;
1986 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1987 if $options{'quiet'};
1988 warn " running cust_event ". $cust_event->eventnum. "\n"
1991 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1992 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1993 #XXX wtf is this? figure out a proper dealio with return value
2005 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2007 Inserts database records for and returns an ordered listref of new events due
2008 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2009 events are due, an empty listref is returned. If there is an error, returns a
2010 scalar error message.
2012 To actually run the events, call each event's test_condition method, and if
2013 still true, call the event's do_event method.
2015 Options are passed as a hashref or as a list of name-value pairs. Available
2022 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.
2026 "collect" (the default) or "pre-bill"
2030 "Current time" for the events.
2034 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)
2038 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2042 Explicitly pass the objects to be tested (typically used with eventtable).
2046 Set to true to return the objects, but not actually insert them into the
2053 sub due_cust_event {
2055 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2058 #my $DEBUG = $opt{'debug'}
2059 $opt{'debug'} ||= 0; # silence some warnings
2060 local($DEBUG) = $opt{'debug'}
2061 if $opt{'debug'} > $DEBUG;
2062 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2064 warn "$me due_cust_event called with options ".
2065 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2068 $opt{'time'} ||= time;
2070 local $SIG{HUP} = 'IGNORE';
2071 local $SIG{INT} = 'IGNORE';
2072 local $SIG{QUIT} = 'IGNORE';
2073 local $SIG{TERM} = 'IGNORE';
2074 local $SIG{TSTP} = 'IGNORE';
2075 local $SIG{PIPE} = 'IGNORE';
2077 my $oldAutoCommit = $FS::UID::AutoCommit;
2078 local $FS::UID::AutoCommit = 0;
2081 $self->select_for_update #mutex
2082 unless $opt{testonly};
2085 # find possible events (initial search)
2088 my @cust_event = ();
2090 my @eventtable = $opt{'eventtable'}
2091 ? ( $opt{'eventtable'} )
2092 : FS::part_event->eventtables_runorder;
2094 my $check_freq = $opt{'check_freq'} || '1d';
2096 foreach my $eventtable ( @eventtable ) {
2099 if ( $opt{'objects'} ) {
2101 @objects = @{ $opt{'objects'} };
2103 } elsif ( $eventtable eq 'cust_main' ) {
2105 @objects = ( $self );
2109 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2110 # linkage not needed here because FS::cust_main->$eventtable will
2113 #some false laziness w/Cron::bill bill_where
2115 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2116 'time' => $opt{'time'});
2117 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2118 'time'=>$opt{'time'},
2120 $where = $where ? "AND $where" : '';
2122 my $are_part_event =
2123 "EXISTS ( SELECT 1 FROM part_event $join
2124 WHERE check_freq = '$check_freq'
2125 AND eventtable = '$eventtable'
2126 AND ( disabled = '' OR disabled IS NULL )
2132 @objects = $self->$eventtable(
2133 'addl_from' => $cm_join,
2134 'extra_sql' => " AND $are_part_event",
2136 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2138 my @e_cust_event = ();
2140 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2142 my $cross = "CROSS JOIN $eventtable $linkage";
2143 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2144 unless $eventtable eq 'cust_main';
2146 foreach my $object ( @objects ) {
2148 #this first search uses the condition_sql magic for optimization.
2149 #the more possible events we can eliminate in this step the better
2151 my $cross_where = '';
2152 my $pkey = $object->primary_key;
2153 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2155 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2156 'time' => $opt{'time'});
2158 FS::part_event_condition->where_conditions_sql( $eventtable,
2159 'time'=>$opt{'time'}
2161 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2163 $extra_sql = "AND $extra_sql" if $extra_sql;
2165 #here is the agent virtualization
2166 $extra_sql .= " AND ( part_event.agentnum IS NULL
2167 OR part_event.agentnum = ". $self->agentnum. ' )';
2169 $extra_sql .= " $order";
2171 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2172 if $opt{'debug'} > 2;
2173 my @part_event = qsearch( {
2174 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2175 'select' => 'part_event.*',
2176 'table' => 'part_event',
2177 'addl_from' => "$cross $join",
2178 'hashref' => { 'check_freq' => $check_freq,
2179 'eventtable' => $eventtable,
2182 'extra_sql' => "AND $cross_where $extra_sql",
2186 my $pkey = $object->primary_key;
2187 warn " ". scalar(@part_event).
2188 " possible events found for $eventtable ". $object->$pkey(). "\n";
2191 push @e_cust_event, map {
2192 $_->new_cust_event($object, 'time' => $opt{'time'})
2197 warn " ". scalar(@e_cust_event).
2198 " subtotal possible cust events found for $eventtable\n"
2201 push @cust_event, @e_cust_event;
2205 warn " ". scalar(@cust_event).
2206 " total possible cust events found in initial search\n"
2214 $opt{stage} ||= 'collect';
2216 grep { my $stage = $_->part_event->event_stage;
2217 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2227 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2230 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2233 warn " invalid conditions not eliminated with condition_sql:\n".
2234 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2235 if keys %unsat && $DEBUG; # > 1;
2241 unless( $opt{testonly} ) {
2242 foreach my $cust_event ( @cust_event ) {
2244 my $error = $cust_event->insert();
2246 $dbh->rollback if $oldAutoCommit;
2253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2259 warn " returning events: ". Dumper(@cust_event). "\n"
2266 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2268 Applies unapplied payments and credits.
2269 Payments with the no_auto_apply flag set will not be applied.
2271 In most cases, this new method should be used in place of sequential
2272 apply_payments and apply_credits methods.
2274 A hash of optional arguments may be passed. Currently "manual" is supported.
2275 If true, a payment receipt is sent instead of a statement when
2276 'payment_receipt_email' configuration option is set.
2278 If there is an error, returns the error, otherwise returns false.
2282 sub apply_payments_and_credits {
2283 my( $self, %options ) = @_;
2285 local $SIG{HUP} = 'IGNORE';
2286 local $SIG{INT} = 'IGNORE';
2287 local $SIG{QUIT} = 'IGNORE';
2288 local $SIG{TERM} = 'IGNORE';
2289 local $SIG{TSTP} = 'IGNORE';
2290 local $SIG{PIPE} = 'IGNORE';
2292 my $oldAutoCommit = $FS::UID::AutoCommit;
2293 local $FS::UID::AutoCommit = 0;
2296 $self->select_for_update; #mutex
2298 foreach my $cust_bill ( $self->open_cust_bill ) {
2299 my $error = $cust_bill->apply_payments_and_credits(%options);
2301 $dbh->rollback if $oldAutoCommit;
2302 return "Error applying: $error";
2306 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2311 =item apply_credits OPTION => VALUE ...
2313 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2314 to outstanding invoice balances in chronological order (or reverse
2315 chronological order if the I<order> option is set to B<newest>) and returns the
2316 value of any remaining unapplied credits available for refund (see
2317 L<FS::cust_refund>).
2319 Dies if there is an error.
2327 local $SIG{HUP} = 'IGNORE';
2328 local $SIG{INT} = 'IGNORE';
2329 local $SIG{QUIT} = 'IGNORE';
2330 local $SIG{TERM} = 'IGNORE';
2331 local $SIG{TSTP} = 'IGNORE';
2332 local $SIG{PIPE} = 'IGNORE';
2334 my $oldAutoCommit = $FS::UID::AutoCommit;
2335 local $FS::UID::AutoCommit = 0;
2338 $self->select_for_update; #mutex
2340 unless ( $self->total_unapplied_credits ) {
2341 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2345 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2346 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2348 my @invoices = $self->open_cust_bill;
2349 @invoices = sort { $b->_date <=> $a->_date } @invoices
2350 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2352 if ( $conf->exists('pkg-balances') ) {
2353 # limit @credits to those w/ a pkgnum grepped from $self
2355 foreach my $i (@invoices) {
2356 foreach my $li ( $i->cust_bill_pkg ) {
2357 $pkgnums{$li->pkgnum} = 1;
2360 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2365 foreach my $cust_bill ( @invoices ) {
2367 if ( !defined($credit) || $credit->credited == 0) {
2368 $credit = pop @credits or last;
2372 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2373 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2375 $owed = $cust_bill->owed;
2377 unless ( $owed > 0 ) {
2378 push @credits, $credit;
2382 my $amount = min( $credit->credited, $owed );
2384 my $cust_credit_bill = new FS::cust_credit_bill ( {
2385 'crednum' => $credit->crednum,
2386 'invnum' => $cust_bill->invnum,
2387 'amount' => $amount,
2389 $cust_credit_bill->pkgnum( $credit->pkgnum )
2390 if $conf->exists('pkg-balances') && $credit->pkgnum;
2391 my $error = $cust_credit_bill->insert;
2393 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2397 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2401 my $total_unapplied_credits = $self->total_unapplied_credits;
2403 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2405 return $total_unapplied_credits;
2408 =item apply_payments [ OPTION => VALUE ... ]
2410 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2411 to outstanding invoice balances in chronological order.
2412 Payments with the no_auto_apply flag set will not be applied.
2414 #and returns the value of any remaining unapplied payments.
2416 A hash of optional arguments may be passed. Currently "manual" is supported.
2417 If true, a payment receipt is sent instead of a statement when
2418 'payment_receipt_email' configuration option is set.
2420 Dies if there is an error.
2424 sub apply_payments {
2425 my( $self, %options ) = @_;
2427 local $SIG{HUP} = 'IGNORE';
2428 local $SIG{INT} = 'IGNORE';
2429 local $SIG{QUIT} = 'IGNORE';
2430 local $SIG{TERM} = 'IGNORE';
2431 local $SIG{TSTP} = 'IGNORE';
2432 local $SIG{PIPE} = 'IGNORE';
2434 my $oldAutoCommit = $FS::UID::AutoCommit;
2435 local $FS::UID::AutoCommit = 0;
2438 $self->select_for_update; #mutex
2442 my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay;
2444 my @invoices = $self->open_cust_bill;
2446 if ( $conf->exists('pkg-balances') ) {
2447 # limit @payments to those w/ a pkgnum grepped from $self
2449 foreach my $i (@invoices) {
2450 foreach my $li ( $i->cust_bill_pkg ) {
2451 $pkgnums{$li->pkgnum} = 1;
2454 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2459 foreach my $cust_bill ( @invoices ) {
2461 if ( !defined($payment) || $payment->unapplied == 0 ) {
2462 $payment = pop @payments or last;
2466 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2467 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2469 $owed = $cust_bill->owed;
2471 unless ( $owed > 0 ) {
2472 push @payments, $payment;
2476 my $amount = min( $payment->unapplied, $owed );
2479 'paynum' => $payment->paynum,
2480 'invnum' => $cust_bill->invnum,
2481 'amount' => $amount,
2483 $cbp->{_date} = $payment->_date
2484 if $options{'manual'} && $options{'backdate_application'};
2485 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2486 $cust_bill_pay->pkgnum( $payment->pkgnum )
2487 if $conf->exists('pkg-balances') && $payment->pkgnum;
2488 my $error = $cust_bill_pay->insert(%options);
2490 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2494 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2498 my $total_unapplied_payments = $self->total_unapplied_payments;
2500 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2502 return $total_unapplied_payments;
2512 suspend_adjourned_pkgs
2513 unsuspend_resumed_pkgs
2516 (do_cust_event pre-bill)
2518 _omit_zero_value_bundles
2521 apply_payments_and_credits
2530 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>