1 package FS::cust_main::Billing;
4 use vars qw( $conf $DEBUG $me );
6 use List::Util qw( min );
8 use FS::Record qw( qsearch qsearchs dbdef );
10 use FS::cust_bill_pkg;
11 use FS::cust_bill_pkg_display;
12 use FS::cust_bill_pay;
13 use FS::cust_credit_bill;
15 use FS::cust_tax_adjustment;
17 use FS::tax_rate_location;
18 use FS::cust_bill_pkg_tax_location;
19 use FS::cust_bill_pkg_tax_rate_location;
21 use FS::part_event_condition;
23 # 1 is mostly method/subroutine entry and options
24 # 2 traces progress of some operations
25 # 3 is even more information including possibly sensitive data
27 $me = '[FS::cust_main::Billing]';
29 install_callback FS::UID sub {
31 #yes, need it for stuff below (prolly should be cached)
36 FS::cust_main::Billing - Billing mixin for cust_main
42 These methods are available on FS::cust_main objects.
48 =item bill_and_collect
50 Cancels and suspends any packages due, generates bills, applies payments and
51 credits, and applies collection events to run cards, send bills and notices,
54 By default, warns on errors and continues with the next operation (but see the
57 Options are passed as name-value pairs. Currently available options are:
63 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:
67 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
71 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.
75 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
79 If set true, re-charges setup fees.
83 If set any errors prevent subsequent operations from continusing. If set
84 specifically to "return", returns the error (or false, if there is no error).
85 Any other true value causes errors to die.
89 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)
93 Optional FS::queue entry to receive status updates.
97 Options are passed to the B<bill> and B<collect> methods verbatim, so all
98 options of those methods are also available.
102 sub bill_and_collect {
103 my( $self, %options ) = @_;
107 #$options{actual_time} not $options{time} because freeside-daily -d is for
108 #pre-printing invoices
110 $options{'actual_time'} ||= time;
111 my $job = $options{'job'};
113 $job->update_statustext('0,cleaning expired packages') if $job;
114 $error = $self->cancel_expired_pkgs( $options{actual_time} );
116 $error = "Error expiring custnum ". $self->custnum. ": $error";
117 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
118 elsif ( $options{fatal} ) { die $error; }
119 else { warn $error; }
122 $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
124 $error = "Error adjourning custnum ". $self->custnum. ": $error";
125 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
126 elsif ( $options{fatal} ) { die $error; }
127 else { warn $error; }
130 $job->update_statustext('20,billing packages') if $job;
131 $error = $self->bill( %options );
133 $error = "Error billing custnum ". $self->custnum. ": $error";
134 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
135 elsif ( $options{fatal} ) { die $error; }
136 else { warn $error; }
139 $job->update_statustext('50,applying payments and credits') if $job;
140 $error = $self->apply_payments_and_credits;
142 $error = "Error applying custnum ". $self->custnum. ": $error";
143 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
144 elsif ( $options{fatal} ) { die $error; }
145 else { warn $error; }
148 $job->update_statustext('70,running collection events') if $job;
149 unless ( $conf->exists('cancelled_cust-noevents')
150 && ! $self->num_ncancelled_pkgs
152 $error = $self->collect( %options );
154 $error = "Error collecting custnum ". $self->custnum. ": $error";
155 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
156 elsif ($options{fatal} ) { die $error; }
157 else { warn $error; }
160 $job->update_statustext('100,finished') if $job;
166 sub cancel_expired_pkgs {
167 my ( $self, $time, %options ) = @_;
169 my @cancel_pkgs = $self->ncancelled_pkgs( {
170 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
175 foreach my $cust_pkg ( @cancel_pkgs ) {
176 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
177 my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum,
178 'reason_otaker' => $cpr->otaker
182 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
185 scalar(@errors) ? join(' / ', @errors) : '';
189 sub suspend_adjourned_pkgs {
190 my ( $self, $time, %options ) = @_;
192 my @susp_pkgs = $self->ncancelled_pkgs( {
194 " AND ( susp IS NULL OR susp = 0 )
195 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
196 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
201 #only because there's no SQL test for is_prepaid :/
203 grep { ( $_->part_pkg->is_prepaid
208 && $_->adjourn <= $time
216 foreach my $cust_pkg ( @susp_pkgs ) {
217 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
218 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
219 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
220 'reason_otaker' => $cpr->otaker
224 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
227 scalar(@errors) ? join(' / ', @errors) : '';
233 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
234 conjunction with the collect method by calling B<bill_and_collect>.
236 If there is an error, returns the error, otherwise returns false.
238 Options are passed as name-value pairs. Currently available options are:
244 If set true, re-charges setup fees.
248 If set true then only bill recurring charges, not setup, usage, one time
253 If set, then override the normal frequency and look for a part_pkg_discount
254 to take at that frequency.
258 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:
262 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
266 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
268 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
272 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
276 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.
280 This boolean value informs the us that the package is being cancelled. This
281 typically might mean not charging the normal recurring fee but only usage
282 fees since the last billing. Setup charges may be charged. Not all package
283 plans support this feature (they tend to charge 0).
287 Prevent the resetting of usage limits during this call.
291 Do not save the generated bill in the database. Useful with return_bill
295 A list reference on which the generated bill(s) will be returned.
299 Optional terms to be printed on this invoice. Otherwise, customer-specific
300 terms or the default terms are used.
307 my( $self, %options ) = @_;
308 return '' if $self->payby eq 'COMP';
309 warn "$me bill customer ". $self->custnum. "\n"
312 my $time = $options{'time'} || time;
313 my $invoice_time = $options{'invoice_time'} || $time;
315 $options{'not_pkgpart'} ||= {};
316 $options{'not_pkgpart'} = { map { $_ => 1 }
317 split(/\s*,\s*/, $options{'not_pkgpart'})
319 unless ref($options{'not_pkgpart'});
321 local $SIG{HUP} = 'IGNORE';
322 local $SIG{INT} = 'IGNORE';
323 local $SIG{QUIT} = 'IGNORE';
324 local $SIG{TERM} = 'IGNORE';
325 local $SIG{TSTP} = 'IGNORE';
326 local $SIG{PIPE} = 'IGNORE';
328 my $oldAutoCommit = $FS::UID::AutoCommit;
329 local $FS::UID::AutoCommit = 0;
332 warn "$me acquiring lock on customer ". $self->custnum. "\n"
335 $self->select_for_update; #mutex
337 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
340 my $error = $self->do_cust_event(
341 'debug' => ( $options{'debug'} || 0 ),
342 'time' => $invoice_time,
343 'check_freq' => $options{'check_freq'},
344 'stage' => 'pre-bill',
346 unless $options{no_commit};
348 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
352 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
355 #keep auto-charge and non-auto-charge line items separate
356 my @passes = ( '', 'no_auto' );
358 my %cust_bill_pkg = map { $_ => [] } @passes;
361 # find the packages which are due for billing, find out how much they are
362 # & generate invoice database.
365 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
366 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
368 my %taxlisthash = map { $_ => {} } @passes;
370 my @precommit_hooks = ();
372 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
373 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
375 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
377 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
379 #? to avoid use of uninitialized value errors... ?
380 $cust_pkg->setfield('bill', '')
381 unless defined($cust_pkg->bill);
383 #my $part_pkg = $cust_pkg->part_pkg;
385 my $real_pkgpart = $cust_pkg->pkgpart;
386 my %hash = $cust_pkg->hash;
388 # we could implement this bit as FS::part_pkg::has_hidden, but we already
389 # suffer from performance issues
390 $options{has_hidden} = 0;
391 my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
392 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
394 foreach my $part_pkg ( @part_pkg ) {
396 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
398 my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
401 $self->_make_lines( 'part_pkg' => $part_pkg,
402 'cust_pkg' => $cust_pkg,
403 'precommit_hooks' => \@precommit_hooks,
404 'line_items' => $cust_bill_pkg{$pass},
405 'setup' => $total_setup{$pass},
406 'recur' => $total_recur{$pass},
407 'tax_matrix' => $taxlisthash{$pass},
409 'real_pkgpart' => $real_pkgpart,
410 'options' => \%options,
413 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
417 } #foreach my $part_pkg
419 } #foreach my $cust_pkg
421 #if the customer isn't on an automatic payby, everything can go on a single
423 #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
424 #merge everything into one list
427 foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
429 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
431 next unless @cust_bill_pkg; #don't create an invoice w/o line items
433 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
434 !$conf->exists('postal_invoice-recurring_only')
438 my $postal_pkg = $self->charge_postal_fee();
439 if ( $postal_pkg && !ref( $postal_pkg ) ) {
441 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
442 return "can't charge postal invoice fee for customer ".
443 $self->custnum. ": $postal_pkg";
445 } elsif ( $postal_pkg ) {
447 my $real_pkgpart = $postal_pkg->pkgpart;
448 # we could implement this bit as FS::part_pkg::has_hidden, but we already
449 # suffer from performance issues
450 $options{has_hidden} = 0;
451 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
452 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
454 foreach my $part_pkg ( @part_pkg ) {
455 my %postal_options = %options;
456 delete $postal_options{cancel};
458 $self->_make_lines( 'part_pkg' => $part_pkg,
459 'cust_pkg' => $postal_pkg,
460 'precommit_hooks' => \@precommit_hooks,
461 'line_items' => \@cust_bill_pkg,
462 'setup' => $total_setup{$pass},
463 'recur' => $total_recur{$pass},
464 'tax_matrix' => $taxlisthash{$pass},
466 'real_pkgpart' => $real_pkgpart,
467 'options' => \%postal_options,
470 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
475 # it's silly to have a zero value postal_pkg, but....
476 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
482 my $listref_or_error =
483 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
485 unless ( ref( $listref_or_error ) ) {
486 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
487 return $listref_or_error;
490 foreach my $taxline ( @$listref_or_error ) {
491 ${ $total_setup{$pass} } =
492 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
493 push @cust_bill_pkg, $taxline;
497 warn "adding tax adjustments...\n" if $DEBUG > 2;
498 foreach my $cust_tax_adjustment (
499 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
505 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
507 my $itemdesc = $cust_tax_adjustment->taxname;
508 $itemdesc = '' if $itemdesc eq 'Tax';
510 push @cust_bill_pkg, new FS::cust_bill_pkg {
516 'itemdesc' => $itemdesc,
517 'itemcomment' => $cust_tax_adjustment->comment,
518 'cust_tax_adjustment' => $cust_tax_adjustment,
519 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
524 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
526 my @cust_bill = $self->cust_bill;
527 my $balance = $self->balance;
528 my $previous_balance = scalar(@cust_bill)
529 ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
532 $previous_balance += $cust_bill[$#cust_bill]->charged
533 if scalar(@cust_bill);
534 #my $balance_adjustments =
535 # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
537 warn "creating the new invoice\n" if $DEBUG;
538 #create the new invoice
539 my $cust_bill = new FS::cust_bill ( {
540 'custnum' => $self->custnum,
541 '_date' => ( $invoice_time ),
542 'charged' => $charged,
543 'billing_balance' => $balance,
544 'previous_balance' => $previous_balance,
545 'invoice_terms' => $options{'invoice_terms'},
546 'cust_bill_pkg' => \@cust_bill_pkg,
548 $error = $cust_bill->insert unless $options{no_commit};
550 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
551 return "can't create invoice for customer #". $self->custnum. ": $error";
553 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
555 } #foreach my $pass ( keys %cust_bill_pkg )
557 foreach my $hook ( @precommit_hooks ) {
560 } unless $options{no_commit};
562 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
563 return "$@ running precommit hook $hook\n";
567 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
572 #discard bundled packages of 0 value
573 sub _omit_zero_value_bundles {
575 my @cust_bill_pkg = ();
576 my @cust_bill_pkg_bundle = ();
579 foreach my $cust_bill_pkg ( @_ ) {
580 if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
581 push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
582 @cust_bill_pkg_bundle = ();
585 $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
586 push @cust_bill_pkg_bundle, $cust_bill_pkg;
588 push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
594 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
596 This is a weird one. Perhaps it should not even be exposed.
598 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
599 Usually used internally by bill method B<bill>.
601 If there is an error, returns the error, otherwise returns reference to a
602 list of line items suitable for insertion.
608 An array ref of the line items being billed.
612 A strange beast. The keys to this hash are internal identifiers consisting
613 of the name of the tax object type, a space, and its unique identifier ( e.g.
614 'cust_main_county 23' ). The values of the hash are listrefs. The first
615 item in the list is the tax object. The remaining items are either line
616 items or floating point values (currency amounts).
618 The taxes are calculated on this entity. Calculated exemption records are
619 transferred to the LINEITEMREF items on the assumption that they are related.
625 This specifies the date appearing on the associated invoice. Some
626 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
631 sub calculate_taxes {
632 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
634 my @tax_line_items = ();
636 warn "having a look at the taxes we found...\n" if $DEBUG > 2;
638 # keys are tax names (as printed on invoices / itemdesc )
639 # values are listrefs of taxlisthash keys (internal identifiers)
642 # keys are taxlisthash keys (internal identifiers)
643 # values are (cumulative) amounts
646 # keys are taxlisthash keys (internal identifiers)
647 # values are listrefs of cust_bill_pkg_tax_location hashrefs
648 my %tax_location = ();
650 # keys are taxlisthash keys (internal identifiers)
651 # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
652 my %tax_rate_location = ();
654 foreach my $tax ( keys %$taxlisthash ) {
655 my $tax_object = shift @{ $taxlisthash->{$tax} };
656 warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
657 warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
658 my $hashref_or_error =
659 $tax_object->taxline( $taxlisthash->{$tax},
660 'custnum' => $self->custnum,
661 'invoice_time' => $invoice_time
663 return $hashref_or_error unless ref($hashref_or_error);
665 unshift @{ $taxlisthash->{$tax} }, $tax_object;
667 my $name = $hashref_or_error->{'name'};
668 my $amount = $hashref_or_error->{'amount'};
670 #warn "adding $amount as $name\n";
671 $taxname{ $name } ||= [];
672 push @{ $taxname{ $name } }, $tax;
674 $tax{ $tax } += $amount;
676 $tax_location{ $tax } ||= [];
677 if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
678 push @{ $tax_location{ $tax } },
680 'taxnum' => $tax_object->taxnum,
681 'taxtype' => ref($tax_object),
682 'pkgnum' => $tax_object->get('pkgnum'),
683 'locationnum' => $tax_object->get('locationnum'),
684 'amount' => sprintf('%.2f', $amount ),
688 $tax_rate_location{ $tax } ||= [];
689 if ( ref($tax_object) eq 'FS::tax_rate' ) {
690 my $taxratelocationnum =
691 $tax_object->tax_rate_location->taxratelocationnum;
692 push @{ $tax_rate_location{ $tax } },
694 'taxnum' => $tax_object->taxnum,
695 'taxtype' => ref($tax_object),
696 'amount' => sprintf('%.2f', $amount ),
697 'locationtaxid' => $tax_object->location,
698 'taxratelocationnum' => $taxratelocationnum,
704 #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
705 my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
706 foreach my $tax ( keys %$taxlisthash ) {
707 foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
708 next unless ref($_) eq 'FS::cust_bill_pkg';
710 push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
711 splice( @{ $_->_cust_tax_exempt_pkg } );
715 #consolidate and create tax line items
716 warn "consolidating and generating...\n" if $DEBUG > 2;
717 foreach my $taxname ( keys %taxname ) {
720 my @cust_bill_pkg_tax_location = ();
721 my @cust_bill_pkg_tax_rate_location = ();
722 warn "adding $taxname\n" if $DEBUG > 1;
723 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
724 next if $seen{$taxitem}++;
725 warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
726 $tax += $tax{$taxitem};
727 push @cust_bill_pkg_tax_location,
728 map { new FS::cust_bill_pkg_tax_location $_ }
729 @{ $tax_location{ $taxitem } };
730 push @cust_bill_pkg_tax_rate_location,
731 map { new FS::cust_bill_pkg_tax_rate_location $_ }
732 @{ $tax_rate_location{ $taxitem } };
736 $tax = sprintf('%.2f', $tax );
738 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
744 if ( $pkg_category and
745 $conf->config('invoice_latexsummary') ||
746 $conf->config('invoice_htmlsummary')
750 my %hash = ( 'section' => $pkg_category->categoryname );
751 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
755 push @tax_line_items, new FS::cust_bill_pkg {
761 'itemdesc' => $taxname,
762 'display' => \@display,
763 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
764 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
773 my ($self, %params) = @_;
775 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
776 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
777 my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
778 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
779 my $total_setup = $params{setup} or die "no setup accumulator specified";
780 my $total_recur = $params{recur} or die "no recur accumulator specified";
781 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
782 my $time = $params{'time'} or die "no time specified";
783 my (%options) = %{$params{options}};
786 my $real_pkgpart = $params{real_pkgpart};
787 my %hash = $cust_pkg->hash;
788 my $old_cust_pkg = new FS::cust_pkg \%hash;
794 $cust_pkg->pkgpart($part_pkg->pkgpart);
802 if ( $options{'resetup'}
803 || ( ! $cust_pkg->setup
804 && ( ! $cust_pkg->start_date
805 || $cust_pkg->start_date <= $time
807 && ( ! $conf->exists('disable_setup_suspended_pkgs')
808 || ( $conf->exists('disable_setup_suspended_pkgs') &&
809 ! $cust_pkg->getfield('susp')
813 and !$options{recurring_only}
817 warn " bill setup\n" if $DEBUG > 1;
820 $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
821 return "$@ running calc_setup for $cust_pkg\n"
824 $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
826 $cust_pkg->setfield('setup', $time)
827 unless $cust_pkg->setup;
828 #do need it, but it won't get written to the db
829 #|| $cust_pkg->pkgpart != $real_pkgpart;
831 $cust_pkg->setfield('start_date', '')
832 if $cust_pkg->start_date;
840 #XXX unit stuff here too
844 if ( ! $cust_pkg->get('susp')
845 and ! $cust_pkg->get('start_date')
846 and ( $part_pkg->getfield('freq') ne '0'
847 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
849 || ( $part_pkg->plan eq 'voip_cdr'
850 && $part_pkg->option('bill_every_call')
852 || ( $options{cancel} )
855 # XXX should this be a package event? probably. events are called
856 # at collection time at the moment, though...
857 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
858 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
859 #don't want to reset usage just cause we want a line item??
860 #&& $part_pkg->pkgpart == $real_pkgpart;
862 warn " bill recur\n" if $DEBUG > 1;
865 # XXX shared with $recur_prog
866 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
870 #over two params! lets at least switch to a hashref for the rest...
871 my $increment_next_bill = ( $part_pkg->freq ne '0'
872 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
875 my %param = ( 'precommit_hooks' => $precommit_hooks,
876 'increment_next_bill' => $increment_next_bill,
877 'discounts' => \@discounts,
878 'real_pkgpart' => $real_pkgpart,
879 'freq_override' => $options{freq_override} || '',
882 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
884 # There may be some part_pkg for which this is wrong. Only those
885 # which can_discount are supported.
887 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
888 return "$@ running $method for $cust_pkg\n"
891 if ( $increment_next_bill ) {
893 my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
894 return "unparsable frequency: ". $part_pkg->freq
897 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
898 # only for figuring next bill date, nothing else, so, reset $sdate again
900 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
901 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
902 $cust_pkg->last_bill($sdate);
904 $cust_pkg->setfield('bill', $next_bill );
910 warn "\$setup is undefined" unless defined($setup);
911 warn "\$recur is undefined" unless defined($recur);
912 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
915 # If there's line items, create em cust_bill_pkg records
916 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
919 if ( $lineitems || $options{has_hidden} ) {
921 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
922 # hmm.. and if just the options are modified in some weird price plan?
924 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
927 my $error = $cust_pkg->replace( $old_cust_pkg,
928 'options' => { $cust_pkg->options },
930 unless $options{no_commit};
931 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
932 if $error; #just in case
935 $setup = sprintf( "%.2f", $setup );
936 $recur = sprintf( "%.2f", $recur );
937 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
938 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
940 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
941 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
946 !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
949 warn " charges (setup=$setup, recur=$recur); adding line items\n"
952 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
954 warn " adding customer package invoice detail: $_\n"
955 foreach @cust_pkg_detail;
957 push @details, @cust_pkg_detail;
959 my $cust_bill_pkg = new FS::cust_bill_pkg {
960 'pkgnum' => $cust_pkg->pkgnum,
962 'unitsetup' => $unitsetup,
964 'unitrecur' => $unitrecur,
965 'quantity' => $cust_pkg->quantity,
966 'details' => \@details,
967 'discounts' => \@discounts,
968 'hidden' => $part_pkg->hidden,
969 'freq' => $part_pkg->freq,
972 if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
973 $cust_bill_pkg->sdate( $hash{last_bill} );
974 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
975 $cust_bill_pkg->edate( $time ) if $options{cancel};
976 } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
977 $cust_bill_pkg->sdate( $sdate );
978 $cust_bill_pkg->edate( $cust_pkg->bill );
979 #$cust_bill_pkg->edate( $time ) if $options{cancel};
982 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
983 unless $part_pkg->pkgpart == $real_pkgpart;
985 $$total_setup += $setup;
986 $$total_recur += $recur;
993 $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
994 return $error if $error;
996 push @$cust_bill_pkgs, $cust_bill_pkg;
998 } #if $setup != 0 || $recur != 0
1008 my $part_pkg = shift;
1009 my $taxlisthash = shift;
1010 my $cust_bill_pkg = shift;
1011 my $cust_pkg = shift;
1012 my $invoice_time = shift;
1013 my $real_pkgpart = shift;
1014 my $options = shift;
1016 my %cust_bill_pkg = ();
1020 #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
1021 push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
1022 push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
1023 push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
1025 if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
1027 if ( $conf->exists('enable_taxproducts')
1028 && ( scalar($part_pkg->part_pkg_taxoverride)
1029 || $part_pkg->has_taxproduct
1034 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1035 return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
1038 foreach my $class (@classes) {
1039 my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
1040 return $err_or_ref unless ref($err_or_ref);
1041 $taxes{$class} = $err_or_ref;
1044 unless (exists $taxes{''}) {
1045 my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
1046 return $err_or_ref unless ref($err_or_ref);
1047 $taxes{''} = $err_or_ref;
1052 my @loc_keys = qw( city county state country );
1054 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1055 my $cust_location = $cust_pkg->cust_location;
1056 %taxhash = map { $_ => $cust_location->$_() } @loc_keys;
1059 ( $conf->exists('tax-ship_address') && length($self->ship_last) )
1062 %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
1065 $taxhash{'taxclass'} = $part_pkg->taxclass;
1068 my %taxhash_elim = %taxhash;
1069 my @elim = qw( city county state );
1072 #first try a match with taxclass
1073 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1075 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1076 #then try a match without taxclass
1077 my %no_taxclass = %taxhash_elim;
1078 $no_taxclass{ 'taxclass' } = '';
1079 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1082 $taxhash_elim{ shift(@elim) } = '';
1084 } while ( !scalar(@taxes) && scalar(@elim) );
1086 @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
1088 if $self->cust_main_exemption; #just to be safe
1090 if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
1092 $_->set('pkgnum', $cust_pkg->pkgnum );
1093 $_->set('locationnum', $cust_pkg->locationnum );
1097 $taxes{''} = [ @taxes ];
1098 $taxes{'setup'} = [ @taxes ];
1099 $taxes{'recur'} = [ @taxes ];
1100 $taxes{$_} = [ @taxes ] foreach (@classes);
1102 # # maybe eliminate this entirely, along with all the 0% records
1103 # unless ( @taxes ) {
1105 # "fatal: can't find tax rate for state/county/country/taxclass ".
1106 # join('/', map $taxhash{$_}, qw(state county country taxclass) );
1109 } #if $conf->exists('enable_taxproducts') ...
1114 my $separate = $conf->exists('separate_usage');
1115 my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
1116 my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
1117 my $section = $temp_pkg->part_pkg->categoryname;
1118 if ( $separate || $section || $usage_mandate ) {
1120 my %hash = ( 'section' => $section );
1122 $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
1123 my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
1125 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1126 push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
1128 push @display, new FS::cust_bill_pkg_display
1131 ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
1135 if ($separate && $section && $summary) {
1136 push @display, new FS::cust_bill_pkg_display { type => 'U',
1141 if ($usage_mandate || $section && $summary) {
1142 $hash{post_total} = 'Y';
1145 if ($separate || $usage_mandate) {
1146 $hash{section} = $section if ($separate || $usage_mandate);
1147 push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
1151 $cust_bill_pkg->set('display', \@display);
1153 my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1154 foreach my $key (keys %tax_cust_bill_pkg) {
1155 my @taxes = @{ $taxes{$key} || [] };
1156 my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
1158 my %localtaxlisthash = ();
1159 foreach my $tax ( @taxes ) {
1161 my $taxname = ref( $tax ). ' '. $tax->taxnum;
1162 # $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
1163 # ' locationnum'. $cust_pkg->locationnum
1164 # if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
1166 $taxlisthash->{ $taxname } ||= [ $tax ];
1167 push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg;
1169 $localtaxlisthash{ $taxname } ||= [ $tax ];
1170 push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg;
1174 warn "finding taxed taxes...\n" if $DEBUG > 2;
1175 foreach my $tax ( keys %localtaxlisthash ) {
1176 my $tax_object = shift @{ $localtaxlisthash{$tax} };
1177 warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
1179 next unless $tax_object->can('tax_on_tax');
1181 foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
1182 my $totname = ref( $tot ). ' '. $tot->taxnum;
1184 warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
1186 next unless exists( $localtaxlisthash{ $totname } ); # only increase
1188 warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
1189 my $hashref_or_error =
1190 $tax_object->taxline( $localtaxlisthash{$tax},
1191 'custnum' => $self->custnum,
1192 'invoice_time' => $invoice_time,
1194 return $hashref_or_error
1195 unless ref($hashref_or_error);
1197 $taxlisthash->{ $totname } ||= [ $tot ];
1198 push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount};
1210 my $part_pkg = shift;
1214 my $geocode = $self->geocode('cch');
1216 my @taxclassnums = map { $_->taxclassnum }
1217 $part_pkg->part_pkg_taxoverride($class);
1219 unless (@taxclassnums) {
1220 @taxclassnums = map { $_->taxclassnum }
1221 grep { $_->taxable eq 'Y' }
1222 $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
1224 warn "Found taxclassnum values of ". join(',', @taxclassnums)
1229 join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
1231 @taxes = qsearch({ 'table' => 'tax_rate',
1232 'hashref' => { 'geocode' => $geocode, },
1233 'extra_sql' => $extra_sql,
1235 if scalar(@taxclassnums);
1237 warn "Found taxes ".
1238 join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
1245 =item collect [ HASHREF | OPTION => VALUE ... ]
1247 (Attempt to) collect money for this customer's outstanding invoices (see
1248 L<FS::cust_bill>). Usually used after the bill method.
1250 Actions are now triggered by billing events; see L<FS::part_event> and the
1251 billing events web interface. Old-style invoice events (see
1252 L<FS::part_bill_event>) have been deprecated.
1254 If there is an error, returns the error, otherwise returns false.
1256 Options are passed as name-value pairs.
1258 Currently available options are:
1264 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.
1268 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1272 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1276 set true to surpress email card/ACH decline notices.
1280 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)
1286 # allows for one time override of normal customer billing method
1291 my( $self, %options ) = @_;
1292 my $invoice_time = $options{'invoice_time'} || time;
1295 local $SIG{HUP} = 'IGNORE';
1296 local $SIG{INT} = 'IGNORE';
1297 local $SIG{QUIT} = 'IGNORE';
1298 local $SIG{TERM} = 'IGNORE';
1299 local $SIG{TSTP} = 'IGNORE';
1300 local $SIG{PIPE} = 'IGNORE';
1302 my $oldAutoCommit = $FS::UID::AutoCommit;
1303 local $FS::UID::AutoCommit = 0;
1306 $self->select_for_update; #mutex
1309 my $balance = $self->balance;
1310 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1313 if ( exists($options{'retry_card'}) ) {
1314 carp 'retry_card option passed to collect is deprecated; use retry';
1315 $options{'retry'} ||= $options{'retry_card'};
1317 if ( exists($options{'retry'}) && $options{'retry'} ) {
1318 my $error = $self->retry_realtime;
1320 $dbh->rollback if $oldAutoCommit;
1325 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1327 #never want to roll back an event just because it returned an error
1328 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1330 $self->do_cust_event(
1331 'debug' => ( $options{'debug'} || 0 ),
1332 'time' => $invoice_time,
1333 'check_freq' => $options{'check_freq'},
1334 'stage' => 'collect',
1339 =item retry_realtime
1341 Schedules realtime / batch credit card / electronic check / LEC billing
1342 events for for retry. Useful if card information has changed or manual
1343 retry is desired. The 'collect' method must be called to actually retry
1346 Implementation details: For either this customer, or for each of this
1347 customer's open invoices, changes the status of the first "done" (with
1348 statustext error) realtime processing event to "failed".
1352 sub retry_realtime {
1355 local $SIG{HUP} = 'IGNORE';
1356 local $SIG{INT} = 'IGNORE';
1357 local $SIG{QUIT} = 'IGNORE';
1358 local $SIG{TERM} = 'IGNORE';
1359 local $SIG{TSTP} = 'IGNORE';
1360 local $SIG{PIPE} = 'IGNORE';
1362 my $oldAutoCommit = $FS::UID::AutoCommit;
1363 local $FS::UID::AutoCommit = 0;
1366 #a little false laziness w/due_cust_event (not too bad, really)
1368 my $join = FS::part_event_condition->join_conditions_sql;
1369 my $order = FS::part_event_condition->order_conditions_sql;
1372 . join ( ' OR ' , map {
1373 "( part_event.eventtable = " . dbh->quote($_)
1374 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
1375 } FS::part_event->eventtables)
1378 #here is the agent virtualization
1379 my $agent_virt = " ( part_event.agentnum IS NULL
1380 OR part_event.agentnum = ". $self->agentnum. ' )';
1382 #XXX this shouldn't be hardcoded, actions should declare it...
1383 my @realtime_events = qw(
1384 cust_bill_realtime_card
1385 cust_bill_realtime_check
1386 cust_bill_realtime_lec
1390 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
1395 my @cust_event = qsearchs({
1396 'table' => 'cust_event',
1397 'select' => 'cust_event.*',
1398 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
1399 'hashref' => { 'status' => 'done' },
1400 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
1401 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
1404 my %seen_invnum = ();
1405 foreach my $cust_event (@cust_event) {
1407 #max one for the customer, one for each open invoice
1408 my $cust_X = $cust_event->cust_X;
1409 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
1413 or $cust_event->part_event->eventtable eq 'cust_bill'
1416 my $error = $cust_event->retry;
1418 $dbh->rollback if $oldAutoCommit;
1419 return "error scheduling event for retry: $error";
1424 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1429 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
1431 Runs billing events; see L<FS::part_event> and the billing events web
1434 If there is an error, returns the error, otherwise returns false.
1436 Options are passed as name-value pairs.
1438 Currently available options are:
1444 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.
1448 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1452 "collect" (the default) or "pre-bill"
1456 set true to surpress email card/ACH decline notices.
1460 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)
1467 # allows for one time override of normal customer billing method
1471 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1474 my( $self, %options ) = @_;
1475 my $time = $options{'time'} || time;
1478 local $SIG{HUP} = 'IGNORE';
1479 local $SIG{INT} = 'IGNORE';
1480 local $SIG{QUIT} = 'IGNORE';
1481 local $SIG{TERM} = 'IGNORE';
1482 local $SIG{TSTP} = 'IGNORE';
1483 local $SIG{PIPE} = 'IGNORE';
1485 my $oldAutoCommit = $FS::UID::AutoCommit;
1486 local $FS::UID::AutoCommit = 0;
1489 $self->select_for_update; #mutex
1492 my $balance = $self->balance;
1493 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
1496 # if ( exists($options{'retry_card'}) ) {
1497 # carp 'retry_card option passed to collect is deprecated; use retry';
1498 # $options{'retry'} ||= $options{'retry_card'};
1500 # if ( exists($options{'retry'}) && $options{'retry'} ) {
1501 # my $error = $self->retry_realtime;
1503 # $dbh->rollback if $oldAutoCommit;
1508 # false laziness w/pay_batch::import_results
1510 my $due_cust_event = $self->due_cust_event(
1511 'debug' => ( $options{'debug'} || 0 ),
1513 'check_freq' => $options{'check_freq'},
1514 'stage' => ( $options{'stage'} || 'collect' ),
1516 unless( ref($due_cust_event) ) {
1517 $dbh->rollback if $oldAutoCommit;
1518 return $due_cust_event;
1521 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1522 #never want to roll back an event just because it or a different one
1524 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1526 foreach my $cust_event ( @$due_cust_event ) {
1530 #re-eval event conditions (a previous event could have changed things)
1531 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
1532 #don't leave stray "new/locked" records around
1533 my $error = $cust_event->delete;
1534 return $error if $error;
1539 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
1540 if $options{'quiet'};
1541 warn " running cust_event ". $cust_event->eventnum. "\n"
1544 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
1545 if ( my $error = $cust_event->do_event() ) {
1546 #XXX wtf is this? figure out a proper dealio with return value
1558 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
1560 Inserts database records for and returns an ordered listref of new events due
1561 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
1562 events are due, an empty listref is returned. If there is an error, returns a
1563 scalar error message.
1565 To actually run the events, call each event's test_condition method, and if
1566 still true, call the event's do_event method.
1568 Options are passed as a hashref or as a list of name-value pairs. Available
1575 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.
1579 "collect" (the default) or "pre-bill"
1583 "Current time" for the events.
1587 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
1591 Only return events for the specified eventtable (by default, events of all eventtables are returned)
1595 Explicitly pass the objects to be tested (typically used with eventtable).
1599 Set to true to return the objects, but not actually insert them into the
1602 =item discount_terms
1604 Returns a list of lengths for term discounts
1608 sub _discount_pkgs_and_bill {
1611 my @cust_bill = $self->cust_bill;
1612 my $cust_bill = pop @cust_bill;
1613 return () unless $cust_bill && $cust_bill->owed;
1616 push @where, "cust_bill_pkg.invnum = ". $cust_bill->invnum;
1617 push @where, "cust_bill_pkg.pkgpart_override IS NULL";
1618 push @where, "part_pkg.freq = 1";
1619 push @where, "(cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0)";
1620 push @where, "(cust_pkg.susp IS NULL OR cust_pkg.susp = 0)";
1621 push @where, "0<(SELECT count(*) FROM part_pkg_discount
1622 WHERE part_pkg.pkgpart = part_pkg_discount.pkgpart)";
1624 "0=(SELECT count(*) FROM cust_bill_pkg_discount
1625 WHERE cust_bill_pkg.billpkgnum = cust_bill_pkg_discount.billpkgnum)";
1627 my $extra_sql = 'WHERE '. join(' AND ', @where);
1631 'table' => 'cust_pkg',
1632 'select' => "DISTINCT cust_pkg.*",
1633 'addl_from' => 'JOIN cust_bill_pkg USING(pkgnum) '.
1634 'JOIN part_pkg USING(pkgpart)',
1636 'extra_sql' => $extra_sql,
1639 ($cust_bill, @cust_pkg);
1642 sub _discountable_pkgs_at_term {
1643 my ($term, @pkgs) = @_;
1644 my $part_pkg = new FS::part_pkg { freq => $term - 1 };
1645 grep { ( !$_->adjourn || $_->adjourn > $part_pkg->add_freq($_->bill) ) &&
1646 ( !$_->expire || $_->expire > $part_pkg->add_freq($_->bill) )
1651 =item discount_terms
1653 Returns a list of lengths for term discounts
1657 sub discount_terms {
1662 my @discount_pkgs = $self->_discount_pkgs_and_bill;
1663 shift @discount_pkgs; #discard bill;
1665 map { $terms{$_->months} = 1 }
1666 grep { $_->months && $_->months > 1 }
1667 map { $_->discount }
1668 map { $_->part_pkg->part_pkg_discount }
1671 return sort { $a <=> $b } keys %terms;
1677 =item discount_term_values MONTHS
1679 Returns a list with credit, dollar amount saved, and total bill acheived
1680 by prepaying the most recent invoice for MONTHS.
1684 sub discount_term_values {
1687 warn "$me discount_term_values called with $term\n" if $DEBUG;
1691 my @packages = $self->_discount_pkgs_and_bill;
1692 my $cust_bill = shift(@packages);
1693 @packages = _discountable_pkgs_at_term( $term, @packages );
1694 return () unless scalar(@packages);
1696 $_->bill($_->last_bill) foreach @packages;
1697 my @final = map { new FS::cust_pkg { $_->hash } } @packages;
1700 'recurring_only' => 1,
1701 'no_usage_reset' => 1,
1706 'return_bill' => [],
1707 'pkg_list' => \@packages,
1708 'time' => $cust_bill->_date,
1711 my $error = $self->bill(%options, %params);
1712 die $error if $error; # XXX think about this a bit more
1715 $credit += $_->charged foreach @{$params{return_bill}};
1716 $credit = sprintf('%.2f', $credit);
1717 warn "$me discount_term_values $term credit: $credit\n" if $DEBUG;
1720 'return_bill' => [],
1721 'pkg_list' => \@packages,
1722 'time' => $packages[0]->part_pkg->add_freq($cust_bill->_date)
1725 $error = $self->bill(%options, %params);
1726 die $error if $error; # XXX think about this a bit more
1729 $next += $_->charged foreach @{$params{return_bill}};
1730 warn "$me discount_term_values $term next: $next\n" if $DEBUG;
1733 'return_bill' => [],
1734 'pkg_list' => \@final,
1735 'time' => $cust_bill->_date,
1736 'freq_override' => $term,
1739 $error = $self->bill(%options, %params);
1740 die $error if $error; # XXX think about this a bit more
1742 my $final = $self->balance - $credit;
1743 $final += $_->charged foreach @{$params{return_bill}};
1744 $final = sprintf('%.2f', $final);
1745 warn "$me discount_term_values $term final: $final\n" if $DEBUG;
1747 my $savings = sprintf('%.2f', $self->balance + ($term - 1) * $next - $final);
1749 ( $credit, $savings, $final );
1753 sub discount_terms_hash {
1757 my @terms = $self->discount_terms;
1758 foreach my $term (@terms) {
1759 my @result = $self->discount_term_values($term);
1760 $result{$term} = [ @result ] if scalar(@result);
1771 sub due_cust_event {
1773 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
1776 #my $DEBUG = $opt{'debug'}
1777 local($DEBUG) = $opt{'debug'}
1778 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
1780 warn "$me due_cust_event called with options ".
1781 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
1784 $opt{'time'} ||= time;
1786 local $SIG{HUP} = 'IGNORE';
1787 local $SIG{INT} = 'IGNORE';
1788 local $SIG{QUIT} = 'IGNORE';
1789 local $SIG{TERM} = 'IGNORE';
1790 local $SIG{TSTP} = 'IGNORE';
1791 local $SIG{PIPE} = 'IGNORE';
1793 my $oldAutoCommit = $FS::UID::AutoCommit;
1794 local $FS::UID::AutoCommit = 0;
1797 $self->select_for_update #mutex
1798 unless $opt{testonly};
1801 # find possible events (initial search)
1804 my @cust_event = ();
1806 my @eventtable = $opt{'eventtable'}
1807 ? ( $opt{'eventtable'} )
1808 : FS::part_event->eventtables_runorder;
1810 my $check_freq = $opt{'check_freq'} || '1d';
1812 foreach my $eventtable ( @eventtable ) {
1815 if ( $opt{'objects'} ) {
1817 @objects = @{ $opt{'objects'} };
1821 #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
1822 if ( $eventtable eq 'cust_main' ) {
1823 @objects = ( $self );
1827 "LEFT JOIN cust_main USING ( custnum )";
1829 #some false laziness w/Cron::bill bill_where
1831 my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
1832 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
1833 'time'=>$opt{'time'},
1835 $where = $where ? "AND $where" : '';
1837 my $are_part_event =
1838 "EXISTS ( SELECT 1 FROM part_event $join
1839 WHERE check_freq = '$check_freq'
1840 AND eventtable = '$eventtable'
1841 AND ( disabled = '' OR disabled IS NULL )
1847 @objects = $self->$eventtable(
1848 'addl_from' => $cm_join,
1849 'extra_sql' => " AND $are_part_event",
1855 my @e_cust_event = ();
1857 my $cross = "CROSS JOIN $eventtable";
1858 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
1859 unless $eventtable eq 'cust_main';
1861 foreach my $object ( @objects ) {
1863 #this first search uses the condition_sql magic for optimization.
1864 #the more possible events we can eliminate in this step the better
1866 my $cross_where = '';
1867 my $pkey = $object->primary_key;
1868 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
1870 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
1872 FS::part_event_condition->where_conditions_sql( $eventtable,
1873 'time'=>$opt{'time'}
1875 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
1877 $extra_sql = "AND $extra_sql" if $extra_sql;
1879 #here is the agent virtualization
1880 $extra_sql .= " AND ( part_event.agentnum IS NULL
1881 OR part_event.agentnum = ". $self->agentnum. ' )';
1883 $extra_sql .= " $order";
1885 warn "searching for events for $eventtable ". $object->$pkey. "\n"
1886 if $opt{'debug'} > 2;
1887 my @part_event = qsearch( {
1888 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
1889 'select' => 'part_event.*',
1890 'table' => 'part_event',
1891 'addl_from' => "$cross $join",
1892 'hashref' => { 'check_freq' => $check_freq,
1893 'eventtable' => $eventtable,
1896 'extra_sql' => "AND $cross_where $extra_sql",
1900 my $pkey = $object->primary_key;
1901 warn " ". scalar(@part_event).
1902 " possible events found for $eventtable ". $object->$pkey(). "\n";
1905 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
1909 warn " ". scalar(@e_cust_event).
1910 " subtotal possible cust events found for $eventtable\n"
1913 push @cust_event, @e_cust_event;
1917 warn " ". scalar(@cust_event).
1918 " total possible cust events found in initial search\n"
1926 $opt{stage} ||= 'collect';
1928 grep { my $stage = $_->part_event->event_stage;
1929 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
1939 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
1940 'stats_hashref' => \%unsat ),
1943 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
1946 warn " invalid conditions not eliminated with condition_sql:\n".
1947 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
1948 if keys %unsat && $DEBUG; # > 1;
1954 unless( $opt{testonly} ) {
1955 foreach my $cust_event ( @cust_event ) {
1957 my $error = $cust_event->insert();
1959 $dbh->rollback if $oldAutoCommit;
1966 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1972 warn " returning events: ". Dumper(@cust_event). "\n"
1979 =item apply_payments_and_credits [ OPTION => VALUE ... ]
1981 Applies unapplied payments and credits.
1983 In most cases, this new method should be used in place of sequential
1984 apply_payments and apply_credits methods.
1986 A hash of optional arguments may be passed. Currently "manual" is supported.
1987 If true, a payment receipt is sent instead of a statement when
1988 'payment_receipt_email' configuration option is set.
1990 If there is an error, returns the error, otherwise returns false.
1994 sub apply_payments_and_credits {
1995 my( $self, %options ) = @_;
1997 local $SIG{HUP} = 'IGNORE';
1998 local $SIG{INT} = 'IGNORE';
1999 local $SIG{QUIT} = 'IGNORE';
2000 local $SIG{TERM} = 'IGNORE';
2001 local $SIG{TSTP} = 'IGNORE';
2002 local $SIG{PIPE} = 'IGNORE';
2004 my $oldAutoCommit = $FS::UID::AutoCommit;
2005 local $FS::UID::AutoCommit = 0;
2008 $self->select_for_update; #mutex
2010 foreach my $cust_bill ( $self->open_cust_bill ) {
2011 my $error = $cust_bill->apply_payments_and_credits(%options);
2013 $dbh->rollback if $oldAutoCommit;
2014 return "Error applying: $error";
2018 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2023 =item apply_credits OPTION => VALUE ...
2025 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2026 to outstanding invoice balances in chronological order (or reverse
2027 chronological order if the I<order> option is set to B<newest>) and returns the
2028 value of any remaining unapplied credits available for refund (see
2029 L<FS::cust_refund>).
2031 Dies if there is an error.
2039 local $SIG{HUP} = 'IGNORE';
2040 local $SIG{INT} = 'IGNORE';
2041 local $SIG{QUIT} = 'IGNORE';
2042 local $SIG{TERM} = 'IGNORE';
2043 local $SIG{TSTP} = 'IGNORE';
2044 local $SIG{PIPE} = 'IGNORE';
2046 my $oldAutoCommit = $FS::UID::AutoCommit;
2047 local $FS::UID::AutoCommit = 0;
2050 $self->select_for_update; #mutex
2052 unless ( $self->total_unapplied_credits ) {
2053 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2057 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2058 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2060 my @invoices = $self->open_cust_bill;
2061 @invoices = sort { $b->_date <=> $a->_date } @invoices
2062 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2064 if ( $conf->exists('pkg-balances') ) {
2065 # limit @credits to those w/ a pkgnum grepped from $self
2067 foreach my $i (@invoices) {
2068 foreach my $li ( $i->cust_bill_pkg ) {
2069 $pkgnums{$li->pkgnum} = 1;
2072 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2077 foreach my $cust_bill ( @invoices ) {
2079 if ( !defined($credit) || $credit->credited == 0) {
2080 $credit = pop @credits or last;
2084 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2085 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2087 $owed = $cust_bill->owed;
2089 unless ( $owed > 0 ) {
2090 push @credits, $credit;
2094 my $amount = min( $credit->credited, $owed );
2096 my $cust_credit_bill = new FS::cust_credit_bill ( {
2097 'crednum' => $credit->crednum,
2098 'invnum' => $cust_bill->invnum,
2099 'amount' => $amount,
2101 $cust_credit_bill->pkgnum( $credit->pkgnum )
2102 if $conf->exists('pkg-balances') && $credit->pkgnum;
2103 my $error = $cust_credit_bill->insert;
2105 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2109 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2113 my $total_unapplied_credits = $self->total_unapplied_credits;
2115 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2117 return $total_unapplied_credits;
2120 =item apply_payments [ OPTION => VALUE ... ]
2122 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2123 to outstanding invoice balances in chronological order.
2125 #and returns the value of any remaining unapplied payments.
2127 A hash of optional arguments may be passed. Currently "manual" is supported.
2128 If true, a payment receipt is sent instead of a statement when
2129 'payment_receipt_email' configuration option is set.
2131 Dies if there is an error.
2135 sub apply_payments {
2136 my( $self, %options ) = @_;
2138 local $SIG{HUP} = 'IGNORE';
2139 local $SIG{INT} = 'IGNORE';
2140 local $SIG{QUIT} = 'IGNORE';
2141 local $SIG{TERM} = 'IGNORE';
2142 local $SIG{TSTP} = 'IGNORE';
2143 local $SIG{PIPE} = 'IGNORE';
2145 my $oldAutoCommit = $FS::UID::AutoCommit;
2146 local $FS::UID::AutoCommit = 0;
2149 $self->select_for_update; #mutex
2153 my @payments = sort { $b->_date <=> $a->_date }
2154 grep { $_->unapplied > 0 }
2157 my @invoices = sort { $a->_date <=> $b->_date}
2158 grep { $_->owed > 0 }
2161 if ( $conf->exists('pkg-balances') ) {
2162 # limit @payments to those w/ a pkgnum grepped from $self
2164 foreach my $i (@invoices) {
2165 foreach my $li ( $i->cust_bill_pkg ) {
2166 $pkgnums{$li->pkgnum} = 1;
2169 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2174 foreach my $cust_bill ( @invoices ) {
2176 if ( !defined($payment) || $payment->unapplied == 0 ) {
2177 $payment = pop @payments or last;
2181 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2182 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2184 $owed = $cust_bill->owed;
2186 unless ( $owed > 0 ) {
2187 push @payments, $payment;
2191 my $amount = min( $payment->unapplied, $owed );
2193 my $cust_bill_pay = new FS::cust_bill_pay ( {
2194 'paynum' => $payment->paynum,
2195 'invnum' => $cust_bill->invnum,
2196 'amount' => $amount,
2198 $cust_bill_pay->pkgnum( $payment->pkgnum )
2199 if $conf->exists('pkg-balances') && $payment->pkgnum;
2200 my $error = $cust_bill_pay->insert(%options);
2202 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2206 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2210 my $total_unapplied_payments = $self->total_unapplied_payments;
2212 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2214 return $total_unapplied_payments;
2221 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>