use strict;
use vars qw( $conf $DEBUG $me );
use Carp;
+use Data::Dumper;
+use List::Util qw( min );
use FS::UID qw( dbh );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs dbdef );
+use FS::Misc::DateTime qw( day_end );
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::cust_bill_pkg_display;
use FS::cust_bill_pay;
use FS::cust_credit_bill;
-use FS::cust_pkg;
use FS::cust_tax_adjustment;
use FS::tax_rate;
use FS::tax_rate_location;
use FS::cust_bill_pkg_tax_location;
use FS::cust_bill_pkg_tax_rate_location;
+use FS::part_event;
+use FS::part_event_condition;
+use FS::pkg_category;
# 1 is mostly method/subroutine entry and options
# 2 traces progress of some operations
=head1 SYNOPSIS
-=head1 DESCRIPTIONS
+=head1 DESCRIPTION
These methods are available on FS::cust_main objects.
my $job = $options{'job'};
$job->update_statustext('0,cleaning expired packages') if $job;
- $error = $self->cancel_expired_pkgs( $options{actual_time} );
+ $error = $self->cancel_expired_pkgs( day_end( $options{actual_time} ) );
if ( $error ) {
$error = "Error expiring custnum ". $self->custnum. ": $error";
if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
else { warn $error; }
}
- $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
+ $error = $self->suspend_adjourned_pkgs( day_end( $options{actual_time} ) );
if ( $error ) {
$error = "Error adjourning custnum ". $self->custnum. ": $error";
if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
sub cancel_expired_pkgs {
my ( $self, $time, %options ) = @_;
-
+
my @cancel_pkgs = $self->ncancelled_pkgs( {
'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
} );
sub suspend_adjourned_pkgs {
my ( $self, $time, %options ) = @_;
-
+
my @susp_pkgs = $self->ncancelled_pkgs( {
'extra_sql' =>
" AND ( susp IS NULL OR susp = 0 )
If set true, re-charges setup fees.
+=item recurring_only
+
+If set true then only bill recurring charges, not setup, usage, one time
+charges, etc.
+
+=item freq_override
+
+If set, then override the normal frequency and look for a part_pkg_discount
+to take at that frequency. This will exclude any packages that aren't billed
+on a monthly cycle.
+
=item time
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:
fees since the last billing. Setup charges may be charged. Not all package
plans support this feature (they tend to charge 0).
+=item no_usage_reset
+
+Prevent the resetting of usage limits during this call.
+
+=item no_commit
+
+Do not save the generated bill in the database. Useful with return_bill
+
+=item return_bill
+
+A list reference on which the generated bill(s) will be returned.
+
=item invoice_terms
Optional terms to be printed on this invoice. Otherwise, customer-specific
sub bill {
my( $self, %options ) = @_;
+
return '' if $self->payby eq 'COMP';
+
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
warn "$me bill customer ". $self->custnum. "\n"
if $DEBUG;
'time' => $invoice_time,
'check_freq' => $options{'check_freq'},
'stage' => 'pre-bill',
- );
+ )
+ unless $options{no_commit};
if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
- my $error =
- $self->_make_lines( 'part_pkg' => $part_pkg,
- 'cust_pkg' => $cust_pkg,
- 'precommit_hooks' => \@precommit_hooks,
- 'line_items' => $cust_bill_pkg{$pass},
- 'setup' => $total_setup{$pass},
- 'recur' => $total_recur{$pass},
- 'tax_matrix' => $taxlisthash{$pass},
- 'time' => $time,
- 'real_pkgpart' => $real_pkgpart,
- 'options' => \%options,
- );
+ my $next_bill = $cust_pkg->getfield('bill') || 0;
+ my $error;
+ while ( $next_bill <= $time ) {
+ $error =
+ $self->_make_lines( 'part_pkg' => $part_pkg,
+ 'cust_pkg' => $cust_pkg,
+ 'precommit_hooks' => \@precommit_hooks,
+ 'line_items' => $cust_bill_pkg{$pass},
+ 'setup' => $total_setup{$pass},
+ 'recur' => $total_recur{$pass},
+ 'tax_matrix' => $taxlisthash{$pass},
+ 'time' => $time,
+ 'real_pkgpart' => $real_pkgpart,
+ 'options' => \%options,
+ );
+ # Stop if anything goes wrong, or if we're not incrementing
+ # the bill date.
+ last if $error;
+ last if ($cust_pkg->getfield('bill') || 0) == $next_bill;
+ $next_bill = $cust_pkg->getfield('bill') || 0;
+ }
if ($error) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
next unless @cust_bill_pkg; #don't create an invoice w/o line items
+ warn "$me billing pass $pass\n"
+ #.Dumper(\@cust_bill_pkg)."\n"
+ if $DEBUG > 2;
+
if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
!$conf->exists('postal_invoice-recurring_only')
)
my $postal_pkg = $self->charge_postal_fee();
if ( $postal_pkg && !ref( $postal_pkg ) ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "can't charge postal invoice fee for customer ".
$self->custnum. ": $postal_pkg";
'options' => \%postal_options,
);
if ($error) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $error;
}
}
$self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
unless ( ref( $listref_or_error ) ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return $listref_or_error;
}
#my $balance_adjustments =
# sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
+ warn "creating the new invoice\n" if $DEBUG;
#create the new invoice
my $cust_bill = new FS::cust_bill ( {
'custnum' => $self->custnum,
- '_date' => ( $invoice_time ),
+ '_date' => $invoice_time,
'charged' => $charged,
'billing_balance' => $balance,
'previous_balance' => $previous_balance,
'invoice_terms' => $options{'invoice_terms'},
+ 'cust_bill_pkg' => \@cust_bill_pkg,
} );
- $error = $cust_bill->insert;
+ $error = $cust_bill->insert unless $options{no_commit};
if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "can't create invoice for customer #". $self->custnum. ": $error";
}
-
- foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
- $cust_bill_pkg->invnum($cust_bill->invnum);
- my $error = $cust_bill_pkg->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "can't create invoice line item: $error";
- }
- }
+ push @{$options{return_bill}}, $cust_bill if $options{return_bill};
} #foreach my $pass ( keys %cust_bill_pkg )
foreach my $hook ( @precommit_hooks ) {
eval {
&{$hook}; #($self) ?
- };
+ } unless $options{no_commit};
if ( $@ ) {
- $dbh->rollback if $oldAutoCommit;
+ $dbh->rollback if $oldAutoCommit && !$options{no_commit};
return "$@ running precommit hook $hook\n";
}
}
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit && !$options{no_commit};
+
''; #no error
}
#discard bundled packages of 0 value
sub _omit_zero_value_bundles {
+ my @in = @_;
my @cust_bill_pkg = ();
my @cust_bill_pkg_bundle = ();
my $sum = 0;
+ my $discount_show_always = 0;
+
+ foreach my $cust_bill_pkg ( @in ) {
+
+ $discount_show_always = ($cust_bill_pkg->get('discounts')
+ && scalar(@{$cust_bill_pkg->get('discounts')})
+ && $conf->exists('discount-show-always'));
+
+ warn " pkgnum ". $cust_bill_pkg->pkgnum. " sum $sum, ".
+ "setup_show_zero ". $cust_bill_pkg->setup_show_zero.
+ "recur_show_zero ". $cust_bill_pkg->recur_show_zero. "\n"
+ if $DEBUG > 0;
- foreach my $cust_bill_pkg ( @_ ) {
if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
- push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
+ push @cust_bill_pkg, @cust_bill_pkg_bundle
+ if $sum > 0
+ || ($sum == 0 && ( $discount_show_always
+ || grep {$_->recur_show_zero || $_->setup_show_zero}
+ @cust_bill_pkg_bundle
+ )
+ );
@cust_bill_pkg_bundle = ();
$sum = 0;
}
+
$sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur;
push @cust_bill_pkg_bundle, $cust_bill_pkg;
+
}
- push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0;
+
+ push @cust_bill_pkg, @cust_bill_pkg_bundle
+ if $sum > 0
+ || ($sum == 0 && ( $discount_show_always
+ || grep {$_->recur_show_zero || $_->setup_show_zero}
+ @cust_bill_pkg_bundle
+ )
+ );
+
+ warn " _omit_zero_value_bundles: ". scalar(@in).
+ '->'. scalar(@cust_bill_pkg). "\n" #. Dumper(@cust_bill_pkg). "\n"
+ if $DEBUG > 2;
(@cust_bill_pkg);
=back
=cut
+
sub calculate_taxes {
my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
- my @tax_line_items = ();
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
- warn "having a look at the taxes we found...\n" if $DEBUG > 2;
+ warn "$me calculate_taxes\n"
+ #.Dumper($self, $cust_bill_pkg, $taxlisthash, $invoice_time). "\n"
+ if $DEBUG > 2;
+
+ my @tax_line_items = ();
# keys are tax names (as printed on invoices / itemdesc )
# values are listrefs of taxlisthash keys (internal identifiers)
foreach my $tax ( keys %$taxlisthash ) {
foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
next unless ref($_) eq 'FS::cust_bill_pkg';
+
+ my @cust_tax_exempt_pkg = splice( @{ $_->_cust_tax_exempt_pkg } );
- push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
- splice( @{ $_->_cust_tax_exempt_pkg } );
+ next unless @cust_tax_exempt_pkg; #just avoiding the prob when irrelevant?
+ die "can't distribute tax exemptions: no line item for ". Dumper($_).
+ " in packagemap ". join(',', sort {$a<=>$b} keys %packagemap). "\n"
+ unless $packagemap{$_->pkgnum};
+
+ push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
+ @cust_tax_exempt_pkg;
}
}
sub _make_lines {
my ($self, %params) = @_;
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
my $time = $params{'time'} or die "no time specified";
my (%options) = %{$params{options}};
+ if ( $part_pkg->freq ne '1' and ($options{'freq_override'} || 0) > 0 ) {
+ # this should never happen
+ die 'freq_override billing attempted on non-monthly package '.
+ $cust_pkg->pkgnum;
+ }
+
my $dbh = dbh;
my $real_pkgpart = $params{real_pkgpart};
my %hash = $cust_pkg->hash;
my $old_cust_pkg = new FS::cust_pkg \%hash;
my @details = ();
- my @discounts = ();
my $lineitems = 0;
$cust_pkg->pkgpart($part_pkg->pkgpart);
my $setup = 0;
my $unitsetup = 0;
- if ( $options{'resetup'}
- || ( ! $cust_pkg->setup
- && ( ! $cust_pkg->start_date
- || $cust_pkg->start_date <= $time
- )
- && ( ! $conf->exists('disable_setup_suspended_pkgs')
- || ( $conf->exists('disable_setup_suspended_pkgs') &&
- ! $cust_pkg->getfield('susp')
- )
- )
- )
- )
+ my @setup_discounts = ();
+ my %setup_param = ( 'discounts' => \@setup_discounts );
+ if ( ! $options{recurring_only}
+ and ! $options{cancel}
+ and ( $options{'resetup'}
+ || ( ! $cust_pkg->setup
+ && ( ! $cust_pkg->start_date
+ || $cust_pkg->start_date <= day_end($time)
+ )
+ && ( ! $conf->exists('disable_setup_suspended_pkgs')
+ || ( $conf->exists('disable_setup_suspended_pkgs') &&
+ ! $cust_pkg->getfield('susp')
+ )
+ )
+ )
+ )
+ )
{
warn " bill setup\n" if $DEBUG > 1;
- $lineitems++;
- $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
- return "$@ running calc_setup for $cust_pkg\n"
- if $@;
+ unless ( $cust_pkg->waive_setup ) {
+ $lineitems++;
- $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
+ $setup = eval { $cust_pkg->calc_setup( $time, \@details, \%setup_param ) };
+ return "$@ running calc_setup for $cust_pkg\n"
+ if $@;
+
+ $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
+ }
$cust_pkg->setfield('setup', $time)
unless $cust_pkg->setup;
#XXX unit stuff here too
my $recur = 0;
my $unitrecur = 0;
+ my @recur_discounts = ();
my $sdate;
- if ( ! $cust_pkg->get('susp')
- and ! $cust_pkg->get('start_date')
- and ( $part_pkg->getfield('freq') ne '0'
- && ( $cust_pkg->getfield('bill') || 0 ) <= $time
- )
- || ( $part_pkg->plan eq 'voip_cdr'
- && $part_pkg->option('bill_every_call')
- )
- || ( $options{cancel} )
+ if ( ! $cust_pkg->start_date
+ and ( ! $cust_pkg->susp || $part_pkg->option('suspend_bill', 1) )
+ and
+ ( $part_pkg->freq ne '0' && ( $cust_pkg->bill || 0 ) <= day_end($time) )
+ || ( $part_pkg->plan eq 'voip_cdr'
+ && $part_pkg->option('bill_every_call')
+ )
+ || $options{cancel}
) {
# XXX should this be a package event? probably. events are called
# at collection time at the moment, though...
$part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
- if $part_pkg->can('reset_usage');
+ if $part_pkg->can('reset_usage') && !$options{'no_usage_reset'};
#don't want to reset usage just cause we want a line item??
#&& $part_pkg->pkgpart == $real_pkgpart;
#over two params! lets at least switch to a hashref for the rest...
my $increment_next_bill = ( $part_pkg->freq ne '0'
- && ( $cust_pkg->getfield('bill') || 0 ) <= $time
+ && ( $cust_pkg->getfield('bill') || 0 ) <= day_end($time)
&& !$options{cancel}
);
- my %param = ( 'precommit_hooks' => $precommit_hooks,
+ my %param = ( %setup_param,
+ 'precommit_hooks' => $precommit_hooks,
'increment_next_bill' => $increment_next_bill,
- 'discounts' => \@discounts,
+ 'discounts' => \@recur_discounts,
'real_pkgpart' => $real_pkgpart,
+ 'freq_override' => $options{freq_override} || '',
+ 'setup_fee' => 0,
);
my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
+
+ # There may be some part_pkg for which this is wrong. Only those
+ # which can_discount are supported.
+ # (the UI should prevent adding discounts to these at the moment)
+
+ warn "calling $method on cust_pkg ". $cust_pkg->pkgnum.
+ " for pkgpart ". $cust_pkg->pkgpart.
+ " with params ". join(' / ', map "$_=>$param{$_}", keys %param). "\n"
+ if $DEBUG > 2;
+
$recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
return "$@ running $method for $cust_pkg\n"
if ( $@ );
if ( $increment_next_bill ) {
- my $next_bill = $part_pkg->add_freq($sdate);
+ my $next_bill = $part_pkg->add_freq($sdate, $options{freq_override} || 0);
return "unparsable frequency: ". $part_pkg->freq
if $next_bill == -1;
}
+ if ( $param{'setup_fee'} ) {
+ # Add an additional setup fee at the billing stage.
+ # Used for prorate_defer_bill.
+ $setup += $param{'setup_fee'};
+ $unitsetup += $param{'setup_fee'};
+ $lineitems++;
+ }
+
+ if ( defined $param{'discount_left_setup'} ) {
+ foreach my $discount_setup ( values %{$param{'discount_left_setup'}} ) {
+ $setup -= $discount_setup;
+ }
+ }
+
}
warn "\$setup is undefined" unless defined($setup);
# If $cust_pkg has been modified, update it (if we're a real pkgpart)
###
- if ( $lineitems || $options{has_hidden} ) {
+ if ( $lineitems ) {
if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
# hmm.. and if just the options are modified in some weird price plan?
if $DEBUG >1;
my $error = $cust_pkg->replace( $old_cust_pkg,
+ 'depend_jobnum'=>$options{depend_jobnum},
'options' => { $cust_pkg->options },
- );
+ )
+ unless $options{no_commit};
return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
if $error; #just in case
}
return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
}
- if ( $setup != 0 ||
- $recur != 0 ||
- !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
+ my $discount_show_always = $conf->exists('discount-show-always')
+ && ( ($setup == 0 && scalar(@setup_discounts))
+ || ($recur == 0 && scalar(@recur_discounts))
+ );
+
+ if ( $setup != 0
+ || $recur != 0
+ || (!$part_pkg->hidden && $options{has_hidden}) #include some $0 lines
+ || $discount_show_always
+ || ($setup == 0 && $cust_pkg->_X_show_zero('setup'))
+ || ($recur == 0 && $cust_pkg->_X_show_zero('recur'))
+ )
{
warn " charges (setup=$setup, recur=$recur); adding line items\n"
'unitrecur' => $unitrecur,
'quantity' => $cust_pkg->quantity,
'details' => \@details,
- 'discounts' => \@discounts,
+ 'discounts' => [ @setup_discounts, @recur_discounts ],
'hidden' => $part_pkg->hidden,
+ 'freq' => $part_pkg->freq,
};
- if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
+ if ( $part_pkg->recur_temporality eq 'preceding' ) {
$cust_bill_pkg->sdate( $hash{last_bill} );
$cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1
$cust_bill_pkg->edate( $time ) if $options{cancel};
- } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
+ } else { #if ( $part_pkg->recur_temporality eq 'upcoming' ) {
$cust_bill_pkg->sdate( $sdate );
$cust_bill_pkg->edate( $cust_pkg->bill );
#$cust_bill_pkg->edate( $time ) if $options{cancel};
# handle taxes
###
- my $error =
- $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
- return $error if $error;
+ unless ( $discount_show_always ) {
+ my $error =
+ $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
+ return $error if $error;
+ }
push @$cust_bill_pkgs, $cust_bill_pkg;
my $real_pkgpart = shift;
my $options = shift;
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
my %cust_bill_pkg = ();
my %taxes = ();
)
{
- if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
- return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
- }
-
foreach my $class (@classes) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $cust_pkg );
return $err_or_ref unless ref($err_or_ref);
$taxes{$class} = $err_or_ref;
}
unless (exists $taxes{''}) {
- my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
+ my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $cust_pkg );
return $err_or_ref unless ref($err_or_ref);
$taxes{''} = $err_or_ref;
}
} #if $conf->exists('enable_taxproducts') ...
}
-
- my @display = ();
- my $separate = $conf->exists('separate_usage');
- my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
- my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
- my $section = $temp_pkg->part_pkg->categoryname;
- if ( $separate || $section || $usage_mandate ) {
-
- my %hash = ( 'section' => $section );
-
- $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
- my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
- if ( $separate ) {
- push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
- push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
- } else {
- push @display, new FS::cust_bill_pkg_display
- { type => '',
- %hash,
- ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
- };
- }
- if ($separate && $section && $summary) {
- push @display, new FS::cust_bill_pkg_display { type => 'U',
- summary => 'Y',
- %hash,
- };
- }
- if ($usage_mandate || $section && $summary) {
- $hash{post_total} = 'Y';
- }
-
- if ($separate || $usage_mandate) {
- $hash{section} = $section if ($separate || $usage_mandate);
- push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
- }
-
- }
- $cust_bill_pkg->set('display', \@display);
+ #what's this doing in the middle of _handle_taxes? probably should split
+ #this into three parts above in _make_lines
+ $cust_bill_pkg->set_display( part_pkg => $part_pkg,
+ real_pkgpart => $real_pkgpart,
+ );
my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
foreach my $key (keys %tax_cust_bill_pkg) {
my $self = shift;
my $part_pkg = shift;
my $class = shift;
+ my $cust_pkg = shift;
+
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
+ my $geocode;
+ if ( $cust_pkg->locationnum && $conf->exists('tax-pkg_address') ) {
+ $geocode = $cust_pkg->cust_location->geocode('cch');
+ } else {
+ $geocode = $self->geocode('cch');
+ }
my @taxes = ();
- my $geocode = $self->geocode('cch');
my @taxclassnums = map { $_->taxclassnum }
$part_pkg->part_pkg_taxoverride($class);
sub collect {
my( $self, %options ) = @_;
+
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
my $invoice_time = $options{'invoice_time'} || time;
#put below somehow?
}
+=item retry_realtime
+
+Schedules realtime / batch credit card / electronic check / LEC billing
+events for for retry. Useful if card information has changed or manual
+retry is desired. The 'collect' method must be called to actually retry
+the transaction.
+
+Implementation details: For either this customer, or for each of this
+customer's open invoices, changes the status of the first "done" (with
+statustext error) realtime processing event to "failed".
+
+=cut
+
+sub retry_realtime {
+ my $self = shift;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ #a little false laziness w/due_cust_event (not too bad, really)
+
+ my $join = FS::part_event_condition->join_conditions_sql;
+ my $order = FS::part_event_condition->order_conditions_sql;
+ my $mine =
+ '( '
+ . join ( ' OR ' , map {
+ "( part_event.eventtable = " . dbh->quote($_)
+ . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
+ } FS::part_event->eventtables)
+ . ') ';
+
+ #here is the agent virtualization
+ my $agent_virt = " ( part_event.agentnum IS NULL
+ OR part_event.agentnum = ". $self->agentnum. ' )';
+
+ #XXX this shouldn't be hardcoded, actions should declare it...
+ my @realtime_events = qw(
+ cust_bill_realtime_card
+ cust_bill_realtime_check
+ cust_bill_realtime_lec
+ cust_bill_batch
+ );
+
+ my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
+ @realtime_events
+ ).
+ ' ) ';
+
+ my @cust_event = qsearchs({
+ 'table' => 'cust_event',
+ 'select' => 'cust_event.*',
+ 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
+ 'hashref' => { 'status' => 'done' },
+ 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
+ " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
+ });
+
+ my %seen_invnum = ();
+ foreach my $cust_event (@cust_event) {
+
+ #max one for the customer, one for each open invoice
+ my $cust_X = $cust_event->cust_X;
+ next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
+ ? $cust_X->invnum
+ : 0
+ }++
+ or $cust_event->part_event->eventtable eq 'cust_bill'
+ && ! $cust_X->owed;
+
+ my $error = $cust_event->retry;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "error scheduling event for retry: $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+=item do_cust_event [ HASHREF | OPTION => VALUE ... ]
+
+Runs billing events; see L<FS::part_event> and the billing events web
+interface.
+
+If there is an error, returns the error, otherwise returns false.
+
+Options are passed as name-value pairs.
+
+Currently available options are:
+
+=over 4
+
+=item time
+
+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.
+
+=item check_freq
+
+"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
+
+=item stage
+
+"collect" (the default) or "pre-bill"
+
+=item quiet
+
+set true to surpress email card/ACH decline notices.
+
+=item debug
+
+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)
+
+=back
+=cut
+
+# =item payby
+#
+# allows for one time override of normal customer billing method
+
+# =item retry
+#
+# Retry card/echeck/LEC transactions even when not scheduled by invoice events.
+
+sub do_cust_event {
+ my( $self, %options ) = @_;
+
+ local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
+ my $time = $options{'time'} || time;
+
+ #put below somehow?
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $self->select_for_update; #mutex
+
+ if ( $DEBUG ) {
+ my $balance = $self->balance;
+ warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
+ }
+
+# if ( exists($options{'retry_card'}) ) {
+# carp 'retry_card option passed to collect is deprecated; use retry';
+# $options{'retry'} ||= $options{'retry_card'};
+# }
+# if ( exists($options{'retry'}) && $options{'retry'} ) {
+# my $error = $self->retry_realtime;
+# if ( $error ) {
+# $dbh->rollback if $oldAutoCommit;
+# return $error;
+# }
+# }
+
+ # false laziness w/pay_batch::import_results
+
+ my $due_cust_event = $self->due_cust_event(
+ 'debug' => ( $options{'debug'} || 0 ),
+ 'time' => $time,
+ 'check_freq' => $options{'check_freq'},
+ 'stage' => ( $options{'stage'} || 'collect' ),
+ );
+ unless( ref($due_cust_event) ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $due_cust_event;
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ #never want to roll back an event just because it or a different one
+ # returned an error
+ local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
+
+ foreach my $cust_event ( @$due_cust_event ) {
+
+ #XXX lock event
+
+ #re-eval event conditions (a previous event could have changed things)
+ unless ( $cust_event->test_conditions( 'time' => $time ) ) {
+ #don't leave stray "new/locked" records around
+ my $error = $cust_event->delete;
+ return $error if $error;
+ next;
+ }
+
+ {
+ local $FS::cust_main::Billing_Realtime::realtime_bop_decline_quiet = 1
+ if $options{'quiet'};
+ warn " running cust_event ". $cust_event->eventnum. "\n"
+ if $DEBUG > 1;
+
+ #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
+ if ( my $error = $cust_event->do_event( 'time' => $time ) ) {
+ #XXX wtf is this? figure out a proper dealio with return value
+ #from do_event
+ return $error;
+ }
+ }
+
+ }
+
+ '';
+
+}
+
+=item due_cust_event [ HASHREF | OPTION => VALUE ... ]
+
+Inserts database records for and returns an ordered listref of new events due
+for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
+events are due, an empty listref is returned. If there is an error, returns a
+scalar error message.
+
+To actually run the events, call each event's test_condition method, and if
+still true, call the event's do_event method.
+
+Options are passed as a hashref or as a list of name-value pairs. Available
+options are:
+
+=over 4
+
+=item check_freq
+
+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.
+
+=item stage
+
+"collect" (the default) or "pre-bill"
+
+=item time
+
+"Current time" for the events.
+
+=item debug
+
+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)
+
+=item eventtable
+
+Only return events for the specified eventtable (by default, events of all eventtables are returned)
+
+=item objects
+
+Explicitly pass the objects to be tested (typically used with eventtable).
+
+=item testonly
+
+Set to true to return the objects, but not actually insert them into the
+database.
+
+=back
+
+=cut
+
+sub due_cust_event {
+ my $self = shift;
+ my %opt = ref($_[0]) ? %{ $_[0] } : @_;
+
+ #???
+ #my $DEBUG = $opt{'debug'}
+ local($DEBUG) = $opt{'debug'}
+ if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
+ $DEBUG = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
+
+ warn "$me due_cust_event called with options ".
+ join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
+ if $DEBUG;
+
+ $opt{'time'} ||= time;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ $self->select_for_update #mutex
+ unless $opt{testonly};
+
+ ###
+ # find possible events (initial search)
+ ###
+
+ my @cust_event = ();
+
+ my @eventtable = $opt{'eventtable'}
+ ? ( $opt{'eventtable'} )
+ : FS::part_event->eventtables_runorder;
+
+ my $check_freq = $opt{'check_freq'} || '1d';
+
+ foreach my $eventtable ( @eventtable ) {
+
+ my @objects;
+ if ( $opt{'objects'} ) {
+
+ @objects = @{ $opt{'objects'} };
+
+ } else {
+
+ #my @objects = $self->$eventtable(); # sub cust_main { @{ [ $self ] }; }
+ if ( $eventtable eq 'cust_main' ) {
+ @objects = ( $self );
+ } else {
+
+ my $cm_join =
+ "LEFT JOIN cust_main USING ( custnum )";
+
+ #some false laziness w/Cron::bill bill_where
+
+ my $join = FS::part_event_condition->join_conditions_sql( $eventtable);
+ my $where = FS::part_event_condition->where_conditions_sql($eventtable,
+ 'time'=>$opt{'time'},
+ );
+ $where = $where ? "AND $where" : '';
+
+ my $are_part_event =
+ "EXISTS ( SELECT 1 FROM part_event $join
+ WHERE check_freq = '$check_freq'
+ AND eventtable = '$eventtable'
+ AND ( disabled = '' OR disabled IS NULL )
+ $where
+ )
+ ";
+ #eofalse
+
+ @objects = $self->$eventtable(
+ 'addl_from' => $cm_join,
+ 'extra_sql' => " AND $are_part_event",
+ );
+ }
+
+ }
+
+ my @e_cust_event = ();
+
+ my $cross = "CROSS JOIN $eventtable";
+ $cross .= ' LEFT JOIN cust_main USING ( custnum )'
+ unless $eventtable eq 'cust_main';
+
+ foreach my $object ( @objects ) {
+
+ #this first search uses the condition_sql magic for optimization.
+ #the more possible events we can eliminate in this step the better
+
+ my $cross_where = '';
+ my $pkey = $object->primary_key;
+ $cross_where = "$eventtable.$pkey = ". $object->$pkey();
+
+ my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
+ my $extra_sql =
+ FS::part_event_condition->where_conditions_sql( $eventtable,
+ 'time'=>$opt{'time'}
+ );
+ my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
+
+ $extra_sql = "AND $extra_sql" if $extra_sql;
+
+ #here is the agent virtualization
+ $extra_sql .= " AND ( part_event.agentnum IS NULL
+ OR part_event.agentnum = ". $self->agentnum. ' )';
+
+ $extra_sql .= " $order";
+
+ warn "searching for events for $eventtable ". $object->$pkey. "\n"
+ if $opt{'debug'} > 2;
+ my @part_event = qsearch( {
+ 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
+ 'select' => 'part_event.*',
+ 'table' => 'part_event',
+ 'addl_from' => "$cross $join",
+ 'hashref' => { 'check_freq' => $check_freq,
+ 'eventtable' => $eventtable,
+ 'disabled' => '',
+ },
+ 'extra_sql' => "AND $cross_where $extra_sql",
+ } );
+
+ if ( $DEBUG > 2 ) {
+ my $pkey = $object->primary_key;
+ warn " ". scalar(@part_event).
+ " possible events found for $eventtable ". $object->$pkey(). "\n";
+ }
+
+ push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
+
+ }
+
+ warn " ". scalar(@e_cust_event).
+ " subtotal possible cust events found for $eventtable\n"
+ if $DEBUG > 1;
+
+ push @cust_event, @e_cust_event;
+
+ }
+
+ warn " ". scalar(@cust_event).
+ " total possible cust events found in initial search\n"
+ if $DEBUG; # > 1;
+
+
+ ##
+ # test stage
+ ##
+
+ $opt{stage} ||= 'collect';
+ @cust_event =
+ grep { my $stage = $_->part_event->event_stage;
+ $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
+ }
+ @cust_event;
+
+ ##
+ # test conditions
+ ##
+
+ my %unsat = ();
+
+ @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
+ 'stats_hashref' => \%unsat ),
+ @cust_event;
+
+ warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
+ if $DEBUG; # > 1;
+
+ warn " invalid conditions not eliminated with condition_sql:\n".
+ join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
+ if keys %unsat && $DEBUG; # > 1;
+
+ ##
+ # insert
+ ##
+
+ unless( $opt{testonly} ) {
+ foreach my $cust_event ( @cust_event ) {
+
+ my $error = $cust_event->insert();
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ }
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+ ##
+ # return
+ ##
+
+ warn " returning events: ". Dumper(@cust_event). "\n"
+ if $DEBUG > 2;
+
+ \@cust_event;
+
+}
=item apply_payments_and_credits [ OPTION => VALUE ... ]
my $amount = min( $payment->unapplied, $owed );
- my $cust_bill_pay = new FS::cust_bill_pay ( {
+ my $cbp = {
'paynum' => $payment->paynum,
'invnum' => $cust_bill->invnum,
'amount' => $amount,
- } );
+ };
+ $cbp->{_date} = $payment->_date
+ if $options{'manual'} && $options{'backdate_application'};
+ my $cust_bill_pay = new FS::cust_bill_pay($cbp);
$cust_bill_pay->pkgnum( $payment->pkgnum )
if $conf->exists('pkg-balances') && $payment->pkgnum;
my $error = $cust_bill_pay->insert(%options);
return $total_unapplied_payments;
}
+=back
+
+=head1 FLOW
+
+ bill_and_collect
+
+ cancel_expired_pkgs
+ suspend_adjourned_pkgs
+
+ bill
+ (do_cust_event pre-bill)
+ _make_lines
+ _handle_taxes
+ (vendor-only) _gather_taxes
+ _omit_zero_value_bundles
+ calculate_taxes
+
+ apply_payments_and_credits
+ collect
+ do_cust_event
+ due_cust_event
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, L<FS::cust_main::Billing_Realtime>
+
+=cut
+
1;
projects / freeside.git / blobdiff