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;
26 # 1 is mostly method/subroutine entry and options
27 # 2 traces progress of some operations
28 # 3 is even more information including possibly sensitive data
30 $me = '[FS::cust_main::Billing]';
32 install_callback FS::UID sub {
34 #yes, need it for stuff below (prolly should be cached)
39 FS::cust_main::Billing - Billing mixin for cust_main
45 These methods are available on FS::cust_main objects.
51 =item bill_and_collect
53 Cancels and suspends any packages due, generates bills, applies payments and
54 credits, and applies collection events to run cards, send bills and notices,
57 By default, warns on errors and continues with the next operation (but see the
60 Options are passed as name-value pairs. Currently available options are:
66 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:
70 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
74 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.
78 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
82 If set true, re-charges setup fees.
86 If set any errors prevent subsequent operations from continusing. If set
87 specifically to "return", returns the error (or false, if there is no error).
88 Any other true value causes errors to die.
92 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)
96 Optional FS::queue entry to receive status updates.
100 Options are passed to the B<bill> and B<collect> methods verbatim, so all
101 options of those methods are also available.
105 sub bill_and_collect {
106 my( $self, %options ) = @_;
108 my $log = FS::Log->new('bill_and_collect');
109 $log->debug('start', object => $self, agentnum => $self->agentnum);
113 #$options{actual_time} not $options{time} because freeside-daily -d is for
114 #pre-printing invoices
116 $options{'actual_time'} ||= time;
117 my $job = $options{'job'};
119 $job->update_statustext('0,cleaning expired packages') if $job;
120 $error = $self->cancel_expired_pkgs( day_end( $options{actual_time} ) );
122 $error = "Error expiring custnum ". $self->custnum. ": $error";
123 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
124 elsif ( $options{fatal} ) { die $error; }
125 else { warn $error; }
128 $error = $self->suspend_adjourned_pkgs( day_end( $options{actual_time} ) );
130 $error = "Error adjourning custnum ". $self->custnum. ": $error";
131 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
132 elsif ( $options{fatal} ) { die $error; }
133 else { warn $error; }
136 $error = $self->unsuspend_resumed_pkgs( day_end( $options{actual_time} ) );
138 $error = "Error resuming custnum ".$self->custnum. ": $error";
139 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
140 elsif ( $options{fatal} ) { die $error; }
141 else { warn $error; }
144 $job->update_statustext('20,billing packages') if $job;
145 $error = $self->bill( %options );
147 $error = "Error billing custnum ". $self->custnum. ": $error";
148 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
149 elsif ( $options{fatal} ) { die $error; }
150 else { warn $error; }
153 $job->update_statustext('50,applying payments and credits') if $job;
154 $error = $self->apply_payments_and_credits;
156 $error = "Error applying 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('70,running collection events') if $job;
163 unless ( $conf->exists('cancelled_cust-noevents')
164 && ! $self->num_ncancelled_pkgs
166 $error = $self->collect( %options );
168 $error = "Error collecting custnum ". $self->custnum. ": $error";
169 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
170 elsif ($options{fatal} ) { die $error; }
171 else { warn $error; }
174 $job->update_statustext('100,finished') if $job;
175 $log->debug('finish', object => $self, agentnum => $self->agentnum);
181 sub cancel_expired_pkgs {
182 my ( $self, $time, %options ) = @_;
184 my @cancel_pkgs = $self->ncancelled_pkgs( {
185 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
190 foreach my $cust_pkg ( @cancel_pkgs ) {
191 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
192 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
193 'reason_otaker' => $cpr->otaker,
198 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
201 join(' / ', @errors);
205 sub suspend_adjourned_pkgs {
206 my ( $self, $time, %options ) = @_;
208 my @susp_pkgs = $self->ncancelled_pkgs( {
210 " AND ( susp IS NULL OR susp = 0 )
211 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
212 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
217 #only because there's no SQL test for is_prepaid :/
219 grep { ( $_->part_pkg->is_prepaid
224 && $_->adjourn <= $time
232 foreach my $cust_pkg ( @susp_pkgs ) {
233 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
234 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
235 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
236 'reason_otaker' => $cpr->otaker
240 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
243 join(' / ', @errors);
247 sub unsuspend_resumed_pkgs {
248 my ( $self, $time, %options ) = @_;
250 my @unsusp_pkgs = $self->ncancelled_pkgs( {
251 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
256 foreach my $cust_pkg ( @unsusp_pkgs ) {
257 my $error = $cust_pkg->unsuspend( 'time' => $time );
258 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
261 join(' / ', @errors);
267 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
268 conjunction with the collect method by calling B<bill_and_collect>.
270 If there is an error, returns the error, otherwise returns false.
272 Options are passed as name-value pairs. Currently available options are:
278 If set true, re-charges setup fees.
282 If set true then only bill recurring charges, not setup, usage, one time
287 If set, then override the normal frequency and look for a part_pkg_discount
288 to take at that frequency. This is appropriate only when the normal
289 frequency for all packages is monthly, and is an error otherwise. Use
290 C<pkg_list> to limit the set of packages included in billing.
294 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:
298 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
302 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
304 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
308 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
312 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.
316 This boolean value informs the us that the package is being cancelled. This
317 typically might mean not charging the normal recurring fee but only usage
318 fees since the last billing. Setup charges may be charged. Not all package
319 plans support this feature (they tend to charge 0).
323 Prevent the resetting of usage limits during this call.
327 Do not save the generated bill in the database. Useful with return_bill
331 A list reference on which the generated bill(s) will be returned.
335 Optional terms to be printed on this invoice. Otherwise, customer-specific
336 terms or the default terms are used.
343 my( $self, %options ) = @_;
345 return '' if $self->payby eq 'COMP';
347 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
349 warn "$me bill customer ". $self->custnum. "\n"
352 my $time = $options{'time'} || time;
353 my $invoice_time = $options{'invoice_time'} || $time;
355 $options{'not_pkgpart'} ||= {};
356 $options{'not_pkgpart'} = { map { $_ => 1 }
357 split(/\s*,\s*/, $options{'not_pkgpart'})
359 unless ref($options{'not_pkgpart'});
361 local $SIG{HUP} = 'IGNORE';
362 local $SIG{INT} = 'IGNORE';
363 local $SIG{QUIT} = 'IGNORE';
364 local $SIG{TERM} = 'IGNORE';
365 local $SIG{TSTP} = 'IGNORE';
366 local $SIG{PIPE} = 'IGNORE';
368 my $oldAutoCommit = $FS::UID::AutoCommit;
369 local $FS::UID::AutoCommit = 0;
372 warn "$me acquiring lock on customer ". $self->custnum. "\n"
375 $self->select_for_update; #mutex
377 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
380 my $error = $self->do_cust_event(
381 'debug' => ( $options{'debug'} || 0 ),
382 'time' => $invoice_time,
383 'check_freq' => $options{'check_freq'},
384 'stage' => 'pre-bill',
386 unless $options{no_commit};
388 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
392 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
395 #keep auto-charge and non-auto-charge line items separate
396 my @passes = ( '', 'no_auto' );
398 my %cust_bill_pkg = map { $_ => [] } @passes;
401 # find the packages which are due for billing, find out how much they are
402 # & generate invoice database.
405 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
406 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
408 my %taxlisthash = map { $_ => {} } @passes;
410 my @precommit_hooks = ();
412 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
413 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
415 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
417 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
419 #? to avoid use of uninitialized value errors... ?
420 $cust_pkg->setfield('bill', '')
421 unless defined($cust_pkg->bill);
423 #my $part_pkg = $cust_pkg->part_pkg;
425 my $real_pkgpart = $cust_pkg->pkgpart;
426 my %hash = $cust_pkg->hash;
428 # we could implement this bit as FS::part_pkg::has_hidden, but we already
429 # suffer from performance issues
430 $options{has_hidden} = 0;
431 my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
432 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
434 foreach my $part_pkg ( @part_pkg ) {
436 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
438 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
440 my $next_bill = $cust_pkg->getfield('bill') || 0;
442 # let this run once if this is the last bill upon cancellation
443 while ( $next_bill <= $time or $options{cancel} ) {
445 $self->_make_lines( 'part_pkg' => $part_pkg,
446 'cust_pkg' => $cust_pkg,
447 'precommit_hooks' => \@precommit_hooks,
448 'line_items' => $cust_bill_pkg{$pass},
449 'setup' => $total_setup{$pass},
450 'recur' => $total_recur{$pass},
451 'tax_matrix' => $taxlisthash{$pass},
453 'real_pkgpart' => $real_pkgpart,
454 'options' => \%options,
457 # Stop if anything goes wrong
460 # or if we're not incrementing the bill date.
461 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
463 # or if we're letting it run only once
464 last if $options{cancel};
466 $next_bill = $cust_pkg->getfield('bill') || 0;
468 #stop if -o was passed to freeside-daily
469 last if $options{'one_recur'};
472 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
476 } #foreach my $part_pkg
478 } #foreach my $cust_pkg
480 #if the customer isn't on an automatic payby, everything can go on a single
482 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
483 #merge everything into one list
486 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
488 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
490 next unless @cust_bill_pkg; #don't create an invoice w/o line items
492 warn "$me billing pass $pass\n"
493 #.Dumper(\@cust_bill_pkg)."\n"
496 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
497 !$conf->exists('postal_invoice-recurring_only')
501 my $postal_pkg = $self->charge_postal_fee();
502 if ( $postal_pkg && !ref( $postal_pkg ) ) {
504 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
505 return "can't charge postal invoice fee for customer ".
506 $self->custnum. ": $postal_pkg";
508 } elsif ( $postal_pkg ) {
510 my $real_pkgpart = $postal_pkg->pkgpart;
511 # we could implement this bit as FS::part_pkg::has_hidden, but we already
512 # suffer from performance issues
513 $options{has_hidden} = 0;
514 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
515 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
517 foreach my $part_pkg ( @part_pkg ) {
518 my %postal_options = %options;
519 delete $postal_options{cancel};
521 $self->_make_lines( 'part_pkg' => $part_pkg,
522 'cust_pkg' => $postal_pkg,
523 'precommit_hooks' => \@precommit_hooks,
524 'line_items' => \@cust_bill_pkg,
525 'setup' => $total_setup{$pass},
526 'recur' => $total_recur{$pass},
527 'tax_matrix' => $taxlisthash{$pass},
529 'real_pkgpart' => $real_pkgpart,
530 'options' => \%postal_options,
533 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
538 # it's silly to have a zero value postal_pkg, but....
539 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
545 my $listref_or_error =
546 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
548 unless ( ref( $listref_or_error ) ) {
549 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
550 return $listref_or_error;
553 foreach my $taxline ( @$listref_or_error ) {
554 ${ $total_setup{$pass} } =
555 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
556 push @cust_bill_pkg, $taxline;
560 warn "adding tax adjustments...\n" if $DEBUG > 2;
561 foreach my $cust_tax_adjustment (
562 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
568 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
570 my $itemdesc = $cust_tax_adjustment->taxname;
571 $itemdesc = '' if $itemdesc eq 'Tax';
573 push @cust_bill_pkg, new FS::cust_bill_pkg {
579 'itemdesc' => $itemdesc,
580 'itemcomment' => $cust_tax_adjustment->comment,
581 'cust_tax_adjustment' => $cust_tax_adjustment,
582 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
587 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
589 my @cust_bill = $self->cust_bill;
590 my $balance = $self->balance;
591 my $previous_balance = scalar(@cust_bill)
592 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
595 $previous_balance += $cust_bill[$#cust_bill]->charged
596 if scalar(@cust_bill);
597 #my $balance_adjustments =
598 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
600 warn "creating the new invoice\n" if $DEBUG;
601 #create the new invoice
602 my $cust_bill = new FS::cust_bill ( {
603 'custnum' => $self->custnum,
604 '_date' => $invoice_time,
605 'charged' => $charged,
606 'billing_balance' => $balance,
607 'previous_balance' => $previous_balance,
608 'invoice_terms' => $options{'invoice_terms'},
609 'cust_bill_pkg' => \@cust_bill_pkg,
611 $error = $cust_bill->insert unless $options{no_commit};
613 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
614 return "can't create invoice for customer #". $self->custnum. ": $error";
616 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
618 } #foreach my $pass ( keys %cust_bill_pkg )
620 foreach my $hook ( @precommit_hooks ) {
623 } unless $options{no_commit};
625 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
626 return "$@ running precommit hook $hook\n";
630 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
635 #discard bundled packages of 0 value
636 sub _omit_zero_value_bundles {
639 my @cust_bill_pkg = ();
640 my @cust_bill_pkg_bundle = ();
642 my $discount_show_always = 0;
644 foreach my $cust_bill_pkg ( @in ) {
646 $discount_show_always = ($cust_bill_pkg->get('discounts')
647 && scalar(@{$cust_bill_pkg->get('discounts')})
648 && $conf->exists('discount-show-always'));
650 warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
651 "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
652 "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
655 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
656 push @cust_bill_pkg, @cust_bill_pkg_bundle
658 || ($sum == 0 && ( $discount_show_always
659 || grep {$_->recur_show_zero || $_->setup_show_zero}
660 @cust_bill_pkg_bundle
663 @cust_bill_pkg_bundle = ();
667 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
668 push @cust_bill_pkg_bundle, $cust_bill_pkg;
672 push @cust_bill_pkg, @cust_bill_pkg_bundle
674 || ($sum == 0 && ( $discount_show_always
675 || grep {$_->recur_show_zero || $_->setup_show_zero}
676 @cust_bill_pkg_bundle
680 warn " _omit_zero_value_bundles: ". scalar(@in).
681 '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
688 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
690 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
691 Usually used internally by bill method B<bill>.
693 If there is an error, returns the error, otherwise returns reference to a
694 list of line items suitable for insertion.
700 An array ref of the line items being billed.
704 A strange beast. The keys to this hash are internal identifiers consisting
705 of the name of the tax object type, a space, and its unique identifier ( e.g.
706 'cust_main_county 23' ). The values of the hash are listrefs. The first
707 item in the list is the tax object. The remaining items are either line
708 items or floating point values (currency amounts).
710 The taxes are calculated on this entity. Calculated exemption records are
711 transferred to the LINEITEMREF items on the assumption that they are related.
717 This specifies the date appearing on the associated invoice. Some
718 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
724 sub calculate_taxes {
725 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
727 # $taxlisthash is a hashref
728 # keys are identifiers, values are arrayrefs
729 # each arrayref starts with a tax object (cust_main_county or tax_rate)
730 # then any cust_bill_pkg objects the tax applies to
732 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
734 warn "$me calculate_taxes\n"
735 #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
738 my @tax_line_items = ();
740 # keys are tax names (as printed on invoices / itemdesc )
741 # values are arrayrefs of taxlisthash keys (internal identifiers)
744 # keys are taxlisthash keys (internal identifiers)
745 # values are (cumulative) amounts
748 # keys are taxlisthash keys (internal identifiers)
749 # values are arrayrefs of cust_bill_pkg_tax_location hashrefs
750 my %tax_location = ();
752 # keys are taxlisthash keys (internal identifiers)
753 # values are arrayrefs of cust_bill_pkg_tax_rate_location hashrefs
754 my %tax_rate_location = ();
756 # keys are taxlisthash keys (internal identifiers!)
757 # values are arrayrefs of cust_tax_exempt_pkg objects
760 foreach my $tax ( keys %$taxlisthash ) {
761 # $tax is a tax identifier (intersection of a tax definition record
762 # and a cust_bill_pkg record)
763 my $tax_object = shift @{ $taxlisthash->{$tax} };
764 # $tax_object is a cust_main_county or tax_rate
765 # (with billpkgnum, pkgnum, locationnum set)
766 # the rest of @{ $taxlisthash->{$tax} } is cust_bill_pkg component objects
767 # (setup, recurring, usage classes)
768 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
769 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
770 # taxline calculates the tax on all cust_bill_pkgs in the
771 # first (arrayref) argument, and returns a hashref of 'name'
772 # (the line item description) and 'amount'.
773 # It also calculates exemptions and attaches them to the cust_bill_pkgs
775 my $taxables = $taxlisthash->{$tax};
776 my $exemptions = $tax_exemption{$tax} ||= [];
777 my $taxline = $tax_object->taxline(
779 'custnum' => $self->custnum,
780 'invoice_time' => $invoice_time,
781 'exemptions' => $exemptions,
783 return $taxline unless ref($taxline);
785 unshift @{ $taxlisthash->{$tax} }, $tax_object;
787 if ( $tax_object->isa('FS::cust_main_county') ) {
788 # then $taxline is a real line item
789 push @{ $taxname{ $taxline->itemdesc } }, $taxline;
792 # leave this as is for now
794 my $name = $taxline->{'name'};
795 my $amount = $taxline->{'amount'};
797 #warn "adding $amount as $name\n";
798 $taxname{ $name } ||= [];
799 push @{ $taxname{ $name } }, $tax;
801 $tax_amount{ $tax } += $amount;
803 # link records between cust_main_county/tax_rate and cust_location
804 $tax_rate_location{ $tax } ||= [];
805 my $taxratelocationnum =
806 $tax_object->tax_rate_location->taxratelocationnum;
807 push @{ $tax_rate_location{ $tax } },
809 'taxnum' => $tax_object->taxnum,
810 'taxtype' => ref($tax_object),
811 'amount' => sprintf('%.2f', $amount ),
812 'locationtaxid' => $tax_object->location,
813 'taxratelocationnum' => $taxratelocationnum,
815 } #if ref($tax_object)...
816 } #foreach keys %$taxlisthash
818 #consolidate and create tax line items
819 warn "consolidating and generating...\n" if $DEBUG > 2;
820 foreach my $taxname ( keys %taxname ) {
821 my @cust_bill_pkg_tax_location;
822 my @cust_bill_pkg_tax_rate_location;
823 my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({
828 'itemdesc' => $taxname,
829 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
830 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
835 warn "adding $taxname\n" if $DEBUG > 1;
836 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
837 if ( ref($taxitem) eq 'FS::cust_bill_pkg' ) {
838 # then we need to transfer the amount and the links from the
839 # line item to the new one we're creating.
840 $tax_total += $taxitem->setup;
841 foreach my $link ( @{ $taxitem->get('cust_bill_pkg_tax_location') } ) {
842 $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg);
843 push @cust_bill_pkg_tax_location, $link;
847 next if $seen{$taxitem}++;
848 warn "adding $tax_amount{$taxitem}\n" if $DEBUG > 1;
849 $tax_total += $tax_amount{$taxitem};
850 push @cust_bill_pkg_tax_rate_location,
851 map { new FS::cust_bill_pkg_tax_rate_location $_ }
852 @{ $tax_rate_location{ $taxitem } };
855 next unless $tax_total;
857 # we should really neverround this up...I guess it's okay if taxline
858 # already returns amounts with 2 decimal places
859 $tax_total = sprintf('%.2f', $tax_total );
860 $tax_cust_bill_pkg->set('setup', $tax_total);
862 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
868 if ( $pkg_category and
869 $conf->config('invoice_latexsummary') ||
870 $conf->config('invoice_htmlsummary')
874 my %hash = ( 'section' => $pkg_category->categoryname );
875 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
878 $tax_cust_bill_pkg->set('display', \@display);
880 push @tax_line_items, $tax_cust_bill_pkg;
887 my ($self, %params) = @_;
889 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
891 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
892 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
893 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
894 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
895 my $total_setup = $params{setup} or die "no setup accumulator specified";
896 my $total_recur = $params{recur} or die "no recur accumulator specified";
897 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
898 my $time = $params{'time'} or die "no time specified";
899 my (%options) = %{$params{options}};
901 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
902 # this should never happen
903 die 'freq_override billing attempted on non-monthly package '.
908 my $real_pkgpart = $params{real_pkgpart};
909 my %hash = $cust_pkg->hash;
910 my $old_cust_pkg = new FS::cust_pkg \%hash;
915 $cust_pkg->pkgpart($part_pkg->pkgpart);
923 my @setup_discounts = ();
924 my %setup_param = ( 'discounts' => \@setup_discounts );
925 if ( ! $options{recurring_only}
926 and ! $options{cancel}
927 and ( $options{'resetup'}
928 || ( ! $cust_pkg->setup
929 && ( ! $cust_pkg->start_date
930 || $cust_pkg->start_date <= day_end($time)
932 && ( ! $conf->exists('disable_setup_suspended_pkgs')
933 || ( $conf->exists('disable_setup_suspended_pkgs') &&
934 ! $cust_pkg->getfield('susp')
942 warn " bill setup\n" if $DEBUG > 1;
944 unless ( $cust_pkg->waive_setup ) {
947 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
948 return "$@ running calc_setup for $cust_pkg\n"
951 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
954 $cust_pkg->setfield('setup', $time)
955 unless $cust_pkg->setup;
956 #do need it, but it won't get written to the db
957 #|| $cust_pkg->pkgpart != $real_pkgpart;
959 $cust_pkg->setfield('start_date', '')
960 if $cust_pkg->start_date;
970 my @recur_discounts = ();
972 if ( ! $cust_pkg->start_date
973 and ( ! $cust_pkg->susp || $cust_pkg->option('suspend_bill',1)
974 || ( $part_pkg->option('suspend_bill', 1) )
975 && ! $cust_pkg->option('no_suspend_bill',1)
978 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) )
979 || ( $part_pkg->plan eq 'voip_cdr'
980 && $part_pkg->option('bill_every_call')
985 # XXX should this be a package event? probably. events are called
986 # at collection time at the moment, though...
987 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
988 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
989 #don't want to reset usage just cause we want a line item??
990 #&& $part_pkg->pkgpart == $real_pkgpart;
992 warn " bill recur\n" if $DEBUG > 1;
995 # XXX shared with $recur_prog
996 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1000 #over two params! lets at least switch to a hashref for the rest...
1001 my $increment_next_bill = ( $part_pkg->freq ne '0'
1002 && ( $cust_pkg->getfield('bill') || 0 ) <= day_end($time)
1003 && !$options{cancel}
1005 my %param = ( %setup_param,
1006 'precommit_hooks' => $precommit_hooks,
1007 'increment_next_bill' => $increment_next_bill,
1008 'discounts' => \@recur_discounts,
1009 'real_pkgpart' => $real_pkgpart,
1010 'freq_override' => $options{freq_override} || '',
1014 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1016 # There may be some part_pkg for which this is wrong. Only those
1017 # which can_discount are supported.
1018 # (the UI should prevent adding discounts to these at the moment)
1020 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1021 " for pkgpart ". $cust_pkg->pkgpart.
1022 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1025 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1026 return "$@ running $method for $cust_pkg\n"
1030 $unitrecur = $cust_pkg->part_pkg->base_recur || $recur; #XXX uuh
1032 if ( $increment_next_bill ) {
1034 my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1035 return "unparsable frequency: ". $part_pkg->freq
1036 if $next_bill == -1;
1038 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1039 # only for figuring next bill date, nothing else, so, reset $sdate again
1041 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1042 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1043 $cust_pkg->last_bill($sdate);
1045 $cust_pkg->setfield('bill', $next_bill );
1049 if ( $param{'setup_fee'} ) {
1050 # Add an additional setup fee at the billing stage.
1051 # Used for prorate_defer_bill.
1052 $setup += $param{'setup_fee'};
1053 $unitsetup += $param{'setup_fee'};
1057 if ( defined $param{'discount_left_setup'} ) {
1058 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1059 $setup -= $discount_setup;
1065 warn "\$setup is undefined" unless defined($setup);
1066 warn "\$recur is undefined" unless defined($recur);
1067 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1070 # If there's line items, create em cust_bill_pkg records
1071 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1076 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1077 # hmm.. and if just the options are modified in some weird price plan?
1079 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1082 my $error = $cust_pkg->replace( $old_cust_pkg,
1083 'depend_jobnum'=>$options{depend_jobnum},
1084 'options' => { $cust_pkg->options },
1086 unless $options{no_commit};
1087 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1088 if $error; #just in case
1091 $setup = sprintf( "%.2f", $setup );
1092 $recur = sprintf( "%.2f", $recur );
1093 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1094 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1096 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1097 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1100 my $discount_show_always = $conf->exists('discount-show-always')
1101 && ( ($setup == 0 && scalar(@setup_discounts))
1102 || ($recur == 0 && scalar(@recur_discounts))
1107 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1108 || $discount_show_always
1109 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1110 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1114 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1117 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1119 warn " adding customer package invoice detail: $_\n"
1120 foreach @cust_pkg_detail;
1122 push @details, @cust_pkg_detail;
1124 my $cust_bill_pkg = new FS::cust_bill_pkg {
1125 'pkgnum' => $cust_pkg->pkgnum,
1127 'unitsetup' => $unitsetup,
1129 'unitrecur' => $unitrecur,
1130 'quantity' => $cust_pkg->quantity,
1131 'details' => \@details,
1132 'discounts' => [ @setup_discounts, @recur_discounts ],
1133 'hidden' => $part_pkg->hidden,
1134 'freq' => $part_pkg->freq,
1137 if ( $part_pkg->option('prorate_defer_bill',1)
1138 and !$hash{last_bill} ) {
1139 # both preceding and upcoming, technically
1140 $cust_bill_pkg->sdate( $cust_pkg->setup );
1141 $cust_bill_pkg->edate( $cust_pkg->bill );
1142 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1143 $cust_bill_pkg->sdate( $hash{last_bill} );
1144 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1145 $cust_bill_pkg->edate( $time ) if $options{cancel};
1146 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1147 $cust_bill_pkg->sdate( $sdate );
1148 $cust_bill_pkg->edate( $cust_pkg->bill );
1149 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1152 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1153 unless $part_pkg->pkgpart == $real_pkgpart;
1155 $$total_setup += $setup;
1156 $$total_recur += $recur;
1162 #unless ( $discount_show_always ) { # oh, for god's sake
1163 my $error = $self->_handle_taxes(
1168 $options{invoice_time},
1170 \%options # I have serious objections to this
1172 return $error if $error;
1175 $cust_bill_pkg->set_display(
1176 part_pkg => $part_pkg,
1177 real_pkgpart => $real_pkgpart,
1180 push @$cust_bill_pkgs, $cust_bill_pkg;
1182 } #if $setup != 0 || $recur != 0
1190 # This is _handle_taxes. It's called once for each cust_bill_pkg generated
1191 # from _make_lines, along with the part_pkg, cust_pkg, invoice time, the
1192 # non-overridden pkgpart, a flag indicating whether the package is being
1193 # canceled, and a partridge in a pear tree.
1195 # The most important argument is 'taxlisthash'. This is shared across the
1196 # entire invoice. It looks like this:
1198 # 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1199 # 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1202 # 'cust_main_county' can also be 'tax_rate'. The first object in the array
1203 # is always the cust_main_county or tax_rate identified by the key.
1205 # That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1206 # the 'taxline' method to calculate the amount of the tax. This doesn't
1207 # happen until calculate_taxes, though.
1211 my $part_pkg = shift;
1212 my $taxlisthash = shift;
1213 my $cust_bill_pkg = shift;
1214 my $cust_pkg = shift;
1215 my $invoice_time = shift;
1216 my $real_pkgpart = shift;
1217 my $options = shift;
1219 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1221 return if ( $self->payby eq 'COMP' ); #dubious
1223 if ( $conf->exists('enable_taxproducts')
1224 && ( scalar($part_pkg->part_pkg_taxoverride)
1225 || $part_pkg->has_taxproduct
1230 # EXTERNAL TAX RATES (via tax_rate)
1231 my %cust_bill_pkg = ();
1235 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1236 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1238 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1239 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1241 my $exempt = $conf->exists('cust_class-tax_exempt')
1242 ? ( $self->cust_class ? $self->cust_class->tax : '' )
1244 # standardize this just to be sure
1245 $exempt = ($exempt eq 'Y') ? 'Y' : '';
1249 foreach my $class (@classes) {
1250 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
1251 return $err_or_ref unless ref($err_or_ref);
1252 $taxes{$class} = $err_or_ref;
1255 unless (exists $taxes{''}) {
1256 my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
1257 return $err_or_ref unless ref($err_or_ref);
1258 $taxes{''} = $err_or_ref;
1263 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1264 foreach my $key (keys %tax_cust_bill_pkg) {
1265 # $key is "setup", "recur", or a usage class name. ('' is a usage class.)
1266 # $tax_cust_bill_pkg{$key} is a cust_bill_pkg for that component of
1268 # $taxes{$key} is an arrayref of cust_main_county or tax_rate objects that
1269 # apply to $key-class charges.
1270 my @taxes = @{ $taxes{$key} || [] };
1271 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1273 my %localtaxlisthash = ();
1274 foreach my $tax ( @taxes ) {
1276 # this is the tax identifier, not the taxname
1277 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1278 $taxname .= ' billpkgnum'. $cust_bill_pkg->billpkgnum;
1279 # We need to create a separate $taxlisthash entry for each billpkgnum
1280 # on the invoice, so that cust_bill_pkg_tax_location records will
1281 # be linked correctly.
1283 # $taxlisthash: keys are "setup", "recur", and usage classes.
1284 # Values are arrayrefs, first the tax object (cust_main_county
1285 # or tax_rate) and then any cust_bill_pkg objects that the
1287 $taxlisthash->{ $taxname } ||= [ $tax ];
1288 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1290 $localtaxlisthash{ $taxname } ||= [ $tax ];
1291 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1295 warn "finding taxed taxes...\n" if $DEBUG > 2;
1296 foreach my $tax ( keys %localtaxlisthash ) {
1297 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1298 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1300 next unless $tax_object->can('tax_on_tax');
1302 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1303 my $totname = ref( $tot ). ' '. $tot->taxnum;
1305 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1307 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1309 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1310 # we're calling taxline() right here? wtf?
1311 my $hashref_or_error =
1312 $tax_object->taxline( $localtaxlisthash{$tax},
1313 'custnum' => $self->custnum,
1314 'invoice_time' => $invoice_time,
1316 return $hashref_or_error
1317 unless ref($hashref_or_error);
1319 $taxlisthash->{ $totname } ||= [ $tot ];
1320 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1328 # INTERNAL TAX RATES (cust_main_county)
1330 # We fetch taxes even if the customer is completely exempt,
1331 # because we need to record that fact.
1333 my @loc_keys = qw( district city county state country );
1334 my $location = $cust_pkg->tax_location;
1335 my %taxhash = map { $_ => $location->$_ } @loc_keys;
1337 $taxhash{'taxclass'} = $part_pkg->taxclass;
1339 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1341 my @taxes = (); # entries are cust_main_county objects
1342 my %taxhash_elim = %taxhash;
1343 my @elim = qw( district city county state );
1346 #first try a match with taxclass
1347 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1349 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1350 #then try a match without taxclass
1351 my %no_taxclass = %taxhash_elim;
1352 $no_taxclass{ 'taxclass' } = '';
1353 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1356 $taxhash_elim{ shift(@elim) } = '';
1358 } while ( !scalar(@taxes) && scalar(@elim) );
1361 my $tax_id = 'cust_main_county '.$_->taxnum;
1362 $taxlisthash->{$tax_id} ||= [ $_ ];
1363 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1372 my $part_pkg = shift;
1374 my $cust_pkg = shift;
1376 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1379 if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
1380 $geocode = $cust_pkg->cust_location->geocode('cch');
1382 $geocode = $self->geocode('cch');
1387 my @taxclassnums = map { $_->taxclassnum }
1388 $part_pkg->part_pkg_taxoverride($class);
1390 unless (@taxclassnums) {
1391 @taxclassnums = map { $_->taxclassnum }
1392 grep { $_->taxable eq 'Y' }
1393 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1395 warn "Found taxclassnum values of ". join(',', @taxclassnums)
1400 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1402 @taxes = qsearch({ 'table' => 'tax_rate',
1403 'hashref' => { 'geocode' => $geocode, },
1404 'extra_sql' => $extra_sql,
1406 if scalar(@taxclassnums);
1408 warn "Found taxes ".
1409 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1416 =item collect [ HASHREF | OPTION => VALUE ... ]
1418 (Attempt to) collect money for this customer's outstanding invoices (see
1419 L<FS::cust_bill>). Usually used after the bill method.
1421 Actions are now triggered by billing events; see L<FS::part_event> and the
1422 billing events web interface. Old-style invoice events (see
1423 L<FS::part_bill_event>) have been deprecated.
1425 If there is an error, returns the error, otherwise returns false.
1427 Options are passed as name-value pairs.
1429 Currently available options are:
1435 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.
1439 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1443 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1447 set true to surpress email card/ACH decline notices.
1451 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)
1457 # allows for one time override of normal customer billing method
1462 my( $self, %options ) = @_;
1464 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1466 my $invoice_time = $options{'invoice_time'} || time;
1469 local $SIG{HUP} = 'IGNORE';
1470 local $SIG{INT} = 'IGNORE';
1471 local $SIG{QUIT} = 'IGNORE';
1472 local $SIG{TERM} = 'IGNORE';
1473 local $SIG{TSTP} = 'IGNORE';
1474 local $SIG{PIPE} = 'IGNORE';
1476 my $oldAutoCommit = $FS::UID::AutoCommit;
1477 local $FS::UID::AutoCommit = 0;
1480 $self->select_for_update; #mutex
1483 my $balance = $self->balance;
1484 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1487 if ( exists($options{'retry_card'}) ) {
1488 carp 'retry_card option passed to collect is deprecated; use retry';
1489 $options{'retry'} ||= $options{'retry_card'};
1491 if ( exists($options{'retry'}) && $options{'retry'} ) {
1492 my $error = $self->retry_realtime;
1494 $dbh->rollback if $oldAutoCommit;
1499 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1501 #never want to roll back an event just because it returned an error
1502 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1504 $self->do_cust_event(
1505 'debug' => ( $options{'debug'} || 0 ),
1506 'time' => $invoice_time,
1507 'check_freq' => $options{'check_freq'},
1508 'stage' => 'collect',
1513 =item retry_realtime
1515 Schedules realtime / batch credit card / electronic check / LEC billing
1516 events for for retry. Useful if card information has changed or manual
1517 retry is desired. The 'collect' method must be called to actually retry
1520 Implementation details: For either this customer, or for each of this
1521 customer's open invoices, changes the status of the first "done" (with
1522 statustext error) realtime processing event to "failed".
1526 sub retry_realtime {
1529 local $SIG{HUP} = 'IGNORE';
1530 local $SIG{INT} = 'IGNORE';
1531 local $SIG{QUIT} = 'IGNORE';
1532 local $SIG{TERM} = 'IGNORE';
1533 local $SIG{TSTP} = 'IGNORE';
1534 local $SIG{PIPE} = 'IGNORE';
1536 my $oldAutoCommit = $FS::UID::AutoCommit;
1537 local $FS::UID::AutoCommit = 0;
1540 #a little false laziness w/due_cust_event (not too bad, really)
1542 my $join = FS::part_event_condition->join_conditions_sql;
1543 my $order = FS::part_event_condition->order_conditions_sql;
1546 . join ( ' OR ' , map {
1547 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1548 my $custnum = FS::part_event->eventtables_custnum->{$_};
1549 "( part_event.eventtable = " . dbh->quote($_)
1550 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1551 . " from $_ $cust_join"
1552 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1553 } FS::part_event->eventtables)
1556 #here is the agent virtualization
1557 my $agent_virt = " ( part_event.agentnum IS NULL
1558 OR part_event.agentnum = ". $self->agentnum. ' )';
1560 #XXX this shouldn't be hardcoded, actions should declare it...
1561 my @realtime_events = qw(
1562 cust_bill_realtime_card
1563 cust_bill_realtime_check
1564 cust_bill_realtime_lec
1568 my $is_realtime_event =
1569 ' part_event.action IN ( '.
1570 join(',', map "'$_'", @realtime_events ).
1573 my $batch_or_statustext =
1574 "( part_event.action = 'cust_bill_batch'
1575 OR ( statustext IS NOT NULL AND statustext != '' )
1579 my @cust_event = qsearch({
1580 'table' => 'cust_event',
1581 'select' => 'cust_event.*',
1582 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1583 'hashref' => { 'status' => 'done' },
1584 'extra_sql' => " AND $batch_or_statustext ".
1585 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1588 my %seen_invnum = ();
1589 foreach my $cust_event (@cust_event) {
1591 #max one for the customer, one for each open invoice
1592 my $cust_X = $cust_event->cust_X;
1593 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1597 or $cust_event->part_event->eventtable eq 'cust_bill'
1600 my $error = $cust_event->retry;
1602 $dbh->rollback if $oldAutoCommit;
1603 return "error scheduling event for retry: $error";
1608 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1613 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1615 Runs billing events; see L<FS::part_event> and the billing events web
1618 If there is an error, returns the error, otherwise returns false.
1620 Options are passed as name-value pairs.
1622 Currently available options are:
1628 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.
1632 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1636 "collect" (the default) or "pre-bill"
1640 set true to surpress email card/ACH decline notices.
1644 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)
1651 # allows for one time override of normal customer billing method
1655 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1658 my( $self, %options ) = @_;
1660 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1662 my $time = $options{'time'} || time;
1665 local $SIG{HUP} = 'IGNORE';
1666 local $SIG{INT} = 'IGNORE';
1667 local $SIG{QUIT} = 'IGNORE';
1668 local $SIG{TERM} = 'IGNORE';
1669 local $SIG{TSTP} = 'IGNORE';
1670 local $SIG{PIPE} = 'IGNORE';
1672 my $oldAutoCommit = $FS::UID::AutoCommit;
1673 local $FS::UID::AutoCommit = 0;
1676 $self->select_for_update; #mutex
1679 my $balance = $self->balance;
1680 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1683 # if ( exists($options{'retry_card'}) ) {
1684 # carp 'retry_card option passed to collect is deprecated; use retry';
1685 # $options{'retry'} ||= $options{'retry_card'};
1687 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1688 # my $error = $self->retry_realtime;
1690 # $dbh->rollback if $oldAutoCommit;
1695 # false laziness w/pay_batch::import_results
1697 my $due_cust_event = $self->due_cust_event(
1698 'debug' => ( $options{'debug'} || 0 ),
1700 'check_freq' => $options{'check_freq'},
1701 'stage' => ( $options{'stage'} || 'collect' ),
1703 unless( ref($due_cust_event) ) {
1704 $dbh->rollback if $oldAutoCommit;
1705 return $due_cust_event;
1708 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1709 #never want to roll back an event just because it or a different one
1711 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1713 foreach my $cust_event ( @$due_cust_event ) {
1717 #re-eval event conditions (a previous event could have changed things)
1718 unless ( $cust_event->test_conditions ) {
1719 #don't leave stray "new/locked" records around
1720 my $error = $cust_event->delete;
1721 return $error if $error;
1726 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1727 if $options{'quiet'};
1728 warn " running cust_event ". $cust_event->eventnum. "\n"
1731 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1732 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
1733 #XXX wtf is this? figure out a proper dealio with return value
1745 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1747 Inserts database records for and returns an ordered listref of new events due
1748 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1749 events are due, an empty listref is returned. If there is an error, returns a
1750 scalar error message.
1752 To actually run the events, call each event's test_condition method, and if
1753 still true, call the event's do_event method.
1755 Options are passed as a hashref or as a list of name-value pairs. Available
1762 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.
1766 "collect" (the default) or "pre-bill"
1770 "Current time" for the events.
1774 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)
1778 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1782 Explicitly pass the objects to be tested (typically used with eventtable).
1786 Set to true to return the objects, but not actually insert them into the
1793 sub due_cust_event {
1795 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1798 #my $DEBUG = $opt{'debug'}
1799 local($DEBUG) = $opt{'debug'}
1800 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1801 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1803 warn "$me due_cust_event called with options ".
1804 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1807 $opt{'time'} ||= time;
1809 local $SIG{HUP} = 'IGNORE';
1810 local $SIG{INT} = 'IGNORE';
1811 local $SIG{QUIT} = 'IGNORE';
1812 local $SIG{TERM} = 'IGNORE';
1813 local $SIG{TSTP} = 'IGNORE';
1814 local $SIG{PIPE} = 'IGNORE';
1816 my $oldAutoCommit = $FS::UID::AutoCommit;
1817 local $FS::UID::AutoCommit = 0;
1820 $self->select_for_update #mutex
1821 unless $opt{testonly};
1824 # find possible events (initial search)
1827 my @cust_event = ();
1829 my @eventtable = $opt{'eventtable'}
1830 ? ( $opt{'eventtable'} )
1831 : FS::part_event->eventtables_runorder;
1833 my $check_freq = $opt{'check_freq'} || '1d';
1835 foreach my $eventtable ( @eventtable ) {
1838 if ( $opt{'objects'} ) {
1840 @objects = @{ $opt{'objects'} };
1842 } elsif ( $eventtable eq 'cust_main' ) {
1844 @objects = ( $self );
1848 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
1849 # linkage not needed here because FS::cust_main->$eventtable will
1852 #some false laziness w/Cron::bill bill_where
1854 my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
1855 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1856 'time'=>$opt{'time'},
1858 $where = $where ? "AND $where" : '';
1860 my $are_part_event =
1861 "EXISTS ( SELECT 1 FROM part_event $join
1862 WHERE check_freq = '$check_freq'
1863 AND eventtable = '$eventtable'
1864 AND ( disabled = '' OR disabled IS NULL )
1870 @objects = $self->$eventtable(
1871 'addl_from' => $cm_join,
1872 'extra_sql' => " AND $are_part_event",
1874 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
1876 my @e_cust_event = ();
1878 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
1880 my $cross = "CROSS JOIN $eventtable $linkage";
1881 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1882 unless $eventtable eq 'cust_main';
1884 foreach my $object ( @objects ) {
1886 #this first search uses the condition_sql magic for optimization.
1887 #the more possible events we can eliminate in this step the better
1889 my $cross_where = '';
1890 my $pkey = $object->primary_key;
1891 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1893 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1895 FS::part_event_condition->where_conditions_sql( $eventtable,
1896 'time'=>$opt{'time'}
1898 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1900 $extra_sql = "AND $extra_sql" if $extra_sql;
1902 #here is the agent virtualization
1903 $extra_sql .= " AND ( part_event.agentnum IS NULL
1904 OR part_event.agentnum = ". $self->agentnum. ' )';
1906 $extra_sql .= " $order";
1908 warn "searching for events for $eventtable ". $object->$pkey. "\n"
1909 if $opt{'debug'} > 2;
1910 my @part_event = qsearch( {
1911 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
1912 'select' => 'part_event.*',
1913 'table' => 'part_event',
1914 'addl_from' => "$cross $join",
1915 'hashref' => { 'check_freq' => $check_freq,
1916 'eventtable' => $eventtable,
1919 'extra_sql' => "AND $cross_where $extra_sql",
1923 my $pkey = $object->primary_key;
1924 warn " ". scalar(@part_event).
1925 " possible events found for $eventtable ". $object->$pkey(). "\n";
1928 push @e_cust_event, map {
1929 $_->new_cust_event($object, 'time' => $opt{'time'})
1934 warn " ". scalar(@e_cust_event).
1935 " subtotal possible cust events found for $eventtable\n"
1938 push @cust_event, @e_cust_event;
1942 warn " ". scalar(@cust_event).
1943 " total possible cust events found in initial search\n"
1951 $opt{stage} ||= 'collect';
1953 grep { my $stage = $_->part_event->event_stage;
1954 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1964 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
1967 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
1970 warn " invalid conditions not eliminated with condition_sql:\n".
1971 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
1972 if keys %unsat && $DEBUG; # > 1;
1978 unless( $opt{testonly} ) {
1979 foreach my $cust_event ( @cust_event ) {
1981 my $error = $cust_event->insert();
1983 $dbh->rollback if $oldAutoCommit;
1990 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1996 warn " returning events: ". Dumper(@cust_event). "\n"
2003 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2005 Applies unapplied payments and credits.
2007 In most cases, this new method should be used in place of sequential
2008 apply_payments and apply_credits methods.
2010 A hash of optional arguments may be passed. Currently "manual" is supported.
2011 If true, a payment receipt is sent instead of a statement when
2012 'payment_receipt_email' configuration option is set.
2014 If there is an error, returns the error, otherwise returns false.
2018 sub apply_payments_and_credits {
2019 my( $self, %options ) = @_;
2021 local $SIG{HUP} = 'IGNORE';
2022 local $SIG{INT} = 'IGNORE';
2023 local $SIG{QUIT} = 'IGNORE';
2024 local $SIG{TERM} = 'IGNORE';
2025 local $SIG{TSTP} = 'IGNORE';
2026 local $SIG{PIPE} = 'IGNORE';
2028 my $oldAutoCommit = $FS::UID::AutoCommit;
2029 local $FS::UID::AutoCommit = 0;
2032 $self->select_for_update; #mutex
2034 foreach my $cust_bill ( $self->open_cust_bill ) {
2035 my $error = $cust_bill->apply_payments_and_credits(%options);
2037 $dbh->rollback if $oldAutoCommit;
2038 return "Error applying: $error";
2042 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2047 =item apply_credits OPTION => VALUE ...
2049 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2050 to outstanding invoice balances in chronological order (or reverse
2051 chronological order if the I<order> option is set to B<newest>) and returns the
2052 value of any remaining unapplied credits available for refund (see
2053 L<FS::cust_refund>).
2055 Dies if there is an error.
2063 local $SIG{HUP} = 'IGNORE';
2064 local $SIG{INT} = 'IGNORE';
2065 local $SIG{QUIT} = 'IGNORE';
2066 local $SIG{TERM} = 'IGNORE';
2067 local $SIG{TSTP} = 'IGNORE';
2068 local $SIG{PIPE} = 'IGNORE';
2070 my $oldAutoCommit = $FS::UID::AutoCommit;
2071 local $FS::UID::AutoCommit = 0;
2074 $self->select_for_update; #mutex
2076 unless ( $self->total_unapplied_credits ) {
2077 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2081 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2082 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2084 my @invoices = $self->open_cust_bill;
2085 @invoices = sort { $b->_date <=> $a->_date } @invoices
2086 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2088 if ( $conf->exists('pkg-balances') ) {
2089 # limit @credits to those w/ a pkgnum grepped from $self
2091 foreach my $i (@invoices) {
2092 foreach my $li ( $i->cust_bill_pkg ) {
2093 $pkgnums{$li->pkgnum} = 1;
2096 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2101 foreach my $cust_bill ( @invoices ) {
2103 if ( !defined($credit) || $credit->credited == 0) {
2104 $credit = pop @credits or last;
2108 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2109 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2111 $owed = $cust_bill->owed;
2113 unless ( $owed > 0 ) {
2114 push @credits, $credit;
2118 my $amount = min( $credit->credited, $owed );
2120 my $cust_credit_bill = new FS::cust_credit_bill ( {
2121 'crednum' => $credit->crednum,
2122 'invnum' => $cust_bill->invnum,
2123 'amount' => $amount,
2125 $cust_credit_bill->pkgnum( $credit->pkgnum )
2126 if $conf->exists('pkg-balances') && $credit->pkgnum;
2127 my $error = $cust_credit_bill->insert;
2129 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2133 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2137 my $total_unapplied_credits = $self->total_unapplied_credits;
2139 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2141 return $total_unapplied_credits;
2144 =item apply_payments [ OPTION => VALUE ... ]
2146 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2147 to outstanding invoice balances in chronological order.
2149 #and returns the value of any remaining unapplied payments.
2151 A hash of optional arguments may be passed. Currently "manual" is supported.
2152 If true, a payment receipt is sent instead of a statement when
2153 'payment_receipt_email' configuration option is set.
2155 Dies if there is an error.
2159 sub apply_payments {
2160 my( $self, %options ) = @_;
2162 local $SIG{HUP} = 'IGNORE';
2163 local $SIG{INT} = 'IGNORE';
2164 local $SIG{QUIT} = 'IGNORE';
2165 local $SIG{TERM} = 'IGNORE';
2166 local $SIG{TSTP} = 'IGNORE';
2167 local $SIG{PIPE} = 'IGNORE';
2169 my $oldAutoCommit = $FS::UID::AutoCommit;
2170 local $FS::UID::AutoCommit = 0;
2173 $self->select_for_update; #mutex
2177 my @payments = sort { $b->_date <=> $a->_date }
2178 grep { $_->unapplied > 0 }
2181 my @invoices = sort { $a->_date <=> $b->_date}
2182 grep { $_->owed > 0 }
2185 if ( $conf->exists('pkg-balances') ) {
2186 # limit @payments to those w/ a pkgnum grepped from $self
2188 foreach my $i (@invoices) {
2189 foreach my $li ( $i->cust_bill_pkg ) {
2190 $pkgnums{$li->pkgnum} = 1;
2193 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2198 foreach my $cust_bill ( @invoices ) {
2200 if ( !defined($payment) || $payment->unapplied == 0 ) {
2201 $payment = pop @payments or last;
2205 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2206 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2208 $owed = $cust_bill->owed;
2210 unless ( $owed > 0 ) {
2211 push @payments, $payment;
2215 my $amount = min( $payment->unapplied, $owed );
2218 'paynum' => $payment->paynum,
2219 'invnum' => $cust_bill->invnum,
2220 'amount' => $amount,
2222 $cbp->{_date} = $payment->_date
2223 if $options{'manual'} && $options{'backdate_application'};
2224 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2225 $cust_bill_pay->pkgnum( $payment->pkgnum )
2226 if $conf->exists('pkg-balances') && $payment->pkgnum;
2227 my $error = $cust_bill_pay->insert(%options);
2229 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2233 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2237 my $total_unapplied_payments = $self->total_unapplied_payments;
2239 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2241 return $total_unapplied_payments;
2251 suspend_adjourned_pkgs
2252 unsuspend_resumed_pkgs
2255 (do_cust_event pre-bill)
2258 (vendor-only) _gather_taxes
2259 _omit_zero_value_bundles
2262 apply_payments_and_credits
2271 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>