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 'real_pkgpart' => $params{real_pkgpart}
952 my $setup_billed_currency = '';
953 my $setup_billed_amount = 0;
954 # Conditions for setting setup date and charging the setup fee:
955 # - this is not a recurring-only billing run
956 # - and the package is not currently being canceled
957 # - and, unless we're specifically told otherwise via 'resetup':
958 # - it doesn't already HAVE a setup date
959 # - or a start date in the future
960 # - and it's not suspended
962 # The last condition used to check the "disable_setup_suspended" option but
963 # that's obsolete. We now never set the setup date on a suspended package.
964 if ( ! $options{recurring_only}
965 and ! $options{cancel}
966 and ( $options{'resetup'}
967 || ( ! $cust_pkg->setup
968 && ( ! $cust_pkg->start_date
969 || $cust_pkg->start_date <= $cmp_time
971 && ( ! $cust_pkg->getfield('susp') )
977 warn " bill setup\n" if $DEBUG > 1;
979 unless ( $cust_pkg->waive_setup ) {
982 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
983 return "$@ running calc_setup for $cust_pkg\n"
986 $unitsetup = $cust_pkg->base_setup()
989 if ( $setup_param{'billed_currency'} ) {
990 $setup_billed_currency = delete $setup_param{'billed_currency'};
991 $setup_billed_amount = delete $setup_param{'billed_amount'};
995 $cust_pkg->setfield('setup', $time)
996 unless $cust_pkg->setup;
997 #do need it, but it won't get written to the db
998 #|| $cust_pkg->pkgpart != $real_pkgpart;
1000 $cust_pkg->setfield('start_date', '')
1001 if $cust_pkg->start_date;
1006 # bill recurring fee
1011 my @recur_discounts = ();
1012 my $recur_billed_currency = '';
1013 my $recur_billed_amount = 0;
1015 if ( ! $cust_pkg->start_date
1018 || ( $cust_pkg->susp != $cust_pkg->order_date
1019 && ( $cust_pkg->option('suspend_bill',1)
1020 || ( $part_pkg->option('suspend_bill', 1)
1021 && ! $cust_pkg->option('no_suspend_bill',1)
1027 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1028 || ( $part_pkg->plan eq 'voip_cdr'
1029 && $part_pkg->option('bill_every_call')
1034 # XXX should this be a package event? probably. events are called
1035 # at collection time at the moment, though...
1036 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1037 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1038 #don't want to reset usage just cause we want a line item??
1039 #&& $part_pkg->pkgpart == $real_pkgpart;
1041 warn " bill recur\n" if $DEBUG > 1;
1044 # XXX shared with $recur_prog
1045 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1049 #over two params! lets at least switch to a hashref for the rest...
1050 my $increment_next_bill = ( $part_pkg->freq ne '0'
1051 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1052 && !$options{cancel}
1054 my %param = ( %setup_param,
1055 'precommit_hooks' => $precommit_hooks,
1056 'increment_next_bill' => $increment_next_bill,
1057 'discounts' => \@recur_discounts,
1058 'real_pkgpart' => $real_pkgpart,
1059 'freq_override' => $options{freq_override} || '',
1063 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1065 # There may be some part_pkg for which this is wrong. Only those
1066 # which can_discount are supported.
1067 # (the UI should prevent adding discounts to these at the moment)
1069 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1070 " for pkgpart ". $cust_pkg->pkgpart.
1071 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1074 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1075 return "$@ running $method for $cust_pkg\n"
1079 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1081 if ( $param{'billed_currency'} ) {
1082 $recur_billed_currency = delete $param{'billed_currency'};
1083 $recur_billed_amount = delete $param{'billed_amount'};
1086 if ( $increment_next_bill ) {
1090 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1091 # supplemental package
1092 # to keep in sync with the main package, simulate billing at
1094 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1095 my $supp_pkg_freq = $part_pkg->freq;
1096 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1097 if ( $ratio != int($ratio) ) {
1098 # the UI should prevent setting up packages like this, but just
1100 return "supplemental package period is not an integer multiple of main package period";
1102 $next_bill = $sdate;
1104 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1109 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1110 return "unparsable frequency: ". $part_pkg->freq
1111 if $next_bill == -1;
1114 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1115 # only for figuring next bill date, nothing else, so, reset $sdate again
1117 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1118 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1119 $cust_pkg->last_bill($sdate);
1121 $cust_pkg->setfield('bill', $next_bill );
1125 if ( $param{'setup_fee'} ) {
1126 # Add an additional setup fee at the billing stage.
1127 # Used for prorate_defer_bill.
1128 $setup += $param{'setup_fee'};
1129 $unitsetup += $param{'setup_fee'};
1133 if ( defined $param{'discount_left_setup'} ) {
1134 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1135 $setup -= $discount_setup;
1141 warn "\$setup is undefined" unless defined($setup);
1142 warn "\$recur is undefined" unless defined($recur);
1143 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1146 # If there's line items, create em cust_bill_pkg records
1147 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1152 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1153 # hmm.. and if just the options are modified in some weird price plan?
1155 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1158 my $error = $cust_pkg->replace( $old_cust_pkg,
1159 'depend_jobnum'=>$options{depend_jobnum},
1160 'options' => { $cust_pkg->options },
1162 unless $options{no_commit};
1163 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1164 if $error; #just in case
1167 $setup = sprintf( "%.2f", $setup );
1168 $recur = sprintf( "%.2f", $recur );
1169 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1170 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1172 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1173 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1176 my $discount_show_always = $conf->exists('discount-show-always')
1177 && ( ($setup == 0 && scalar(@setup_discounts))
1178 || ($recur == 0 && scalar(@recur_discounts))
1183 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1184 || $discount_show_always
1185 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1186 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1190 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1193 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1195 warn " adding customer package invoice detail: $_\n"
1196 foreach @cust_pkg_detail;
1198 push @details, @cust_pkg_detail;
1200 my $cust_bill_pkg = new FS::cust_bill_pkg {
1201 'pkgnum' => $cust_pkg->pkgnum,
1203 'unitsetup' => $unitsetup,
1204 'setup_billed_currency' => $setup_billed_currency,
1205 'setup_billed_amount' => $setup_billed_amount,
1207 'unitrecur' => $unitrecur,
1208 'recur_billed_currency' => $recur_billed_currency,
1209 'recur_billed_amount' => $recur_billed_amount,
1210 'quantity' => $cust_pkg->quantity,
1211 'details' => \@details,
1212 'discounts' => [ @setup_discounts, @recur_discounts ],
1213 'hidden' => $part_pkg->hidden,
1214 'freq' => $part_pkg->freq,
1217 if ( $part_pkg->option('prorate_defer_bill',1)
1218 and !$hash{last_bill} ) {
1219 # both preceding and upcoming, technically
1220 $cust_bill_pkg->sdate( $cust_pkg->setup );
1221 $cust_bill_pkg->edate( $cust_pkg->bill );
1222 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1223 $cust_bill_pkg->sdate( $hash{last_bill} );
1224 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1225 $cust_bill_pkg->edate( $time ) if $options{cancel};
1226 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' )
1227 $cust_bill_pkg->sdate( $sdate );
1228 $cust_bill_pkg->edate( $cust_pkg->bill );
1229 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1232 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1233 unless $part_pkg->pkgpart == $real_pkgpart;
1235 $$total_setup += $setup;
1236 $$total_recur += $recur;
1242 my $error = $tax_engine->add_sale($cust_bill_pkg);
1243 return $error if $error;
1245 $cust_bill_pkg->set_display(
1246 part_pkg => $part_pkg,
1247 real_pkgpart => $real_pkgpart,
1250 push @$cust_bill_pkgs, $cust_bill_pkg;
1252 } #if $setup != 0 || $recur != 0
1260 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1262 Takes one argument, a cust_pkg object that is being billed. This will
1263 be called only if the package was created by a package change, and has
1264 not been billed since the package change, and package balance tracking
1265 is enabled. The second argument can be an alternate package number to
1266 transfer the balance from; this should not be used externally.
1268 Transfers the balance from the previous package (now canceled) to
1269 this package, by crediting one package and creating an invoice item for
1270 the other. Inserts the credit and returns the invoice item (so that it
1271 can be added to an invoice that's being built).
1273 If the previous package was never billed, and was also created by a package
1274 change, then this will also transfer the balance from I<its> previous
1275 package, and so on, until reaching a package that either has been billed
1276 or was not created by a package change.
1280 my $balance_transfer_reason;
1282 sub _transfer_balance {
1284 my $cust_pkg = shift;
1285 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1286 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1290 # if $from_pkg is not the first package in the chain, and it was never
1292 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1293 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1296 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1297 if ( $prev_balance != 0 ) {
1298 $balance_transfer_reason ||= FS::reason->new_or_existing(
1299 'reason' => 'Package balance transfer',
1300 'type' => 'Internal adjustment',
1304 my $credit = FS::cust_credit->new({
1305 'custnum' => $self->custnum,
1306 'amount' => abs($prev_balance),
1307 'reasonnum' => $balance_transfer_reason->reasonnum,
1308 '_date' => $cust_pkg->change_date,
1311 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1313 'recur' => abs($prev_balance),
1314 #'sdate' => $from_pkg->last_bill, # not sure about this
1315 #'edate' => $cust_pkg->change_date,
1316 'itemdesc' => $self->mt('Previous Balance, [_1]',
1317 $from_pkg->part_pkg->pkg),
1320 if ( $prev_balance > 0 ) {
1321 # credit the old package, charge the new one
1322 $credit->set('pkgnum', $from_pkgnum);
1323 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1326 $credit->set('pkgnum', $cust_pkg->pkgnum);
1327 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1329 my $error = $credit->insert;
1330 die "error transferring package balance from #".$from_pkgnum.
1331 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1333 push @transfers, $cust_bill_pkg;
1334 } # $prev_balance != 0
1339 #### vestigial code ####
1341 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1343 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1346 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1349 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1350 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1353 'cust_main_county' can also be 'tax_rate'. The first object in the array
1354 is always the cust_main_county or tax_rate identified by the key.
1356 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1357 the 'taxline' method to calculate the amount of the tax. This doesn't
1358 happen until calculate_taxes, though.
1360 OPTIONS may include:
1361 - part_item: a part_pkg or part_fee object to be used as the package/fee
1363 - location: a cust_location to be used as the billing location.
1364 - cancel: true if this package is being billed on cancellation. This
1365 allows tax to be calculated on usage charges only.
1367 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1368 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1369 the customer's default service location).
1375 my $taxlisthash = shift;
1376 my $cust_bill_pkg = shift;
1379 # at this point I realize that we have enough information to infer all this
1380 # stuff, instead of passing around giant honking argument lists
1381 my $location = $options{location} || $cust_bill_pkg->tax_location;
1382 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1384 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1386 return if ( $self->payby eq 'COMP' ); #dubious
1388 if ( $conf->exists('enable_taxproducts')
1389 && ( scalar($part_item->part_pkg_taxoverride)
1390 || $part_item->has_taxproduct
1395 # EXTERNAL TAX RATES (via tax_rate)
1396 my %cust_bill_pkg = ();
1400 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1401 push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1402 push @classes, 'recur' if $cust_bill_pkg->recur and !$options{cancel};
1404 my $exempt = $conf->exists('cust_class-tax_exempt')
1405 ? ( $self->cust_class ? $self->cust_class->tax : '' )
1407 # standardize this just to be sure
1408 $exempt = ($exempt eq 'Y') ? 'Y' : '';
1412 foreach my $class (@classes) {
1413 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1414 return $err_or_ref unless ref($err_or_ref);
1415 $taxes{$class} = $err_or_ref;
1418 unless (exists $taxes{''}) {
1419 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1420 return $err_or_ref unless ref($err_or_ref);
1421 $taxes{''} = $err_or_ref;
1426 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; # grrr
1427 foreach my $key (keys %tax_cust_bill_pkg) {
1428 # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1429 # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1431 # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1432 # apply to $key-class charges.
1433 my @taxes = @{ $taxes{$key} || [] };
1434 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1436 my %localtaxlisthash = ();
1437 foreach my $tax ( @taxes ) {
1439 # this is the tax identifier, not the taxname
1440 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1441 # $taxlisthash: keys are "setup", "recur", and usage classes.
1442 # Values are arrayrefs, first the tax object (cust_main_county
1443 # or tax_rate) and then any cust_bill_pkg objects that the
1445 $taxlisthash->{ $taxname } ||= [ $tax ];
1446 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1448 $localtaxlisthash{ $taxname } ||= [ $tax ];
1449 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1453 warn "finding taxed taxes...\n" if $DEBUG > 2;
1454 foreach my $tax ( keys %localtaxlisthash ) {
1455 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1456 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1458 next unless $tax_object->can('tax_on_tax');
1460 foreach my $tot ( $tax_object->tax_on_tax( $location ) ) {
1461 my $totname = ref( $tot ). ' '. $tot->taxnum;
1463 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1465 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1467 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1468 # calculate the tax amount that the tax_on_tax will apply to
1469 my $hashref_or_error =
1470 $tax_object->taxline( $localtaxlisthash{$tax} );
1471 return $hashref_or_error
1472 unless ref($hashref_or_error);
1474 # and append it to the list of taxable items
1475 $taxlisthash->{ $totname } ||= [ $tot ];
1476 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1484 # INTERNAL TAX RATES (cust_main_county)
1486 # We fetch taxes even if the customer is completely exempt,
1487 # because we need to record that fact.
1489 my @loc_keys = qw( district city county state country );
1490 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1492 $taxhash{'taxclass'} = $part_item->taxclass;
1494 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1496 my @taxes = (); # entries are cust_main_county objects
1497 my %taxhash_elim = %taxhash;
1498 my @elim = qw( district city county state );
1501 #first try a match with taxclass
1502 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1504 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1505 #then try a match without taxclass
1506 my %no_taxclass = %taxhash_elim;
1507 $no_taxclass{ 'taxclass' } = '';
1508 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1511 $taxhash_elim{ shift(@elim) } = '';
1513 } while ( !scalar(@taxes) && scalar(@elim) );
1516 my $tax_id = 'cust_main_county '.$_->taxnum;
1517 $taxlisthash->{$tax_id} ||= [ $_ ];
1518 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1525 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1527 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1528 or part_fee (which will define the tax eligibility of the product), CLASS is
1529 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1530 location where the service was provided (or billed, depending on
1531 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1532 can apply to this line item.
1538 my $part_item = shift;
1540 my $location = shift;
1542 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1544 my $geocode = $location->geocode('cch');
1546 [ $part_item->tax_rates('cch', $geocode, $class) ]
1550 #### end vestigial code ####
1552 =item collect [ HASHREF | OPTION => VALUE ... ]
1554 (Attempt to) collect money for this customer's outstanding invoices (see
1555 L<FS::cust_bill>). Usually used after the bill method.
1557 Actions are now triggered by billing events; see L<FS::part_event> and the
1558 billing events web interface. Old-style invoice events (see
1559 L<FS::part_bill_event>) have been deprecated.
1561 If there is an error, returns the error, otherwise returns false.
1563 Options are passed as name-value pairs.
1565 Currently available options are:
1571 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.
1575 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1579 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1583 set true to surpress email card/ACH decline notices.
1587 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)
1593 # allows for one time override of normal customer billing method
1598 my( $self, %options ) = @_;
1600 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1602 my $invoice_time = $options{'invoice_time'} || time;
1605 local $SIG{HUP} = 'IGNORE';
1606 local $SIG{INT} = 'IGNORE';
1607 local $SIG{QUIT} = 'IGNORE';
1608 local $SIG{TERM} = 'IGNORE';
1609 local $SIG{TSTP} = 'IGNORE';
1610 local $SIG{PIPE} = 'IGNORE';
1612 my $oldAutoCommit = $FS::UID::AutoCommit;
1613 local $FS::UID::AutoCommit = 0;
1616 $self->select_for_update; #mutex
1619 my $balance = $self->balance;
1620 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1623 if ( exists($options{'retry_card'}) ) {
1624 carp 'retry_card option passed to collect is deprecated; use retry';
1625 $options{'retry'} ||= $options{'retry_card'};
1627 if ( exists($options{'retry'}) && $options{'retry'} ) {
1628 my $error = $self->retry_realtime;
1630 $dbh->rollback if $oldAutoCommit;
1635 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1637 #never want to roll back an event just because it returned an error
1638 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1640 $self->do_cust_event(
1641 'debug' => ( $options{'debug'} || 0 ),
1642 'time' => $invoice_time,
1643 'check_freq' => $options{'check_freq'},
1644 'stage' => 'collect',
1649 =item retry_realtime
1651 Schedules realtime / batch credit card / electronic check / LEC billing
1652 events for for retry. Useful if card information has changed or manual
1653 retry is desired. The 'collect' method must be called to actually retry
1656 Implementation details: For either this customer, or for each of this
1657 customer's open invoices, changes the status of the first "done" (with
1658 statustext error) realtime processing event to "failed".
1662 sub retry_realtime {
1665 local $SIG{HUP} = 'IGNORE';
1666 local $SIG{INT} = 'IGNORE';
1667 local $SIG{QUIT} = 'IGNORE';
1668 local $SIG{TERM} = 'IGNORE';
1669 local $SIG{TSTP} = 'IGNORE';
1670 local $SIG{PIPE} = 'IGNORE';
1672 my $oldAutoCommit = $FS::UID::AutoCommit;
1673 local $FS::UID::AutoCommit = 0;
1676 #a little false laziness w/due_cust_event (not too bad, really)
1678 # I guess this is always as of now?
1679 my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1680 my $order = FS::part_event_condition->order_conditions_sql;
1683 . join ( ' OR ' , map {
1684 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1685 my $custnum = FS::part_event->eventtables_custnum->{$_};
1686 "( part_event.eventtable = " . dbh->quote($_)
1687 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1688 . " from $_ $cust_join"
1689 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1690 } FS::part_event->eventtables)
1693 #here is the agent virtualization
1694 my $agent_virt = " ( part_event.agentnum IS NULL
1695 OR part_event.agentnum = ". $self->agentnum. ' )';
1697 #XXX this shouldn't be hardcoded, actions should declare it...
1698 my @realtime_events = qw(
1699 cust_bill_realtime_card
1700 cust_bill_realtime_check
1701 cust_bill_realtime_lec
1705 my $is_realtime_event =
1706 ' part_event.action IN ( '.
1707 join(',', map "'$_'", @realtime_events ).
1710 my $batch_or_statustext =
1711 "( part_event.action = 'cust_bill_batch'
1712 OR ( statustext IS NOT NULL AND statustext != '' )
1716 my @cust_event = qsearch({
1717 'table' => 'cust_event',
1718 'select' => 'cust_event.*',
1719 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1720 'hashref' => { 'status' => 'done' },
1721 'extra_sql' => " AND $batch_or_statustext ".
1722 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1725 my %seen_invnum = ();
1726 foreach my $cust_event (@cust_event) {
1728 #max one for the customer, one for each open invoice
1729 my $cust_X = $cust_event->cust_X;
1730 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1734 or $cust_event->part_event->eventtable eq 'cust_bill'
1737 my $error = $cust_event->retry;
1739 $dbh->rollback if $oldAutoCommit;
1740 return "error scheduling event for retry: $error";
1745 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1750 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1752 Runs billing events; see L<FS::part_event> and the billing events web
1755 If there is an error, returns the error, otherwise returns false.
1757 Options are passed as name-value pairs.
1759 Currently available options are:
1765 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.
1769 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1773 "collect" (the default) or "pre-bill"
1777 set true to surpress email card/ACH decline notices.
1781 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)
1788 # allows for one time override of normal customer billing method
1792 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1795 my( $self, %options ) = @_;
1797 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1799 my $time = $options{'time'} || time;
1802 local $SIG{HUP} = 'IGNORE';
1803 local $SIG{INT} = 'IGNORE';
1804 local $SIG{QUIT} = 'IGNORE';
1805 local $SIG{TERM} = 'IGNORE';
1806 local $SIG{TSTP} = 'IGNORE';
1807 local $SIG{PIPE} = 'IGNORE';
1809 my $oldAutoCommit = $FS::UID::AutoCommit;
1810 local $FS::UID::AutoCommit = 0;
1813 $self->select_for_update; #mutex
1816 my $balance = $self->balance;
1817 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1820 # if ( exists($options{'retry_card'}) ) {
1821 # carp 'retry_card option passed to collect is deprecated; use retry';
1822 # $options{'retry'} ||= $options{'retry_card'};
1824 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1825 # my $error = $self->retry_realtime;
1827 # $dbh->rollback if $oldAutoCommit;
1832 # false laziness w/pay_batch::import_results
1834 my $due_cust_event = $self->due_cust_event(
1835 'debug' => ( $options{'debug'} || 0 ),
1837 'check_freq' => $options{'check_freq'},
1838 'stage' => ( $options{'stage'} || 'collect' ),
1840 unless( ref($due_cust_event) ) {
1841 $dbh->rollback if $oldAutoCommit;
1842 return $due_cust_event;
1845 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1846 #never want to roll back an event just because it or a different one
1848 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1850 foreach my $cust_event ( @$due_cust_event ) {
1854 #re-eval event conditions (a previous event could have changed things)
1855 unless ( $cust_event->test_conditions ) {
1856 #don't leave stray "new/locked" records around
1857 my $error = $cust_event->delete;
1858 return $error if $error;
1863 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1864 if $options{'quiet'};
1865 warn " running cust_event ". $cust_event->eventnum. "\n"
1868 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1869 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1870 #XXX wtf is this? figure out a proper dealio with return value
1882 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1884 Inserts database records for and returns an ordered listref of new events due
1885 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1886 events are due, an empty listref is returned. If there is an error, returns a
1887 scalar error message.
1889 To actually run the events, call each event's test_condition method, and if
1890 still true, call the event's do_event method.
1892 Options are passed as a hashref or as a list of name-value pairs. Available
1899 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.
1903 "collect" (the default) or "pre-bill"
1907 "Current time" for the events.
1911 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)
1915 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1919 Explicitly pass the objects to be tested (typically used with eventtable).
1923 Set to true to return the objects, but not actually insert them into the
1930 sub due_cust_event {
1932 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1935 #my $DEBUG = $opt{'debug'}
1936 $opt{'debug'} ||= 0; # silence some warnings
1937 local($DEBUG) = $opt{'debug'}
1938 if $opt{'debug'} > $DEBUG;
1939 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1941 warn "$me due_cust_event called with options ".
1942 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1945 $opt{'time'} ||= time;
1947 local $SIG{HUP} = 'IGNORE';
1948 local $SIG{INT} = 'IGNORE';
1949 local $SIG{QUIT} = 'IGNORE';
1950 local $SIG{TERM} = 'IGNORE';
1951 local $SIG{TSTP} = 'IGNORE';
1952 local $SIG{PIPE} = 'IGNORE';
1954 my $oldAutoCommit = $FS::UID::AutoCommit;
1955 local $FS::UID::AutoCommit = 0;
1958 $self->select_for_update #mutex
1959 unless $opt{testonly};
1962 # find possible events (initial search)
1965 my @cust_event = ();
1967 my @eventtable = $opt{'eventtable'}
1968 ? ( $opt{'eventtable'} )
1969 : FS::part_event->eventtables_runorder;
1971 my $check_freq = $opt{'check_freq'} || '1d';
1973 foreach my $eventtable ( @eventtable ) {
1976 if ( $opt{'objects'} ) {
1978 @objects = @{ $opt{'objects'} };
1980 } elsif ( $eventtable eq 'cust_main' ) {
1982 @objects = ( $self );
1986 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1987 # linkage not needed here because FS::cust_main->$eventtable will
1990 #some false laziness w/Cron::bill bill_where
1992 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
1993 'time' => $opt{'time'});
1994 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1995 'time'=>$opt{'time'},
1997 $where = $where ? "AND $where" : '';
1999 my $are_part_event =
2000 "EXISTS ( SELECT 1 FROM part_event $join
2001 WHERE check_freq = '$check_freq'
2002 AND eventtable = '$eventtable'
2003 AND ( disabled = '' OR disabled IS NULL )
2009 @objects = $self->$eventtable(
2010 'addl_from' => $cm_join,
2011 'extra_sql' => " AND $are_part_event",
2013 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2015 my @e_cust_event = ();
2017 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2019 my $cross = "CROSS JOIN $eventtable $linkage";
2020 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2021 unless $eventtable eq 'cust_main';
2023 foreach my $object ( @objects ) {
2025 #this first search uses the condition_sql magic for optimization.
2026 #the more possible events we can eliminate in this step the better
2028 my $cross_where = '';
2029 my $pkey = $object->primary_key;
2030 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2032 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2033 'time' => $opt{'time'});
2035 FS::part_event_condition->where_conditions_sql( $eventtable,
2036 'time'=>$opt{'time'}
2038 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2040 $extra_sql = "AND $extra_sql" if $extra_sql;
2042 #here is the agent virtualization
2043 $extra_sql .= " AND ( part_event.agentnum IS NULL
2044 OR part_event.agentnum = ". $self->agentnum. ' )';
2046 $extra_sql .= " $order";
2048 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2049 if $opt{'debug'} > 2;
2050 my @part_event = qsearch( {
2051 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2052 'select' => 'part_event.*',
2053 'table' => 'part_event',
2054 'addl_from' => "$cross $join",
2055 'hashref' => { 'check_freq' => $check_freq,
2056 'eventtable' => $eventtable,
2059 'extra_sql' => "AND $cross_where $extra_sql",
2063 my $pkey = $object->primary_key;
2064 warn " ". scalar(@part_event).
2065 " possible events found for $eventtable ". $object->$pkey(). "\n";
2068 push @e_cust_event, map {
2069 $_->new_cust_event($object, 'time' => $opt{'time'})
2074 warn " ". scalar(@e_cust_event).
2075 " subtotal possible cust events found for $eventtable\n"
2078 push @cust_event, @e_cust_event;
2082 warn " ". scalar(@cust_event).
2083 " total possible cust events found in initial search\n"
2091 $opt{stage} ||= 'collect';
2093 grep { my $stage = $_->part_event->event_stage;
2094 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2104 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2107 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2110 warn " invalid conditions not eliminated with condition_sql:\n".
2111 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2112 if keys %unsat && $DEBUG; # > 1;
2118 unless( $opt{testonly} ) {
2119 foreach my $cust_event ( @cust_event ) {
2121 my $error = $cust_event->insert();
2123 $dbh->rollback if $oldAutoCommit;
2130 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2136 warn " returning events: ". Dumper(@cust_event). "\n"
2143 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2145 Applies unapplied payments and credits.
2147 In most cases, this new method should be used in place of sequential
2148 apply_payments and apply_credits methods.
2150 A hash of optional arguments may be passed. Currently "manual" is supported.
2151 If true, a payment receipt is sent instead of a statement when
2152 'payment_receipt_email' configuration option is set.
2154 If there is an error, returns the error, otherwise returns false.
2158 sub apply_payments_and_credits {
2159 my( $self, %options ) = @_;
2161 local $SIG{HUP} = 'IGNORE';
2162 local $SIG{INT} = 'IGNORE';
2163 local $SIG{QUIT} = 'IGNORE';
2164 local $SIG{TERM} = 'IGNORE';
2165 local $SIG{TSTP} = 'IGNORE';
2166 local $SIG{PIPE} = 'IGNORE';
2168 my $oldAutoCommit = $FS::UID::AutoCommit;
2169 local $FS::UID::AutoCommit = 0;
2172 $self->select_for_update; #mutex
2174 foreach my $cust_bill ( $self->open_cust_bill ) {
2175 my $error = $cust_bill->apply_payments_and_credits(%options);
2177 $dbh->rollback if $oldAutoCommit;
2178 return "Error applying: $error";
2182 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2187 =item apply_credits OPTION => VALUE ...
2189 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2190 to outstanding invoice balances in chronological order (or reverse
2191 chronological order if the I<order> option is set to B<newest>) and returns the
2192 value of any remaining unapplied credits available for refund (see
2193 L<FS::cust_refund>).
2195 Dies if there is an error.
2203 local $SIG{HUP} = 'IGNORE';
2204 local $SIG{INT} = 'IGNORE';
2205 local $SIG{QUIT} = 'IGNORE';
2206 local $SIG{TERM} = 'IGNORE';
2207 local $SIG{TSTP} = 'IGNORE';
2208 local $SIG{PIPE} = 'IGNORE';
2210 my $oldAutoCommit = $FS::UID::AutoCommit;
2211 local $FS::UID::AutoCommit = 0;
2214 $self->select_for_update; #mutex
2216 unless ( $self->total_unapplied_credits ) {
2217 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2221 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2222 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2224 my @invoices = $self->open_cust_bill;
2225 @invoices = sort { $b->_date <=> $a->_date } @invoices
2226 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2228 if ( $conf->exists('pkg-balances') ) {
2229 # limit @credits to those w/ a pkgnum grepped from $self
2231 foreach my $i (@invoices) {
2232 foreach my $li ( $i->cust_bill_pkg ) {
2233 $pkgnums{$li->pkgnum} = 1;
2236 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2241 foreach my $cust_bill ( @invoices ) {
2243 if ( !defined($credit) || $credit->credited == 0) {
2244 $credit = pop @credits or last;
2248 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2249 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2251 $owed = $cust_bill->owed;
2253 unless ( $owed > 0 ) {
2254 push @credits, $credit;
2258 my $amount = min( $credit->credited, $owed );
2260 my $cust_credit_bill = new FS::cust_credit_bill ( {
2261 'crednum' => $credit->crednum,
2262 'invnum' => $cust_bill->invnum,
2263 'amount' => $amount,
2265 $cust_credit_bill->pkgnum( $credit->pkgnum )
2266 if $conf->exists('pkg-balances') && $credit->pkgnum;
2267 my $error = $cust_credit_bill->insert;
2269 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2273 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2277 my $total_unapplied_credits = $self->total_unapplied_credits;
2279 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2281 return $total_unapplied_credits;
2284 =item apply_payments [ OPTION => VALUE ... ]
2286 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2287 to outstanding invoice balances in chronological order.
2289 #and returns the value of any remaining unapplied payments.
2291 A hash of optional arguments may be passed. Currently "manual" is supported.
2292 If true, a payment receipt is sent instead of a statement when
2293 'payment_receipt_email' configuration option is set.
2295 Dies if there is an error.
2299 sub apply_payments {
2300 my( $self, %options ) = @_;
2302 local $SIG{HUP} = 'IGNORE';
2303 local $SIG{INT} = 'IGNORE';
2304 local $SIG{QUIT} = 'IGNORE';
2305 local $SIG{TERM} = 'IGNORE';
2306 local $SIG{TSTP} = 'IGNORE';
2307 local $SIG{PIPE} = 'IGNORE';
2309 my $oldAutoCommit = $FS::UID::AutoCommit;
2310 local $FS::UID::AutoCommit = 0;
2313 $self->select_for_update; #mutex
2317 my @payments = $self->unapplied_cust_pay;
2319 my @invoices = $self->open_cust_bill;
2321 if ( $conf->exists('pkg-balances') ) {
2322 # limit @payments to those w/ a pkgnum grepped from $self
2324 foreach my $i (@invoices) {
2325 foreach my $li ( $i->cust_bill_pkg ) {
2326 $pkgnums{$li->pkgnum} = 1;
2329 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2334 foreach my $cust_bill ( @invoices ) {
2336 if ( !defined($payment) || $payment->unapplied == 0 ) {
2337 $payment = pop @payments or last;
2341 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2342 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2344 $owed = $cust_bill->owed;
2346 unless ( $owed > 0 ) {
2347 push @payments, $payment;
2351 my $amount = min( $payment->unapplied, $owed );
2354 'paynum' => $payment->paynum,
2355 'invnum' => $cust_bill->invnum,
2356 'amount' => $amount,
2358 $cbp->{_date} = $payment->_date
2359 if $options{'manual'} && $options{'backdate_application'};
2360 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2361 $cust_bill_pay->pkgnum( $payment->pkgnum )
2362 if $conf->exists('pkg-balances') && $payment->pkgnum;
2363 my $error = $cust_bill_pay->insert(%options);
2365 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2369 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2373 my $total_unapplied_payments = $self->total_unapplied_payments;
2375 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2377 return $total_unapplied_payments;
2387 suspend_adjourned_pkgs
2388 unsuspend_resumed_pkgs
2391 (do_cust_event pre-bill)
2393 _omit_zero_value_bundles
2396 apply_payments_and_credits
2405 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>