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 );
13 use FS::cust_bill_pkg;
14 use FS::cust_bill_pkg_display;
15 use FS::cust_bill_pay;
16 use FS::cust_credit_bill;
17 use FS::cust_tax_adjustment;
19 use FS::tax_rate_location;
20 use FS::cust_bill_pkg_tax_location;
21 use FS::cust_bill_pkg_tax_rate_location;
23 use FS::part_event_condition;
25 use FS::FeeOrigin_Mixin;
28 # 1 is mostly method/subroutine entry and options
29 # 2 traces progress of some operations
30 # 3 is even more information including possibly sensitive data
32 $me = '[FS::cust_main::Billing]';
34 install_callback FS::UID sub {
36 #yes, need it for stuff below (prolly should be cached)
41 FS::cust_main::Billing - Billing mixin for cust_main
47 These methods are available on FS::cust_main objects.
53 =item bill_and_collect
55 Cancels and suspends any packages due, generates bills, applies payments and
56 credits, and applies collection events to run cards, send bills and notices,
59 By default, warns on errors and continues with the next operation (but see the
62 Options are passed as name-value pairs. Currently available options are:
68 Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example:
72 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
76 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
80 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
84 If set true, re-charges setup fees.
88 If set any errors prevent subsequent operations from continusing. If set
89 specifically to "return", returns the error (or false, if there is no error).
90 Any other true value causes errors to die.
94 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
98 Optional FS::queue entry to receive status updates.
102 Options are passed to the B<bill> and B<collect> methods verbatim, so all
103 options of those methods are also available.
107 sub bill_and_collect {
108 my( $self, %options ) = @_;
110 my $log = FS::Log->new('FS::cust_main::Billing::bill_and_collect');
111 my %logopt = (object => $self);
112 $log->debug('start', %logopt);
116 #$options{actual_time} not $options{time} because freeside-daily -d is for
117 #pre-printing invoices
119 $options{'actual_time'} ||= time;
120 my $job = $options{'job'};
122 my $actual_time = ( $conf->exists('next-bill-ignore-time')
123 ? day_end( $options{actual_time} )
124 : $options{actual_time}
127 $job->update_statustext('0,cleaning expired packages') if $job;
128 $log->debug('canceling expired packages', %logopt);
129 $error = $self->cancel_expired_pkgs( $actual_time );
131 $error = "Error expiring custnum ". $self->custnum. ": $error";
132 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
133 elsif ( $options{fatal} ) { die $error; }
134 else { warn $error; }
137 $log->debug('suspending adjourned packages', %logopt);
138 $error = $self->suspend_adjourned_pkgs( $actual_time );
140 $error = "Error adjourning custnum ". $self->custnum. ": $error";
141 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
142 elsif ( $options{fatal} ) { die $error; }
143 else { warn $error; }
146 $log->debug('unsuspending resumed packages', %logopt);
147 $error = $self->unsuspend_resumed_pkgs( $actual_time );
149 $error = "Error resuming custnum ".$self->custnum. ": $error";
150 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
151 elsif ( $options{fatal} ) { die $error; }
152 else { warn $error; }
155 $job->update_statustext('20,billing packages') if $job;
156 $log->debug('billing packages', %logopt);
157 $error = $self->bill( %options );
159 $error = "Error billing custnum ". $self->custnum. ": $error";
160 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
161 elsif ( $options{fatal} ) { die $error; }
162 else { warn $error; }
165 $job->update_statustext('50,applying payments and credits') if $job;
166 $log->debug('applying payments and credits', %logopt);
167 $error = $self->apply_payments_and_credits;
169 $error = "Error applying custnum ". $self->custnum. ": $error";
170 if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
171 elsif ( $options{fatal} ) { die $error; }
172 else { warn $error; }
175 unless ( $conf->exists('cancelled_cust-noevents')
176 && ! $self->num_ncancelled_pkgs
178 $job->update_statustext('70,running collection events') if $job;
179 $log->debug('running collection events', %logopt);
180 $error = $self->collect( %options );
182 $error = "Error collecting custnum ". $self->custnum. ": $error";
183 if ($options{fatal} && $options{fatal} eq 'return') { return $error; }
184 elsif ($options{fatal} ) { die $error; }
185 else { warn $error; }
189 $job->update_statustext('100,finished') if $job;
190 $log->debug('finish', %logopt);
196 sub cancel_expired_pkgs {
197 my ( $self, $time, %options ) = @_;
199 my @cancel_pkgs = $self->ncancelled_pkgs( {
200 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
205 my @really_cancel_pkgs;
208 CUST_PKG: foreach my $cust_pkg ( @cancel_pkgs ) {
209 my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
212 if ( $cust_pkg->change_to_pkgnum ) {
214 my $new_pkg = FS::cust_pkg->by_key($cust_pkg->change_to_pkgnum);
216 push @errors, 'can\'t change pkgnum '.$cust_pkg->pkgnum.' to pkgnum '.
217 $cust_pkg->change_to_pkgnum.'; not expiring';
220 $error = $cust_pkg->change( 'cust_pkg' => $new_pkg,
221 'unprotect_svcs' => 1 );
222 $error = '' if ref $error eq 'FS::cust_pkg';
224 } else { # just cancel it
226 push @really_cancel_pkgs, $cust_pkg;
227 push @cancel_reasons, $cpr;
232 if (@really_cancel_pkgs) {
234 my %cancel_opt = ( 'cust_pkg' => \@really_cancel_pkgs,
235 'cust_pkg_reason' => \@cancel_reasons,
239 push @errors, $self->cancel_pkgs(%cancel_opt);
243 join(' / ', @errors);
247 sub suspend_adjourned_pkgs {
248 my ( $self, $time, %options ) = @_;
250 my @susp_pkgs = $self->ncancelled_pkgs( {
252 " AND ( susp IS NULL OR susp = 0 )
253 AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time )
254 OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
259 #only because there's no SQL test for is_prepaid :/
261 grep { ( $_->part_pkg->is_prepaid
266 && $_->adjourn <= $time
274 foreach my $cust_pkg ( @susp_pkgs ) {
275 my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
276 if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
277 my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
278 'reason_otaker' => $cpr->otaker
282 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
285 join(' / ', @errors);
289 sub unsuspend_resumed_pkgs {
290 my ( $self, $time, %options ) = @_;
292 my @unsusp_pkgs = $self->ncancelled_pkgs( {
293 'extra_sql' => " AND resume IS NOT NULL AND resume > 0 AND resume <= $time "
298 foreach my $cust_pkg ( @unsusp_pkgs ) {
299 my $error = $cust_pkg->unsuspend( 'time' => $time );
300 push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
303 join(' / ', @errors);
309 Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in
310 conjunction with the collect method by calling B<bill_and_collect>.
312 If there is an error, returns the error, otherwise returns false.
314 Options are passed as name-value pairs. Currently available options are:
320 If set true, re-charges setup fees.
324 If set true then only bill recurring charges, not setup, usage, one time
329 If set, then override the normal frequency and look for a part_pkg_discount
330 to take at that frequency. This is appropriate only when the normal
331 frequency for all packages is monthly, and is an error otherwise. Use
332 C<pkg_list> to limit the set of packages included in billing.
336 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:
340 $cust_main->bill( 'time' => str2time('April 20th, 2001') );
344 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
346 $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
350 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
354 Do not bill prepaid packages. Used by freeside-daily.
358 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.
362 This boolean value informs the us that the package is being cancelled. This
363 typically might mean not charging the normal recurring fee but only usage
364 fees since the last billing. Setup charges may be charged. Not all package
365 plans support this feature (they tend to charge 0).
369 Prevent the resetting of usage limits during this call.
373 Do not save the generated bill in the database. Useful with return_bill
377 A list reference on which the generated bill(s) will be returned.
381 Optional terms to be printed on this invoice. Otherwise, customer-specific
382 terms or the default terms are used.
389 my( $self, %options ) = @_;
391 return '' if $self->payby eq 'COMP';
393 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
394 my $log = FS::Log->new('FS::cust_main::Billing::bill');
395 my %logopt = (object => $self);
397 $log->debug('start', %logopt);
398 warn "$me bill customer ". $self->custnum. "\n"
401 my $time = $options{'time'} || time;
402 my $invoice_time = $options{'invoice_time'} || $time;
404 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
409 $options{'not_pkgpart'} ||= {};
410 $options{'not_pkgpart'} = { map { $_ => 1 }
411 split(/\s*,\s*/, $options{'not_pkgpart'})
413 unless ref($options{'not_pkgpart'});
415 local $SIG{HUP} = 'IGNORE';
416 local $SIG{INT} = 'IGNORE';
417 local $SIG{QUIT} = 'IGNORE';
418 local $SIG{TERM} = 'IGNORE';
419 local $SIG{TSTP} = 'IGNORE';
420 local $SIG{PIPE} = 'IGNORE';
422 my $oldAutoCommit = $FS::UID::AutoCommit;
423 local $FS::UID::AutoCommit = 0;
426 $log->debug('acquiring lock', %logopt);
427 warn "$me acquiring lock on customer ". $self->custnum. "\n"
430 $self->select_for_update; #mutex
432 $log->debug('running pre-bill events', %logopt);
433 warn "$me running pre-bill events for customer ". $self->custnum. "\n"
436 my $error = $self->do_cust_event(
437 'debug' => ( $options{'debug'} || 0 ),
438 'time' => $invoice_time,
439 'check_freq' => $options{'check_freq'},
440 'stage' => 'pre-bill',
442 unless $options{no_commit};
444 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
448 $log->debug('done running pre-bill events', %logopt);
449 warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
452 #keep auto-charge and non-auto-charge line items separate
453 my @passes = ( '', 'no_auto' );
455 my %cust_bill_pkg = map { $_ => [] } @passes;
458 # find the packages which are due for billing, find out how much they are
459 # & generate invoice database.
462 my %total_setup = map { my $z = 0; $_ => \$z; } @passes;
463 my %total_recur = map { my $z = 0; $_ => \$z; } @passes;
465 my %taxlisthash = map { $_ => {} } @passes;
467 my @precommit_hooks = ();
469 $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks?
471 foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
473 next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
475 my $part_pkg = $cust_pkg->part_pkg;
477 next if $options{'no_prepaid'} && $part_pkg->is_prepaid;
479 $log->debug('bill package '. $cust_pkg->pkgnum, %logopt);
480 warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG;
482 #? to avoid use of uninitialized value errors... ?
483 $cust_pkg->setfield('bill', '')
484 unless defined($cust_pkg->bill);
486 my $real_pkgpart = $cust_pkg->pkgpart;
487 my %hash = $cust_pkg->hash;
489 # we could implement this bit as FS::part_pkg::has_hidden, but we already
490 # suffer from performance issues
491 $options{has_hidden} = 0;
492 my @part_pkg = $part_pkg->self_and_bill_linked;
493 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
495 # if this package was changed from another package,
496 # and it hasn't been billed since then,
497 # and package balances are enabled,
498 if ( $cust_pkg->change_pkgnum
499 and $cust_pkg->change_date >= ($cust_pkg->last_bill || 0)
500 and $cust_pkg->change_date < $invoice_time
501 and $conf->exists('pkg-balances') )
503 # _transfer_balance will also create the appropriate credit
504 my @transfer_items = $self->_transfer_balance($cust_pkg);
505 # $part_pkg[0] is the "real" part_pkg
506 my $pass = ($cust_pkg->no_auto || $part_pkg[0]->no_auto) ?
508 push @{ $cust_bill_pkg{$pass} }, @transfer_items;
509 # treating this as recur, just because most charges are recur...
510 ${$total_recur{$pass}} += $_->recur foreach @transfer_items;
512 # currently not considering separate_bill here, as it's for
513 # one-time charges only
516 foreach my $part_pkg ( @part_pkg ) {
518 $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
521 if ( $cust_pkg->separate_bill ) {
522 # if no_auto is also set, that's fine. we just need to not have
523 # invoices that are both auto and no_auto, and since the package
524 # gets an invoice all to itself, it will only be one or the other.
525 $pass = $cust_pkg->pkgnum;
526 if (!exists $cust_bill_pkg{$pass}) { # it may not exist yet
528 $total_setup{$pass} = do { my $z = 0; \$z };
529 $total_recur{$pass} = do { my $z = 0; \$z };
530 $taxlisthash{$pass} = {};
531 $cust_bill_pkg{$pass} = [];
533 } elsif ( ($cust_pkg->no_auto || $part_pkg->no_auto) ) {
537 my $next_bill = $cust_pkg->getfield('bill') || 0;
539 # let this run once if this is the last bill upon cancellation
540 while ( $next_bill <= $cmp_time or $options{cancel} ) {
542 $self->_make_lines( 'part_pkg' => $part_pkg,
543 'cust_pkg' => $cust_pkg,
544 'precommit_hooks' => \@precommit_hooks,
545 'line_items' => $cust_bill_pkg{$pass},
546 'setup' => $total_setup{$pass},
547 'recur' => $total_recur{$pass},
548 'tax_matrix' => $taxlisthash{$pass},
550 'real_pkgpart' => $real_pkgpart,
551 'options' => \%options,
554 # Stop if anything goes wrong
557 # or if we're not incrementing the bill date.
558 last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
560 # or if we're letting it run only once
561 last if $options{cancel};
563 $next_bill = $cust_pkg->getfield('bill') || 0;
565 #stop if -o was passed to freeside-daily
566 last if $options{'one_recur'};
569 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
573 } #foreach my $part_pkg
575 } #foreach my $cust_pkg
577 foreach my $pass (@passes) { # keys %cust_bill_pkg )
579 my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} });
581 warn "$me billing pass $pass\n"
582 #.Dumper(\@cust_bill_pkg)."\n"
589 my @pending_fees = FS::FeeOrigin_Mixin->by_cust($self->custnum,
590 hashref => { 'billpkgnum' => '' }
592 warn "$me found pending fees:\n".Dumper(\@pending_fees)."\n"
593 if @pending_fees and $DEBUG > 1;
595 # determine whether to generate an invoice
596 my $generate_bill = scalar(@cust_bill_pkg) > 0;
598 foreach my $fee (@pending_fees) {
599 $generate_bill = 1 unless $fee->nextbill;
602 # don't create an invoice with no line items, or where the only line
603 # items are fees that are supposed to be held until the next invoice
604 next if !$generate_bill;
608 foreach my $fee_origin (@pending_fees) {
609 my $part_fee = $fee_origin->part_fee;
611 # check whether the fee is applicable before doing anything expensive:
613 # if the fee def belongs to a different agent, don't charge the fee.
614 # event conditions should prevent this, but just in case they don't,
616 if ( $part_fee->agentnum and $part_fee->agentnum != $self->agentnum ) {
617 warn "tried to charge fee#".$part_fee->feepart .
618 " on customer#".$self->custnum." from a different agent.\n";
621 # also skip if it's disabled
622 next if $part_fee->disabled eq 'Y';
624 # Decide which invoice to base the fee on.
625 my $cust_bill = $fee_origin->cust_bill;
627 # Then link it to the current invoice. This isn't the real cust_bill
628 # object that will be inserted--in particular there are no taxes yet.
629 # If you want to charge a fee on the total invoice amount including
630 # taxes, you have to put the fee on the next invoice.
631 $cust_bill = FS::cust_bill->new({
632 'custnum' => $self->custnum,
633 'cust_bill_pkg' => \@cust_bill_pkg,
634 'charged' => ${ $total_setup{$pass} } +
635 ${ $total_recur{$pass} },
638 # If the origin is for a specific package, then only apply the fee to
639 # line items from that package.
640 if ( my $cust_pkg = $fee_origin->cust_pkg ) {
641 my @charge_fee_on_item;
642 my $charge_fee_on_amount = 0;
643 foreach (@cust_bill_pkg) {
644 if ($_->pkgnum == $cust_pkg->pkgnum) {
645 push @charge_fee_on_item, $_;
646 $charge_fee_on_amount += $_->setup + $_->recur;
649 $cust_bill->set('cust_bill_pkg', \@charge_fee_on_item);
650 $cust_bill->set('charged', $charge_fee_on_amount);
653 } # $cust_bill is now set
655 my $fee_item = $part_fee->lineitem($cust_bill) or next;
656 # link this so that we can clear the marker on inserting the line item
657 $fee_item->set('fee_origin', $fee_origin);
658 push @fee_items, $fee_item;
662 # add fees to the invoice
663 foreach my $fee_item (@fee_items) {
665 push @cust_bill_pkg, $fee_item;
666 ${ $total_setup{$pass} } += $fee_item->setup;
667 ${ $total_recur{$pass} } += $fee_item->recur;
669 my $part_fee = $fee_item->part_fee;
670 my $fee_location = $self->ship_location; # I think?
672 my $error = $self->_handle_taxes(
675 location => $fee_location
676 # probably not right to pass cancel => 1 for fees
678 return $error if $error;
682 # XXX implementation of fees is supposed to make this go away...
683 if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
684 !$conf->exists('postal_invoice-recurring_only')
688 my $postal_pkg = $self->charge_postal_fee();
689 if ( $postal_pkg && !ref( $postal_pkg ) ) {
691 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
692 return "can't charge postal invoice fee for customer ".
693 $self->custnum. ": $postal_pkg";
695 } elsif ( $postal_pkg ) {
697 my $real_pkgpart = $postal_pkg->pkgpart;
698 # we could implement this bit as FS::part_pkg::has_hidden, but we already
699 # suffer from performance issues
700 $options{has_hidden} = 0;
701 my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
702 $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
704 foreach my $part_pkg ( @part_pkg ) {
705 my %postal_options = %options;
706 delete $postal_options{cancel};
708 $self->_make_lines( 'part_pkg' => $part_pkg,
709 'cust_pkg' => $postal_pkg,
710 'precommit_hooks' => \@precommit_hooks,
711 'line_items' => \@cust_bill_pkg,
712 'setup' => $total_setup{$pass},
713 'recur' => $total_recur{$pass},
714 'tax_matrix' => $taxlisthash{$pass},
716 'real_pkgpart' => $real_pkgpart,
717 'options' => \%postal_options,
720 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
725 # it's silly to have a zero value postal_pkg, but....
726 @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg);
732 my $listref_or_error =
733 $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
735 unless ( ref( $listref_or_error ) ) {
736 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
737 return $listref_or_error;
740 foreach my $taxline ( @$listref_or_error ) {
741 ${ $total_setup{$pass} } =
742 sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
743 push @cust_bill_pkg, $taxline;
747 warn "adding tax adjustments...\n" if $DEBUG > 2;
748 foreach my $cust_tax_adjustment (
749 qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum,
755 my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
757 my $itemdesc = $cust_tax_adjustment->taxname;
758 $itemdesc = '' if $itemdesc eq 'Tax';
760 push @cust_bill_pkg, new FS::cust_bill_pkg {
766 'itemdesc' => $itemdesc,
767 'itemcomment' => $cust_tax_adjustment->comment,
768 'cust_tax_adjustment' => $cust_tax_adjustment,
769 #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
774 my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
776 my $balance = $self->balance;
778 my $previous_bill = qsearchs({ 'table' => 'cust_bill',
779 'hashref' => { custnum=>$self->custnum },
780 'extra_sql' => 'ORDER BY _date DESC LIMIT 1',
782 my $previous_balance =
784 ? ( $previous_bill->billing_balance + $previous_bill->charged )
787 $log->debug('creating the new invoice', %logopt);
788 warn "creating the new invoice\n" if $DEBUG;
789 #create the new invoice
790 my $cust_bill = new FS::cust_bill ( {
791 'custnum' => $self->custnum,
792 '_date' => $invoice_time,
793 'charged' => $charged,
794 'billing_balance' => $balance,
795 'previous_balance' => $previous_balance,
796 'invoice_terms' => $options{'invoice_terms'},
797 'cust_bill_pkg' => \@cust_bill_pkg,
799 $error = $cust_bill->insert unless $options{no_commit};
801 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
802 return "can't create invoice for customer #". $self->custnum. ": $error";
804 push @{$options{return_bill}}, $cust_bill if $options{return_bill};
806 } #foreach my $pass ( keys %cust_bill_pkg )
808 foreach my $hook ( @precommit_hooks ) {
811 } unless $options{no_commit};
813 $dbh->rollback if $oldAutoCommit && !$options{no_commit};
814 return "$@ running precommit hook $hook\n";
818 $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
823 #discard bundled packages of 0 value
824 # XXX we should reconsider whether we even need this
825 sub _omit_zero_value_bundles {
830 my $discount_show_always = $conf->exists('discount-show-always');
833 # Sort @in the same way we do during invoice rendering, so we can identify
834 # bundles. See FS::Template_Mixin::_items_nontax.
835 @in = sort { $a->pkgnum <=> $b->pkgnum or
836 $a->sdate <=> $b->sdate or
837 ($a->pkgpart_override ? 0 : -1) or
838 ($b->pkgpart_override ? 0 : 1) or
839 $b->hidden cmp $a->hidden or
840 $a->pkgpart_override <=> $b->pkgpart_override
843 # this is a pack-and-deliver pattern. every time there's a cust_bill_pkg
844 # _without_ pkgpart_override, that's the start of the new bundle. if there's
845 # an existing bundle, and it contains a nonzero amount (or a zero amount
846 # that's displayable anyway), push all line items in the bundle.
847 foreach my $cust_bill_pkg ( @in ) {
849 if (scalar(@bundle) and !$cust_bill_pkg->pkgpart_override) {
850 # ship out this bundle and reset it
858 # add this item to the current bundle
859 push @bundle, $cust_bill_pkg;
861 # determine if it makes the bundle displayable
862 if ( $cust_bill_pkg->setup > 0
863 or $cust_bill_pkg->recur > 0
864 or $cust_bill_pkg->setup_show_zero
865 or $cust_bill_pkg->recur_show_zero
866 or ($discount_show_always
867 and scalar(@{ $cust_bill_pkg->get('discounts')})
879 warn " _omit_zero_value_bundles: ". scalar(@in).
880 '->'. scalar(@out). "\n" #. Dumper(@out). "\n"
886 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
888 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
889 Usually used internally by bill method B<bill>.
891 If there is an error, returns the error, otherwise returns reference to a
892 list of line items suitable for insertion.
898 An array ref of the line items being billed.
902 A strange beast. The keys to this hash are internal identifiers consisting
903 of the name of the tax object type, a space, and its unique identifier ( e.g.
904 'cust_main_county 23' ). The values of the hash are listrefs. The first
905 item in the list is the tax object. The remaining items are either line
906 items or floating point values (currency amounts).
908 The taxes are calculated on this entity. Calculated exemption records are
909 transferred to the LINEITEMREF items on the assumption that they are related.
915 This specifies the date appearing on the associated invoice. Some
916 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
922 sub calculate_taxes {
923 my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
925 # $taxlisthash is a hashref
926 # keys are identifiers, values are arrayrefs
927 # each arrayref starts with a tax object (cust_main_county or tax_rate)
928 # then a cust_bill_pkg object the tax applies to, then the charge class
929 # on that object (setup, recur, a usage class number, or '')
930 # For internal taxes the charge class is always undef.
932 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
934 warn "$me calculate_taxes\n"
935 #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
938 my $custnum = $self->custnum;
939 # The main tax accumulator. One bin for each tax name (itemdesc).
940 # For each subdivision of tax under this name, push a cust_bill_pkg item
941 # for the calculated tax into the arrayref.
943 # values are arrayrefs of tax lines
946 # keys are taxlisthash keys (internal identifiers)
947 # values are (cumulative) amounts
950 # keys are taxlisthash keys
951 # values are arrayrefs of cust_tax_exempt_pkg objects
954 # For tax on tax calculation, we need to remember which taxable items
955 # (and charge classes) had which taxes applied to them.
957 # keys are cust_bill_pkg objects (taxable items)
958 # values are hashrefs
959 # keys are charge classes
960 # values are hashrefs
961 # keys are taxnums (in tax_rate only; cust_main_county doesn't use this)
962 # values are the taxlines generated for those taxes
963 tie my %item_has_tax, 'Tie::RefHash',
964 map { $_ => {} } @$cust_bill_pkg;
966 foreach my $tax_id ( keys %$taxlisthash ) {
967 # $tax_id: the identifier of the tax we are calculating in this pass
969 my $taxables = $taxlisthash->{$tax_id};
970 my $tax_object = shift @$taxables;
971 my $taxnum = $tax_object->taxnum;
972 # $tax_object is a cust_main_county or tax_rate
973 # (with billpkgnum, pkgnum, locationnum set)
974 # the rest of @{ $taxlisthash->{$tax_id} } is cust_bill_pkg objects,
975 # optionally followed by their charge classes.
976 warn "found ". $tax_object->taxname. " as $tax_id\n" if $DEBUG > 2;
978 # taxline calculates the tax on all cust_bill_pkgs in the
979 # first (arrayref) argument.
981 # Note that non-monthly exemptions have already been calculated and
982 # attached to the items. Monthly exemptions will be attached in this
984 my $exemptions = $tax_exemption{$tax_id} ||= [];
985 if ( $tax_object->isa('FS::tax_rate') ) { # EXTERNAL TAXES
986 # STILL have tax_rate-specific crap in here...
987 my @taxlines = $tax_object->taxline( $taxables,
988 'custnum' => $custnum,
989 'invoice_time' => $invoice_time,
990 'exemptions' => $exemptions,
993 if (!ref $taxlines[0]) {
994 # it's an error string
995 warn "error evaluating $tax_id on custnum $custnum\n";
998 foreach my $taxline (@taxlines) {
999 push @{ $taxname{ $taxline->itemdesc } }, $taxline;
1000 my $link = $taxline->get('cust_bill_pkg_tax_rate_location')->[0];
1001 my $taxable_item = $link->taxable_cust_bill_pkg;
1002 $item_has_tax{$taxable_item}{$taxline->_class}{$taxnum} = $taxline;
1005 } else { # INTERNAL TAXES
1006 # we can do this in a single taxline, because it's not stupid
1008 my $taxline = $tax_object->taxline( $taxables,
1009 'custnum' => $custnum,
1010 'invoice_time' => $invoice_time,
1011 'exemptions' => $exemptions,
1014 if (!ref $taxline) {
1015 # it's an error string
1016 warn "error evaluating $tax_id on custnum $custnum\n";
1019 # if the calculated tax is zero, don't even keep it
1020 next if $taxline->setup < 0.001;
1021 push @{ $taxname{ $taxline->itemdesc } }, $taxline;
1024 $DB::single = 1; # XXX
1026 # all first-tier taxes are calculated. now for tax on tax:
1028 foreach my $taxable_item ( @$cust_bill_pkg ) {
1029 # taxes that apply to this item
1030 my $this_has_tax = $item_has_tax{$taxable_item};
1032 my $location = $taxable_item->tax_location;
1034 foreach my $charge_class (keys %$this_has_tax) {
1035 # taxes that apply to this item and charge class
1036 my $this_class_has_tax = $this_has_tax->{$charge_class};
1037 foreach my $taxnum (keys %$this_class_has_tax) {
1039 # for each tax item that was calculated in phase 1, get the
1041 my $tax_object = FS::tax_rate->by_key($taxnum);
1042 # and find all taxes that apply to it in this location
1043 my @tot = $tax_object->tax_on_tax( $location );
1045 warn "found possible taxed taxnum $taxnum\n"
1047 # Calculate ToT separately for each taxable item and class, and only
1048 # if _that class on the item_ is already taxed under the ToT. This is
1050 # See RT#5243 and RT#36380.
1051 foreach my $tot (@tot) {
1052 my $totnum = $tot->taxnum;
1053 warn "checking taxnum $totnum which we call ". $tot->taxname ."\n"
1055 # note: if the _null class_ on this item is taxed under the ToT,
1056 # then this specific class is taxed also (because null class
1057 # includes all classes) and so ToT is applicable.
1059 exists $this_class_has_tax->{ $totnum }
1060 or exists $this_has_tax->{''}{ $totnum }
1063 warn "calculating tax on tax: taxnum $totnum on $taxnum\n"
1065 my @taxlines = $tot->taxline(
1066 $this_class_has_tax->{ $taxnum }, # the first-stage tax
1067 'custnum' => $custnum,
1068 'invoice_time' => $invoice_time,
1070 next if (!@taxlines); # it didn't apply after all
1071 if (!ref($taxlines[0])) {
1072 warn "error evaluating taxnum $totnum TOT on custnum $custnum\n";
1073 return $taxlines[0];
1075 foreach my $taxline (@taxlines) {
1076 push @{ $taxname{ $taxline->itemdesc } }, $taxline;
1079 } # foreach my $tot (tax-on-tax rate definition)
1080 } # foreach $taxnum (first-tier rate definition)
1081 } # foreach $charge_class
1082 } # foreach $taxable_item
1084 #consolidate and create tax line items
1085 warn "consolidating and generating...\n" if $DEBUG > 2;
1086 my %final_tax_items; # taxname => item
1087 foreach my $taxname ( keys %taxname ) {
1088 my @cust_bill_pkg_tax_location;
1089 my @cust_bill_pkg_tax_rate_location;
1090 my $tax_cust_bill_pkg = FS::cust_bill_pkg->new({
1095 'itemdesc' => $taxname,
1096 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
1097 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
1102 warn "adding $taxname\n" if $DEBUG > 1;
1103 foreach my $taxitem ( @{ $taxname{$taxname} } ) {
1104 next if $taxitem->get('setup') == 0;
1105 # if ( ref($taxitem) eq 'FS::cust_bill_pkg' ) # always true
1106 # then we need to transfer the amount and the links from the
1107 # line item to the new one we're creating.
1108 $tax_total += $taxitem->setup;
1110 $taxitem->get('cust_bill_pkg_tax_location') ||
1111 $taxitem->get('cust_bill_pkg_tax_rate_location') ||
1114 foreach my $link ( @links ) {
1115 $link->set('tax_cust_bill_pkg', $tax_cust_bill_pkg);
1116 if ($link->isa('FS::cust_bill_pkg_tax_location')) {
1117 push @cust_bill_pkg_tax_location, $link;
1118 } elsif ($link->isa('FS::cust_bill_pkg_tax_rate_location')) {
1119 push @cust_bill_pkg_tax_rate_location, $link;
1123 next unless $tax_total;
1125 # we should really neverround this up...I guess it's okay if taxline
1126 # already returns amounts with 2 decimal places
1127 $tax_total = sprintf('%.2f', $tax_total );
1128 $tax_cust_bill_pkg->set('setup', $tax_total);
1130 my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
1136 if ( $pkg_category and
1137 $conf->config('invoice_latexsummary') ||
1138 $conf->config('invoice_htmlsummary')
1142 my %hash = ( 'section' => $pkg_category->categoryname );
1143 push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
1146 $tax_cust_bill_pkg->set('display', \@display);
1148 $final_tax_items{$taxname} = $tax_cust_bill_pkg;
1149 } # foreach $taxname
1151 # fix ToT backlinks for taxes that have been consolidated
1152 # (has to be done in a separate pass)
1153 foreach my $tax_item (values %final_tax_items) {
1154 foreach my $taxable_link (@{ $tax_item->cust_bill_pkg_tax_rate_location }) {
1155 my $taxed_item = $taxable_link->taxable_cust_bill_pkg;
1156 next if $taxed_item->pkgnum > 0; # primary taxes
1157 my $taxname = $taxed_item->itemdesc;
1158 $taxable_link->set('taxable_cust_bill_pkg', $final_tax_items{ $taxname });
1162 [ values %final_tax_items ]
1166 my ($self, %params) = @_;
1168 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1170 my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
1171 my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
1172 my $cust_location = $cust_pkg->tax_location;
1173 my $precommit_hooks = $params{precommit_hooks} or die "no precommit_hooks specified";
1174 my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
1175 my $total_setup = $params{setup} or die "no setup accumulator specified";
1176 my $total_recur = $params{recur} or die "no recur accumulator specified";
1177 my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
1178 my $time = $params{'time'} or die "no time specified";
1179 my (%options) = %{$params{options}};
1181 if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
1182 # this should never happen
1183 die 'freq_override billing attempted on non-monthly package '.
1188 my $real_pkgpart = $params{real_pkgpart};
1189 my %hash = $cust_pkg->hash;
1190 my $old_cust_pkg = new FS::cust_pkg \%hash;
1195 $cust_pkg->pkgpart($part_pkg->pkgpart);
1197 my $cmp_time = ( $conf->exists('next-bill-ignore-time')
1208 my @setup_discounts = ();
1209 my %setup_param = ( 'discounts' => \@setup_discounts,
1210 'real_pkgpart' => $params{real_pkgpart}
1212 # Conditions for setting setup date and charging the setup fee:
1213 # - this is not a recurring-only billing run
1214 # - and the package is not currently being canceled
1215 # - and, unless we're specifically told otherwise via 'resetup':
1216 # - it doesn't already HAVE a setup date
1217 # - or a start date in the future
1218 # - and it's not suspended
1219 # - and it doesn't have an expire date in the past
1221 # The "disable_setup_suspended" option is now obsolete; we never set the
1222 # setup date on a suspended package.
1223 if ( ! $options{recurring_only}
1224 and ! $options{cancel}
1225 and ( $options{'resetup'}
1226 || ( ! $cust_pkg->setup
1227 && ( ! $cust_pkg->start_date
1228 || $cust_pkg->start_date <= $cmp_time
1230 && ( ! $cust_pkg->getfield('susp') )
1233 and ( ! $cust_pkg->expire
1234 || $cust_pkg->expire > $cmp_time )
1238 warn " bill setup\n" if $DEBUG > 1;
1240 unless ( $cust_pkg->waive_setup ) {
1243 $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
1244 return "$@ running calc_setup for $cust_pkg\n"
1247 # Only increment unitsetup here if there IS a setup fee.
1248 # prorate_defer_bill may cause calc_setup on a setup-stage package
1249 # to return zero, and the setup fee to be charged later. (This happens
1250 # when it's first billed on the prorate cutoff day. RT#31276.)
1252 $unitsetup = $cust_pkg->base_setup()
1257 $cust_pkg->setfield('setup', $time)
1258 unless $cust_pkg->setup;
1259 #do need it, but it won't get written to the db
1260 #|| $cust_pkg->pkgpart != $real_pkgpart;
1262 $cust_pkg->setfield('start_date', '')
1263 if $cust_pkg->start_date;
1268 # bill recurring fee
1273 my @recur_discounts = ();
1276 my $override_quantity;
1278 # Conditions for billing the recurring fee:
1279 # - the package doesn't have a future start date
1280 # - and it's not suspended
1281 # - unless suspend_bill is enabled on the package or package def
1282 # - but still not, if the package is on hold
1283 # - or it's suspended for a delayed cancellation
1284 # - and its next bill date is in the past
1285 # - or it doesn't have a next bill date yet
1286 # - or it's a one-time charge
1287 # - or it's a CDR plan with the "bill_every_call" option
1288 # - or it's being canceled
1289 # - and it doesn't have an expire date in the past (this can happen with
1291 # - again, unless it's being canceled
1292 if ( ! $cust_pkg->start_date
1295 || ( $cust_pkg->susp != $cust_pkg->order_date
1296 && ( $cust_pkg->option('suspend_bill',1)
1297 || ( $part_pkg->option('suspend_bill', 1)
1298 && ! $cust_pkg->option('no_suspend_bill',1)
1302 || $cust_pkg->is_status_delay_cancel
1305 ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= $cmp_time )
1306 || ( $part_pkg->plan eq 'voip_cdr'
1307 && $part_pkg->option('bill_every_call')
1312 ( ! $cust_pkg->expire
1313 || $cust_pkg->expire > $cmp_time
1318 # XXX should this be a package event? probably. events are called
1319 # at collection time at the moment, though...
1320 $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
1321 if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
1322 #don't want to reset usage just cause we want a line item??
1323 #&& $part_pkg->pkgpart == $real_pkgpart;
1325 warn " bill recur\n" if $DEBUG > 1;
1328 # XXX shared with $recur_prog
1329 $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
1333 #over two params! lets at least switch to a hashref for the rest...
1334 my $increment_next_bill = ( $part_pkg->freq ne '0'
1335 && ( $cust_pkg->getfield('bill') || 0 ) <= $cmp_time
1336 && !$options{cancel}
1338 my %param = ( %setup_param,
1339 'precommit_hooks' => $precommit_hooks,
1340 'increment_next_bill' => $increment_next_bill,
1341 'discounts' => \@recur_discounts,
1342 'real_pkgpart' => $real_pkgpart,
1343 'freq_override' => $options{freq_override} || '',
1347 my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
1349 # There may be some part_pkg for which this is wrong. Only those
1350 # which can_discount are supported.
1351 # (the UI should prevent adding discounts to these at the moment)
1353 warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
1354 " for pkgpart ". $cust_pkg->pkgpart.
1355 " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
1358 $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
1359 return "$@ running $method for $cust_pkg\n"
1362 if ($recur eq 'NOTHING') {
1363 # then calc_cancel (or calc_recur but that's not used) has declined to
1364 # generate a recurring lineitem at all. treat this as zero, but also
1365 # try not to generate a lineitem.
1371 $unitrecur = $cust_pkg->base_recur( \$sdate ) || $recur; #XXX uuh, better
1373 if ( $param{'override_quantity'} ) {
1374 $override_quantity = $param{'override_quantity'};
1375 $unitrecur = $recur / $override_quantity;
1378 if ( $increment_next_bill ) {
1382 if ( my $main_pkg = $cust_pkg->main_pkg ) {
1383 # supplemental package
1384 # to keep in sync with the main package, simulate billing at
1386 my $main_pkg_freq = $main_pkg->part_pkg->freq;
1387 my $supp_pkg_freq = $part_pkg->freq;
1388 my $ratio = $supp_pkg_freq / $main_pkg_freq;
1389 if ( $ratio != int($ratio) ) {
1390 # the UI should prevent setting up packages like this, but just
1392 return "supplemental package period is not an integer multiple of main package period";
1394 $next_bill = $sdate;
1396 $next_bill = $part_pkg->add_freq( $next_bill, $main_pkg_freq );
1401 $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
1402 return "unparsable frequency: ".
1403 ($options{freq_override} || $part_pkg->freq)
1404 if $next_bill == -1;
1407 #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
1408 # only for figuring next bill date, nothing else, so, reset $sdate again
1410 $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
1411 #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
1412 $cust_pkg->last_bill($sdate);
1414 $cust_pkg->setfield('bill', $next_bill );
1418 if ( $param{'setup_fee'} ) {
1419 # Add an additional setup fee at the billing stage.
1420 # Used for prorate_defer_bill.
1421 $setup += $param{'setup_fee'};
1422 $unitsetup = $cust_pkg->base_setup();
1426 if ( defined $param{'discount_left_setup'} ) {
1427 foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
1428 $setup -= $discount_setup;
1432 } # end of recurring fee
1434 warn "\$setup is undefined" unless defined($setup);
1435 warn "\$recur is undefined" unless defined($recur);
1436 warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
1439 # If there's line items, create em cust_bill_pkg records
1440 # If $cust_pkg has been modified, update it (if we're a real pkgpart)
1445 if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
1446 # hmm.. and if just the options are modified in some weird price plan?
1448 warn " package ". $cust_pkg->pkgnum. " modified; updating\n"
1451 my $error = $cust_pkg->replace( $old_cust_pkg,
1452 'depend_jobnum'=>$options{depend_jobnum},
1453 'options' => { $cust_pkg->options },
1455 unless $options{no_commit};
1456 return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
1457 if $error; #just in case
1460 $setup = sprintf( "%.2f", $setup );
1461 $recur = sprintf( "%.2f", $recur );
1462 if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
1463 return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
1465 if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
1466 return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
1469 my $discount_show_always = $conf->exists('discount-show-always')
1470 && ( ($setup == 0 && scalar(@setup_discounts))
1471 || ($recur == 0 && scalar(@recur_discounts))
1476 || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
1477 || $discount_show_always
1478 || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
1479 || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
1483 warn " charges (setup=$setup, recur=$recur); adding line items\n"
1486 my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
1488 warn " adding customer package invoice detail: $_\n"
1489 foreach @cust_pkg_detail;
1491 push @details, @cust_pkg_detail;
1493 my $cust_bill_pkg = new FS::cust_bill_pkg {
1494 'pkgnum' => $cust_pkg->pkgnum,
1496 'unitsetup' => sprintf('%.2f', $unitsetup),
1498 'unitrecur' => sprintf('%.2f', $unitrecur),
1499 'quantity' => $override_quantity || $cust_pkg->quantity,
1500 'details' => \@details,
1501 'discounts' => [ @setup_discounts, @recur_discounts ],
1502 'hidden' => $part_pkg->hidden,
1503 'freq' => $part_pkg->freq,
1506 if ( $part_pkg->option('prorate_defer_bill',1)
1507 and !$hash{last_bill} ) {
1508 # both preceding and upcoming, technically
1509 $cust_bill_pkg->sdate( $cust_pkg->setup );
1510 $cust_bill_pkg->edate( $cust_pkg->bill );
1511 } elsif ( $part_pkg->recur_temporality eq 'preceding' ) {
1512 $cust_bill_pkg->sdate( $hash{last_bill} );
1513 $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
1514 $cust_bill_pkg->edate( $time ) if $options{cancel};
1515 } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
1516 $cust_bill_pkg->sdate( $sdate );
1517 $cust_bill_pkg->edate( $cust_pkg->bill );
1518 #$cust_bill_pkg->edate( $time ) if $options{cancel};
1521 $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
1522 unless $part_pkg->pkgpart == $real_pkgpart;
1524 $$total_setup += $setup;
1525 $$total_recur += $recur;
1531 my $error = $self->_handle_taxes( $taxlisthash, $cust_bill_pkg,
1532 cancel => $options{cancel} );
1533 return $error if $error;
1535 $cust_bill_pkg->set_display(
1536 part_pkg => $part_pkg,
1537 real_pkgpart => $real_pkgpart,
1540 push @$cust_bill_pkgs, $cust_bill_pkg;
1542 } #if $setup != 0 || $recur != 0
1550 =item _transfer_balance TO_PKG [ FROM_PKGNUM ]
1552 Takes one argument, a cust_pkg object that is being billed. This will
1553 be called only if the package was created by a package change, and has
1554 not been billed since the package change, and package balance tracking
1555 is enabled. The second argument can be an alternate package number to
1556 transfer the balance from; this should not be used externally.
1558 Transfers the balance from the previous package (now canceled) to
1559 this package, by crediting one package and creating an invoice item for
1560 the other. Inserts the credit and returns the invoice item (so that it
1561 can be added to an invoice that's being built).
1563 If the previous package was never billed, and was also created by a package
1564 change, then this will also transfer the balance from I<its> previous
1565 package, and so on, until reaching a package that either has been billed
1566 or was not created by a package change.
1570 my $balance_transfer_reason;
1572 sub _transfer_balance {
1574 my $cust_pkg = shift;
1575 my $from_pkgnum = shift || $cust_pkg->change_pkgnum;
1576 my $from_pkg = FS::cust_pkg->by_key($from_pkgnum);
1580 # if $from_pkg is not the first package in the chain, and it was never
1582 if ( $from_pkg->change_pkgnum and scalar($from_pkg->cust_bill_pkg) == 0 ) {
1583 @transfers = $self->_transfer_balance($cust_pkg, $from_pkg->change_pkgnum);
1586 my $prev_balance = $self->balance_pkgnum($from_pkgnum);
1587 if ( $prev_balance != 0 ) {
1588 $balance_transfer_reason ||= FS::reason->new_or_existing(
1589 'reason' => 'Package balance transfer',
1590 'type' => 'Internal adjustment',
1594 my $credit = FS::cust_credit->new({
1595 'custnum' => $self->custnum,
1596 'amount' => abs($prev_balance),
1597 'reasonnum' => $balance_transfer_reason->reasonnum,
1598 '_date' => $cust_pkg->change_date,
1601 my $cust_bill_pkg = FS::cust_bill_pkg->new({
1603 'recur' => abs($prev_balance),
1604 #'sdate' => $from_pkg->last_bill, # not sure about this
1605 #'edate' => $cust_pkg->change_date,
1606 'itemdesc' => $self->mt('Previous Balance, [_1]',
1607 $from_pkg->part_pkg->pkg),
1610 if ( $prev_balance > 0 ) {
1611 # credit the old package, charge the new one
1612 $credit->set('pkgnum', $from_pkgnum);
1613 $cust_bill_pkg->set('pkgnum', $cust_pkg->pkgnum);
1616 $credit->set('pkgnum', $cust_pkg->pkgnum);
1617 $cust_bill_pkg->set('pkgnum', $from_pkgnum);
1619 my $error = $credit->insert;
1620 die "error transferring package balance from #".$from_pkgnum.
1621 " to #".$cust_pkg->pkgnum.": $error\n" if $error;
1623 push @transfers, $cust_bill_pkg;
1624 } # $prev_balance != 0
1629 =item handle_taxes TAXLISTHASH CUST_BILL_PKG [ OPTIONS ]
1631 This is _handle_taxes. It's called once for each cust_bill_pkg generated
1634 TAXLISTHASH is a hashref shared across the entire invoice. It looks like
1637 'cust_main_county 1001' => [ [FS::cust_main_county], ... ],
1638 'cust_main_county 1002' => [ [FS::cust_main_county], ... ],
1641 'cust_main_county' can also be 'tax_rate'. The first object in the array
1642 is always the cust_main_county or tax_rate identified by the key.
1644 That "..." is a list of FS::cust_bill_pkg objects that will be fed to
1645 the 'taxline' method to calculate the amount of the tax. This doesn't
1646 happen until calculate_taxes, though.
1648 OPTIONS may include:
1649 - part_item: a part_pkg or part_fee object to be used as the package/fee
1651 - location: a cust_location to be used as the billing location.
1652 - cancel: true if this package is being billed on cancellation. This
1653 allows tax to be calculated on usage charges only.
1655 If not supplied, part_item will be inferred from the pkgnum or feepart of the
1656 cust_bill_pkg, and location from the pkgnum (or, for fees, the invnum and
1657 the customer's default service location).
1659 This method will also calculate exemptions for any taxes that apply to the
1660 line item (using the C<set_exemptions> method of L<FS::cust_bill_pkg>) and
1661 attach them. This is the only place C<set_exemptions> is called in normal
1668 my $taxlisthash = shift;
1669 my $cust_bill_pkg = shift;
1672 # at this point I realize that we have enough information to infer all this
1673 # stuff, instead of passing around giant honking argument lists
1674 my $location = $options{location} || $cust_bill_pkg->tax_location;
1675 my $part_item = $options{part_item} || $cust_bill_pkg->part_X;
1677 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1679 return if ( $self->payby eq 'COMP' ); #dubious
1681 if ( $conf->exists('enable_taxproducts')
1682 && ( scalar($part_item->part_pkg_taxoverride)
1683 || $part_item->has_taxproduct
1688 # EXTERNAL TAX RATES (via tax_rate)
1689 my %cust_bill_pkg = ();
1693 my $usage = $cust_bill_pkg->usage || 0;
1694 push @classes, $cust_bill_pkg->usage_classes if $usage;
1695 push @classes, 'setup' if $cust_bill_pkg->setup and !$options{cancel};
1696 push @classes, 'recur' if ($cust_bill_pkg->recur - $usage)
1697 and !$options{cancel};
1698 # that's better--probably don't even need $options{cancel} now
1699 # but leave it for now, just to be safe
1701 # About $options{cancel}: This protects against charging per-line or
1702 # per-customer or other flat-rate surcharges on a package that's being
1703 # billed on cancellation (which is an out-of-cycle bill and should only
1704 # have usage charges). See RT#29443.
1706 # customer exemption is now handled in the 'taxline' method
1707 #my $exempt = $conf->exists('cust_class-tax_exempt')
1708 # ? ( $self->cust_class ? $self->cust_class->tax : '' )
1710 # standardize this just to be sure
1711 #$exempt = ($exempt eq 'Y') ? 'Y' : '';
1715 unless (exists $taxes{''}) {
1716 # unsure what purpose this serves, but last time I deleted something
1717 # from here just because I didn't see the point, it actually did
1718 # something important.
1719 my $err_or_ref = $self->_gather_taxes($part_item, '', $location);
1720 return $err_or_ref unless ref($err_or_ref);
1721 $taxes{''} = $err_or_ref;
1724 # NO DISINTEGRATIONS.
1725 # my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
1727 # do not call taxline() with any argument except the entire set of
1728 # cust_bill_pkgs on an invoice that are eligible for the tax.
1730 # only calculate exemptions once for each tax rate, even if it's used
1731 # for multiple classes
1734 foreach my $class (@classes) {
1735 my $err_or_ref = $self->_gather_taxes($part_item, $class, $location);
1736 return $err_or_ref unless ref($err_or_ref);
1737 my @taxes = @$err_or_ref;
1741 foreach my $tax ( @taxes ) {
1743 my $tax_id = ref( $tax ). ' '. $tax->taxnum;
1744 # $taxlisthash: keys are tax identifiers ('FS::tax_rate 123456').
1745 # Values are arrayrefs, first the tax object (cust_main_county
1746 # or tax_rate), then the cust_bill_pkg object that the
1747 # tax applies to, then the tax class (setup, recur, usage classnum).
1748 $taxlisthash->{ $tax_id } ||= [ $tax ];
1749 push @{ $taxlisthash->{ $tax_id } }, $cust_bill_pkg, $class;
1751 # determine any exemptions that apply
1752 if (!$tax_seen{$tax_id}) {
1753 $cust_bill_pkg->set_exemptions( $tax, custnum => $self->custnum );
1754 $tax_seen{$tax_id} = 1;
1757 # tax on tax will be done later, when we actually create the tax
1765 # INTERNAL TAX RATES (cust_main_county)
1767 # We fetch taxes even if the customer is completely exempt,
1768 # because we need to record that fact.
1770 my %taxhash = map { $_ => $location->get($_) }
1771 qw( district county state country );
1772 # city names in cust_main_county are uppercase
1773 $taxhash{'city'} = uc($location->get('city'));
1775 $taxhash{'taxclass'} = $part_item->taxclass;
1777 warn "taxhash:\n". Dumper(\%taxhash) if $DEBUG > 2;
1779 my @taxes = (); # entries are cust_main_county objects
1780 my %taxhash_elim = %taxhash;
1781 my @elim = qw( district city county state );
1784 #first try a match with taxclass
1785 @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
1787 if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
1788 #then try a match without taxclass
1789 my %no_taxclass = %taxhash_elim;
1790 $no_taxclass{ 'taxclass' } = '';
1791 @taxes = qsearch( 'cust_main_county', \%no_taxclass );
1794 $taxhash_elim{ shift(@elim) } = '';
1796 } while ( !scalar(@taxes) && scalar(@elim) );
1799 my $tax_id = 'cust_main_county '.$_->taxnum;
1800 $taxlisthash->{$tax_id} ||= [ $_ ];
1801 $cust_bill_pkg->set_exemptions($_, custnum => $self->custnum);
1802 push @{ $taxlisthash->{$tax_id} }, $cust_bill_pkg;
1809 =item _gather_taxes PART_ITEM CLASS CUST_LOCATION
1811 Internal method used with vendor-provided tax tables. PART_ITEM is a part_pkg
1812 or part_fee (which will define the tax eligibility of the product), CLASS is
1813 'setup', 'recur', null, or a C<usage_class> number, and CUST_LOCATION is the
1814 location where the service was provided (or billed, depending on
1815 configuration). Returns an arrayref of L<FS::tax_rate> objects that
1816 can apply to this line item.
1822 my $part_item = shift;
1824 my $location = shift;
1826 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1828 my $geocode = $location->geocode('cch');
1830 [ $part_item->tax_rates('cch', $geocode, $class) ]
1834 =item collect [ HASHREF | OPTION => VALUE ... ]
1836 (Attempt to) collect money for this customer's outstanding invoices (see
1837 L<FS::cust_bill>). Usually used after the bill method.
1839 Actions are now triggered by billing events; see L<FS::part_event> and the
1840 billing events web interface. Old-style invoice events (see
1841 L<FS::part_bill_event>) have been deprecated.
1843 If there is an error, returns the error, otherwise returns false.
1845 Options are passed as name-value pairs.
1847 Currently available options are:
1853 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.
1857 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
1861 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
1865 set true to surpress email card/ACH decline notices.
1869 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)
1875 # allows for one time override of normal customer billing method
1880 my( $self, %options ) = @_;
1882 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
1884 my $invoice_time = $options{'invoice_time'} || time;
1887 local $SIG{HUP} = 'IGNORE';
1888 local $SIG{INT} = 'IGNORE';
1889 local $SIG{QUIT} = 'IGNORE';
1890 local $SIG{TERM} = 'IGNORE';
1891 local $SIG{TSTP} = 'IGNORE';
1892 local $SIG{PIPE} = 'IGNORE';
1894 my $oldAutoCommit = $FS::UID::AutoCommit;
1895 local $FS::UID::AutoCommit = 0;
1898 $self->select_for_update; #mutex
1901 my $balance = $self->balance;
1902 warn "$me collect customer ". $self->custnum. ": balance $balance\n"
1905 if ( exists($options{'retry_card'}) ) {
1906 carp 'retry_card option passed to collect is deprecated; use retry';
1907 $options{'retry'} ||= $options{'retry_card'};
1909 if ( exists($options{'retry'}) && $options{'retry'} ) {
1910 my $error = $self->retry_realtime;
1912 $dbh->rollback if $oldAutoCommit;
1917 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1919 #never want to roll back an event just because it returned an error
1920 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
1922 $self->do_cust_event(
1923 'debug' => ( $options{'debug'} || 0 ),
1924 'time' => $invoice_time,
1925 'check_freq' => $options{'check_freq'},
1926 'stage' => 'collect',
1931 =item retry_realtime
1933 Schedules realtime / batch credit card / electronic check / LEC billing
1934 events for for retry. Useful if card information has changed or manual
1935 retry is desired. The 'collect' method must be called to actually retry
1938 Implementation details: For either this customer, or for each of this
1939 customer's open invoices, changes the status of the first "done" (with
1940 statustext error) realtime processing event to "failed".
1944 sub retry_realtime {
1947 local $SIG{HUP} = 'IGNORE';
1948 local $SIG{INT} = 'IGNORE';
1949 local $SIG{QUIT} = 'IGNORE';
1950 local $SIG{TERM} = 'IGNORE';
1951 local $SIG{TSTP} = 'IGNORE';
1952 local $SIG{PIPE} = 'IGNORE';
1954 my $oldAutoCommit = $FS::UID::AutoCommit;
1955 local $FS::UID::AutoCommit = 0;
1958 #a little false laziness w/due_cust_event (not too bad, really)
1960 # I guess this is always as of now?
1961 my $join = FS::part_event_condition->join_conditions_sql('', 'time' => time);
1962 my $order = FS::part_event_condition->order_conditions_sql;
1965 . join ( ' OR ' , map {
1966 my $cust_join = FS::part_event->eventtables_cust_join->{$_} || '';
1967 my $custnum = FS::part_event->eventtables_custnum->{$_};
1968 "( part_event.eventtable = " . dbh->quote($_)
1969 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key
1970 . " from $_ $cust_join"
1971 . " where $custnum = " . dbh->quote( $self->custnum ) . "))" ;
1972 } FS::part_event->eventtables)
1975 #here is the agent virtualization
1976 my $agent_virt = " ( part_event.agentnum IS NULL
1977 OR part_event.agentnum = ". $self->agentnum. ' )';
1979 #XXX this shouldn't be hardcoded, actions should declare it...
1980 my @realtime_events = qw(
1981 cust_bill_realtime_card
1982 cust_bill_realtime_check
1983 cust_bill_realtime_lec
1987 my $is_realtime_event =
1988 ' part_event.action IN ( '.
1989 join(',', map "'$_'", @realtime_events ).
1992 my $batch_or_statustext =
1993 "( part_event.action = 'cust_bill_batch'
1994 OR ( statustext IS NOT NULL AND statustext != '' )
1998 my @cust_event = qsearch({
1999 'table' => 'cust_event',
2000 'select' => 'cust_event.*',
2001 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
2002 'hashref' => { 'status' => 'done' },
2003 'extra_sql' => " AND $batch_or_statustext ".
2004 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
2007 my %seen_invnum = ();
2008 foreach my $cust_event (@cust_event) {
2010 #max one for the customer, one for each open invoice
2011 my $cust_X = $cust_event->cust_X;
2012 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
2016 or $cust_event->part_event->eventtable eq 'cust_bill'
2019 my $error = $cust_event->retry;
2021 $dbh->rollback if $oldAutoCommit;
2022 return "error scheduling event for retry: $error";
2027 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2032 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2034 Runs billing events; see L<FS::part_event> and the billing events web
2037 If there is an error, returns the error, otherwise returns false.
2039 Options are passed as name-value pairs.
2041 Currently available options are:
2047 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.
2051 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2055 "collect" (the default) or "pre-bill"
2059 set true to surpress email card/ACH decline notices.
2063 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)
2070 # allows for one time override of normal customer billing method
2074 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2077 my( $self, %options ) = @_;
2079 local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2081 my $time = $options{'time'} || time;
2084 local $SIG{HUP} = 'IGNORE';
2085 local $SIG{INT} = 'IGNORE';
2086 local $SIG{QUIT} = 'IGNORE';
2087 local $SIG{TERM} = 'IGNORE';
2088 local $SIG{TSTP} = 'IGNORE';
2089 local $SIG{PIPE} = 'IGNORE';
2091 my $oldAutoCommit = $FS::UID::AutoCommit;
2092 local $FS::UID::AutoCommit = 0;
2095 $self->select_for_update; #mutex
2098 my $balance = $self->balance;
2099 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2102 # if ( exists($options{'retry_card'}) ) {
2103 # carp 'retry_card option passed to collect is deprecated; use retry';
2104 # $options{'retry'} ||= $options{'retry_card'};
2106 # if ( exists($options{'retry'}) && $options{'retry'} ) {
2107 # my $error = $self->retry_realtime;
2109 # $dbh->rollback if $oldAutoCommit;
2114 # false laziness w/pay_batch::import_results
2116 my $due_cust_event = $self->due_cust_event(
2117 'debug' => ( $options{'debug'} || 0 ),
2119 'check_freq' => $options{'check_freq'},
2120 'stage' => ( $options{'stage'} || 'collect' ),
2122 unless( ref($due_cust_event) ) {
2123 $dbh->rollback if $oldAutoCommit;
2124 return $due_cust_event;
2127 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2128 #never want to roll back an event just because it or a different one
2130 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2132 foreach my $cust_event ( @$due_cust_event ) {
2136 #re-eval event conditions (a previous event could have changed things)
2137 unless ( $cust_event->test_conditions ) {
2138 #don't leave stray "new/locked" records around
2139 my $error = $cust_event->delete;
2140 return $error if $error;
2145 local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
2146 if $options{'quiet'};
2147 warn " running cust_event ". $cust_event->eventnum. "\n"
2150 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2151 if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
2152 #XXX wtf is this? figure out a proper dealio with return value
2164 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2166 Inserts database records for and returns an ordered listref of new events due
2167 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2168 events are due, an empty listref is returned. If there is an error, returns a
2169 scalar error message.
2171 To actually run the events, call each event's test_condition method, and if
2172 still true, call the event's do_event method.
2174 Options are passed as a hashref or as a list of name-value pairs. Available
2181 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.
2185 "collect" (the default) or "pre-bill"
2189 "Current time" for the events.
2193 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)
2197 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2201 Explicitly pass the objects to be tested (typically used with eventtable).
2205 Set to true to return the objects, but not actually insert them into the
2212 sub due_cust_event {
2214 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2217 #my $DEBUG = $opt{'debug'}
2218 $opt{'debug'} ||= 0; # silence some warnings
2219 local($DEBUG) = $opt{'debug'}
2220 if $opt{'debug'} > $DEBUG;
2221 $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
2223 warn "$me due_cust_event called with options ".
2224 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2227 $opt{'time'} ||= time;
2229 local $SIG{HUP} = 'IGNORE';
2230 local $SIG{INT} = 'IGNORE';
2231 local $SIG{QUIT} = 'IGNORE';
2232 local $SIG{TERM} = 'IGNORE';
2233 local $SIG{TSTP} = 'IGNORE';
2234 local $SIG{PIPE} = 'IGNORE';
2236 my $oldAutoCommit = $FS::UID::AutoCommit;
2237 local $FS::UID::AutoCommit = 0;
2240 $self->select_for_update #mutex
2241 unless $opt{testonly};
2244 # find possible events (initial search)
2247 my @cust_event = ();
2249 my @eventtable = $opt{'eventtable'}
2250 ? ( $opt{'eventtable'} )
2251 : FS::part_event->eventtables_runorder;
2253 my $check_freq = $opt{'check_freq'} || '1d';
2255 foreach my $eventtable ( @eventtable ) {
2258 if ( $opt{'objects'} ) {
2260 @objects = @{ $opt{'objects'} };
2262 } elsif ( $eventtable eq 'cust_main' ) {
2264 @objects = ( $self );
2268 my $cm_join = " LEFT JOIN cust_main USING ( custnum )";
2269 # linkage not needed here because FS::cust_main->$eventtable will
2272 #some false laziness w/Cron::bill bill_where
2274 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2275 'time' => $opt{'time'});
2276 my $where = FS::part_event_condition->where_conditions_sql($eventtable,
2277 'time'=>$opt{'time'},
2279 $where = $where ? "AND $where" : '';
2281 my $are_part_event =
2282 "EXISTS ( SELECT 1 FROM part_event $join
2283 WHERE check_freq = '$check_freq'
2284 AND eventtable = '$eventtable'
2285 AND ( disabled = '' OR disabled IS NULL )
2291 @objects = $self->$eventtable(
2292 'addl_from' => $cm_join,
2293 'extra_sql' => " AND $are_part_event",
2295 } # if ( !$opt{objects} and $eventtable ne 'cust_main' )
2297 my @e_cust_event = ();
2299 my $linkage = FS::part_event->eventtables_cust_join->{$eventtable} || '';
2301 my $cross = "CROSS JOIN $eventtable $linkage";
2302 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2303 unless $eventtable eq 'cust_main';
2305 foreach my $object ( @objects ) {
2307 #this first search uses the condition_sql magic for optimization.
2308 #the more possible events we can eliminate in this step the better
2310 my $cross_where = '';
2311 my $pkey = $object->primary_key;
2312 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2314 my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
2315 'time' => $opt{'time'});
2317 FS::part_event_condition->where_conditions_sql( $eventtable,
2318 'time'=>$opt{'time'}
2320 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2322 $extra_sql = "AND $extra_sql" if $extra_sql;
2324 #here is the agent virtualization
2325 $extra_sql .= " AND ( part_event.agentnum IS NULL
2326 OR part_event.agentnum = ". $self->agentnum. ' )';
2328 $extra_sql .= " $order";
2330 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2331 if $opt{'debug'} > 2;
2332 my @part_event = qsearch( {
2333 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2334 'select' => 'part_event.*',
2335 'table' => 'part_event',
2336 'addl_from' => "$cross $join",
2337 'hashref' => { 'check_freq' => $check_freq,
2338 'eventtable' => $eventtable,
2341 'extra_sql' => "AND $cross_where $extra_sql",
2345 my $pkey = $object->primary_key;
2346 warn " ". scalar(@part_event).
2347 " possible events found for $eventtable ". $object->$pkey(). "\n";
2350 push @e_cust_event, map {
2351 $_->new_cust_event($object, 'time' => $opt{'time'})
2356 warn " ". scalar(@e_cust_event).
2357 " subtotal possible cust events found for $eventtable\n"
2360 push @cust_event, @e_cust_event;
2364 warn " ". scalar(@cust_event).
2365 " total possible cust events found in initial search\n"
2373 $opt{stage} ||= 'collect';
2375 grep { my $stage = $_->part_event->event_stage;
2376 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2386 @cust_event = grep $_->test_conditions( 'stats_hashref' => \%unsat ),
2389 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2392 warn " invalid conditions not eliminated with condition_sql:\n".
2393 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2394 if keys %unsat && $DEBUG; # > 1;
2400 unless( $opt{testonly} ) {
2401 foreach my $cust_event ( @cust_event ) {
2403 my $error = $cust_event->insert();
2405 $dbh->rollback if $oldAutoCommit;
2412 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2418 warn " returning events: ". Dumper(@cust_event). "\n"
2425 =item apply_payments_and_credits [ OPTION => VALUE ... ]
2427 Applies unapplied payments and credits.
2428 Payments with the no_auto_apply flag set will not be applied.
2430 In most cases, this new method should be used in place of sequential
2431 apply_payments and apply_credits methods.
2433 A hash of optional arguments may be passed. Currently "manual" is supported.
2434 If true, a payment receipt is sent instead of a statement when
2435 'payment_receipt_email' configuration option is set.
2437 If there is an error, returns the error, otherwise returns false.
2441 sub apply_payments_and_credits {
2442 my( $self, %options ) = @_;
2444 local $SIG{HUP} = 'IGNORE';
2445 local $SIG{INT} = 'IGNORE';
2446 local $SIG{QUIT} = 'IGNORE';
2447 local $SIG{TERM} = 'IGNORE';
2448 local $SIG{TSTP} = 'IGNORE';
2449 local $SIG{PIPE} = 'IGNORE';
2451 my $oldAutoCommit = $FS::UID::AutoCommit;
2452 local $FS::UID::AutoCommit = 0;
2455 $self->select_for_update; #mutex
2457 foreach my $cust_bill ( $self->open_cust_bill ) {
2458 my $error = $cust_bill->apply_payments_and_credits(%options);
2460 $dbh->rollback if $oldAutoCommit;
2461 return "Error applying: $error";
2465 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2470 =item apply_credits OPTION => VALUE ...
2472 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
2473 to outstanding invoice balances in chronological order (or reverse
2474 chronological order if the I<order> option is set to B<newest>) and returns the
2475 value of any remaining unapplied credits available for refund (see
2476 L<FS::cust_refund>).
2478 Dies if there is an error.
2486 local $SIG{HUP} = 'IGNORE';
2487 local $SIG{INT} = 'IGNORE';
2488 local $SIG{QUIT} = 'IGNORE';
2489 local $SIG{TERM} = 'IGNORE';
2490 local $SIG{TSTP} = 'IGNORE';
2491 local $SIG{PIPE} = 'IGNORE';
2493 my $oldAutoCommit = $FS::UID::AutoCommit;
2494 local $FS::UID::AutoCommit = 0;
2497 $self->select_for_update; #mutex
2499 unless ( $self->total_unapplied_credits ) {
2500 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2504 my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
2505 qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
2507 my @invoices = $self->open_cust_bill;
2508 @invoices = sort { $b->_date <=> $a->_date } @invoices
2509 if defined($opt{'order'}) && $opt{'order'} eq 'newest';
2511 if ( $conf->exists('pkg-balances') ) {
2512 # limit @credits to those w/ a pkgnum grepped from $self
2514 foreach my $i (@invoices) {
2515 foreach my $li ( $i->cust_bill_pkg ) {
2516 $pkgnums{$li->pkgnum} = 1;
2519 @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
2524 foreach my $cust_bill ( @invoices ) {
2526 if ( !defined($credit) || $credit->credited == 0) {
2527 $credit = pop @credits or last;
2531 if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
2532 $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
2534 $owed = $cust_bill->owed;
2536 unless ( $owed > 0 ) {
2537 push @credits, $credit;
2541 my $amount = min( $credit->credited, $owed );
2543 my $cust_credit_bill = new FS::cust_credit_bill ( {
2544 'crednum' => $credit->crednum,
2545 'invnum' => $cust_bill->invnum,
2546 'amount' => $amount,
2548 $cust_credit_bill->pkgnum( $credit->pkgnum )
2549 if $conf->exists('pkg-balances') && $credit->pkgnum;
2550 my $error = $cust_credit_bill->insert;
2552 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2556 redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2560 my $total_unapplied_credits = $self->total_unapplied_credits;
2562 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2564 return $total_unapplied_credits;
2567 =item apply_payments [ OPTION => VALUE ... ]
2569 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
2570 to outstanding invoice balances in chronological order.
2571 Payments with the no_auto_apply flag set will not be applied.
2573 #and returns the value of any remaining unapplied payments.
2575 A hash of optional arguments may be passed. Currently "manual" is supported.
2576 If true, a payment receipt is sent instead of a statement when
2577 'payment_receipt_email' configuration option is set.
2579 Dies if there is an error.
2583 sub apply_payments {
2584 my( $self, %options ) = @_;
2586 local $SIG{HUP} = 'IGNORE';
2587 local $SIG{INT} = 'IGNORE';
2588 local $SIG{QUIT} = 'IGNORE';
2589 local $SIG{TERM} = 'IGNORE';
2590 local $SIG{TSTP} = 'IGNORE';
2591 local $SIG{PIPE} = 'IGNORE';
2593 my $oldAutoCommit = $FS::UID::AutoCommit;
2594 local $FS::UID::AutoCommit = 0;
2597 $self->select_for_update; #mutex
2601 my @payments = grep { !$_->no_auto_apply } $self->unapplied_cust_pay;
2603 my @invoices = $self->open_cust_bill;
2605 if ( $conf->exists('pkg-balances') ) {
2606 # limit @payments to those w/ a pkgnum grepped from $self
2608 foreach my $i (@invoices) {
2609 foreach my $li ( $i->cust_bill_pkg ) {
2610 $pkgnums{$li->pkgnum} = 1;
2613 @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
2618 foreach my $cust_bill ( @invoices ) {
2620 if ( !defined($payment) || $payment->unapplied == 0 ) {
2621 $payment = pop @payments or last;
2625 if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
2626 $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
2628 $owed = $cust_bill->owed;
2630 unless ( $owed > 0 ) {
2631 push @payments, $payment;
2635 my $amount = min( $payment->unapplied, $owed );
2638 'paynum' => $payment->paynum,
2639 'invnum' => $cust_bill->invnum,
2640 'amount' => $amount,
2642 $cbp->{_date} = $payment->_date
2643 if $options{'manual'} && $options{'backdate_application'};
2644 my $cust_bill_pay = new FS::cust_bill_pay($cbp);
2645 $cust_bill_pay->pkgnum( $payment->pkgnum )
2646 if $conf->exists('pkg-balances') && $payment->pkgnum;
2647 my $error = $cust_bill_pay->insert(%options);
2649 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
2653 redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
2657 my $total_unapplied_payments = $self->total_unapplied_payments;
2659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2661 return $total_unapplied_payments;
2671 suspend_adjourned_pkgs
2672 unsuspend_resumed_pkgs
2675 (do_cust_event pre-bill)
2678 (vendor-only) _gather_taxes
2679 _omit_zero_value_bundles
2680 _handle_taxes (for fees)
2683 apply_payments_and_credits
2692 L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>