[freeside-commits] branch FREESIDE_4_BRANCH updated. f618014107741d159fb257f1a6726a92cb046dfb
Mark Wells
mark at 420.am
Wed Sep 21 14:30:15 PDT 2016
The branch, FREESIDE_4_BRANCH has been updated
via f618014107741d159fb257f1a6726a92cb046dfb (commit)
via ad78be45d49a6933879e07e7d6f7c53b883249a5 (commit)
via 07a2a31a569a6ea8c2ab91e4b13eb9a00d570bed (commit)
from ab38715f806c564c8bb5d331c6ed5b31c77591d5 (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 f618014107741d159fb257f1a6726a92cb046dfb
Author: Mark Wells <mark at freeside.biz>
Date: Wed Sep 21 14:30:01 2016 -0700
and still create credit source records on 4.x+, #42729
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 23b7aed..eaff6e8 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -797,6 +797,7 @@ Example:
'setuprecurs' => \@setuprecurs,
'amounts' => \@amounts,
'apply' => 1, #0 leaves the credit unapplied
+ 'set_source' => 1, #creates credit source records for the line items
#the credit
map { $_ => scalar($cgi->param($_)) }
@@ -861,6 +862,8 @@ sub credit_lineitems {
$arg{amount} = sprintf('%.2f', $tax_adjust{subtotal} + $tax_adjust{taxtotal});
}
+ my $set_source = $arg{set_source};
+
# create the credit
my $cust_credit = new FS::cust_credit ( {
map { $_ => $arg{$_} }
@@ -884,6 +887,7 @@ sub credit_lineitems {
my %cust_bill_pkg = ();
my %cust_credit_bill_pkg = ();
my %unapplied_payments = (); #invoice numbers, and then billpaynums
+ my %currency;
# little private function to unapply payments from a cust_bill_pkg until
# there's a specified amount of unpaid balance on it.
@@ -956,6 +960,17 @@ sub credit_lineitems {
# unapply payments if necessary
$error = &{$unapply_sub}($cust_bill_pkg, $setuprecur, $amount);
+ if ( $set_source ) {
+ $currency{$invnum} ||= $cust_bill_pkg->cust_bill->currency;
+ my $source = FS::cust_credit_source_bill_pkg->new({
+ 'crednum' => $cust_credit->crednum,
+ 'billpkgnum' => $billpkgnum,
+ 'amount' => $amount,
+ 'currency' => $currency{invnum},
+ });
+ $error ||= $source->insert;
+ }
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error unapplying payment: $error";
@@ -993,6 +1008,19 @@ sub credit_lineitems {
};
$error = &{$unapply_sub}($cust_bill_pkg, 'setup', $amount);
+
+ # I guess it's correct to do this for taxes also?
+ if ( $set_source ) {
+ $currency{$invnum} ||= $cust_bill_pkg->cust_bill->currency;
+ my $source = FS::cust_credit_source_bill_pkg->new({
+ 'crednum' => $cust_credit->crednum,
+ 'billpkgnum' => $billpkgnum,
+ 'amount' => $amount,
+ 'currency' => $currency{invnum},
+ });
+ $error ||= $source->insert;
+ }
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error unapplying payment: $error";
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index c8f337f..634895a 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -1866,6 +1866,7 @@ sub credit_remaining {
'date' => time,
'reasonnum' => $reason->reasonnum,
'apply' => 1,
+ 'set_source' => 1,
);
'';
diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm
index 84599ea..97d4363 100644
--- a/FS/FS/part_pkg/flat.pm
+++ b/FS/FS/part_pkg/flat.pm
@@ -225,6 +225,8 @@ sub calc_cancel {
}
}
+# no longer used; see credit_remaining in FS::cust_pkg
+
sub calc_remain {
my ($self, $cust_pkg, %options) = @_;
commit ad78be45d49a6933879e07e7d6f7c53b883249a5
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 564cbb4..23b7aed 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -885,6 +885,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}};
@@ -909,17 +952,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";
}
}
@@ -952,17 +991,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 07a2a31a569a6ea8c2ab91e4b13eb9a00d570bed
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
diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm
index 8546372..564cbb4 100644
--- a/FS/FS/cust_credit.pm
+++ b/FS/FS/cust_credit.pm
@@ -782,7 +782,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:
@@ -801,6 +805,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
@@ -840,10 +854,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 ) {
@@ -863,9 +885,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 df66e74..c8f337f 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -8,7 +8,7 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API
use strict;
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;
@@ -1781,50 +1781,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 @cust_credit_source_bill_pkg = ();
- my $remaining_value = 0;
+ $time ||= time;
- my $remain_pkg = $self;
- $remaining_value = $remain_pkg->calc_remain(
- 'time' => $time,
- 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
- );
+ 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,
- 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
- );
+
+ 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,
- 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
- );
- 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 | 132 +++++++++++++++++++++++++------
FS/FS/cust_pkg.pm | 124 +++++++++++++++++++----------
FS/FS/part_pkg/flat.pm | 2 +
FS/t/suite/09-sales_tax_credit_change.t | 108 +++++++++++++++++++++++++
4 files changed, 300 insertions(+), 66 deletions(-)
create mode 100755 FS/t/suite/09-sales_tax_credit_change.t
More information about the freeside-commits
mailing list