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
184 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
187 scalar(@errors) ? join(' / ', @errors) : '';
191 sub suspend_adjourned_pkgs {
192 my ( $self, $time, %options ) = @_;
194 my @susp_pkgs = $self->ncancelled_pkgs( {
196 " AND ( susp IS NULL OR susp = 0 )
197 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
198 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
203 #only because there's no SQL test for is_prepaid :/
205 grep { ( $_->part_pkg->is_prepaid
210 && $_->adjourn <= $time
218 foreach my $cust_pkg ( @susp_pkgs ) {
219 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
220 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
221 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
222 'reason_otaker' => $cpr->otaker
226 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
229 scalar(@errors) ? join(' / ', @errors) : '';
235 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
236 conjunction with the collect method by calling B<bill_and_collect>.
238 If there is an error, returns the error, otherwise returns false.
240 Options are passed as name-value pairs. Currently available options are:
246 If set true, re-charges setup fees.
250 If set true then only bill recurring charges, not setup, usage, one time
255 If set, then override the normal frequency and look for a part_pkg_discount
256 to take at that frequency.
260 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:
264 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
268 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
270 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
274 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
278 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.
282 This boolean value informs the us that the package is being cancelled. This
283 typically might mean not charging the normal recurring fee but only usage
284 fees since the last billing. Setup charges may be charged. Not all package
285 plans support this feature (they tend to charge 0).
289 Prevent the resetting of usage limits during this call.
293 Do not save the generated bill in the database. Useful with return_bill
297 A list reference on which the generated bill(s) will be returned.
301 Optional terms to be printed on this invoice. Otherwise, customer-specific
302 terms or the default terms are used.
309 my( $self, %options ) = @_;
311 return '' if $self->payby eq 'COMP';
313 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
315 warn "$me bill customer ". $self->custnum. "\n"
318 my $time = $options{'time'} || time;
319 my $invoice_time = $options{'invoice_time'} || $time;
321 $options{'not_pkgpart'} ||= {};
322 $options{'not_pkgpart'} = { map { $_ => 1 }
323 split(/\s*,\s*/, $options{'not_pkgpart'})
325 unless ref($options{'not_pkgpart'});
327 local $SIG{HUP} = 'IGNORE';
328 local $SIG{INT} = 'IGNORE';
329 local $SIG{QUIT} = 'IGNORE';
330 local $SIG{TERM} = 'IGNORE';
331 local $SIG{TSTP} = 'IGNORE';
332 local $SIG{PIPE} = 'IGNORE';
334 my $oldAutoCommit = $FS::UID::AutoCommit;
335 local $FS::UID::AutoCommit = 0;
338 warn "$me acquiring lock on customer ". $self->custnum. "\n"
341 $self->select_for_update; #mutex
343 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
346 my $error = $self->do_cust_event(
347 'debug' => ( $options{'debug'} || 0 ),
348 'time' => $invoice_time,
349 'check_freq' => $options{'check_freq'},
350 'stage' => 'pre-bill',
352 unless $options{no_commit};
354 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
358 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
361 #keep auto-charge and non-auto-charge line items separate
362 my @passes = ( '', 'no_auto' );
364 my %cust_bill_pkg = map { $_ => [] } @passes;
367 # find the packages which are due for billing, find out how much they are
368 # & generate invoice database.
371 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
372 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
374 my %taxlisthash = map { $_ => {} } @passes;
376 my @precommit_hooks = ();
378 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
379 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
381 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
383 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
385 #? to avoid use of uninitialized value errors... ?
386 $cust_pkg->setfield('bill', '')
387 unless defined($cust_pkg->bill);
389 #my $part_pkg = $cust_pkg->part_pkg;
391 my $real_pkgpart = $cust_pkg->pkgpart;
392 my %hash = $cust_pkg->hash;
394 # we could implement this bit as FS::part_pkg::has_hidden, but we already
395 # suffer from performance issues
396 $options{has_hidden} = 0;
397 my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
398 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
400 foreach my $part_pkg ( @part_pkg ) {
402 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
404 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
406 my $next_bill = $cust_pkg->getfield('bill') || 0;
408 while ( $next_bill <= $time ) {
410 $self->_make_lines( 'part_pkg' => $part_pkg,
411 'cust_pkg' => $cust_pkg,
412 'precommit_hooks' => \@precommit_hooks,
413 'line_items' => $cust_bill_pkg{$pass},
414 'setup' => $total_setup{$pass},
415 'recur' => $total_recur{$pass},
416 'tax_matrix' => $taxlisthash{$pass},
418 'real_pkgpart' => $real_pkgpart,
419 'options' => \%options,
421 # Stop if anything goes wrong, or if we're not incrementing
424 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
425 $next_bill = $cust_pkg->getfield('bill') || 0;
428 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
432 } #foreach my $part_pkg
434 } #foreach my $cust_pkg
436 #if the customer isn't on an automatic payby, everything can go on a single
438 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
439 #merge everything into one list
442 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
444 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
446 next unless @cust_bill_pkg; #don't create an invoice w/o line items
448 warn "$me billing pass $pass\n"
449 #.Dumper(\@cust_bill_pkg)."\n"
452 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
453 !$conf->exists('postal_invoice-recurring_only')
457 my $postal_pkg = $self->charge_postal_fee();
458 if ( $postal_pkg && !ref( $postal_pkg ) ) {
460 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
461 return "can't charge postal invoice fee for customer ".
462 $self->custnum. ": $postal_pkg";
464 } elsif ( $postal_pkg ) {
466 my $real_pkgpart = $postal_pkg->pkgpart;
467 # we could implement this bit as FS::part_pkg::has_hidden, but we already
468 # suffer from performance issues
469 $options{has_hidden} = 0;
470 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
471 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
473 foreach my $part_pkg ( @part_pkg ) {
474 my %postal_options = %options;
475 delete $postal_options{cancel};
477 $self->_make_lines( 'part_pkg' => $part_pkg,
478 'cust_pkg' => $postal_pkg,
479 'precommit_hooks' => \@precommit_hooks,
480 'line_items' => \@cust_bill_pkg,
481 'setup' => $total_setup{$pass},
482 'recur' => $total_recur{$pass},
483 'tax_matrix' => $taxlisthash{$pass},
485 'real_pkgpart' => $real_pkgpart,
486 'options' => \%postal_options,
489 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
494 # it's silly to have a zero value postal_pkg, but....
495 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
501 my $listref_or_error =
502 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
504 unless ( ref( $listref_or_error ) ) {
505 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
506 return $listref_or_error;
509 foreach my $taxline ( @$listref_or_error ) {
510 ${ $total_setup{$pass} } =
511 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
512 push @cust_bill_pkg, $taxline;
516 warn "adding tax adjustments...\n" if $DEBUG > 2;
517 foreach my $cust_tax_adjustment (
518 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
524 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
526 my $itemdesc = $cust_tax_adjustment->taxname;
527 $itemdesc = '' if $itemdesc eq 'Tax';
529 push @cust_bill_pkg, new FS::cust_bill_pkg {
535 'itemdesc' => $itemdesc,
536 'itemcomment' => $cust_tax_adjustment->comment,
537 'cust_tax_adjustment' => $cust_tax_adjustment,
538 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
543 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
545 my @cust_bill = $self->cust_bill;
546 my $balance = $self->balance;
547 my $previous_balance = scalar(@cust_bill)
548 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
551 $previous_balance += $cust_bill[$#cust_bill]->charged
552 if scalar(@cust_bill);
553 #my $balance_adjustments =
554 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
556 warn "creating the new invoice\n" if $DEBUG;
557 #create the new invoice
558 my $cust_bill = new FS::cust_bill ( {
559 'custnum' => $self->custnum,
560 '_date' => $invoice_time,
561 'charged' => $charged,
562 'billing_balance' => $balance,
563 'previous_balance' => $previous_balance,
564 'invoice_terms' => $options{'invoice_terms'},
565 'cust_bill_pkg' => \@cust_bill_pkg,
567 $error = $cust_bill->insert unless $options{no_commit};
569 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
570 return "can't create invoice for customer #". $self->custnum. ": $error";
572 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
574 } #foreach my $pass ( keys %cust_bill_pkg )
576 foreach my $hook ( @precommit_hooks ) {
579 } unless $options{no_commit};
581 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
582 return "$@ running precommit hook $hook\n";
586 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
591 #discard bundled packages of 0 value
592 sub _omit_zero_value_bundles {
595 my @cust_bill_pkg = ();
596 my @cust_bill_pkg_bundle = ();
598 my $discount_show_always = 0;
600 foreach my $cust_bill_pkg ( @in ) {
602 $discount_show_always = ($cust_bill_pkg->get('discounts')
603 && scalar(@{$cust_bill_pkg->get('discounts')})
604 && $conf->exists('discount-show-always'));
606 warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
607 "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
608 "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
611 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
612 push @cust_bill_pkg, @cust_bill_pkg_bundle
614 || ($sum == 0 && ( $discount_show_always
615 || grep {$_->recur_show_zero || $_->setup_show_zero}
616 @cust_bill_pkg_bundle
619 @cust_bill_pkg_bundle = ();
623 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
624 push @cust_bill_pkg_bundle, $cust_bill_pkg;
628 push @cust_bill_pkg, @cust_bill_pkg_bundle
630 || ($sum == 0 && ( $discount_show_always
631 || grep {$_->recur_show_zero || $_->setup_show_zero}
632 @cust_bill_pkg_bundle
636 warn " _omit_zero_value_bundles: ". scalar(@in).
637 '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
644 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
646 This is a weird one. Perhaps it should not even be exposed.
648 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
649 Usually used internally by bill method B<bill>.
651 If there is an error, returns the error, otherwise returns reference to a
652 list of line items suitable for insertion.
658 An array ref of the line items being billed.
662 A strange beast. The keys to this hash are internal identifiers consisting
663 of the name of the tax object type, a space, and its unique identifier ( e.g.
664 'cust_main_county 23' ). The values of the hash are listrefs. The first
665 item in the list is the tax object. The remaining items are either line
666 items or floating point values (currency amounts).
668 The taxes are calculated on this entity. Calculated exemption records are
669 transferred to the LINEITEMREF items on the assumption that they are related.
675 This specifies the date appearing on the associated invoice. Some
676 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
682 sub calculate_taxes {
683 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
685 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
687 warn "$me calculate_taxes\n"
688 #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
691 my @tax_line_items = ();
693 # keys are tax names (as printed on invoices / itemdesc )
694 # values are listrefs of taxlisthash keys (internal identifiers)
697 # keys are taxlisthash keys (internal identifiers)
698 # values are (cumulative) amounts
701 # keys are taxlisthash keys (internal identifiers)
702 # values are listrefs of cust_bill_pkg_tax_location hashrefs
703 my %tax_location = ();
705 # keys are taxlisthash keys (internal identifiers)
706 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
707 my %tax_rate_location = ();
709 foreach my $tax ( keys %$taxlisthash ) {
710 my $tax_object = shift @{ $taxlisthash->{$tax} };
711 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
712 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
713 my $hashref_or_error =
714 $tax_object->taxline( $taxlisthash->{$tax},
715 'custnum' => $self->custnum,
716 'invoice_time' => $invoice_time
718 return $hashref_or_error unless ref($hashref_or_error);
720 unshift @{ $taxlisthash->{$tax} }, $tax_object;
722 my $name = $hashref_or_error->{'name'};
723 my $amount = $hashref_or_error->{'amount'};
725 #warn "adding $amount as $name\n";
726 $taxname{ $name } ||= [];
727 push @{ $taxname{ $name } }, $tax;
729 $tax{ $tax } += $amount;
731 $tax_location{ $tax } ||= [];
732 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
733 push @{ $tax_location{ $tax } },
735 'taxnum' => $tax_object->taxnum,
736 'taxtype' => ref($tax_object),
737 'pkgnum' => $tax_object->get('pkgnum'),
738 'locationnum' => $tax_object->get('locationnum'),
739 'amount' => sprintf('%.2f', $amount ),
743 $tax_rate_location{ $tax } ||= [];
744 if ( ref($tax_object) eq 'FS::tax_rate' ) {
745 my $taxratelocationnum =
746 $tax_object->tax_rate_location->taxratelocationnum;
747 push @{ $tax_rate_location{ $tax } },
749 'taxnum' => $tax_object->taxnum,
750 'taxtype' => ref($tax_object),
751 'amount' => sprintf('%.2f', $amount ),
752 'locationtaxid' => $tax_object->location,
753 'taxratelocationnum' => $taxratelocationnum,
759 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
760 my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
761 foreach my $tax ( keys %$taxlisthash ) {
762 foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
763 next unless ref($_) eq 'FS::cust_bill_pkg';
765 my @cust_tax_exempt_pkg = splice( @{ $_->_cust_tax_exempt_pkg } );
767 next unless @cust_tax_exempt_pkg; #just avoiding the prob when irrelevant?
768 die "can't distribute tax exemptions: no line item for ". Dumper($_).
769 " in packagemap ". join(',', sort {$a<=>$b} keys %packagemap). "\n"
770 unless $packagemap{$_->pkgnum};
772 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
773 @cust_tax_exempt_pkg;
777 #consolidate and create tax line items
778 warn "consolidating and generating...\n" if $DEBUG > 2;
779 foreach my $taxname ( keys %taxname ) {
782 my @cust_bill_pkg_tax_location = ();
783 my @cust_bill_pkg_tax_rate_location = ();
784 warn "adding $taxname\n" if $DEBUG > 1;
785 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
786 next if $seen{$taxitem}++;
787 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
788 $tax += $tax{$taxitem};
789 push @cust_bill_pkg_tax_location,
790 map { new FS::cust_bill_pkg_tax_location $_ }
791 @{ $tax_location{ $taxitem } };
792 push @cust_bill_pkg_tax_rate_location,
793 map { new FS::cust_bill_pkg_tax_rate_location $_ }
794 @{ $tax_rate_location{ $taxitem } };
798 $tax = sprintf('%.2f', $tax );
800 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
806 if ( $pkg_category and
807 $conf->config('invoice_latexsummary') ||
808 $conf->config('invoice_htmlsummary')
812 my %hash = ( 'section' => $pkg_category->categoryname );
813 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
817 push @tax_line_items, new FS::cust_bill_pkg {
823 'itemdesc' => $taxname,
824 'display' => \@display,
825 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
826 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
835 my ($self, %params) = @_;
837 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
839 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
840 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
841 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
842 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
843 my $total_setup = $params{setup} or die "no setup accumulator specified";
844 my $total_recur = $params{recur} or die "no recur accumulator specified";
845 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
846 my $time = $params{'time'} or die "no time specified";
847 my (%options) = %{$params{options}};
850 my $real_pkgpart = $params{real_pkgpart};
851 my %hash = $cust_pkg->hash;
852 my $old_cust_pkg = new FS::cust_pkg \%hash;
857 $cust_pkg->pkgpart($part_pkg->pkgpart);
865 my @setup_discounts = ();
866 my %setup_param = ( 'discounts' => \@setup_discounts );
867 if ( ! $options{recurring_only}
868 and ! $options{cancel}
869 and ( $options{'resetup'}
870 || ( ! $cust_pkg->setup
871 && ( ! $cust_pkg->start_date
872 || $cust_pkg->start_date <= day_end($time)
874 && ( ! $conf->exists('disable_setup_suspended_pkgs')
875 || ( $conf->exists('disable_setup_suspended_pkgs') &&
876 ! $cust_pkg->getfield('susp')
884 warn " bill setup\n" if $DEBUG > 1;
886 unless ( $cust_pkg->waive_setup ) {
889 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
890 return "$@ running calc_setup for $cust_pkg\n"
893 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
896 $cust_pkg->setfield('setup', $time)
897 unless $cust_pkg->setup;
898 #do need it, but it won't get written to the db
899 #|| $cust_pkg->pkgpart != $real_pkgpart;
901 $cust_pkg->setfield('start_date', '')
902 if $cust_pkg->start_date;
910 #XXX unit stuff here too
913 my @recur_discounts = ();
915 if ( ! $cust_pkg->start_date
916 and ( ! $cust_pkg->susp || $part_pkg->option('suspend_bill', 1) )
918 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) )
919 || ( $part_pkg->plan eq 'voip_cdr'
920 && $part_pkg->option('bill_every_call')
925 # XXX should this be a package event? probably. events are called
926 # at collection time at the moment, though...
927 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
928 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
929 #don't want to reset usage just cause we want a line item??
930 #&& $part_pkg->pkgpart == $real_pkgpart;
932 warn " bill recur\n" if $DEBUG > 1;
935 # XXX shared with $recur_prog
936 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
940 #over two params! lets at least switch to a hashref for the rest...
941 my $increment_next_bill = ( $part_pkg->freq ne '0'
942 && ( $cust_pkg->getfield('bill') || 0 ) <= day_end($time)
945 my %param = ( %setup_param,
946 'precommit_hooks' => $precommit_hooks,
947 'increment_next_bill' => $increment_next_bill,
948 'discounts' => \@recur_discounts,
949 'real_pkgpart' => $real_pkgpart,
950 'freq_override' => $options{freq_override} || '',
954 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
956 # There may be some part_pkg for which this is wrong. Only those
957 # which can_discount are supported.
958 # (the UI should prevent adding discounts to these at the moment)
960 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
961 " for pkgpart ". $cust_pkg->pkgpart.
962 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
965 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
966 return "$@ running $method for $cust_pkg\n"
969 if ( $increment_next_bill ) {
971 my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
972 return "unparsable frequency: ". $part_pkg->freq
975 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
976 # only for figuring next bill date, nothing else, so, reset $sdate again
978 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
979 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
980 $cust_pkg->last_bill($sdate);
982 $cust_pkg->setfield('bill', $next_bill );
986 if ( $param{'setup_fee'} ) {
987 # Add an additional setup fee at the billing stage.
988 # Used for prorate_defer_bill.
989 $setup += $param{'setup_fee'};
990 $unitsetup += $param{'setup_fee'};
994 if ( defined $param{'discount_left_setup'} ) {
995 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
996 $setup -= $discount_setup;
1002 warn "\$setup is undefined" unless defined($setup);
1003 warn "\$recur is undefined" unless defined($recur);
1004 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1007 # If there's line items, create em cust_bill_pkg records
1008 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1013 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1014 # hmm.. and if just the options are modified in some weird price plan?
1016 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1019 my $error = $cust_pkg->replace( $old_cust_pkg,
1020 'depend_jobnum'=>$options{depend_jobnum},
1021 'options' => { $cust_pkg->options },
1023 unless $options{no_commit};
1024 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1025 if $error; #just in case
1028 $setup = sprintf( "%.2f", $setup );
1029 $recur = sprintf( "%.2f", $recur );
1030 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1031 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1033 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1034 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1037 my $discount_show_always = $conf->exists('discount-show-always')
1038 && ( ($setup == 0 && scalar(@setup_discounts))
1039 || ($recur == 0 && scalar(@recur_discounts))
1044 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1045 || $discount_show_always
1046 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1047 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1051 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1054 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1056 warn " adding customer package invoice detail: $_\n"
1057 foreach @cust_pkg_detail;
1059 push @details, @cust_pkg_detail;
1061 my $cust_bill_pkg = new FS::cust_bill_pkg {
1062 'pkgnum' => $cust_pkg->pkgnum,
1064 'unitsetup' => $unitsetup,
1066 'unitrecur' => $unitrecur,
1067 'quantity' => $cust_pkg->quantity,
1068 'details' => \@details,
1069 'discounts' => [ @setup_discounts, @recur_discounts ],
1070 'hidden' => $part_pkg->hidden,
1071 'freq' => $part_pkg->freq,
1074 if ( $part_pkg->recur_temporality eq 'preceding' ) {
1075 $cust_bill_pkg->sdate( $hash{last_bill} );
1076 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1077 $cust_bill_pkg->edate( $time ) if $options{cancel};
1078 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1079 $cust_bill_pkg->sdate( $sdate );
1080 $cust_bill_pkg->edate( $cust_pkg->bill );
1081 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1084 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1085 unless $part_pkg->pkgpart == $real_pkgpart;
1087 $$total_setup += $setup;
1088 $$total_recur += $recur;
1094 unless ( $discount_show_always ) {
1096 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
1097 return $error if $error;
1100 push @$cust_bill_pkgs, $cust_bill_pkg;
1102 } #if $setup != 0 || $recur != 0
1112 my $part_pkg = shift;
1113 my $taxlisthash = shift;
1114 my $cust_bill_pkg = shift;
1115 my $cust_pkg = shift;
1116 my $invoice_time = shift;
1117 my $real_pkgpart = shift;
1118 my $options = shift;
1120 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1122 my %cust_bill_pkg = ();
1126 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1127 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1128 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1129 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1131 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
1133 if ( $conf->exists('enable_taxproducts')
1134 && ( scalar($part_pkg->part_pkg_taxoverride)
1135 || $part_pkg->has_taxproduct
1140 foreach my $class (@classes) {
1141 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
1142 return $err_or_ref unless ref($err_or_ref);
1143 $taxes{$class} = $err_or_ref;
1146 unless (exists $taxes{''}) {
1147 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
1148 return $err_or_ref unless ref($err_or_ref);
1149 $taxes{''} = $err_or_ref;
1154 my @loc_keys = qw( city county state country );
1156 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1157 my $cust_location = $cust_pkg->cust_location;
1158 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
1161 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1164 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
1167 $taxhash{'taxclass'} = $part_pkg->taxclass;
1170 my %taxhash_elim = %taxhash;
1171 my @elim = qw( city county state );
1174 #first try a match with taxclass
1175 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1177 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1178 #then try a match without taxclass
1179 my %no_taxclass = %taxhash_elim;
1180 $no_taxclass{ 'taxclass' } = '';
1181 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1184 $taxhash_elim{ shift(@elim) } = '';
1186 } while ( !scalar(@taxes) && scalar(@elim) );
1188 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
1190 if $self->cust_main_exemption; #just to be safe
1192 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1194 $_->set('pkgnum', $cust_pkg->pkgnum );
1195 $_->set('locationnum', $cust_pkg->locationnum );
1199 $taxes{''} = [ @taxes ];
1200 $taxes{'setup'} = [ @taxes ];
1201 $taxes{'recur'} = [ @taxes ];
1202 $taxes{$_} = [ @taxes ] foreach (@classes);
1204 # # maybe eliminate this entirely, along with all the 0% records
1205 # unless ( @taxes ) {
1207 # "fatal: can't find tax rate for state/county/country/taxclass ".
1208 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
1211 } #if $conf->exists('enable_taxproducts') ...
1215 #what's this doing in the middle of _handle_taxes? probably should split
1216 #this into three parts above in _make_lines
1217 $cust_bill_pkg->set_display( part_pkg => $part_pkg,
1218 real_pkgpart => $real_pkgpart,
1221 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1222 foreach my $key (keys %tax_cust_bill_pkg) {
1223 my @taxes = @{ $taxes{$key} || [] };
1224 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1226 my %localtaxlisthash = ();
1227 foreach my $tax ( @taxes ) {
1229 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1230 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
1231 # ' locationnum'. $cust_pkg->locationnum
1232 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
1234 $taxlisthash->{ $taxname } ||= [ $tax ];
1235 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1237 $localtaxlisthash{ $taxname } ||= [ $tax ];
1238 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1242 warn "finding taxed taxes...\n" if $DEBUG > 2;
1243 foreach my $tax ( keys %localtaxlisthash ) {
1244 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1245 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1247 next unless $tax_object->can('tax_on_tax');
1249 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1250 my $totname = ref( $tot ). ' '. $tot->taxnum;
1252 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1254 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1256 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1257 my $hashref_or_error =
1258 $tax_object->taxline( $localtaxlisthash{$tax},
1259 'custnum' => $self->custnum,
1260 'invoice_time' => $invoice_time,
1262 return $hashref_or_error
1263 unless ref($hashref_or_error);
1265 $taxlisthash->{ $totname } ||= [ $tot ];
1266 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1278 my $part_pkg = shift;
1280 my $cust_pkg = shift;
1282 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1285 if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
1286 $geocode = $cust_pkg->cust_location->geocode('cch');
1288 $geocode = $self->geocode('cch');
1293 my @taxclassnums = map { $_->taxclassnum }
1294 $part_pkg->part_pkg_taxoverride($class);
1296 unless (@taxclassnums) {
1297 @taxclassnums = map { $_->taxclassnum }
1298 grep { $_->taxable eq 'Y' }
1299 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1301 warn "Found taxclassnum values of ". join(',', @taxclassnums)
1306 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1308 @taxes = qsearch({ 'table' => 'tax_rate',
1309 'hashref' => { 'geocode' => $geocode, },
1310 'extra_sql' => $extra_sql,
1312 if scalar(@taxclassnums);
1314 warn "Found taxes ".
1315 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1322 =item collect [ HASHREF | OPTION => VALUE ... ]
1324 (Attempt to) collect money for this customer's outstanding invoices (see
1325 L<FS::cust_bill>). Usually used after the bill method.
1327 Actions are now triggered by billing events; see L<FS::part_event> and the
1328 billing events web interface. Old-style invoice events (see
1329 L<FS::part_bill_event>) have been deprecated.
1331 If there is an error, returns the error, otherwise returns false.
1333 Options are passed as name-value pairs.
1335 Currently available options are:
1341 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.
1345 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1349 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1353 set true to surpress email card/ACH decline notices.
1357 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)
1363 # allows for one time override of normal customer billing method
1368 my( $self, %options ) = @_;
1370 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1372 my $invoice_time = $options{'invoice_time'} || time;
1375 local $SIG{HUP} = 'IGNORE';
1376 local $SIG{INT} = 'IGNORE';
1377 local $SIG{QUIT} = 'IGNORE';
1378 local $SIG{TERM} = 'IGNORE';
1379 local $SIG{TSTP} = 'IGNORE';
1380 local $SIG{PIPE} = 'IGNORE';
1382 my $oldAutoCommit = $FS::UID::AutoCommit;
1383 local $FS::UID::AutoCommit = 0;
1386 $self->select_for_update; #mutex
1389 my $balance = $self->balance;
1390 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1393 if ( exists($options{'retry_card'}) ) {
1394 carp 'retry_card option passed to collect is deprecated; use retry';
1395 $options{'retry'} ||= $options{'retry_card'};
1397 if ( exists($options{'retry'}) && $options{'retry'} ) {
1398 my $error = $self->retry_realtime;
1400 $dbh->rollback if $oldAutoCommit;
1405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1407 #never want to roll back an event just because it returned an error
1408 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1410 $self->do_cust_event(
1411 'debug' => ( $options{'debug'} || 0 ),
1412 'time' => $invoice_time,
1413 'check_freq' => $options{'check_freq'},
1414 'stage' => 'collect',
1419 =item retry_realtime
1421 Schedules realtime / batch credit card / electronic check / LEC billing
1422 events for for retry. Useful if card information has changed or manual
1423 retry is desired. The 'collect' method must be called to actually retry
1426 Implementation details: For either this customer, or for each of this
1427 customer's open invoices, changes the status of the first "done" (with
1428 statustext error) realtime processing event to "failed".
1432 sub retry_realtime {
1435 local $SIG{HUP} = 'IGNORE';
1436 local $SIG{INT} = 'IGNORE';
1437 local $SIG{QUIT} = 'IGNORE';
1438 local $SIG{TERM} = 'IGNORE';
1439 local $SIG{TSTP} = 'IGNORE';
1440 local $SIG{PIPE} = 'IGNORE';
1442 my $oldAutoCommit = $FS::UID::AutoCommit;
1443 local $FS::UID::AutoCommit = 0;
1446 #a little false laziness w/due_cust_event (not too bad, really)
1448 my $join = FS::part_event_condition->join_conditions_sql;
1449 my $order = FS::part_event_condition->order_conditions_sql;
1452 . join ( ' OR ' , map {
1453 "( part_event.eventtable = " . dbh->quote($_)
1454 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
1455 } FS::part_event->eventtables)
1458 #here is the agent virtualization
1459 my $agent_virt = " ( part_event.agentnum IS NULL
1460 OR part_event.agentnum = ". $self->agentnum. ' )';
1462 #XXX this shouldn't be hardcoded, actions should declare it...
1463 my @realtime_events = qw(
1464 cust_bill_realtime_card
1465 cust_bill_realtime_check
1466 cust_bill_realtime_lec
1470 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
1475 my @cust_event = qsearchs({
1476 'table' => 'cust_event',
1477 'select' => 'cust_event.*',
1478 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1479 'hashref' => { 'status' => 'done' },
1480 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
1481 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1484 my %seen_invnum = ();
1485 foreach my $cust_event (@cust_event) {
1487 #max one for the customer, one for each open invoice
1488 my $cust_X = $cust_event->cust_X;
1489 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1493 or $cust_event->part_event->eventtable eq 'cust_bill'
1496 my $error = $cust_event->retry;
1498 $dbh->rollback if $oldAutoCommit;
1499 return "error scheduling event for retry: $error";
1504 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1509 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1511 Runs billing events; see L<FS::part_event> and the billing events web
1514 If there is an error, returns the error, otherwise returns false.
1516 Options are passed as name-value pairs.
1518 Currently available options are:
1524 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.
1528 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1532 "collect" (the default) or "pre-bill"
1536 set true to surpress email card/ACH decline notices.
1540 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)
1547 # allows for one time override of normal customer billing method
1551 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1554 my( $self, %options ) = @_;
1556 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1558 my $time = $options{'time'} || time;
1561 local $SIG{HUP} = 'IGNORE';
1562 local $SIG{INT} = 'IGNORE';
1563 local $SIG{QUIT} = 'IGNORE';
1564 local $SIG{TERM} = 'IGNORE';
1565 local $SIG{TSTP} = 'IGNORE';
1566 local $SIG{PIPE} = 'IGNORE';
1568 my $oldAutoCommit = $FS::UID::AutoCommit;
1569 local $FS::UID::AutoCommit = 0;
1572 $self->select_for_update; #mutex
1575 my $balance = $self->balance;
1576 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1579 # if ( exists($options{'retry_card'}) ) {
1580 # carp 'retry_card option passed to collect is deprecated; use retry';
1581 # $options{'retry'} ||= $options{'retry_card'};
1583 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1584 # my $error = $self->retry_realtime;
1586 # $dbh->rollback if $oldAutoCommit;
1591 # false laziness w/pay_batch::import_results
1593 my $due_cust_event = $self->due_cust_event(
1594 'debug' => ( $options{'debug'} || 0 ),
1596 'check_freq' => $options{'check_freq'},
1597 'stage' => ( $options{'stage'} || 'collect' ),
1599 unless( ref($due_cust_event) ) {
1600 $dbh->rollback if $oldAutoCommit;
1601 return $due_cust_event;
1604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1605 #never want to roll back an event just because it or a different one
1607 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1609 foreach my $cust_event ( @$due_cust_event ) {
1613 #re-eval event conditions (a previous event could have changed things)
1614 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
1615 #don't leave stray "new/locked" records around
1616 my $error = $cust_event->delete;
1617 return $error if $error;
1622 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1623 if $options{'quiet'};
1624 warn " running cust_event ". $cust_event->eventnum. "\n"
1627 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1628 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1629 #XXX wtf is this? figure out a proper dealio with return value
1641 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1643 Inserts database records for and returns an ordered listref of new events due
1644 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1645 events are due, an empty listref is returned. If there is an error, returns a
1646 scalar error message.
1648 To actually run the events, call each event's test_condition method, and if
1649 still true, call the event's do_event method.
1651 Options are passed as a hashref or as a list of name-value pairs. Available
1658 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.
1662 "collect" (the default) or "pre-bill"
1666 "Current time" for the events.
1670 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)
1674 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1678 Explicitly pass the objects to be tested (typically used with eventtable).
1682 Set to true to return the objects, but not actually insert them into the
1689 sub due_cust_event {
1691 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1694 #my $DEBUG = $opt{'debug'}
1695 local($DEBUG) = $opt{'debug'}
1696 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1697 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1699 warn "$me due_cust_event called with options ".
1700 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1703 $opt{'time'} ||= time;
1705 local $SIG{HUP} = 'IGNORE';
1706 local $SIG{INT} = 'IGNORE';
1707 local $SIG{QUIT} = 'IGNORE';
1708 local $SIG{TERM} = 'IGNORE';
1709 local $SIG{TSTP} = 'IGNORE';
1710 local $SIG{PIPE} = 'IGNORE';
1712 my $oldAutoCommit = $FS::UID::AutoCommit;
1713 local $FS::UID::AutoCommit = 0;
1716 $self->select_for_update #mutex
1717 unless $opt{testonly};
1720 # find possible events (initial search)
1723 my @cust_event = ();
1725 my @eventtable = $opt{'eventtable'}
1726 ? ( $opt{'eventtable'} )
1727 : FS::part_event->eventtables_runorder;
1729 my $check_freq = $opt{'check_freq'} || '1d';
1731 foreach my $eventtable ( @eventtable ) {
1734 if ( $opt{'objects'} ) {
1736 @objects = @{ $opt{'objects'} };
1740 #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
1741 if ( $eventtable eq 'cust_main' ) {
1742 @objects = ( $self );
1746 "LEFT JOIN cust_main USING ( custnum )";
1748 #some false laziness w/Cron::bill bill_where
1750 my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
1751 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1752 'time'=>$opt{'time'},
1754 $where = $where ? "AND $where" : '';
1756 my $are_part_event =
1757 "EXISTS ( SELECT 1 FROM part_event $join
1758 WHERE check_freq = '$check_freq'
1759 AND eventtable = '$eventtable'
1760 AND ( disabled = '' OR disabled IS NULL )
1766 @objects = $self->$eventtable(
1767 'addl_from' => $cm_join,
1768 'extra_sql' => " AND $are_part_event",
1774 my @e_cust_event = ();
1776 my $cross = "CROSS JOIN $eventtable";
1777 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1778 unless $eventtable eq 'cust_main';
1780 foreach my $object ( @objects ) {
1782 #this first search uses the condition_sql magic for optimization.
1783 #the more possible events we can eliminate in this step the better
1785 my $cross_where = '';
1786 my $pkey = $object->primary_key;
1787 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1789 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1791 FS::part_event_condition->where_conditions_sql( $eventtable,
1792 'time'=>$opt{'time'}
1794 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1796 $extra_sql = "AND $extra_sql" if $extra_sql;
1798 #here is the agent virtualization
1799 $extra_sql .= " AND ( part_event.agentnum IS NULL
1800 OR part_event.agentnum = ". $self->agentnum. ' )';
1802 $extra_sql .= " $order";
1804 warn "searching for events for $eventtable ". $object->$pkey. "\n"
1805 if $opt{'debug'} > 2;
1806 my @part_event = qsearch( {
1807 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
1808 'select' => 'part_event.*',
1809 'table' => 'part_event',
1810 'addl_from' => "$cross $join",
1811 'hashref' => { 'check_freq' => $check_freq,
1812 'eventtable' => $eventtable,
1815 'extra_sql' => "AND $cross_where $extra_sql",
1819 my $pkey = $object->primary_key;
1820 warn " ". scalar(@part_event).
1821 " possible events found for $eventtable ". $object->$pkey(). "\n";
1824 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
1828 warn " ". scalar(@e_cust_event).
1829 " subtotal possible cust events found for $eventtable\n"
1832 push @cust_event, @e_cust_event;
1836 warn " ". scalar(@cust_event).
1837 " total possible cust events found in initial search\n"
1845 $opt{stage} ||= 'collect';
1847 grep { my $stage = $_->part_event->event_stage;
1848 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1858 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
1859 'stats_hashref' => \%unsat ),
1862 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
1865 warn " invalid conditions not eliminated with condition_sql:\n".
1866 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
1867 if keys %unsat && $DEBUG; # > 1;
1873 unless( $opt{testonly} ) {
1874 foreach my $cust_event ( @cust_event ) {
1876 my $error = $cust_event->insert();
1878 $dbh->rollback if $oldAutoCommit;
1885 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1891 warn " returning events: ". Dumper(@cust_event). "\n"
1898 =item apply_payments_and_credits [ OPTION => VALUE ... ]
1900 Applies unapplied payments and credits.
1902 In most cases, this new method should be used in place of sequential
1903 apply_payments and apply_credits methods.
1905 A hash of optional arguments may be passed. Currently "manual" is supported.
1906 If true, a payment receipt is sent instead of a statement when
1907 'payment_receipt_email' configuration option is set.
1909 If there is an error, returns the error, otherwise returns false.
1913 sub apply_payments_and_credits {
1914 my( $self, %options ) = @_;
1916 local $SIG{HUP} = 'IGNORE';
1917 local $SIG{INT} = 'IGNORE';
1918 local $SIG{QUIT} = 'IGNORE';
1919 local $SIG{TERM} = 'IGNORE';
1920 local $SIG{TSTP} = 'IGNORE';
1921 local $SIG{PIPE} = 'IGNORE';
1923 my $oldAutoCommit = $FS::UID::AutoCommit;
1924 local $FS::UID::AutoCommit = 0;
1927 $self->select_for_update; #mutex
1929 foreach my $cust_bill ( $self->open_cust_bill ) {
1930 my $error = $cust_bill->apply_payments_and_credits(%options);
1932 $dbh->rollback if $oldAutoCommit;
1933 return "Error applying: $error";
1937 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1942 =item apply_credits OPTION => VALUE ...
1944 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
1945 to outstanding invoice balances in chronological order (or reverse
1946 chronological order if the I<order> option is set to B<newest>) and returns the
1947 value of any remaining unapplied credits available for refund (see
1948 L<FS::cust_refund>).
1950 Dies if there is an error.
1958 local $SIG{HUP} = 'IGNORE';
1959 local $SIG{INT} = 'IGNORE';
1960 local $SIG{QUIT} = 'IGNORE';
1961 local $SIG{TERM} = 'IGNORE';
1962 local $SIG{TSTP} = 'IGNORE';
1963 local $SIG{PIPE} = 'IGNORE';
1965 my $oldAutoCommit = $FS::UID::AutoCommit;
1966 local $FS::UID::AutoCommit = 0;
1969 $self->select_for_update; #mutex
1971 unless ( $self->total_unapplied_credits ) {
1972 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1976 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
1977 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
1979 my @invoices = $self->open_cust_bill;
1980 @invoices = sort { $b->_date <=> $a->_date } @invoices
1981 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
1983 if ( $conf->exists('pkg-balances') ) {
1984 # limit @credits to those w/ a pkgnum grepped from $self
1986 foreach my $i (@invoices) {
1987 foreach my $li ( $i->cust_bill_pkg ) {
1988 $pkgnums{$li->pkgnum} = 1;
1991 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
1996 foreach my $cust_bill ( @invoices ) {
1998 if ( !defined($credit) || $credit->credited == 0) {
1999 $credit = pop @credits or last;
2003 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2004 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2006 $owed = $cust_bill->owed;
2008 unless ( $owed > 0 ) {
2009 push @credits, $credit;
2013 my $amount = min( $credit->credited, $owed );
2015 my $cust_credit_bill = new FS::cust_credit_bill ( {
2016 'crednum' => $credit->crednum,
2017 'invnum' => $cust_bill->invnum,
2018 'amount' => $amount,
2020 $cust_credit_bill->pkgnum( $credit->pkgnum )
2021 if $conf->exists('pkg-balances') && $credit->pkgnum;
2022 my $error = $cust_credit_bill->insert;
2024 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2028 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2032 my $total_unapplied_credits = $self->total_unapplied_credits;
2034 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2036 return $total_unapplied_credits;
2039 =item apply_payments [ OPTION => VALUE ... ]
2041 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2042 to outstanding invoice balances in chronological order.
2044 #and returns the value of any remaining unapplied payments.
2046 A hash of optional arguments may be passed. Currently "manual" is supported.
2047 If true, a payment receipt is sent instead of a statement when
2048 'payment_receipt_email' configuration option is set.
2050 Dies if there is an error.
2054 sub apply_payments {
2055 my( $self, %options ) = @_;
2057 local $SIG{HUP} = 'IGNORE';
2058 local $SIG{INT} = 'IGNORE';
2059 local $SIG{QUIT} = 'IGNORE';
2060 local $SIG{TERM} = 'IGNORE';
2061 local $SIG{TSTP} = 'IGNORE';
2062 local $SIG{PIPE} = 'IGNORE';
2064 my $oldAutoCommit = $FS::UID::AutoCommit;
2065 local $FS::UID::AutoCommit = 0;
2068 $self->select_for_update; #mutex
2072 my @payments = sort { $b->_date <=> $a->_date }
2073 grep { $_->unapplied > 0 }
2076 my @invoices = sort { $a->_date <=> $b->_date}
2077 grep { $_->owed > 0 }
2080 if ( $conf->exists('pkg-balances') ) {
2081 # limit @payments to those w/ a pkgnum grepped from $self
2083 foreach my $i (@invoices) {
2084 foreach my $li ( $i->cust_bill_pkg ) {
2085 $pkgnums{$li->pkgnum} = 1;
2088 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2093 foreach my $cust_bill ( @invoices ) {
2095 if ( !defined($payment) || $payment->unapplied == 0 ) {
2096 $payment = pop @payments or last;
2100 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2101 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2103 $owed = $cust_bill->owed;
2105 unless ( $owed > 0 ) {
2106 push @payments, $payment;
2110 my $amount = min( $payment->unapplied, $owed );
2113 'paynum' => $payment->paynum,
2114 'invnum' => $cust_bill->invnum,
2115 'amount' => $amount,
2117 $cbp->{_date} = $payment->_date
2118 if $options{'manual'} && $options{'backdate_application'};
2119 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2120 $cust_bill_pay->pkgnum( $payment->pkgnum )
2121 if $conf->exists('pkg-balances') && $payment->pkgnum;
2122 my $error = $cust_bill_pay->insert(%options);
2124 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2128 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2132 my $total_unapplied_payments = $self->total_unapplied_payments;
2134 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2136 return $total_unapplied_payments;
2146 suspend_adjourned_pkgs
2149 (do_cust_event pre-bill)
2152 (vendor-only) _gather_taxes
2153 _omit_zero_value_bundles
2156 apply_payments_and_credits
2165 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>