[freeside-commits] branch FREESIDE_3_BRANCH updated. 6d1717a6efc1db987c309d149e679a5676a04e4a
Mark Wells
mark at 420.am
Wed Sep 21 14:30:13 PDT 2016
The branch, FREESIDE_3_BRANCH has been updated
via 6d1717a6efc1db987c309d149e679a5676a04e4a (commit)
via 6d2db824c90c29789852fb1a7645400c90032091 (commit)
from 28cd25044dcda22e1e879e94d953c98f32be2b28 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 6d1717a6efc1db987c309d149e679a5676a04e4a
Author: Mark Wells <mark at freeside.biz>
Date: Wed Sep 21 14:03:08 2016 -0700
be more selective when unapplying payments for a line item credit, #42729
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 610d173..18f4a32 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -901,6 +901,49 @@ sub credit_lineitems {
my %cust_credit_bill_pkg = ();
my %unapplied_payments = (); #invoice numbers, and then billpaynums
+ # little private function to unapply payments from a cust_bill_pkg until
+ # there's a specified amount of unpaid balance on it.
+ # it's a separate sub because we do it for both tax and nontax items. it's
+ # private because it needs access to some local data structures.
+ my $unapply_sub = sub {
+ my ($cust_bill_pkg, $setuprecur, $need_to_unapply) = @_;
+
+ my $invnum = $cust_bill_pkg->invnum;
+
+ $need_to_unapply -= $cust_bill_pkg->owed($setuprecur);
+ next if $need_to_unapply < 0.005;
+
+ my $error;
+ # then unapply payments one at a time (partially if need be) until the
+ # unpaid balance = the credit amount.
+ foreach my $cust_bill_pay_pkg (
+ $cust_bill_pkg->cust_bill_pay_pkg($setuprecur)
+ ) {
+ my $this_amount = $cust_bill_pay_pkg->amount;
+ if ( $this_amount > $need_to_unapply ) {
+ # unapply the needed amount
+ $cust_bill_pay_pkg->set('amount',
+ sprintf('%.2f', $this_amount - $need_to_unapply));
+ $error = $cust_bill_pay_pkg->replace;
+ $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} += $need_to_unapply;
+ last; # and we're done
+
+ } else {
+ # unapply it all
+ $error = $cust_bill_pay_pkg->delete;
+ $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum} += $this_amount;
+
+ $need_to_unapply -= $this_amount;
+ }
+
+ } # foreach $cust_bill_pay_pkg
+
+ # return an error if we somehow still have leftover $need_to_unapply?
+
+ return $error;
+ };
+
+
foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
my $setuprecur = shift @{$arg{setuprecurs}};
my $amount = shift @{$arg{amounts}};
@@ -925,17 +968,13 @@ sub credit_lineitems {
'sdate' => $cust_bill_pkg->sdate,
'edate' => $cust_bill_pkg->edate,
};
- # unapply payments (but not other credits) from this line item
- foreach my $cust_bill_pay_pkg (
- $cust_bill_pkg->cust_bill_pay_pkg($setuprecur)
- ) {
- $error = $cust_bill_pay_pkg->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error unapplying payment: $error";
- }
- $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
- += $cust_bill_pay_pkg->amount;
+
+ # unapply payments if necessary
+ $error = &{$unapply_sub}($cust_bill_pkg, $setuprecur, $amount);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error unapplying payment: $error";
}
}
@@ -968,17 +1007,11 @@ sub credit_lineitems {
'setuprecur' => 'setup',
$tax_link->primary_key, $tax_credit->{num}
};
- # unapply any payments from the tax
- foreach my $cust_bill_pay_pkg (
- $cust_bill_pkg->cust_bill_pay_pkg('setup')
- ) {
- $error = $cust_bill_pay_pkg->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error unapplying payment: $error";
- }
- $unapplied_payments{$invnum}{$cust_bill_pay_pkg->billpaynum}
- += $cust_bill_pay_pkg->amount;
+
+ $error = &{$unapply_sub}($cust_bill_pkg, 'setup', $amount);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error unapplying payment: $error";
}
}
diff --git a/FS/t/suite/09-sales_tax_credit_change.t b/FS/t/suite/09-sales_tax_credit_change.t
index 58d9968..80a05c6 100755
--- a/FS/t/suite/09-sales_tax_credit_change.t
+++ b/FS/t/suite/09-sales_tax_credit_change.t
@@ -13,7 +13,7 @@ Correct: The credit amount will be $11.00.
=cut
use strict;
-use Test::More tests => 2;
+use Test::More tests => 3;
use FS::Test;
use Date::Parse 'str2time';
use Date::Format 'time2str';
@@ -78,18 +78,19 @@ ok ( $tax_item && $tax_item->setup == 3.00, "Tax charged = 3.00" );
# sync
$pkg = $pkg->replace_old;
-# Pay the bill
+# Pay the bill in two parts
set_fixed_time(str2time('2016-04-02 00:00'));
-my $cust_pay = FS::cust_pay->new({
- custnum => $cust->custnum,
- invnum => $cust_bill->invnum,
- _date => time,
- paid => $cust_bill->owed,
- payby => 'CASH',
-});
-$error = $cust_pay->insert;
-BAIL_OUT("can't record payment: $error") if $error;
-
+foreach my $paid (10.00, 23.00) {
+ my $cust_pay = FS::cust_pay->new({
+ custnum => $cust->custnum,
+ invnum => $cust_bill->invnum,
+ _date => time,
+ paid => $paid,
+ payby => 'CASH',
+ });
+ $error = $cust_pay->insert;
+ BAIL_OUT("can't record payment: $error") if $error;
+}
# Now cancel with 1/3 of the period left
set_fixed_time(str2time('2016-04-21 00:00'));
$error = $pkg->cancel();
@@ -100,3 +101,8 @@ my ($credit) = $cust->cust_credit
or BAIL_OUT("no credit was created");
ok ( $credit->amount == 11.00, "Credited 1/3 of package charge with tax" )
or diag("is ". $credit->amount );
+
+# the invoice should also be fully paid after that
+ok ( $cust_bill->owed == 0, "Invoice balance is zero" )
+ or diag("is ". $cust_bill->owed);
+
commit 6d2db824c90c29789852fb1a7645400c90032091
Author: Mark Wells <mark at freeside.biz>
Date: Wed Sep 21 10:20:18 2016 -0700
use credit_lineitems logic for unused-time credits, #42729
Conflicts:
FS/FS/cust_pkg.pm
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 4286d34..610d173 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -798,7 +798,11 @@ sub calculate_tax_adjustment {
);
}
-=item credit_lineitems
+=item credit_lineitems OPTIONS
+
+Creates a credit to a group of line items, with a specified amount applied
+to each. This will also calculate the tax adjustments for those amounts and
+credit the appropriate tax line items.
Example:
@@ -817,6 +821,16 @@ Example:
);
+C<billpkgnums>, C<setuprecurs>, C<amounts> are required and are parallel
+arrays. Each one indicates an amount of credit to be applied to either the
+setup or recur portion of a (non-tax) line item.
+
+C<custnum>, C<_date>, C<reasonnum>, and C<addlinfo> will be set on the
+credit before it's inserted.
+
+C<amount> is the total amount. If unspecified, the credit will be the sum
+of the per-line-item amounts and their tax adjustments.
+
=cut
#maybe i should just be an insert with extra args instead of a class method
@@ -856,10 +870,18 @@ sub credit_lineitems {
my $error = '';
+ # first, determine the tax adjustments
+ my %tax_adjust = $class->calculate_tax_adjustment(%arg);
+ # and determine the amount automatically if it wasn't specified
+ if ( !exists( $arg{amount} ) ) {
+ $arg{amount} = sprintf('%.2f', $tax_adjust{subtotal} + $tax_adjust{taxtotal});
+ }
+
+ # create the credit
my $cust_credit = new FS::cust_credit ( {
map { $_ => $arg{$_} }
#fields('cust_credit')
- qw( custnum _date amount reasonnum addlinfo ), #pkgnum eventnum
+ qw( custnum _date amount reason reasonnum addlinfo ), #pkgnum eventnum
} );
$error = $cust_credit->insert;
if ( $error ) {
@@ -879,9 +901,6 @@ sub credit_lineitems {
my %cust_credit_bill_pkg = ();
my %unapplied_payments = (); #invoice numbers, and then billpaynums
- # determine the tax adjustments
- my %tax_adjust = $class->calculate_tax_adjustment(%arg);
-
foreach my $billpkgnum ( @{$arg{billpkgnums}} ) {
my $setuprecur = shift @{$arg{setuprecurs}};
my $amount = shift @{$arg{amounts}};
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 4a19f6f..467b54d 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -7,7 +7,7 @@ use strict;
use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
use Carp qw(cluck);
use Scalar::Util qw( blessed );
-use List::Util qw(min max);
+use List::Util qw(min max sum);
use Tie::IxHash;
use Time::Local qw( timelocal timelocal_nocheck );
use MIME::Entity;
@@ -1756,42 +1756,93 @@ sub credit_remaining {
my $conf = FS::Conf->new;
my $reason_type = $conf->config($mode.'_credit_type');
- my $last_bill = $self->getfield('last_bill') || 0;
- my $next_bill = $self->getfield('bill') || 0;
- if ( $last_bill > 0 # the package has been billed
- and $next_bill > 0 # the package has a next bill date
- and $next_bill >= $time # which is in the future
- ) {
- my $remaining_value = 0;
+ $time ||= time;
- my $remain_pkg = $self;
- $remaining_value = $remain_pkg->calc_remain('time' => $time);
+ my $remain_pkg = $self;
+ my (@billpkgnums, @amounts, @setuprecurs);
+
+ # we may have to walk back past some package changes to get to the
+ # one that actually has unused time. loop until that happens, or we
+ # reach the first package in the chain.
+ while (1) {
+ my $last_bill = $remain_pkg->get('last_bill') || 0;
+ my $next_bill = $remain_pkg->get('bill') || 0;
+ if ( $last_bill > 0 # the package has been billed
+ and $next_bill > 0 # the package has a next bill date
+ and $next_bill >= $time # which is in the future
+ ) {
+
+ # Find actual charges for the period ending on or after the cancel
+ # date.
+ my @charges = qsearch('cust_bill_pkg', {
+ pkgnum => $remain_pkg->pkgnum,
+ edate => {op => '>=', value => $time},
+ recur => {op => '>' , value => 0},
+ });
+
+ foreach my $cust_bill_pkg (@charges) {
+ # hack to deal with the weird behavior of edate on package
+ # cancellation
+ my $edate = $cust_bill_pkg->edate;
+ if ( $self->recur_temporality eq 'preceding' ) {
+ $edate = $self->add_freq($cust_bill_pkg->sdate);
+ }
+
+ # this will also get any package charges that are _entirely_ after
+ # the cancellation date (can happen with advance billing). in that
+ # case, use the entire recurring charge:
+ my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage;
+
+ # but if the cancellation happens during the interval, prorate it:
+ # (XXX obey prorate_round_day here?)
+ if ( $cust_bill_pkg->sdate < $time ) {
+ $amount = $amount *
+ ($edate - $time) / ($edate - $cust_bill_pkg->sdate);
+ }
+
+ $amount = sprintf('%.2f', $amount);
+
+ push @billpkgnums, $cust_bill_pkg->billpkgnum;
+ push @amounts, $amount;
+ push @setuprecurs, 'recur';
+
+ warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n"
+ if $DEBUG;
- # we may have to walk back past some package changes to get to the
- # one that actually has unused time
- while ( $remaining_value == 0 ) {
- if ( $remain_pkg->change_pkgnum ) {
- $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
- } else {
- # the package has really never been billed
- return;
}
- $remaining_value = $remain_pkg->calc_remain('time' => $time);
+
+ last if @charges;
}
- if ( $remaining_value > 0 ) {
- warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
- if $DEBUG;
- my $error = $self->cust_main->credit(
- $remaining_value,
- 'Credit for unused time on '. $self->part_pkg->pkg,
- 'reason_type' => $reason_type,
- );
- return "Error crediting customer \$$remaining_value for unused time".
- " on ". $self->part_pkg->pkg. ": $error"
- if $error;
- } #if $remaining_value
- } #if $last_bill, etc.
+ if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) {
+ $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum);
+ } else {
+ # the package has really never been billed
+ return;
+ }
+ }
+
+ # keep traditional behavior here.
+ local $@;
+ my $reason = FS::reason->new_or_existing(
+ reason => 'Credit for unused time on '. $self->part_pkg->pkg,
+ type => $reason_type,
+ class => 'R',
+ );
+ if ( $@ ) {
+ return "failed to set credit reason: $@";
+ }
+
+ my $error = FS::cust_credit->credit_lineitems(
+ 'billpkgnums' => \@billpkgnums,
+ 'setuprecurs' => \@setuprecurs,
+ 'amounts' => \@amounts,
+ 'custnum' => $self->custnum,
+ 'date' => time,
+ 'reasonnum' => $reason->reasonnum,
+ 'apply' => 1,
+ );
+
'';
}
diff --git a/FS/t/suite/09-sales_tax_credit_change.t b/FS/t/suite/09-sales_tax_credit_change.t
new file mode 100755
index 0000000..58d9968
--- /dev/null
+++ b/FS/t/suite/09-sales_tax_credit_change.t
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+=head2 DESCRIPTION
+
+Tests crediting a package for unused time when it has sales tax. See
+RT#42729.
+
+The package will be billed for $30.00 with 10% tax, then credited for 1/3
+of the billing period.
+
+Correct: The credit amount will be $11.00.
+
+=cut
+
+use strict;
+use Test::More tests => 2;
+use FS::Test;
+use Date::Parse 'str2time';
+use Date::Format 'time2str';
+use Test::MockTime qw(set_fixed_time);
+use FS::cust_main;
+use FS::cust_pkg;
+use FS::part_pkg;
+use FS::Conf;
+my $FS= FS::Test->new;
+
+# Create a package def
+my $error;
+my $part_pkg = FS::part_pkg->new({
+ pkg => 'Tax credit test',
+ plan => 'flat',
+ freq => '1',
+ agentnum => 1,
+});
+my %options = (
+ 'setup_fee' => 0,
+ 'recur_fee' => 30.00,
+ 'recur_temporality' => 'upcoming',
+ 'unused_credit_cancel' => '1',
+);
+$error = $part_pkg->insert(options => \%options);
+BAIL_OUT("can't create package def: $error") if $error;
+
+# Create the customer and order a package
+my $cust = $FS->new_customer('Credit unused with taxes');
+$cust->bill_location->state('AK');
+$error = $cust->insert;
+BAIL_OUT("can't create test customer: $error") if $error;
+
+my $pkg = FS::cust_pkg->new({ pkgpart => $part_pkg->pkgpart });
+$error = $cust->order_pkg({ cust_pkg => $pkg });
+BAIL_OUT("can't create test charges: $error") if $error;
+
+# Create tax def
+my $cust_main_county = FS::cust_main_county->new({
+ 'country' => 'US',
+ 'state' => 'AK',
+ 'exempt_amount' => 0.00,
+ 'taxname' => 'Test tax',
+ 'tax' => '10',
+});
+$error = $cust_main_county->insert;
+BAIL_OUT("can't create tax definitions: $error") if $error;
+
+# Bill the customer on Apr 1
+# (April because it's 30 days, and also doesn't have DST)
+set_fixed_time(str2time('2016-04-01 00:00'));
+my @return;
+$error = $cust->bill( return_bill => \@return );
+BAIL_OUT("can't bill charges: $error") if $error;
+my $cust_bill = $return[0] or BAIL_OUT("no invoice generated");
+
+# Check amount
+my ($tax_item) = grep { $_->itemdesc eq $cust_main_county->taxname }
+ $cust_bill->cust_bill_pkg;
+ok ( $tax_item && $tax_item->setup == 3.00, "Tax charged = 3.00" );
+
+# sync
+$pkg = $pkg->replace_old;
+
+# Pay the bill
+set_fixed_time(str2time('2016-04-02 00:00'));
+my $cust_pay = FS::cust_pay->new({
+ custnum => $cust->custnum,
+ invnum => $cust_bill->invnum,
+ _date => time,
+ paid => $cust_bill->owed,
+ payby => 'CASH',
+});
+$error = $cust_pay->insert;
+BAIL_OUT("can't record payment: $error") if $error;
+
+# Now cancel with 1/3 of the period left
+set_fixed_time(str2time('2016-04-21 00:00'));
+$error = $pkg->cancel();
+BAIL_OUT("can't cancel package: $error") if $error;
+
+# and find the credit
+my ($credit) = $cust->cust_credit
+ or BAIL_OUT("no credit was created");
+ok ( $credit->amount == 11.00, "Credited 1/3 of package charge with tax" )
+ or diag("is ". $credit->amount );
-----------------------------------------------------------------------
Summary of changes:
FS/FS/cust_credit.pm | 104 +++++++++++++++++++++-------
FS/FS/cust_pkg.pm | 115 ++++++++++++++++++++++---------
FS/t/suite/09-sales_tax_credit_change.t | 108 +++++++++++++++++++++++++++++
3 files changed, 269 insertions(+), 58 deletions(-)
create mode 100755 FS/t/suite/09-sales_tax_credit_change.t
More information about the freeside-commits
mailing list