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;
25 # 1 is mostly method/subroutine entry and options
26 # 2 traces progress of some operations
27 # 3 is even more information including possibly sensitive data
29 $me = '[FS::cust_main::Billing]';
31 install_callback FS::UID sub {
33 #yes, need it for stuff below (prolly should be cached)
38 FS::cust_main::Billing - Billing mixin for cust_main
44 These methods are available on FS::cust_main objects.
50 =item bill_and_collect
52 Cancels and suspends any packages due, generates bills, applies payments and
53 credits, and applies collection events to run cards, send bills and notices,
56 By default, warns on errors and continues with the next operation (but see the
59 Options are passed as name-value pairs. Currently available options are:
65 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:
69 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
73 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.
77 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
81 If set true, re-charges setup fees.
85 If set any errors prevent subsequent operations from continusing. If set
86 specifically to "return", returns the error (or false, if there is no error).
87 Any other true value causes errors to die.
91 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)
95 Optional FS::queue entry to receive status updates.
99 Options are passed to the B<bill> and B<collect> methods verbatim, so all
100 options of those methods are also available.
104 sub bill_and_collect {
105 my( $self, %options ) = @_;
109 #$options{actual_time} not $options{time} because freeside-daily -d is for
110 #pre-printing invoices
112 $options{'actual_time'} ||= time;
113 my $job = $options{'job'};
115 $job->update_statustext('0,cleaning expired packages') if $job;
116 $error = $self->cancel_expired_pkgs( day_end( $options{actual_time} ) );
118 $error = "Error expiring custnum ". $self->custnum. ": $error";
119 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
120 elsif ( $options{fatal} ) { die $error; }
121 else { warn $error; }
124 $error = $self->suspend_adjourned_pkgs( day_end( $options{actual_time} ) );
126 $error = "Error adjourning custnum ". $self->custnum. ": $error";
127 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
128 elsif ( $options{fatal} ) { die $error; }
129 else { warn $error; }
132 $job->update_statustext('20,billing packages') if $job;
133 $error = $self->bill( %options );
135 $error = "Error billing custnum ". $self->custnum. ": $error";
136 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
137 elsif ( $options{fatal} ) { die $error; }
138 else { warn $error; }
141 $job->update_statustext('50,applying payments and credits') if $job;
142 $error = $self->apply_payments_and_credits;
144 $error = "Error applying custnum ". $self->custnum. ": $error";
145 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
146 elsif ( $options{fatal} ) { die $error; }
147 else { warn $error; }
150 $job->update_statustext('70,running collection events') if $job;
151 unless ( $conf->exists('cancelled_cust-noevents')
152 && ! $self->num_ncancelled_pkgs
154 $error = $self->collect( %options );
156 $error = "Error collecting custnum ". $self->custnum. ": $error";
157 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
158 elsif ($options{fatal} ) { die $error; }
159 else { warn $error; }
162 $job->update_statustext('100,finished') if $job;
168 sub cancel_expired_pkgs {
169 my ( $self, $time, %options ) = @_;
171 my @cancel_pkgs = $self->ncancelled_pkgs( {
172 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
177 foreach my $cust_pkg ( @cancel_pkgs ) {
178 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
179 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
180 'reason_otaker' => $cpr->otaker,
185 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
188 scalar(@errors) ? join(' / ', @errors) : '';
192 sub suspend_adjourned_pkgs {
193 my ( $self, $time, %options ) = @_;
195 my @susp_pkgs = $self->ncancelled_pkgs( {
197 " AND ( susp IS NULL OR susp = 0 )
198 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
199 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
204 #only because there's no SQL test for is_prepaid :/
206 grep { ( $_->part_pkg->is_prepaid
211 && $_->adjourn <= $time
219 foreach my $cust_pkg ( @susp_pkgs ) {
220 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
221 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
222 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
223 'reason_otaker' => $cpr->otaker
227 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
230 scalar(@errors) ? join(' / ', @errors) : '';
236 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
237 conjunction with the collect method by calling B<bill_and_collect>.
239 If there is an error, returns the error, otherwise returns false.
241 Options are passed as name-value pairs. Currently available options are:
247 If set true, re-charges setup fees.
251 If set true then only bill recurring charges, not setup, usage, one time
256 If set, then override the normal frequency and look for a part_pkg_discount
257 to take at that frequency. This is appropriate only when the normal
258 frequency for all packages is monthly, and is an error otherwise. Use
259 C<pkg_list> to limit the set of packages included in billing.
263 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:
267 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
271 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
273 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
277 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
281 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.
285 This boolean value informs the us that the package is being cancelled. This
286 typically might mean not charging the normal recurring fee but only usage
287 fees since the last billing. Setup charges may be charged. Not all package
288 plans support this feature (they tend to charge 0).
292 Prevent the resetting of usage limits during this call.
296 Do not save the generated bill in the database. Useful with return_bill
300 A list reference on which the generated bill(s) will be returned.
304 Optional terms to be printed on this invoice. Otherwise, customer-specific
305 terms or the default terms are used.
312 my( $self, %options ) = @_;
314 return '' if $self->payby eq 'COMP';
316 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
318 warn "$me bill customer ". $self->custnum. "\n"
321 my $time = $options{'time'} || time;
322 my $invoice_time = $options{'invoice_time'} || $time;
324 $options{'not_pkgpart'} ||= {};
325 $options{'not_pkgpart'} = { map { $_ => 1 }
326 split(/\s*,\s*/, $options{'not_pkgpart'})
328 unless ref($options{'not_pkgpart'});
330 local $SIG{HUP} = 'IGNORE';
331 local $SIG{INT} = 'IGNORE';
332 local $SIG{QUIT} = 'IGNORE';
333 local $SIG{TERM} = 'IGNORE';
334 local $SIG{TSTP} = 'IGNORE';
335 local $SIG{PIPE} = 'IGNORE';
337 my $oldAutoCommit = $FS::UID::AutoCommit;
338 local $FS::UID::AutoCommit = 0;
341 warn "$me acquiring lock on customer ". $self->custnum. "\n"
344 $self->select_for_update; #mutex
346 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
349 my $error = $self->do_cust_event(
350 'debug' => ( $options{'debug'} || 0 ),
351 'time' => $invoice_time,
352 'check_freq' => $options{'check_freq'},
353 'stage' => 'pre-bill',
355 unless $options{no_commit};
357 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
361 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
364 #keep auto-charge and non-auto-charge line items separate
365 my @passes = ( '', 'no_auto' );
367 my %cust_bill_pkg = map { $_ => [] } @passes;
370 # find the packages which are due for billing, find out how much they are
371 # & generate invoice database.
374 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
375 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
377 my %taxlisthash = map { $_ => {} } @passes;
379 my @precommit_hooks = ();
381 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
382 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
384 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
386 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
388 #? to avoid use of uninitialized value errors... ?
389 $cust_pkg->setfield('bill', '')
390 unless defined($cust_pkg->bill);
392 #my $part_pkg = $cust_pkg->part_pkg;
394 my $real_pkgpart = $cust_pkg->pkgpart;
395 my %hash = $cust_pkg->hash;
397 # we could implement this bit as FS::part_pkg::has_hidden, but we already
398 # suffer from performance issues
399 $options{has_hidden} = 0;
400 my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
401 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
403 foreach my $part_pkg ( @part_pkg ) {
405 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
407 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
409 my $next_bill = $cust_pkg->getfield('bill') || 0;
411 # let this run once if this is the last bill upon cancellation
412 while ( $next_bill <= $time or $options{cancel} ) {
414 $self->_make_lines( 'part_pkg' => $part_pkg,
415 'cust_pkg' => $cust_pkg,
416 'precommit_hooks' => \@precommit_hooks,
417 'line_items' => $cust_bill_pkg{$pass},
418 'setup' => $total_setup{$pass},
419 'recur' => $total_recur{$pass},
420 'tax_matrix' => $taxlisthash{$pass},
422 'real_pkgpart' => $real_pkgpart,
423 'options' => \%options,
426 # Stop if anything goes wrong
429 # or if we're not incrementing the bill date.
430 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
432 # or if we're letting it run only once
433 last if $options{cancel};
435 $next_bill = $cust_pkg->getfield('bill') || 0;
437 #stop if -o was passed to freeside-daily
438 last if $options{'one_recur'};
441 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
445 } #foreach my $part_pkg
447 } #foreach my $cust_pkg
449 #if the customer isn't on an automatic payby, everything can go on a single
451 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
452 #merge everything into one list
455 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
457 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
459 next unless @cust_bill_pkg; #don't create an invoice w/o line items
461 warn "$me billing pass $pass\n"
462 #.Dumper(\@cust_bill_pkg)."\n"
465 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
466 !$conf->exists('postal_invoice-recurring_only')
470 my $postal_pkg = $self->charge_postal_fee();
471 if ( $postal_pkg && !ref( $postal_pkg ) ) {
473 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
474 return "can't charge postal invoice fee for customer ".
475 $self->custnum. ": $postal_pkg";
477 } elsif ( $postal_pkg ) {
479 my $real_pkgpart = $postal_pkg->pkgpart;
480 # we could implement this bit as FS::part_pkg::has_hidden, but we already
481 # suffer from performance issues
482 $options{has_hidden} = 0;
483 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
484 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
486 foreach my $part_pkg ( @part_pkg ) {
487 my %postal_options = %options;
488 delete $postal_options{cancel};
490 $self->_make_lines( 'part_pkg' => $part_pkg,
491 'cust_pkg' => $postal_pkg,
492 'precommit_hooks' => \@precommit_hooks,
493 'line_items' => \@cust_bill_pkg,
494 'setup' => $total_setup{$pass},
495 'recur' => $total_recur{$pass},
496 'tax_matrix' => $taxlisthash{$pass},
498 'real_pkgpart' => $real_pkgpart,
499 'options' => \%postal_options,
502 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
507 # it's silly to have a zero value postal_pkg, but....
508 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
514 my $listref_or_error =
515 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
517 unless ( ref( $listref_or_error ) ) {
518 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
519 return $listref_or_error;
522 foreach my $taxline ( @$listref_or_error ) {
523 ${ $total_setup{$pass} } =
524 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
525 push @cust_bill_pkg, $taxline;
529 warn "adding tax adjustments...\n" if $DEBUG > 2;
530 foreach my $cust_tax_adjustment (
531 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
537 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
539 my $itemdesc = $cust_tax_adjustment->taxname;
540 $itemdesc = '' if $itemdesc eq 'Tax';
542 push @cust_bill_pkg, new FS::cust_bill_pkg {
548 'itemdesc' => $itemdesc,
549 'itemcomment' => $cust_tax_adjustment->comment,
550 'cust_tax_adjustment' => $cust_tax_adjustment,
551 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
556 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
558 my @cust_bill = $self->cust_bill;
559 my $balance = $self->balance;
560 my $previous_balance = scalar(@cust_bill)
561 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
564 $previous_balance += $cust_bill[$#cust_bill]->charged
565 if scalar(@cust_bill);
566 #my $balance_adjustments =
567 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
569 warn "creating the new invoice\n" if $DEBUG;
570 #create the new invoice
571 my $cust_bill = new FS::cust_bill ( {
572 'custnum' => $self->custnum,
573 '_date' => $invoice_time,
574 'charged' => $charged,
575 'billing_balance' => $balance,
576 'previous_balance' => $previous_balance,
577 'invoice_terms' => $options{'invoice_terms'},
578 'cust_bill_pkg' => \@cust_bill_pkg,
580 $error = $cust_bill->insert unless $options{no_commit};
582 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
583 return "can't create invoice for customer #". $self->custnum. ": $error";
585 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
587 } #foreach my $pass ( keys %cust_bill_pkg )
589 foreach my $hook ( @precommit_hooks ) {
592 } unless $options{no_commit};
594 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
595 return "$@ running precommit hook $hook\n";
599 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
604 #discard bundled packages of 0 value
605 sub _omit_zero_value_bundles {
608 my @cust_bill_pkg = ();
609 my @cust_bill_pkg_bundle = ();
611 my $discount_show_always = 0;
613 foreach my $cust_bill_pkg ( @in ) {
615 $discount_show_always = ($cust_bill_pkg->get('discounts')
616 && scalar(@{$cust_bill_pkg->get('discounts')})
617 && $conf->exists('discount-show-always'));
619 warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
620 "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
621 "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
624 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
625 push @cust_bill_pkg, @cust_bill_pkg_bundle
627 || ($sum == 0 && ( $discount_show_always
628 || grep {$_->recur_show_zero || $_->setup_show_zero}
629 @cust_bill_pkg_bundle
632 @cust_bill_pkg_bundle = ();
636 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
637 push @cust_bill_pkg_bundle, $cust_bill_pkg;
641 push @cust_bill_pkg, @cust_bill_pkg_bundle
643 || ($sum == 0 && ( $discount_show_always
644 || grep {$_->recur_show_zero || $_->setup_show_zero}
645 @cust_bill_pkg_bundle
649 warn " _omit_zero_value_bundles: ". scalar(@in).
650 '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
657 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
659 This is a weird one. Perhaps it should not even be exposed.
661 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
662 Usually used internally by bill method B<bill>.
664 If there is an error, returns the error, otherwise returns reference to a
665 list of line items suitable for insertion.
671 An array ref of the line items being billed.
675 A strange beast. The keys to this hash are internal identifiers consisting
676 of the name of the tax object type, a space, and its unique identifier ( e.g.
677 'cust_main_county 23' ). The values of the hash are listrefs. The first
678 item in the list is the tax object. The remaining items are either line
679 items or floating point values (currency amounts).
681 The taxes are calculated on this entity. Calculated exemption records are
682 transferred to the LINEITEMREF items on the assumption that they are related.
688 This specifies the date appearing on the associated invoice. Some
689 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
695 sub calculate_taxes {
696 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
698 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
700 warn "$me calculate_taxes\n"
701 #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
704 my @tax_line_items = ();
706 # keys are tax names (as printed on invoices / itemdesc )
707 # values are listrefs of taxlisthash keys (internal identifiers)
710 # keys are taxlisthash keys (internal identifiers)
711 # values are (cumulative) amounts
714 # keys are taxlisthash keys (internal identifiers)
715 # values are listrefs of cust_bill_pkg_tax_location hashrefs
716 my %tax_location = ();
718 # keys are taxlisthash keys (internal identifiers)
719 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
720 my %tax_rate_location = ();
722 foreach my $tax ( keys %$taxlisthash ) {
723 my $tax_object = shift @{ $taxlisthash->{$tax} };
724 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
725 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
726 my $hashref_or_error =
727 $tax_object->taxline( $taxlisthash->{$tax},
728 'custnum' => $self->custnum,
729 'invoice_time' => $invoice_time
731 return $hashref_or_error unless ref($hashref_or_error);
733 unshift @{ $taxlisthash->{$tax} }, $tax_object;
735 my $name = $hashref_or_error->{'name'};
736 my $amount = $hashref_or_error->{'amount'};
738 #warn "adding $amount as $name\n";
739 $taxname{ $name } ||= [];
740 push @{ $taxname{ $name } }, $tax;
742 $tax{ $tax } += $amount;
744 $tax_location{ $tax } ||= [];
745 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
746 push @{ $tax_location{ $tax } },
748 'taxnum' => $tax_object->taxnum,
749 'taxtype' => ref($tax_object),
750 'pkgnum' => $tax_object->get('pkgnum'),
751 'locationnum' => $tax_object->get('locationnum'),
752 'amount' => sprintf('%.2f', $amount ),
756 $tax_rate_location{ $tax } ||= [];
757 if ( ref($tax_object) eq 'FS::tax_rate' ) {
758 my $taxratelocationnum =
759 $tax_object->tax_rate_location->taxratelocationnum;
760 push @{ $tax_rate_location{ $tax } },
762 'taxnum' => $tax_object->taxnum,
763 'taxtype' => ref($tax_object),
764 'amount' => sprintf('%.2f', $amount ),
765 'locationtaxid' => $tax_object->location,
766 'taxratelocationnum' => $taxratelocationnum,
772 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
773 my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
774 foreach my $tax ( keys %$taxlisthash ) {
775 foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
776 next unless ref($_) eq 'FS::cust_bill_pkg';
778 my @cust_tax_exempt_pkg = splice( @{ $_->_cust_tax_exempt_pkg } );
780 next unless @cust_tax_exempt_pkg; #just avoiding the prob when irrelevant?
781 die "can't distribute tax exemptions: no line item for ". Dumper($_).
782 " in packagemap ". join(',', sort {$a<=>$b} keys %packagemap). "\n"
783 unless $packagemap{$_->pkgnum};
785 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
786 @cust_tax_exempt_pkg;
790 #consolidate and create tax line items
791 warn "consolidating and generating...\n" if $DEBUG > 2;
792 foreach my $taxname ( keys %taxname ) {
795 my @cust_bill_pkg_tax_location = ();
796 my @cust_bill_pkg_tax_rate_location = ();
797 warn "adding $taxname\n" if $DEBUG > 1;
798 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
799 next if $seen{$taxitem}++;
800 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
801 $tax += $tax{$taxitem};
802 push @cust_bill_pkg_tax_location,
803 map { new FS::cust_bill_pkg_tax_location $_ }
804 @{ $tax_location{ $taxitem } };
805 push @cust_bill_pkg_tax_rate_location,
806 map { new FS::cust_bill_pkg_tax_rate_location $_ }
807 @{ $tax_rate_location{ $taxitem } };
811 $tax = sprintf('%.2f', $tax );
813 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
819 if ( $pkg_category and
820 $conf->config('invoice_latexsummary') ||
821 $conf->config('invoice_htmlsummary')
825 my %hash = ( 'section' => $pkg_category->categoryname );
826 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
830 push @tax_line_items, new FS::cust_bill_pkg {
836 'itemdesc' => $taxname,
837 'display' => \@display,
838 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
839 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
848 my ($self, %params) = @_;
850 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
852 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
853 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
854 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
855 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
856 my $total_setup = $params{setup} or die "no setup accumulator specified";
857 my $total_recur = $params{recur} or die "no recur accumulator specified";
858 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
859 my $time = $params{'time'} or die "no time specified";
860 my (%options) = %{$params{options}};
862 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
863 # this should never happen
864 die 'freq_override billing attempted on non-monthly package '.
869 my $real_pkgpart = $params{real_pkgpart};
870 my %hash = $cust_pkg->hash;
871 my $old_cust_pkg = new FS::cust_pkg \%hash;
876 $cust_pkg->pkgpart($part_pkg->pkgpart);
884 my @setup_discounts = ();
885 my %setup_param = ( 'discounts' => \@setup_discounts );
886 if ( ! $options{recurring_only}
887 and ! $options{cancel}
888 and ( $options{'resetup'}
889 || ( ! $cust_pkg->setup
890 && ( ! $cust_pkg->start_date
891 || $cust_pkg->start_date <= day_end($time)
893 && ( ! $conf->exists('disable_setup_suspended_pkgs')
894 || ( $conf->exists('disable_setup_suspended_pkgs') &&
895 ! $cust_pkg->getfield('susp')
903 warn " bill setup\n" if $DEBUG > 1;
905 unless ( $cust_pkg->waive_setup ) {
908 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
909 return "$@ running calc_setup for $cust_pkg\n"
912 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
915 $cust_pkg->setfield('setup', $time)
916 unless $cust_pkg->setup;
917 #do need it, but it won't get written to the db
918 #|| $cust_pkg->pkgpart != $real_pkgpart;
920 $cust_pkg->setfield('start_date', '')
921 if $cust_pkg->start_date;
929 #XXX unit stuff here too
932 my @recur_discounts = ();
934 if ( ! $cust_pkg->start_date
935 and ( ! $cust_pkg->susp || $part_pkg->option('suspend_bill', 1) )
937 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) )
938 || ( $part_pkg->plan eq 'voip_cdr'
939 && $part_pkg->option('bill_every_call')
944 # XXX should this be a package event? probably. events are called
945 # at collection time at the moment, though...
946 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
947 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
948 #don't want to reset usage just cause we want a line item??
949 #&& $part_pkg->pkgpart == $real_pkgpart;
951 warn " bill recur\n" if $DEBUG > 1;
954 # XXX shared with $recur_prog
955 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
959 #over two params! lets at least switch to a hashref for the rest...
960 my $increment_next_bill = ( $part_pkg->freq ne '0'
961 && ( $cust_pkg->getfield('bill') || 0 ) <= day_end($time)
964 my %param = ( %setup_param,
965 'precommit_hooks' => $precommit_hooks,
966 'increment_next_bill' => $increment_next_bill,
967 'discounts' => \@recur_discounts,
968 'real_pkgpart' => $real_pkgpart,
969 'freq_override' => $options{freq_override} || '',
973 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
975 # There may be some part_pkg for which this is wrong. Only those
976 # which can_discount are supported.
977 # (the UI should prevent adding discounts to these at the moment)
979 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
980 " for pkgpart ". $cust_pkg->pkgpart.
981 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
984 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
985 return "$@ running $method for $cust_pkg\n"
988 if ( $increment_next_bill ) {
990 my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
991 return "unparsable frequency: ". $part_pkg->freq
994 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
995 # only for figuring next bill date, nothing else, so, reset $sdate again
997 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
998 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
999 $cust_pkg->last_bill($sdate);
1001 $cust_pkg->setfield('bill', $next_bill );
1005 if ( $param{'setup_fee'} ) {
1006 # Add an additional setup fee at the billing stage.
1007 # Used for prorate_defer_bill.
1008 $setup += $param{'setup_fee'};
1009 $unitsetup += $param{'setup_fee'};
1013 if ( defined $param{'discount_left_setup'} ) {
1014 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1015 $setup -= $discount_setup;
1021 warn "\$setup is undefined" unless defined($setup);
1022 warn "\$recur is undefined" unless defined($recur);
1023 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1026 # If there's line items, create em cust_bill_pkg records
1027 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1032 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1033 # hmm.. and if just the options are modified in some weird price plan?
1035 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1038 my $error = $cust_pkg->replace( $old_cust_pkg,
1039 'depend_jobnum'=>$options{depend_jobnum},
1040 'options' => { $cust_pkg->options },
1042 unless $options{no_commit};
1043 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1044 if $error; #just in case
1047 $setup = sprintf( "%.2f", $setup );
1048 $recur = sprintf( "%.2f", $recur );
1049 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1050 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1052 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1053 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1056 my $discount_show_always = $conf->exists('discount-show-always')
1057 && ( ($setup == 0 && scalar(@setup_discounts))
1058 || ($recur == 0 && scalar(@recur_discounts))
1063 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1064 || $discount_show_always
1065 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1066 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1070 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1073 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1075 warn " adding customer package invoice detail: $_\n"
1076 foreach @cust_pkg_detail;
1078 push @details, @cust_pkg_detail;
1080 my $cust_bill_pkg = new FS::cust_bill_pkg {
1081 'pkgnum' => $cust_pkg->pkgnum,
1083 'unitsetup' => $unitsetup,
1085 'unitrecur' => $unitrecur,
1086 'quantity' => $cust_pkg->quantity,
1087 'details' => \@details,
1088 'discounts' => [ @setup_discounts, @recur_discounts ],
1089 'hidden' => $part_pkg->hidden,
1090 'freq' => $part_pkg->freq,
1093 if ( $part_pkg->recur_temporality eq 'preceding' ) {
1094 $cust_bill_pkg->sdate( $hash{last_bill} );
1095 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1096 $cust_bill_pkg->edate( $time ) if $options{cancel};
1097 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1098 $cust_bill_pkg->sdate( $sdate );
1099 $cust_bill_pkg->edate( $cust_pkg->bill );
1100 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1103 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1104 unless $part_pkg->pkgpart == $real_pkgpart;
1106 $$total_setup += $setup;
1107 $$total_recur += $recur;
1113 unless ( $discount_show_always ) {
1115 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
1116 return $error if $error;
1119 push @$cust_bill_pkgs, $cust_bill_pkg;
1121 } #if $setup != 0 || $recur != 0
1131 my $part_pkg = shift;
1132 my $taxlisthash = shift;
1133 my $cust_bill_pkg = shift;
1134 my $cust_pkg = shift;
1135 my $invoice_time = shift;
1136 my $real_pkgpart = shift;
1137 my $options = shift;
1139 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1141 my %cust_bill_pkg = ();
1145 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1146 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1147 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1148 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1150 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
1152 if ( $conf->exists('enable_taxproducts')
1153 && ( scalar($part_pkg->part_pkg_taxoverride)
1154 || $part_pkg->has_taxproduct
1159 foreach my $class (@classes) {
1160 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
1161 return $err_or_ref unless ref($err_or_ref);
1162 $taxes{$class} = $err_or_ref;
1165 unless (exists $taxes{''}) {
1166 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
1167 return $err_or_ref unless ref($err_or_ref);
1168 $taxes{''} = $err_or_ref;
1173 my @loc_keys = qw( district city county state country );
1175 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1176 my $cust_location = $cust_pkg->cust_location;
1177 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
1180 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1183 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
1186 $taxhash{'taxclass'} = $part_pkg->taxclass;
1189 my %taxhash_elim = %taxhash;
1190 my @elim = qw( district city county state );
1193 #first try a match with taxclass
1194 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1196 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1197 #then try a match without taxclass
1198 my %no_taxclass = %taxhash_elim;
1199 $no_taxclass{ 'taxclass' } = '';
1200 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1203 $taxhash_elim{ shift(@elim) } = '';
1205 } while ( !scalar(@taxes) && scalar(@elim) );
1207 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
1209 if $self->cust_main_exemption; #just to be safe
1211 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1213 $_->set('pkgnum', $cust_pkg->pkgnum );
1214 $_->set('locationnum', $cust_pkg->locationnum );
1218 $taxes{''} = [ @taxes ];
1219 $taxes{'setup'} = [ @taxes ];
1220 $taxes{'recur'} = [ @taxes ];
1221 $taxes{$_} = [ @taxes ] foreach (@classes);
1223 # # maybe eliminate this entirely, along with all the 0% records
1224 # unless ( @taxes ) {
1226 # "fatal: can't find tax rate for state/county/country/taxclass ".
1227 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
1230 } #if $conf->exists('enable_taxproducts') ...
1234 #what's this doing in the middle of _handle_taxes? probably should split
1235 #this into three parts above in _make_lines
1236 $cust_bill_pkg->set_display( part_pkg => $part_pkg,
1237 real_pkgpart => $real_pkgpart,
1240 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1241 foreach my $key (keys %tax_cust_bill_pkg) {
1242 my @taxes = @{ $taxes{$key} || [] };
1243 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1245 my %localtaxlisthash = ();
1246 foreach my $tax ( @taxes ) {
1248 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1249 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
1250 # ' locationnum'. $cust_pkg->locationnum
1251 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
1253 $taxlisthash->{ $taxname } ||= [ $tax ];
1254 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1256 $localtaxlisthash{ $taxname } ||= [ $tax ];
1257 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1261 warn "finding taxed taxes...\n" if $DEBUG > 2;
1262 foreach my $tax ( keys %localtaxlisthash ) {
1263 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1264 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1266 next unless $tax_object->can('tax_on_tax');
1268 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1269 my $totname = ref( $tot ). ' '. $tot->taxnum;
1271 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1273 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1275 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1276 my $hashref_or_error =
1277 $tax_object->taxline( $localtaxlisthash{$tax},
1278 'custnum' => $self->custnum,
1279 'invoice_time' => $invoice_time,
1281 return $hashref_or_error
1282 unless ref($hashref_or_error);
1284 $taxlisthash->{ $totname } ||= [ $tot ];
1285 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1297 my $part_pkg = shift;
1299 my $cust_pkg = shift;
1301 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1304 if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
1305 $geocode = $cust_pkg->cust_location->geocode('cch');
1307 $geocode = $self->geocode('cch');
1312 my @taxclassnums = map { $_->taxclassnum }
1313 $part_pkg->part_pkg_taxoverride($class);
1315 unless (@taxclassnums) {
1316 @taxclassnums = map { $_->taxclassnum }
1317 grep { $_->taxable eq 'Y' }
1318 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1320 warn "Found taxclassnum values of ". join(',', @taxclassnums)
1325 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1327 @taxes = qsearch({ 'table' => 'tax_rate',
1328 'hashref' => { 'geocode' => $geocode, },
1329 'extra_sql' => $extra_sql,
1331 if scalar(@taxclassnums);
1333 warn "Found taxes ".
1334 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1341 =item collect [ HASHREF | OPTION => VALUE ... ]
1343 (Attempt to) collect money for this customer's outstanding invoices (see
1344 L<FS::cust_bill>). Usually used after the bill method.
1346 Actions are now triggered by billing events; see L<FS::part_event> and the
1347 billing events web interface. Old-style invoice events (see
1348 L<FS::part_bill_event>) have been deprecated.
1350 If there is an error, returns the error, otherwise returns false.
1352 Options are passed as name-value pairs.
1354 Currently available options are:
1360 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.
1364 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1368 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1372 set true to surpress email card/ACH decline notices.
1376 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)
1382 # allows for one time override of normal customer billing method
1387 my( $self, %options ) = @_;
1389 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1391 my $invoice_time = $options{'invoice_time'} || time;
1394 local $SIG{HUP} = 'IGNORE';
1395 local $SIG{INT} = 'IGNORE';
1396 local $SIG{QUIT} = 'IGNORE';
1397 local $SIG{TERM} = 'IGNORE';
1398 local $SIG{TSTP} = 'IGNORE';
1399 local $SIG{PIPE} = 'IGNORE';
1401 my $oldAutoCommit = $FS::UID::AutoCommit;
1402 local $FS::UID::AutoCommit = 0;
1405 $self->select_for_update; #mutex
1408 my $balance = $self->balance;
1409 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1412 if ( exists($options{'retry_card'}) ) {
1413 carp 'retry_card option passed to collect is deprecated; use retry';
1414 $options{'retry'} ||= $options{'retry_card'};
1416 if ( exists($options{'retry'}) && $options{'retry'} ) {
1417 my $error = $self->retry_realtime;
1419 $dbh->rollback if $oldAutoCommit;
1424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1426 #never want to roll back an event just because it returned an error
1427 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1429 $self->do_cust_event(
1430 'debug' => ( $options{'debug'} || 0 ),
1431 'time' => $invoice_time,
1432 'check_freq' => $options{'check_freq'},
1433 'stage' => 'collect',
1438 =item retry_realtime
1440 Schedules realtime / batch credit card / electronic check / LEC billing
1441 events for for retry. Useful if card information has changed or manual
1442 retry is desired. The 'collect' method must be called to actually retry
1445 Implementation details: For either this customer, or for each of this
1446 customer's open invoices, changes the status of the first "done" (with
1447 statustext error) realtime processing event to "failed".
1451 sub retry_realtime {
1454 local $SIG{HUP} = 'IGNORE';
1455 local $SIG{INT} = 'IGNORE';
1456 local $SIG{QUIT} = 'IGNORE';
1457 local $SIG{TERM} = 'IGNORE';
1458 local $SIG{TSTP} = 'IGNORE';
1459 local $SIG{PIPE} = 'IGNORE';
1461 my $oldAutoCommit = $FS::UID::AutoCommit;
1462 local $FS::UID::AutoCommit = 0;
1465 #a little false laziness w/due_cust_event (not too bad, really)
1467 my $join = FS::part_event_condition->join_conditions_sql;
1468 my $order = FS::part_event_condition->order_conditions_sql;
1471 . join ( ' OR ' , map {
1472 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1473 my $custnum = FS::part_event->eventtables_custnum->{$_};
1474 "( part_event.eventtable = " . dbh->quote($_)
1475 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1476 . " from $_ $cust_join"
1477 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1478 } FS::part_event->eventtables)
1481 #here is the agent virtualization
1482 my $agent_virt = " ( part_event.agentnum IS NULL
1483 OR part_event.agentnum = ". $self->agentnum. ' )';
1485 #XXX this shouldn't be hardcoded, actions should declare it...
1486 my @realtime_events = qw(
1487 cust_bill_realtime_card
1488 cust_bill_realtime_check
1489 cust_bill_realtime_lec
1493 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
1498 my @cust_event = qsearchs({
1499 'table' => 'cust_event',
1500 'select' => 'cust_event.*',
1501 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1502 'hashref' => { 'status' => 'done' },
1503 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
1504 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1507 my %seen_invnum = ();
1508 foreach my $cust_event (@cust_event) {
1510 #max one for the customer, one for each open invoice
1511 my $cust_X = $cust_event->cust_X;
1512 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1516 or $cust_event->part_event->eventtable eq 'cust_bill'
1519 my $error = $cust_event->retry;
1521 $dbh->rollback if $oldAutoCommit;
1522 return "error scheduling event for retry: $error";
1527 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1532 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1534 Runs billing events; see L<FS::part_event> and the billing events web
1537 If there is an error, returns the error, otherwise returns false.
1539 Options are passed as name-value pairs.
1541 Currently available options are:
1547 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.
1551 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1555 "collect" (the default) or "pre-bill"
1559 set true to surpress email card/ACH decline notices.
1563 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)
1570 # allows for one time override of normal customer billing method
1574 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1577 my( $self, %options ) = @_;
1579 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1581 my $time = $options{'time'} || time;
1584 local $SIG{HUP} = 'IGNORE';
1585 local $SIG{INT} = 'IGNORE';
1586 local $SIG{QUIT} = 'IGNORE';
1587 local $SIG{TERM} = 'IGNORE';
1588 local $SIG{TSTP} = 'IGNORE';
1589 local $SIG{PIPE} = 'IGNORE';
1591 my $oldAutoCommit = $FS::UID::AutoCommit;
1592 local $FS::UID::AutoCommit = 0;
1595 $self->select_for_update; #mutex
1598 my $balance = $self->balance;
1599 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1602 # if ( exists($options{'retry_card'}) ) {
1603 # carp 'retry_card option passed to collect is deprecated; use retry';
1604 # $options{'retry'} ||= $options{'retry_card'};
1606 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1607 # my $error = $self->retry_realtime;
1609 # $dbh->rollback if $oldAutoCommit;
1614 # false laziness w/pay_batch::import_results
1616 my $due_cust_event = $self->due_cust_event(
1617 'debug' => ( $options{'debug'} || 0 ),
1619 'check_freq' => $options{'check_freq'},
1620 'stage' => ( $options{'stage'} || 'collect' ),
1622 unless( ref($due_cust_event) ) {
1623 $dbh->rollback if $oldAutoCommit;
1624 return $due_cust_event;
1627 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1628 #never want to roll back an event just because it or a different one
1630 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1632 foreach my $cust_event ( @$due_cust_event ) {
1636 #re-eval event conditions (a previous event could have changed things)
1637 unless ( $cust_event->test_conditions ) {
1638 #don't leave stray "new/locked" records around
1639 my $error = $cust_event->delete;
1640 return $error if $error;
1645 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1646 if $options{'quiet'};
1647 warn " running cust_event ". $cust_event->eventnum. "\n"
1650 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1651 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1652 #XXX wtf is this? figure out a proper dealio with return value
1664 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1666 Inserts database records for and returns an ordered listref of new events due
1667 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1668 events are due, an empty listref is returned. If there is an error, returns a
1669 scalar error message.
1671 To actually run the events, call each event's test_condition method, and if
1672 still true, call the event's do_event method.
1674 Options are passed as a hashref or as a list of name-value pairs. Available
1681 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.
1685 "collect" (the default) or "pre-bill"
1689 "Current time" for the events.
1693 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)
1697 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1701 Explicitly pass the objects to be tested (typically used with eventtable).
1705 Set to true to return the objects, but not actually insert them into the
1712 sub due_cust_event {
1714 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1717 #my $DEBUG = $opt{'debug'}
1718 local($DEBUG) = $opt{'debug'}
1719 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1720 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1722 warn "$me due_cust_event called with options ".
1723 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1726 $opt{'time'} ||= time;
1728 local $SIG{HUP} = 'IGNORE';
1729 local $SIG{INT} = 'IGNORE';
1730 local $SIG{QUIT} = 'IGNORE';
1731 local $SIG{TERM} = 'IGNORE';
1732 local $SIG{TSTP} = 'IGNORE';
1733 local $SIG{PIPE} = 'IGNORE';
1735 my $oldAutoCommit = $FS::UID::AutoCommit;
1736 local $FS::UID::AutoCommit = 0;
1739 $self->select_for_update #mutex
1740 unless $opt{testonly};
1743 # find possible events (initial search)
1746 my @cust_event = ();
1748 my @eventtable = $opt{'eventtable'}
1749 ? ( $opt{'eventtable'} )
1750 : FS::part_event->eventtables_runorder;
1752 my $check_freq = $opt{'check_freq'} || '1d';
1754 foreach my $eventtable ( @eventtable ) {
1757 if ( $opt{'objects'} ) {
1759 @objects = @{ $opt{'objects'} };
1761 } elsif ( $eventtable eq 'cust_main' ) {
1763 @objects = ( $self );
1767 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1768 # linkage not needed here because FS::cust_main->$eventtable will
1771 #some false laziness w/Cron::bill bill_where
1773 my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
1774 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1775 'time'=>$opt{'time'},
1777 $where = $where ? "AND $where" : '';
1779 my $are_part_event =
1780 "EXISTS ( SELECT 1 FROM part_event $join
1781 WHERE check_freq = '$check_freq'
1782 AND eventtable = '$eventtable'
1783 AND ( disabled = '' OR disabled IS NULL )
1789 @objects = $self->$eventtable(
1790 'addl_from' => $cm_join,
1791 'extra_sql' => " AND $are_part_event",
1793 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
1795 my @e_cust_event = ();
1797 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
1799 my $cross = "CROSS JOIN $eventtable $linkage";
1800 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1801 unless $eventtable eq 'cust_main';
1803 foreach my $object ( @objects ) {
1805 #this first search uses the condition_sql magic for optimization.
1806 #the more possible events we can eliminate in this step the better
1808 my $cross_where = '';
1809 my $pkey = $object->primary_key;
1810 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1812 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1814 FS::part_event_condition->where_conditions_sql( $eventtable,
1815 'time'=>$opt{'time'}
1817 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1819 $extra_sql = "AND $extra_sql" if $extra_sql;
1821 #here is the agent virtualization
1822 $extra_sql .= " AND ( part_event.agentnum IS NULL
1823 OR part_event.agentnum = ". $self->agentnum. ' )';
1825 $extra_sql .= " $order";
1827 warn "searching for events for $eventtable ". $object->$pkey. "\n"
1828 if $opt{'debug'} > 2;
1829 my @part_event = qsearch( {
1830 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
1831 'select' => 'part_event.*',
1832 'table' => 'part_event',
1833 'addl_from' => "$cross $join",
1834 'hashref' => { 'check_freq' => $check_freq,
1835 'eventtable' => $eventtable,
1838 'extra_sql' => "AND $cross_where $extra_sql",
1842 my $pkey = $object->primary_key;
1843 warn " ". scalar(@part_event).
1844 " possible events found for $eventtable ". $object->$pkey(). "\n";
1847 push @e_cust_event, map {
1848 $_->new_cust_event($object, 'time' => $opt{'time'})
1853 warn " ". scalar(@e_cust_event).
1854 " subtotal possible cust events found for $eventtable\n"
1857 push @cust_event, @e_cust_event;
1861 warn " ". scalar(@cust_event).
1862 " total possible cust events found in initial search\n"
1870 $opt{stage} ||= 'collect';
1872 grep { my $stage = $_->part_event->event_stage;
1873 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1883 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
1886 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
1889 warn " invalid conditions not eliminated with condition_sql:\n".
1890 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
1891 if keys %unsat && $DEBUG; # > 1;
1897 unless( $opt{testonly} ) {
1898 foreach my $cust_event ( @cust_event ) {
1900 my $error = $cust_event->insert();
1902 $dbh->rollback if $oldAutoCommit;
1909 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1915 warn " returning events: ". Dumper(@cust_event). "\n"
1922 =item apply_payments_and_credits [ OPTION => VALUE ... ]
1924 Applies unapplied payments and credits.
1926 In most cases, this new method should be used in place of sequential
1927 apply_payments and apply_credits methods.
1929 A hash of optional arguments may be passed. Currently "manual" is supported.
1930 If true, a payment receipt is sent instead of a statement when
1931 'payment_receipt_email' configuration option is set.
1933 If there is an error, returns the error, otherwise returns false.
1937 sub apply_payments_and_credits {
1938 my( $self, %options ) = @_;
1940 local $SIG{HUP} = 'IGNORE';
1941 local $SIG{INT} = 'IGNORE';
1942 local $SIG{QUIT} = 'IGNORE';
1943 local $SIG{TERM} = 'IGNORE';
1944 local $SIG{TSTP} = 'IGNORE';
1945 local $SIG{PIPE} = 'IGNORE';
1947 my $oldAutoCommit = $FS::UID::AutoCommit;
1948 local $FS::UID::AutoCommit = 0;
1951 $self->select_for_update; #mutex
1953 foreach my $cust_bill ( $self->open_cust_bill ) {
1954 my $error = $cust_bill->apply_payments_and_credits(%options);
1956 $dbh->rollback if $oldAutoCommit;
1957 return "Error applying: $error";
1961 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1966 =item apply_credits OPTION => VALUE ...
1968 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1969 to outstanding invoice balances in chronological order (or reverse
1970 chronological order if the I<order> option is set to B<newest>) and returns the
1971 value of any remaining unapplied credits available for refund (see
1972 L<FS::cust_refund>).
1974 Dies if there is an error.
1982 local $SIG{HUP} = 'IGNORE';
1983 local $SIG{INT} = 'IGNORE';
1984 local $SIG{QUIT} = 'IGNORE';
1985 local $SIG{TERM} = 'IGNORE';
1986 local $SIG{TSTP} = 'IGNORE';
1987 local $SIG{PIPE} = 'IGNORE';
1989 my $oldAutoCommit = $FS::UID::AutoCommit;
1990 local $FS::UID::AutoCommit = 0;
1993 $self->select_for_update; #mutex
1995 unless ( $self->total_unapplied_credits ) {
1996 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2000 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2001 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2003 my @invoices = $self->open_cust_bill;
2004 @invoices = sort { $b->_date <=> $a->_date } @invoices
2005 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2007 if ( $conf->exists('pkg-balances') ) {
2008 # limit @credits to those w/ a pkgnum grepped from $self
2010 foreach my $i (@invoices) {
2011 foreach my $li ( $i->cust_bill_pkg ) {
2012 $pkgnums{$li->pkgnum} = 1;
2015 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2020 foreach my $cust_bill ( @invoices ) {
2022 if ( !defined($credit) || $credit->credited == 0) {
2023 $credit = pop @credits or last;
2027 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2028 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2030 $owed = $cust_bill->owed;
2032 unless ( $owed > 0 ) {
2033 push @credits, $credit;
2037 my $amount = min( $credit->credited, $owed );
2039 my $cust_credit_bill = new FS::cust_credit_bill ( {
2040 'crednum' => $credit->crednum,
2041 'invnum' => $cust_bill->invnum,
2042 'amount' => $amount,
2044 $cust_credit_bill->pkgnum( $credit->pkgnum )
2045 if $conf->exists('pkg-balances') && $credit->pkgnum;
2046 my $error = $cust_credit_bill->insert;
2048 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2052 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2056 my $total_unapplied_credits = $self->total_unapplied_credits;
2058 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2060 return $total_unapplied_credits;
2063 =item apply_payments [ OPTION => VALUE ... ]
2065 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2066 to outstanding invoice balances in chronological order.
2068 #and returns the value of any remaining unapplied payments.
2070 A hash of optional arguments may be passed. Currently "manual" is supported.
2071 If true, a payment receipt is sent instead of a statement when
2072 'payment_receipt_email' configuration option is set.
2074 Dies if there is an error.
2078 sub apply_payments {
2079 my( $self, %options ) = @_;
2081 local $SIG{HUP} = 'IGNORE';
2082 local $SIG{INT} = 'IGNORE';
2083 local $SIG{QUIT} = 'IGNORE';
2084 local $SIG{TERM} = 'IGNORE';
2085 local $SIG{TSTP} = 'IGNORE';
2086 local $SIG{PIPE} = 'IGNORE';
2088 my $oldAutoCommit = $FS::UID::AutoCommit;
2089 local $FS::UID::AutoCommit = 0;
2092 $self->select_for_update; #mutex
2096 my @payments = sort { $b->_date <=> $a->_date }
2097 grep { $_->unapplied > 0 }
2100 my @invoices = sort { $a->_date <=> $b->_date}
2101 grep { $_->owed > 0 }
2104 if ( $conf->exists('pkg-balances') ) {
2105 # limit @payments to those w/ a pkgnum grepped from $self
2107 foreach my $i (@invoices) {
2108 foreach my $li ( $i->cust_bill_pkg ) {
2109 $pkgnums{$li->pkgnum} = 1;
2112 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2117 foreach my $cust_bill ( @invoices ) {
2119 if ( !defined($payment) || $payment->unapplied == 0 ) {
2120 $payment = pop @payments or last;
2124 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2125 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2127 $owed = $cust_bill->owed;
2129 unless ( $owed > 0 ) {
2130 push @payments, $payment;
2134 my $amount = min( $payment->unapplied, $owed );
2137 'paynum' => $payment->paynum,
2138 'invnum' => $cust_bill->invnum,
2139 'amount' => $amount,
2141 $cbp->{_date} = $payment->_date
2142 if $options{'manual'} && $options{'backdate_application'};
2143 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2144 $cust_bill_pay->pkgnum( $payment->pkgnum )
2145 if $conf->exists('pkg-balances') && $payment->pkgnum;
2146 my $error = $cust_bill_pay->insert(%options);
2148 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2152 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2156 my $total_unapplied_payments = $self->total_unapplied_payments;
2158 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2160 return $total_unapplied_payments;
2170 suspend_adjourned_pkgs
2173 (do_cust_event pre-bill)
2176 (vendor-only) _gather_taxes
2177 _omit_zero_value_bundles
2180 apply_payments_and_credits
2189 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>