1 package FS::cust_main::Billing;
4 use vars qw( $conf $DEBUG $me );
7 use List::Util qw( min );
9 use FS::Record qw( qsearch qsearchs dbdef );
10 use FS::Misc::DateTime qw( day_end );
12 use FS::cust_bill_pkg;
13 use FS::cust_bill_pkg_display;
14 use FS::cust_bill_pay;
15 use FS::cust_credit_bill;
16 use FS::cust_tax_adjustment;
18 use FS::tax_rate_location;
19 use FS::cust_bill_pkg_tax_location;
20 use FS::cust_bill_pkg_tax_rate_location;
22 use FS::part_event_condition;
24 use FS::cust_event_fee;
28 # 1 is mostly method/subroutine entry and options
29 # 2 traces progress of some operations
30 # 3 is even more information including possibly sensitive data
32 $me = '[FS::cust_main::Billing]';
34 install_callback FS::UID sub {
36 #yes, need it for stuff below (prolly should be cached)
41 FS::cust_main::Billing - Billing mixin for cust_main
47 These methods are available on FS::cust_main objects.
53 =item bill_and_collect
55 Cancels and suspends any packages due, generates bills, applies payments and
56 credits, and applies collection events to run cards, send bills and notices,
59 By default, warns on errors and continues with the next operation (but see the
62 Options are passed as name-value pairs. Currently available options are:
68 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:
72 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
76 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.
80 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
84 If set true, re-charges setup fees.
88 If set any errors prevent subsequent operations from continusing. If set
89 specifically to "return", returns the error (or false, if there is no error).
90 Any other true value causes errors to die.
94 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)
98 Optional FS::queue entry to receive status updates.
102 Options are passed to the B<bill> and B<collect> methods verbatim, so all
103 options of those methods are also available.
107 sub bill_and_collect {
108 my( $self, %options ) = @_;
110 my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
111 my %logopt = (object => $self);
112 $log->debug('start', %logopt);
116 #$options{actual_time} not $options{time} because freeside-daily -d is for
117 #pre-printing invoices
119 $options{'actual_time'} ||= time;
120 my $job = $options{'job'};
122 my $actual_time = ( $conf->exists('next-bill-ignore-time')
123 ? day_end( $options{actual_time} )
124 : $options{actual_time}
127 $job->update_statustext('0,cleaning expired packages') if $job;
128 $log->debug('canceling expired packages', %logopt);
129 $error = $self->cancel_expired_pkgs( $actual_time );
131 $error = "Error expiring custnum ". $self->custnum. ": $error";
132 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
133 elsif ( $options{fatal} ) { die $error; }
134 else { warn $error; }
137 $log->debug('suspending adjourned packages', %logopt);
138 $error = $self->suspend_adjourned_pkgs( $actual_time );
140 $error = "Error adjourning custnum ". $self->custnum. ": $error";
141 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
142 elsif ( $options{fatal} ) { die $error; }
143 else { warn $error; }
146 $log->debug('unsuspending resumed packages', %logopt);
147 $error = $self->unsuspend_resumed_pkgs( $actual_time );
149 $error = "Error resuming custnum ".$self->custnum. ": $error";
150 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
151 elsif ( $options{fatal} ) { die $error; }
152 else { warn $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; }
161 elsif ( $options{fatal} ) { die $error; }
162 else { warn $error; }
165 $job->update_statustext('50,applying payments and credits') if $job;
166 $log->debug('applying payments and credits', %logopt);
167 $error = $self->apply_payments_and_credits;
169 $error = "Error applying custnum ". $self->custnum. ": $error";
170 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
171 elsif ( $options{fatal} ) { die $error; }
172 else { warn $error; }
175 # In a batch tax environment, do not run collection if any pending
176 # invoices were created. Collection will run after the next tax batch.
177 my $tax = FS::TaxEngine->new;
178 if ( $tax->info->{batch} and
179 qsearch('cust_bill', { custnum => $self->custnum, pending => 'Y' })
182 warn "skipped collection for custnum ".$self->custnum.
183 " due to pending invoices\n" if $DEBUG;
184 } elsif ( $conf->exists('cancelled_cust-noevents')
185 && ! $self->num_ncancelled_pkgs )
187 warn "skipped collection for custnum ".$self->custnum.
188 " because they have no active packages\n" if $DEBUG;
190 # run collection normally
191 $job->update_statustext('70,running collection events') if $job;
192 $log->debug('running collection events', %logopt);
193 $error = $self->collect( %options );
195 $error = "Error collecting custnum ". $self->custnum. ": $error";
196 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
197 elsif ($options{fatal} ) { die $error; }
198 else { warn $error; }
202 $job->update_statustext('100,finished') if $job;
203 $log->debug('finish', %logopt);
209 sub cancel_expired_pkgs {
210 my ( $self, $time, %options ) = @_;
212 my @cancel_pkgs = $self->ncancelled_pkgs( {
213 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
218 CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
219 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
222 if ( $cust_pkg->change_to_pkgnum ) {
224 my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
226 push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
227 $cust_pkg->change_to_pkgnum.'; not expiring';
230 $error = $cust_pkg->change( 'cust_pkg' => $new_pkg,
231 'unprotect_svcs' => 1 );
232 $error = '' if ref $error eq 'FS::cust_pkg';
234 } else { # just cancel it
235 $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
236 'reason_otaker' => $cpr->otaker,
242 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
245 join(' / ', @errors);
249 sub suspend_adjourned_pkgs {
250 my ( $self, $time, %options ) = @_;
252 my @susp_pkgs = $self->ncancelled_pkgs( {
254 " AND ( susp IS NULL OR susp = 0 )
255 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
256 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
261 #only because there's no SQL test for is_prepaid :/
263 grep { ( $_->part_pkg->is_prepaid
268 && $_->adjourn <= $time
276 foreach my $cust_pkg ( @susp_pkgs ) {
277 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
278 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
279 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
280 'reason_otaker' => $cpr->otaker
284 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
287 join(' / ', @errors);
291 sub unsuspend_resumed_pkgs {
292 my ( $self, $time, %options ) = @_;
294 my @unsusp_pkgs = $self->ncancelled_pkgs( {
295 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
300 foreach my $cust_pkg ( @unsusp_pkgs ) {
301 my $error = $cust_pkg->unsuspend( 'time' => $time );
302 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
305 join(' / ', @errors);
311 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
312 conjunction with the collect method by calling B<bill_and_collect>.
314 If there is an error, returns the error, otherwise returns false.
316 Options are passed as name-value pairs. Currently available options are:
322 If set true, re-charges setup fees.
326 If set true then only bill recurring charges, not setup, usage, one time
331 If set, then override the normal frequency and look for a part_pkg_discount
332 to take at that frequency. This is appropriate only when the normal
333 frequency for all packages is monthly, and is an error otherwise. Use
334 C<pkg_list> to limit the set of packages included in billing.
338 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:
342 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
346 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
348 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
352 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
356 Do not bill prepaid packages. Used by freeside-daily.
360 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.
364 This boolean value informs the us that the package is being cancelled. This
365 typically might mean not charging the normal recurring fee but only usage
366 fees since the last billing. Setup charges may be charged. Not all package
367 plans support this feature (they tend to charge 0).
371 Prevent the resetting of usage limits during this call.
375 Do not save the generated bill in the database. Useful with return_bill
379 A list reference on which the generated bill(s) will be returned.
383 Optional terms to be printed on this invoice. Otherwise, customer-specific
384 terms or the default terms are used.
391 my( $self, %options ) = @_;
393 return '' if $self->payby eq 'COMP';
395 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
396 my $log = FS::Log->new('FS::cust_main::Billing::bill');
397 my %logopt = (object => $self);
399 $log->debug('start', %logopt);
400 warn "$me bill customer ". $self->custnum. "\n"
403 my $time = $options{'time'} || time;
404 my $invoice_time = $options{'invoice_time'} || $time;
406 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
411 $options{'not_pkgpart'} ||= {};
412 $options{'not_pkgpart'} = { map { $_ => 1 }
413 split(/\s*,\s*/, $options{'not_pkgpart'})
415 unless ref($options{'not_pkgpart'});
417 local $SIG{HUP} = 'IGNORE';
418 local $SIG{INT} = 'IGNORE';
419 local $SIG{QUIT} = 'IGNORE';
420 local $SIG{TERM} = 'IGNORE';
421 local $SIG{TSTP} = 'IGNORE';
422 local $SIG{PIPE} = 'IGNORE';
424 my $oldAutoCommit = $FS::UID::AutoCommit;
425 local $FS::UID::AutoCommit = 0;
428 $log->debug('acquiring lock', %logopt);
429 warn "$me acquiring lock on customer ". $self->custnum. "\n"
432 $self->select_for_update; #mutex
434 $log->debug('running pre-bill events', %logopt);
435 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
438 my $error = $self->do_cust_event(
439 'debug' => ( $options{'debug'} || 0 ),
440 'time' => $invoice_time,
441 'check_freq' => $options{'check_freq'},
442 'stage' => 'pre-bill',
444 unless $options{no_commit};
446 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
450 $log->debug('done running pre-bill events', %logopt);
451 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
454 #keep auto-charge and non-auto-charge line items separate
455 my @passes = ( '', 'no_auto' );
457 my %cust_bill_pkg = map { $_ => [] } @passes;
460 # find the packages which are due for billing, find out how much they are
461 # & generate invoice database.
464 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
465 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
467 my @precommit_hooks = ();
469 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
472 my $tax_is_batch = '';
474 $tax_engines{$_} = FS::TaxEngine->new(cust_main => $self,
475 invoice_time => $invoice_time,
476 cancel => $options{cancel}
478 $tax_is_batch ||= $tax_engines{$_}->info->{batch};
481 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
483 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
485 my $part_pkg = $cust_pkg->part_pkg;
487 next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
489 $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
490 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
492 #? to avoid use of uninitialized value errors... ?
493 $cust_pkg->setfield('bill', '')
494 unless defined($cust_pkg->bill);
496 my $real_pkgpart = $cust_pkg->pkgpart;
497 my %hash = $cust_pkg->hash;
499 # we could implement this bit as FS::part_pkg::has_hidden, but we already
500 # suffer from performance issues
501 $options{has_hidden} = 0;
502 my @part_pkg = $part_pkg->self_and_bill_linked;
503 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
505 # if this package was changed from another package,
506 # and it hasn't been billed since then,
507 # and package balances are enabled,
508 if ( $cust_pkg->change_pkgnum
509 and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
510 and $cust_pkg->change_date < $invoice_time
511 and $conf->exists('pkg-balances') )
513 # _transfer_balance will also create the appropriate credit
514 my @transfer_items = $self->_transfer_balance($cust_pkg);
515 # $part_pkg[0] is the "real" part_pkg
516 my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
518 push @{ $cust_bill_pkg{$pass} }, @transfer_items;
519 # treating this as recur, just because most charges are recur...
520 ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
523 foreach my $part_pkg ( @part_pkg ) {
525 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
527 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
529 my $next_bill = $cust_pkg->getfield('bill') || 0;
531 # let this run once if this is the last bill upon cancellation
532 while ( $next_bill <= $cmp_time or $options{cancel} ) {
534 $self->_make_lines( 'part_pkg' => $part_pkg,
535 'cust_pkg' => $cust_pkg,
536 'precommit_hooks' => \@precommit_hooks,
537 'line_items' => $cust_bill_pkg{$pass},
538 'setup' => $total_setup{$pass},
539 'recur' => $total_recur{$pass},
540 'tax_engine' => $tax_engines{$pass},
542 'real_pkgpart' => $real_pkgpart,
543 'options' => \%options,
546 # Stop if anything goes wrong
549 # or if we're not incrementing the bill date.
550 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
552 # or if we're letting it run only once
553 last if $options{cancel};
555 $next_bill = $cust_pkg->getfield('bill') || 0;
557 #stop if -o was passed to freeside-daily
558 last if $options{'one_recur'};
561 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
565 } #foreach my $part_pkg
567 } #foreach my $cust_pkg
569 #if the customer isn't on an automatic payby, everything can go on a single
571 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
572 #merge everything into one list
575 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
577 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
579 warn "$me billing pass $pass\n"
580 #.Dumper(\@cust_bill_pkg)."\n"
587 my @pending_event_fees = FS::cust_event_fee->by_cust($self->custnum,
588 hashref => { 'billpkgnum' => '' }
590 warn "$me found pending fee events:\n".Dumper(\@pending_event_fees)."\n"
591 if @pending_event_fees and $DEBUG > 1;
593 # determine whether to generate an invoice
594 my $generate_bill = scalar(@cust_bill_pkg) > 0;
596 foreach my $event_fee (@pending_event_fees) {
597 $generate_bill = 1 unless $event_fee->nextbill;
600 # don't create an invoice with no line items, or where the only line
601 # items are fees that are supposed to be held until the next invoice
602 next if !$generate_bill;
606 foreach my $event_fee (@pending_event_fees) {
607 my $object = $event_fee->cust_event->cust_X;
608 my $part_fee = $event_fee->part_fee;
610 if ( $object->isa('FS::cust_main')
611 or $object->isa('FS::cust_pkg')
612 or $object->isa('FS::cust_pay_batch') )
614 # Not the real cust_bill object that will be inserted--in particular
615 # there are no taxes yet. If you want to charge a fee on the total
616 # invoice amount including taxes, you have to put the fee on the next
618 $cust_bill = FS::cust_bill->new({
619 'custnum' => $self->custnum,
620 'cust_bill_pkg' => \@cust_bill_pkg,
621 'charged' => ${ $total_setup{$pass} } +
622 ${ $total_recur{$pass} },
625 # If this is a package event, only apply the fee to line items
627 if ($object->isa('FS::cust_pkg')) {
628 $cust_bill->set('cust_bill_pkg',
629 [ grep { $_->pkgnum == $object->pkgnum } @cust_bill_pkg ]
633 } elsif ( $object->isa('FS::cust_bill') ) {
634 # simple case: applying the fee to a previous invoice (late fee,
636 $cust_bill = $object;
638 # if the fee def belongs to a different agent, don't charge the fee.
639 # event conditions should prevent this, but just in case they don't,
641 if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
642 warn "tried to charge fee#".$part_fee->feepart .
643 " on customer#".$self->custnum." from a different agent.\n";
646 # also skip if it's disabled
647 next if $part_fee->disabled eq 'Y';
649 my $fee_item = $part_fee->lineitem($cust_bill) or next;
650 # link this so that we can clear the marker on inserting the line item
651 $fee_item->set('cust_event_fee', $event_fee);
652 push @fee_items, $fee_item;
656 # add fees to the invoice
657 foreach my $fee_item (@fee_items) {
659 push @cust_bill_pkg, $fee_item;
660 ${ $total_setup{$pass} } += $fee_item->setup;
661 ${ $total_recur{$pass} } += $fee_item->recur;
663 my $part_fee = $fee_item->part_fee;
664 my $fee_location = $self->ship_location; # I think?
666 my $error = $tax_engines{''}->add_sale($fee_item);
668 return $error if $error;
672 # XXX implementation of fees is supposed to make this go away...
673 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
674 !$conf->exists('postal_invoice-recurring_only')
678 my $postal_pkg = $self->charge_postal_fee();
679 if ( $postal_pkg && !ref( $postal_pkg ) ) {
681 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
682 return "can't charge postal invoice fee for customer ".
683 $self->custnum. ": $postal_pkg";
685 } elsif ( $postal_pkg ) {
687 my $real_pkgpart = $postal_pkg->pkgpart;
688 # we could implement this bit as FS::part_pkg::has_hidden, but we already
689 # suffer from performance issues
690 $options{has_hidden} = 0;
691 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
692 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
694 foreach my $part_pkg ( @part_pkg ) {
695 my %postal_options = %options;
696 delete $postal_options{cancel};
698 $self->_make_lines( 'part_pkg' => $part_pkg,
699 'cust_pkg' => $postal_pkg,
700 'precommit_hooks' => \@precommit_hooks,
701 'line_items' => \@cust_bill_pkg,
702 'setup' => $total_setup{$pass},
703 'recur' => $total_recur{$pass},
704 'tax_engine' => $tax_engines{$pass},
706 'real_pkgpart' => $real_pkgpart,
707 'options' => \%postal_options,
710 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
715 # it's silly to have a zero value postal_pkg, but....
716 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
723 #XXX does this work with batch tax engines?
724 warn "adding tax adjustments...\n" if $DEBUG > 2;
725 foreach my $cust_tax_adjustment (
726 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
732 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
734 my $itemdesc = $cust_tax_adjustment->taxname;
735 $itemdesc = '' if $itemdesc eq 'Tax';
737 push @cust_bill_pkg, new FS::cust_bill_pkg {
743 'itemdesc' => $itemdesc,
744 'itemcomment' => $cust_tax_adjustment->comment,
745 'cust_tax_adjustment' => $cust_tax_adjustment,
746 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
751 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
753 my $balance = $self->balance;
755 my $previous_bill = qsearchs({ 'table' => 'cust_bill',
756 'hashref' => { custnum=>$self->custnum },
757 'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
759 my $previous_balance =
761 ? ( $previous_bill->billing_balance + $previous_bill->charged )
764 $log->debug('creating the new invoice', %logopt);
765 warn "creating the new invoice\n" if $DEBUG;
766 #create the new invoice
767 my $cust_bill = new FS::cust_bill ( {
768 'custnum' => $self->custnum,
769 '_date' => $invoice_time,
770 'charged' => $charged,
771 'billing_balance' => $balance,
772 'previous_balance' => $previous_balance,
773 'invoice_terms' => $options{'invoice_terms'},
774 'cust_bill_pkg' => \@cust_bill_pkg,
775 'pending' => 'Y', # clear this after doing taxes
778 if (!$options{no_commit}) {
779 # probably we ought to insert it as pending, and then rollback
780 # without ever un-pending it
781 $error = $cust_bill->insert;
783 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
784 return "can't create invoice for customer #". $self->custnum. ": $error";
789 # calculate and append taxes
790 if ( ! $tax_is_batch) {
791 my $arrayref_or_error = $tax_engines{$pass}->calculate_taxes($cust_bill);
793 unless ( ref( $arrayref_or_error ) ) {
794 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
795 return $arrayref_or_error;
798 # or should this be in TaxEngine?
800 foreach my $taxline ( @$arrayref_or_error ) {
801 $total_tax += $taxline->setup;
802 $taxline->set('invnum' => $cust_bill->invnum); # just to be sure
803 push @cust_bill_pkg, $taxline; # for return_bill
805 if (!$options{no_commit}) {
806 my $error = $taxline->insert;
808 $dbh->rollback if $oldAutoCommit;
815 # add tax to the invoice amount and finalize it
816 ${ $total_setup{$pass} } = sprintf('%.2f', ${ $total_setup{$pass} } + $total_tax);
817 $charged = sprintf('%.2f', $charged + $total_tax);
818 $cust_bill->set('charged', $charged);
819 $cust_bill->set('pending', '');
821 if (!$options{no_commit}) {
822 my $error = $cust_bill->replace;
824 $dbh->rollback if $oldAutoCommit;
829 } # if !$tax_is_batch
830 # if it IS batch, then we'll do all this in process_tax_batch
832 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
834 } #foreach my $pass ( keys %cust_bill_pkg )
836 foreach my $hook ( @precommit_hooks ) {
839 } unless $options{no_commit};
841 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
842 return "$@ running precommit hook $hook\n";
846 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
851 #discard bundled packages of 0 value
852 sub _omit_zero_value_bundles {
855 my @cust_bill_pkg = ();
856 my @cust_bill_pkg_bundle = ();
858 my $discount_show_always = 0;
860 foreach my $cust_bill_pkg ( @in ) {
862 $discount_show_always = ($cust_bill_pkg->get('discounts')
863 && scalar(@{$cust_bill_pkg->get('discounts')})
864 && $conf->exists('discount-show-always'));
866 warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
867 "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
868 "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
871 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
872 push @cust_bill_pkg, @cust_bill_pkg_bundle
874 || ($sum == 0 && ( $discount_show_always
875 || grep {$_->recur_show_zero || $_->setup_show_zero}
876 @cust_bill_pkg_bundle
879 @cust_bill_pkg_bundle = ();
883 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
884 push @cust_bill_pkg_bundle, $cust_bill_pkg;
888 push @cust_bill_pkg, @cust_bill_pkg_bundle
890 || ($sum == 0 && ( $discount_show_always
891 || grep {$_->recur_show_zero || $_->setup_show_zero}
892 @cust_bill_pkg_bundle
896 warn " _omit_zero_value_bundles: ". scalar(@in).
897 '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
905 my ($self, %params) = @_;
907 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
909 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
910 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
911 my $cust_location = $cust_pkg->tax_location;
912 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
913 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
914 my $total_setup = $params{setup} or die "no setup accumulator specified";
915 my $total_recur = $params{recur} or die "no recur accumulator specified";
916 my $time = $params{'time'} or die "no time specified";
917 my (%options) = %{$params{options}};
919 my $tax_engine = $params{tax_engine};
921 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
922 # this should never happen
923 die 'freq_override billing attempted on non-monthly package '.
928 my $real_pkgpart = $params{real_pkgpart};
929 my %hash = $cust_pkg->hash;
930 my $old_cust_pkg = new FS::cust_pkg \%hash;
935 $cust_pkg->pkgpart($part_pkg->pkgpart);
937 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
948 my @setup_discounts = ();
949 my %setup_param = ( 'discounts' => \@setup_discounts );
950 my $setup_billed_currency = '';
951 my $setup_billed_amount = 0;
952 # Conditions for setting setup date and charging the setup fee:
953 # - this is not a recurring-only billing run
954 # - and the package is not currently being canceled
955 # - and, unless we're specifically told otherwise via 'resetup':
956 # - it doesn't already HAVE a setup date
957 # - or a start date in the future
958 # - and it's not suspended
960 # The last condition used to check the "disable_setup_suspended" option but
961 # that's obsolete. We now never set the setup date on a suspended package.
962 if ( ! $options{recurring_only}
963 and ! $options{cancel}
964 and ( $options{'resetup'}
965 || ( ! $cust_pkg->setup
966 && ( ! $cust_pkg->start_date
967 || $cust_pkg->start_date <= $cmp_time
969 && ( ! $cust_pkg->getfield('susp') )
975 warn " bill setup\n" if $DEBUG > 1;
977 unless ( $cust_pkg->waive_setup ) {
980 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
981 return "$@ running calc_setup for $cust_pkg\n"
984 $unitsetup = $cust_pkg->base_setup()
987 if ( $setup_param{'billed_currency'} ) {
988 $setup_billed_currency = delete $setup_param{'billed_currency'};
989 $setup_billed_amount = delete $setup_param{'billed_amount'};
993 $cust_pkg->setfield('setup', $time)
994 unless $cust_pkg->setup;
995 #do need it, but it won't get written to the db
996 #|| $cust_pkg->pkgpart != $real_pkgpart;
998 $cust_pkg->setfield('start_date', '')
999 if $cust_pkg->start_date;
1004 # bill recurring fee
1009 my @recur_discounts = ();
1010 my $recur_billed_currency = '';
1011 my $recur_billed_amount = 0;
1013 if ( ! $cust_pkg->start_date
1016 || ( $cust_pkg->susp != $cust_pkg->order_date
1017 && ( $cust_pkg->option('suspend_bill',1)
1018 || ( $part_pkg->option('suspend_bill', 1)
1019 && ! $cust_pkg->option('no_suspend_bill',1)
1025 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1026 || ( $part_pkg->plan eq 'voip_cdr'
1027 && $part_pkg->option('bill_every_call')
1032 # XXX should this be a package event? probably. events are called
1033 # at collection time at the moment, though...
1034 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1035 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1036 #don't want to reset usage just cause we want a line item??
1037 #&& $part_pkg->pkgpart == $real_pkgpart;
1039 warn " bill recur\n" if $DEBUG > 1;
1042 # XXX shared with $recur_prog
1043 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1047 #over two params! lets at least switch to a hashref for the rest...
1048 my $increment_next_bill = ( $part_pkg->freq ne '0'
1049 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1050 && !$options{cancel}
1052 my %param = ( %setup_param,
1053 'precommit_hooks' => $precommit_hooks,
1054 'increment_next_bill' => $increment_next_bill,
1055 'discounts' => \@recur_discounts,
1056 'real_pkgpart' => $real_pkgpart,
1057 'freq_override' => $options{freq_override} || '',
1061 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1063 # There may be some part_pkg for which this is wrong. Only those
1064 # which can_discount are supported.
1065 # (the UI should prevent adding discounts to these at the moment)
1067 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1068 " for pkgpart ". $cust_pkg->pkgpart.
1069 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1072 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1073 return "$@ running $method for $cust_pkg\n"
1077 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1079 if ( $param{'billed_currency'} ) {
1080 $recur_billed_currency = delete $param{'billed_currency'};
1081 $recur_billed_amount = delete $param{'billed_amount'};
1084 if ( $increment_next_bill ) {
1088 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1089 # supplemental package
1090 # to keep in sync with the main package, simulate billing at
1092 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1093 my $supp_pkg_freq = $part_pkg->freq;
1094 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1095 if ( $ratio != int($ratio) ) {
1096 # the UI should prevent setting up packages like this, but just
1098 return "supplemental package period is not an integer multiple of main package period";
1100 $next_bill = $sdate;
1102 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1107 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1108 return "unparsable frequency: ". $part_pkg->freq
1109 if $next_bill == -1;
1112 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1113 # only for figuring next bill date, nothing else, so, reset $sdate again
1115 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1116 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1117 $cust_pkg->last_bill($sdate);
1119 $cust_pkg->setfield('bill', $next_bill );
1123 if ( $param{'setup_fee'} ) {
1124 # Add an additional setup fee at the billing stage.
1125 # Used for prorate_defer_bill.
1126 $setup += $param{'setup_fee'};
1127 $unitsetup += $param{'setup_fee'};
1131 if ( defined $param{'discount_left_setup'} ) {
1132 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1133 $setup -= $discount_setup;
1139 warn "\$setup is undefined" unless defined($setup);
1140 warn "\$recur is undefined" unless defined($recur);
1141 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1144 # If there's line items, create em cust_bill_pkg records
1145 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1150 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1151 # hmm.. and if just the options are modified in some weird price plan?
1153 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1156 my $error = $cust_pkg->replace( $old_cust_pkg,
1157 'depend_jobnum'=>$options{depend_jobnum},
1158 'options' => { $cust_pkg->options },
1160 unless $options{no_commit};
1161 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1162 if $error; #just in case
1165 $setup = sprintf( "%.2f", $setup );
1166 $recur = sprintf( "%.2f", $recur );
1167 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1168 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1170 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1171 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1174 my $discount_show_always = $conf->exists('discount-show-always')
1175 && ( ($setup == 0 && scalar(@setup_discounts))
1176 || ($recur == 0 && scalar(@recur_discounts))
1181 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1182 || $discount_show_always
1183 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1184 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1188 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1191 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1193 warn " adding customer package invoice detail: $_\n"
1194 foreach @cust_pkg_detail;
1196 push @details, @cust_pkg_detail;
1198 my $cust_bill_pkg = new FS::cust_bill_pkg {
1199 'pkgnum' => $cust_pkg->pkgnum,
1201 'unitsetup' => $unitsetup,
1202 'setup_billed_currency' => $setup_billed_currency,
1203 'setup_billed_amount' => $setup_billed_amount,
1205 'unitrecur' => $unitrecur,
1206 'recur_billed_currency' => $recur_billed_currency,
1207 'recur_billed_amount' => $recur_billed_amount,
1208 'quantity' => $cust_pkg->quantity,
1209 'details' => \@details,
1210 'discounts' => [ @setup_discounts, @recur_discounts ],
1211 'hidden' => $part_pkg->hidden,
1212 'freq' => $part_pkg->freq,
1215 if ( $part_pkg->option('prorate_defer_bill',1)
1216 and !$hash{last_bill} ) {
1217 # both preceding and upcoming, technically
1218 $cust_bill_pkg->sdate( $cust_pkg->setup );
1219 $cust_bill_pkg->edate( $cust_pkg->bill );
1220 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1221 $cust_bill_pkg->sdate( $hash{last_bill} );
1222 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1223 $cust_bill_pkg->edate( $time ) if $options{cancel};
1224 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1225 $cust_bill_pkg->sdate( $sdate );
1226 $cust_bill_pkg->edate( $cust_pkg->bill );
1227 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1230 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1231 unless $part_pkg->pkgpart == $real_pkgpart;
1233 $$total_setup += $setup;
1234 $$total_recur += $recur;
1240 my $error = $tax_engine->add_sale($cust_bill_pkg);
1241 return $error if $error;
1243 $cust_bill_pkg->set_display(
1244 part_pkg => $part_pkg,
1245 real_pkgpart => $real_pkgpart,
1248 push @$cust_bill_pkgs, $cust_bill_pkg;
1250 } #if $setup != 0 || $recur != 0
1258 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1260 Takes one argument, a cust_pkg object that is being billed. This will
1261 be called only if the package was created by a package change, and has
1262 not been billed since the package change, and package balance tracking
1263 is enabled. The second argument can be an alternate package number to
1264 transfer the balance from; this should not be used externally.
1266 Transfers the balance from the previous package (now canceled) to
1267 this package, by crediting one package and creating an invoice item for
1268 the other. Inserts the credit and returns the invoice item (so that it
1269 can be added to an invoice that's being built).
1271 If the previous package was never billed, and was also created by a package
1272 change, then this will also transfer the balance from I<its> previous
1273 package, and so on, until reaching a package that either has been billed
1274 or was not created by a package change.
1278 my $balance_transfer_reason;
1280 sub _transfer_balance {
1282 my $cust_pkg = shift;
1283 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1284 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1288 # if $from_pkg is not the first package in the chain, and it was never
1290 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1291 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1294 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1295 if ( $prev_balance != 0 ) {
1296 $balance_transfer_reason ||= FS::reason->new_or_existing(
1297 'reason' => 'Package balance transfer',
1298 'type' => 'Internal adjustment',
1302 my $credit = FS::cust_credit->new({
1303 'custnum' => $self->custnum,
1304 'amount' => abs($prev_balance),
1305 'reasonnum' => $balance_transfer_reason->reasonnum,
1306 '_date' => $cust_pkg->change_date,
1309 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1311 'recur' => abs($prev_balance),
1312 #'sdate' => $from_pkg->last_bill, # not sure about this
1313 #'edate' => $cust_pkg->change_date,
1314 'itemdesc' => $self->mt('Previous Balance, [_1]',
1315 $from_pkg->part_pkg->pkg),
1318 if ( $prev_balance > 0 ) {
1319 # credit the old package, charge the new one
1320 $credit->set('pkgnum', $from_pkgnum);
1321 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1324 $credit->set('pkgnum', $cust_pkg->pkgnum);
1325 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1327 my $error = $credit->insert;
1328 die "error transferring package balance from #".$from_pkgnum.
1329 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1331 push @transfers, $cust_bill_pkg;
1332 } # $prev_balance != 0
1337 #### vestigial code ####
1339 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1341 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1344 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1347 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1348 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1351 'cust_main_county' can also be 'tax_rate'. The first object in the array
1352 is always the cust_main_county or tax_rate identified by the key.
1354 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1355 the 'taxline' method to calculate the amount of the tax. This doesn't
1356 happen until calculate_taxes, though.
1358 OPTIONS may include:
1359 - part_item: a part_pkg or part_fee object to be used as the package/fee
1361 - location: a cust_location to be used as the billing location.
1362 - cancel: true if this package is being billed on cancellation. This
1363 allows tax to be calculated on usage charges only.
1365 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1366 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1367 the customer's default service location).
1373 my $taxlisthash = shift;
1374 my $cust_bill_pkg = shift;
1377 # at this point I realize that we have enough information to infer all this
1378 # stuff, instead of passing around giant honking argument lists
1379 my $location = $options{location} || $cust_bill_pkg->tax_location;
1380 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1382 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1384 return if ( $self->payby eq 'COMP' ); #dubious
1386 if ( $conf->exists('enable_taxproducts')
1387 && ( scalar($part_item->part_pkg_taxoverride)
1388 || $part_item->has_taxproduct
1393 # EXTERNAL TAX RATES (via tax_rate)
1394 my %cust_bill_pkg = ();
1398 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1399 push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1400 push @classes, 'recur' if $cust_bill_pkg->recur and !$options{cancel};
1402 my $exempt = $conf->exists('cust_class-tax_exempt')
1403 ? ( $self->cust_class ? $self->cust_class->tax : '' )
1405 # standardize this just to be sure
1406 $exempt = ($exempt eq 'Y') ? 'Y' : '';
1410 foreach my $class (@classes) {
1411 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1412 return $err_or_ref unless ref($err_or_ref);
1413 $taxes{$class} = $err_or_ref;
1416 unless (exists $taxes{''}) {
1417 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1418 return $err_or_ref unless ref($err_or_ref);
1419 $taxes{''} = $err_or_ref;
1424 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; # grrr
1425 foreach my $key (keys %tax_cust_bill_pkg) {
1426 # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1427 # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1429 # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1430 # apply to $key-class charges.
1431 my @taxes = @{ $taxes{$key} || [] };
1432 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1434 my %localtaxlisthash = ();
1435 foreach my $tax ( @taxes ) {
1437 # this is the tax identifier, not the taxname
1438 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1439 # $taxlisthash: keys are "setup", "recur", and usage classes.
1440 # Values are arrayrefs, first the tax object (cust_main_county
1441 # or tax_rate) and then any cust_bill_pkg objects that the
1443 $taxlisthash->{ $taxname } ||= [ $tax ];
1444 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1446 $localtaxlisthash{ $taxname } ||= [ $tax ];
1447 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1451 warn "finding taxed taxes...\n" if $DEBUG > 2;
1452 foreach my $tax ( keys %localtaxlisthash ) {
1453 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1454 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1456 next unless $tax_object->can('tax_on_tax');
1458 foreach my $tot ( $tax_object->tax_on_tax( $location ) ) {
1459 my $totname = ref( $tot ). ' '. $tot->taxnum;
1461 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1463 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1465 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1466 # calculate the tax amount that the tax_on_tax will apply to
1467 my $hashref_or_error =
1468 $tax_object->taxline( $localtaxlisthash{$tax} );
1469 return $hashref_or_error
1470 unless ref($hashref_or_error);
1472 # and append it to the list of taxable items
1473 $taxlisthash->{ $totname } ||= [ $tot ];
1474 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1482 # INTERNAL TAX RATES (cust_main_county)
1484 # We fetch taxes even if the customer is completely exempt,
1485 # because we need to record that fact.
1487 my @loc_keys = qw( district city county state country );
1488 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1490 $taxhash{'taxclass'} = $part_item->taxclass;
1492 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1494 my @taxes = (); # entries are cust_main_county objects
1495 my %taxhash_elim = %taxhash;
1496 my @elim = qw( district city county state );
1499 #first try a match with taxclass
1500 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1502 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1503 #then try a match without taxclass
1504 my %no_taxclass = %taxhash_elim;
1505 $no_taxclass{ 'taxclass' } = '';
1506 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1509 $taxhash_elim{ shift(@elim) } = '';
1511 } while ( !scalar(@taxes) && scalar(@elim) );
1514 my $tax_id = 'cust_main_county '.$_->taxnum;
1515 $taxlisthash->{$tax_id} ||= [ $_ ];
1516 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1523 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1525 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1526 or part_fee (which will define the tax eligibility of the product), CLASS is
1527 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1528 location where the service was provided (or billed, depending on
1529 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1530 can apply to this line item.
1536 my $part_item = shift;
1538 my $location = shift;
1540 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1542 my $geocode = $location->geocode('cch');
1544 [ $part_item->tax_rates('cch', $geocode, $class) ]
1548 #### end vestigial code ####
1550 =item collect [ HASHREF | OPTION => VALUE ... ]
1552 (Attempt to) collect money for this customer's outstanding invoices (see
1553 L<FS::cust_bill>). Usually used after the bill method.
1555 Actions are now triggered by billing events; see L<FS::part_event> and the
1556 billing events web interface. Old-style invoice events (see
1557 L<FS::part_bill_event>) have been deprecated.
1559 If there is an error, returns the error, otherwise returns false.
1561 Options are passed as name-value pairs.
1563 Currently available options are:
1569 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.
1573 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1577 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1581 set true to surpress email card/ACH decline notices.
1585 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)
1591 # allows for one time override of normal customer billing method
1596 my( $self, %options ) = @_;
1598 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1600 my $invoice_time = $options{'invoice_time'} || time;
1603 local $SIG{HUP} = 'IGNORE';
1604 local $SIG{INT} = 'IGNORE';
1605 local $SIG{QUIT} = 'IGNORE';
1606 local $SIG{TERM} = 'IGNORE';
1607 local $SIG{TSTP} = 'IGNORE';
1608 local $SIG{PIPE} = 'IGNORE';
1610 my $oldAutoCommit = $FS::UID::AutoCommit;
1611 local $FS::UID::AutoCommit = 0;
1614 $self->select_for_update; #mutex
1617 my $balance = $self->balance;
1618 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1621 if ( exists($options{'retry_card'}) ) {
1622 carp 'retry_card option passed to collect is deprecated; use retry';
1623 $options{'retry'} ||= $options{'retry_card'};
1625 if ( exists($options{'retry'}) && $options{'retry'} ) {
1626 my $error = $self->retry_realtime;
1628 $dbh->rollback if $oldAutoCommit;
1633 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1635 #never want to roll back an event just because it returned an error
1636 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1638 $self->do_cust_event(
1639 'debug' => ( $options{'debug'} || 0 ),
1640 'time' => $invoice_time,
1641 'check_freq' => $options{'check_freq'},
1642 'stage' => 'collect',
1647 =item retry_realtime
1649 Schedules realtime / batch credit card / electronic check / LEC billing
1650 events for for retry. Useful if card information has changed or manual
1651 retry is desired. The 'collect' method must be called to actually retry
1654 Implementation details: For either this customer, or for each of this
1655 customer's open invoices, changes the status of the first "done" (with
1656 statustext error) realtime processing event to "failed".
1660 sub retry_realtime {
1663 local $SIG{HUP} = 'IGNORE';
1664 local $SIG{INT} = 'IGNORE';
1665 local $SIG{QUIT} = 'IGNORE';
1666 local $SIG{TERM} = 'IGNORE';
1667 local $SIG{TSTP} = 'IGNORE';
1668 local $SIG{PIPE} = 'IGNORE';
1670 my $oldAutoCommit = $FS::UID::AutoCommit;
1671 local $FS::UID::AutoCommit = 0;
1674 #a little false laziness w/due_cust_event (not too bad, really)
1676 # I guess this is always as of now?
1677 my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1678 my $order = FS::part_event_condition->order_conditions_sql;
1681 . join ( ' OR ' , map {
1682 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1683 my $custnum = FS::part_event->eventtables_custnum->{$_};
1684 "( part_event.eventtable = " . dbh->quote($_)
1685 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1686 . " from $_ $cust_join"
1687 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1688 } FS::part_event->eventtables)
1691 #here is the agent virtualization
1692 my $agent_virt = " ( part_event.agentnum IS NULL
1693 OR part_event.agentnum = ". $self->agentnum. ' )';
1695 #XXX this shouldn't be hardcoded, actions should declare it...
1696 my @realtime_events = qw(
1697 cust_bill_realtime_card
1698 cust_bill_realtime_check
1699 cust_bill_realtime_lec
1703 my $is_realtime_event =
1704 ' part_event.action IN ( '.
1705 join(',', map "'$_'", @realtime_events ).
1708 my $batch_or_statustext =
1709 "( part_event.action = 'cust_bill_batch'
1710 OR ( statustext IS NOT NULL AND statustext != '' )
1714 my @cust_event = qsearch({
1715 'table' => 'cust_event',
1716 'select' => 'cust_event.*',
1717 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1718 'hashref' => { 'status' => 'done' },
1719 'extra_sql' => " AND $batch_or_statustext ".
1720 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1723 my %seen_invnum = ();
1724 foreach my $cust_event (@cust_event) {
1726 #max one for the customer, one for each open invoice
1727 my $cust_X = $cust_event->cust_X;
1728 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1732 or $cust_event->part_event->eventtable eq 'cust_bill'
1735 my $error = $cust_event->retry;
1737 $dbh->rollback if $oldAutoCommit;
1738 return "error scheduling event for retry: $error";
1743 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1748 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1750 Runs billing events; see L<FS::part_event> and the billing events web
1753 If there is an error, returns the error, otherwise returns false.
1755 Options are passed as name-value pairs.
1757 Currently available options are:
1763 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.
1767 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1771 "collect" (the default) or "pre-bill"
1775 set true to surpress email card/ACH decline notices.
1779 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)
1786 # allows for one time override of normal customer billing method
1790 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1793 my( $self, %options ) = @_;
1795 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1797 my $time = $options{'time'} || time;
1800 local $SIG{HUP} = 'IGNORE';
1801 local $SIG{INT} = 'IGNORE';
1802 local $SIG{QUIT} = 'IGNORE';
1803 local $SIG{TERM} = 'IGNORE';
1804 local $SIG{TSTP} = 'IGNORE';
1805 local $SIG{PIPE} = 'IGNORE';
1807 my $oldAutoCommit = $FS::UID::AutoCommit;
1808 local $FS::UID::AutoCommit = 0;
1811 $self->select_for_update; #mutex
1814 my $balance = $self->balance;
1815 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1818 # if ( exists($options{'retry_card'}) ) {
1819 # carp 'retry_card option passed to collect is deprecated; use retry';
1820 # $options{'retry'} ||= $options{'retry_card'};
1822 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1823 # my $error = $self->retry_realtime;
1825 # $dbh->rollback if $oldAutoCommit;
1830 # false laziness w/pay_batch::import_results
1832 my $due_cust_event = $self->due_cust_event(
1833 'debug' => ( $options{'debug'} || 0 ),
1835 'check_freq' => $options{'check_freq'},
1836 'stage' => ( $options{'stage'} || 'collect' ),
1838 unless( ref($due_cust_event) ) {
1839 $dbh->rollback if $oldAutoCommit;
1840 return $due_cust_event;
1843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1844 #never want to roll back an event just because it or a different one
1846 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1848 foreach my $cust_event ( @$due_cust_event ) {
1852 #re-eval event conditions (a previous event could have changed things)
1853 unless ( $cust_event->test_conditions ) {
1854 #don't leave stray "new/locked" records around
1855 my $error = $cust_event->delete;
1856 return $error if $error;
1861 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1862 if $options{'quiet'};
1863 warn " running cust_event ". $cust_event->eventnum. "\n"
1866 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1867 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1868 #XXX wtf is this? figure out a proper dealio with return value
1880 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1882 Inserts database records for and returns an ordered listref of new events due
1883 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1884 events are due, an empty listref is returned. If there is an error, returns a
1885 scalar error message.
1887 To actually run the events, call each event's test_condition method, and if
1888 still true, call the event's do_event method.
1890 Options are passed as a hashref or as a list of name-value pairs. Available
1897 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.
1901 "collect" (the default) or "pre-bill"
1905 "Current time" for the events.
1909 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)
1913 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1917 Explicitly pass the objects to be tested (typically used with eventtable).
1921 Set to true to return the objects, but not actually insert them into the
1928 sub due_cust_event {
1930 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1933 #my $DEBUG = $opt{'debug'}
1934 $opt{'debug'} ||= 0; # silence some warnings
1935 local($DEBUG) = $opt{'debug'}
1936 if $opt{'debug'} > $DEBUG;
1937 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1939 warn "$me due_cust_event called with options ".
1940 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1943 $opt{'time'} ||= time;
1945 local $SIG{HUP} = 'IGNORE';
1946 local $SIG{INT} = 'IGNORE';
1947 local $SIG{QUIT} = 'IGNORE';
1948 local $SIG{TERM} = 'IGNORE';
1949 local $SIG{TSTP} = 'IGNORE';
1950 local $SIG{PIPE} = 'IGNORE';
1952 my $oldAutoCommit = $FS::UID::AutoCommit;
1953 local $FS::UID::AutoCommit = 0;
1956 $self->select_for_update #mutex
1957 unless $opt{testonly};
1960 # find possible events (initial search)
1963 my @cust_event = ();
1965 my @eventtable = $opt{'eventtable'}
1966 ? ( $opt{'eventtable'} )
1967 : FS::part_event->eventtables_runorder;
1969 my $check_freq = $opt{'check_freq'} || '1d';
1971 foreach my $eventtable ( @eventtable ) {
1974 if ( $opt{'objects'} ) {
1976 @objects = @{ $opt{'objects'} };
1978 } elsif ( $eventtable eq 'cust_main' ) {
1980 @objects = ( $self );
1984 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1985 # linkage not needed here because FS::cust_main->$eventtable will
1988 #some false laziness w/Cron::bill bill_where
1990 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
1991 'time' => $opt{'time'});
1992 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1993 'time'=>$opt{'time'},
1995 $where = $where ? "AND $where" : '';
1997 my $are_part_event =
1998 "EXISTS ( SELECT 1 FROM part_event $join
1999 WHERE check_freq = '$check_freq'
2000 AND eventtable = '$eventtable'
2001 AND ( disabled = '' OR disabled IS NULL )
2007 @objects = $self->$eventtable(
2008 'addl_from' => $cm_join,
2009 'extra_sql' => " AND $are_part_event",
2011 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2013 my @e_cust_event = ();
2015 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2017 my $cross = "CROSS JOIN $eventtable $linkage";
2018 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2019 unless $eventtable eq 'cust_main';
2021 foreach my $object ( @objects ) {
2023 #this first search uses the condition_sql magic for optimization.
2024 #the more possible events we can eliminate in this step the better
2026 my $cross_where = '';
2027 my $pkey = $object->primary_key;
2028 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2030 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2031 'time' => $opt{'time'});
2033 FS::part_event_condition->where_conditions_sql( $eventtable,
2034 'time'=>$opt{'time'}
2036 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2038 $extra_sql = "AND $extra_sql" if $extra_sql;
2040 #here is the agent virtualization
2041 $extra_sql .= " AND ( part_event.agentnum IS NULL
2042 OR part_event.agentnum = ". $self->agentnum. ' )';
2044 $extra_sql .= " $order";
2046 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2047 if $opt{'debug'} > 2;
2048 my @part_event = qsearch( {
2049 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2050 'select' => 'part_event.*',
2051 'table' => 'part_event',
2052 'addl_from' => "$cross $join",
2053 'hashref' => { 'check_freq' => $check_freq,
2054 'eventtable' => $eventtable,
2057 'extra_sql' => "AND $cross_where $extra_sql",
2061 my $pkey = $object->primary_key;
2062 warn " ". scalar(@part_event).
2063 " possible events found for $eventtable ". $object->$pkey(). "\n";
2066 push @e_cust_event, map {
2067 $_->new_cust_event($object, 'time' => $opt{'time'})
2072 warn " ". scalar(@e_cust_event).
2073 " subtotal possible cust events found for $eventtable\n"
2076 push @cust_event, @e_cust_event;
2080 warn " ". scalar(@cust_event).
2081 " total possible cust events found in initial search\n"
2089 $opt{stage} ||= 'collect';
2091 grep { my $stage = $_->part_event->event_stage;
2092 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2102 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2105 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2108 warn " invalid conditions not eliminated with condition_sql:\n".
2109 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2110 if keys %unsat && $DEBUG; # > 1;
2116 unless( $opt{testonly} ) {
2117 foreach my $cust_event ( @cust_event ) {
2119 my $error = $cust_event->insert();
2121 $dbh->rollback if $oldAutoCommit;
2128 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2134 warn " returning events: ". Dumper(@cust_event). "\n"
2141 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2143 Applies unapplied payments and credits.
2145 In most cases, this new method should be used in place of sequential
2146 apply_payments and apply_credits methods.
2148 A hash of optional arguments may be passed. Currently "manual" is supported.
2149 If true, a payment receipt is sent instead of a statement when
2150 'payment_receipt_email' configuration option is set.
2152 If there is an error, returns the error, otherwise returns false.
2156 sub apply_payments_and_credits {
2157 my( $self, %options ) = @_;
2159 local $SIG{HUP} = 'IGNORE';
2160 local $SIG{INT} = 'IGNORE';
2161 local $SIG{QUIT} = 'IGNORE';
2162 local $SIG{TERM} = 'IGNORE';
2163 local $SIG{TSTP} = 'IGNORE';
2164 local $SIG{PIPE} = 'IGNORE';
2166 my $oldAutoCommit = $FS::UID::AutoCommit;
2167 local $FS::UID::AutoCommit = 0;
2170 $self->select_for_update; #mutex
2172 foreach my $cust_bill ( $self->open_cust_bill ) {
2173 my $error = $cust_bill->apply_payments_and_credits(%options);
2175 $dbh->rollback if $oldAutoCommit;
2176 return "Error applying: $error";
2180 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2185 =item apply_credits OPTION => VALUE ...
2187 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2188 to outstanding invoice balances in chronological order (or reverse
2189 chronological order if the I<order> option is set to B<newest>) and returns the
2190 value of any remaining unapplied credits available for refund (see
2191 L<FS::cust_refund>).
2193 Dies if there is an error.
2201 local $SIG{HUP} = 'IGNORE';
2202 local $SIG{INT} = 'IGNORE';
2203 local $SIG{QUIT} = 'IGNORE';
2204 local $SIG{TERM} = 'IGNORE';
2205 local $SIG{TSTP} = 'IGNORE';
2206 local $SIG{PIPE} = 'IGNORE';
2208 my $oldAutoCommit = $FS::UID::AutoCommit;
2209 local $FS::UID::AutoCommit = 0;
2212 $self->select_for_update; #mutex
2214 unless ( $self->total_unapplied_credits ) {
2215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2219 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2220 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2222 my @invoices = $self->open_cust_bill;
2223 @invoices = sort { $b->_date <=> $a->_date } @invoices
2224 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2226 if ( $conf->exists('pkg-balances') ) {
2227 # limit @credits to those w/ a pkgnum grepped from $self
2229 foreach my $i (@invoices) {
2230 foreach my $li ( $i->cust_bill_pkg ) {
2231 $pkgnums{$li->pkgnum} = 1;
2234 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2239 foreach my $cust_bill ( @invoices ) {
2241 if ( !defined($credit) || $credit->credited == 0) {
2242 $credit = pop @credits or last;
2246 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2247 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2249 $owed = $cust_bill->owed;
2251 unless ( $owed > 0 ) {
2252 push @credits, $credit;
2256 my $amount = min( $credit->credited, $owed );
2258 my $cust_credit_bill = new FS::cust_credit_bill ( {
2259 'crednum' => $credit->crednum,
2260 'invnum' => $cust_bill->invnum,
2261 'amount' => $amount,
2263 $cust_credit_bill->pkgnum( $credit->pkgnum )
2264 if $conf->exists('pkg-balances') && $credit->pkgnum;
2265 my $error = $cust_credit_bill->insert;
2267 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2271 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2275 my $total_unapplied_credits = $self->total_unapplied_credits;
2277 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2279 return $total_unapplied_credits;
2282 =item apply_payments [ OPTION => VALUE ... ]
2284 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2285 to outstanding invoice balances in chronological order.
2287 #and returns the value of any remaining unapplied payments.
2289 A hash of optional arguments may be passed. Currently "manual" is supported.
2290 If true, a payment receipt is sent instead of a statement when
2291 'payment_receipt_email' configuration option is set.
2293 Dies if there is an error.
2297 sub apply_payments {
2298 my( $self, %options ) = @_;
2300 local $SIG{HUP} = 'IGNORE';
2301 local $SIG{INT} = 'IGNORE';
2302 local $SIG{QUIT} = 'IGNORE';
2303 local $SIG{TERM} = 'IGNORE';
2304 local $SIG{TSTP} = 'IGNORE';
2305 local $SIG{PIPE} = 'IGNORE';
2307 my $oldAutoCommit = $FS::UID::AutoCommit;
2308 local $FS::UID::AutoCommit = 0;
2311 $self->select_for_update; #mutex
2315 my @payments = $self->unapplied_cust_pay;
2317 my @invoices = $self->open_cust_bill;
2319 if ( $conf->exists('pkg-balances') ) {
2320 # limit @payments to those w/ a pkgnum grepped from $self
2322 foreach my $i (@invoices) {
2323 foreach my $li ( $i->cust_bill_pkg ) {
2324 $pkgnums{$li->pkgnum} = 1;
2327 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2332 foreach my $cust_bill ( @invoices ) {
2334 if ( !defined($payment) || $payment->unapplied == 0 ) {
2335 $payment = pop @payments or last;
2339 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2340 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2342 $owed = $cust_bill->owed;
2344 unless ( $owed > 0 ) {
2345 push @payments, $payment;
2349 my $amount = min( $payment->unapplied, $owed );
2352 'paynum' => $payment->paynum,
2353 'invnum' => $cust_bill->invnum,
2354 'amount' => $amount,
2356 $cbp->{_date} = $payment->_date
2357 if $options{'manual'} && $options{'backdate_application'};
2358 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2359 $cust_bill_pay->pkgnum( $payment->pkgnum )
2360 if $conf->exists('pkg-balances') && $payment->pkgnum;
2361 my $error = $cust_bill_pay->insert(%options);
2363 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2367 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2371 my $total_unapplied_payments = $self->total_unapplied_payments;
2373 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2375 return $total_unapplied_payments;
2385 suspend_adjourned_pkgs
2386 unsuspend_resumed_pkgs
2389 (do_cust_event pre-bill)
2391 _omit_zero_value_bundles
2394 apply_payments_and_credits
2403 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>