[freeside-commits] freeside/FS/FS Mason.pm, 1.78.2.5, 1.78.2.6 cust_bill.pm, 1.350.2.15, 1.350.2.16 discount_plan.pm, NONE, 1.1.2.2
Mark Wells
mark at wavetail.420.am
Tue Dec 6 21:50:52 PST 2011
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv25431/FS/FS
Modified Files:
Tag: FREESIDE_2_3_BRANCH
Mason.pm cust_bill.pm
Added Files:
Tag: FREESIDE_2_3_BRANCH
discount_plan.pm
Log Message:
minor refactor and better safeguards on term discounts, #15068
--- NEW FILE: discount_plan.pm ---
package FS::discount_plan;
use strict;
use vars qw( $DEBUG $me );
use FS::Record qw( qsearch );
use FS::cust_bill;
use FS::cust_bill_pkg;
use FS::discount;
use List::Util qw( max );
=head1 NAME
FS::discount_plan - A term discount as applied to an invoice
=head1 DESCRIPTION
An FS::discount_plan object represents a term prepayment discount
available for an invoice (L<FS::cust_bill>). FS::discount_plan
objects are non-persistent and do not inherit from FS::Record.
=head1 CLASS METHODS
=over 4
=item new OPTIONS
Calculate a discount plan. OPTIONS must include:
cust_bill - the invoice to calculate discounts for
months - the number of months to be prepaid
If there are no line items on the invoice eligible for the discount
C<new()> will return undef.
=cut
sub new {
my $class = shift;
my %opt = @_;
%opt = %{ $_[0] } if ( ref $_[0] );
my $cust_bill = $opt{cust_bill}
or die "$me new() requires 'cust_bill'\n";
my $months = $opt{months}
or die "$me new() requires 'months'\n";
my ($previous_balance) = $cust_bill->previous;
my $self = {
pkgnums => [],
base => $previous_balance || 0, # sum of charges before discount
discounted => $previous_balance || 0, # sum of charges after discount
list_pkgnums => 0, # whether any packages are not discounted
};
foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
my $part_pkg = $cust_pkg->part_pkg or next;
my $freq = $part_pkg->freq;
my $setup = $cust_bill_pkg->setup || 0;
my $recur = $cust_bill_pkg->recur || 0;
if ( $freq eq '1' ) { # monthly recurring package
my $permonth = $part_pkg->base_recur_permonth || 0;
my ($discount) = grep { $_->months == $months }
map { $_->discount } $part_pkg->part_pkg_discount;
$self->{base} += $setup + $recur + ($months - 1) * $permonth;
if ( $discount ) {
my $discountable;
if ( $discount->setup ) {
$discountable += $setup;
}
else {
$self->{discounted} += $setup;
}
if ( $discount->percent ) {
$discountable += $months * $permonth;
$discountable -= ($discountable * $discount->percent / 100);
$discountable -= ($permonth - $recur); # correct for prorate
$self->{discounted} += $discountable;
}
else {
$discountable += $recur;
$discountable -= $discount->amount * $recur/$permonth;
$discountable += ($months - 1) * max($permonth - $discount->amount,0);
}
$self->{discounted} += $discountable;
push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
}
else { #no discount
$self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
$self->{list_pkgnums} = 1;
}
} #if $freq eq '1'
else { # all non-monthly packages: include current charges only
$self->{discounted} += $setup + $recur;
$self->{base} += $setup + $recur;
$self->{list_pkgnums} = 1;
}
} #foreach $cust_bill_pkg
# we've considered all line items; exit if none of them are
# discountable
return undef if $self->{base} == $self->{discounted}
or $self->{base} == 0;
return bless $self, $class;
}
=item all CUST_BILL
For an L<FS::cust_bill> object, return a hash of all available
discount plans, with discount term (months) as the key.
=cut
sub all {
my $class = shift;
my $cust_bill = shift;
my %hash;
foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
my $months = $_->months;
my $discount_plan = $class->new(
cust_bill => $cust_bill,
months => $months
);
$hash{$_->months} = $discount_plan if defined($discount_plan);
}
%hash;
}
=back
=head1 METHODS
=over 4
=item discounted_total
Returns the total price for the term after applying discounts. This is the
price the customer would have to pay to receive the discount. Note that
this includes the monthly fees for all packages (including non-discountable
ones) for each month in the term, but only includes fees for other packages
as they appear on the current invoice.
=cut
sub discounted_total {
my $self = shift;
sprintf('%.2f', $self->{discounted});
}
=item base_total
Returns the total price for the term before applying discounts.
=cut
sub base_total {
my $self = shift;
sprintf('%.2f', $self->{base});
}
=item pkgnums
Returns a list of package numbers that are receiving discounts under this
plan.
=cut
sub pkgnums {
my $self = shift;
@{ $self->{pkgnums} };
}
# any others? don't think so
1;
Index: Mason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Mason.pm,v
retrieving revision 1.78.2.5
retrieving revision 1.78.2.6
diff -u -w -d -r1.78.2.5 -r1.78.2.6
--- Mason.pm 28 Nov 2011 01:32:26 -0000 1.78.2.5
+++ Mason.pm 7 Dec 2011 05:50:46 -0000 1.78.2.6
@@ -298,6 +298,7 @@
use FS::rate_tier;
use FS::rate_tier_detail;
use FS::radius_attr;
+ use FS::discount_plan;
# Sammath Naur
if ( $FS::Mason::addl_handler_use ) {
Index: cust_bill.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_bill.pm,v
retrieving revision 1.350.2.15
retrieving revision 1.350.2.16
diff -u -w -d -r1.350.2.15 -r1.350.2.16
--- cust_bill.pm 1 Dec 2011 20:05:30 -0000 1.350.2.15
+++ cust_bill.pm 7 Dec 2011 05:50:46 -0000 1.350.2.16
@@ -43,6 +43,7 @@
use FS::cust_bill_batch;
use FS::cust_bill_pay_pkg;
use FS::cust_credit_bill_pkg;
+use FS::discount_plan;
use FS::L10N;
@ISA = qw( FS::cust_main_Mixin FS::Record );
@@ -748,6 +749,18 @@
qsearch('cust_bill_batch', { 'invnum' => $self->invnum });
}
+=item discount_plans
+
+Returns all discount plans (L<FS::discount_plan>) for this invoice, as a
+hash keyed by term length.
+
+=cut
+
+sub discount_plans {
+ my $self = shift;
+ FS::discount_plan->all($self);
+}
+
=item tax
Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice.
@@ -5218,108 +5231,34 @@
sub _items_discounts_avail {
my $self = shift;
- my %terms;
my $list_pkgnums = 0; # if any packages are not eligible for all discounts
- my ($previous_balance) = $self->previous;
-
- foreach (qsearch('discount',{ 'months' => { op => '>', value => 1} })) {
- $terms{$_->months} = {
- pkgnums => [],
- base => $previous_balance || 0, # pre-discount sum of charges
- discounted => $previous_balance || 0, # post-discount sum
- list_pkgnums => 0, # whether any packages are not discounted
- }
- }
- foreach my $months (keys %terms) {
- my $hash = $terms{$months};
-
- # tricky, because packages may not all be eligible for the same discounts
- foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) {
- my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
- my $part_pkg = $cust_pkg->part_pkg or next;
- my $freq = $part_pkg->freq;
- my $setup = $cust_bill_pkg->setup || 0;
- my $recur = $cust_bill_pkg->recur || 0;
-
- if ( $freq eq '1' ) { #monthly
- my $permonth = $part_pkg->base_recur_permonth || 0;
-
- my ($discount) = grep { $_->months == $months }
- map { $_->discount } $part_pkg->part_pkg_discount;
-
- $hash->{base} += $setup + $recur + ($months - 1) * $permonth;
-
- if ( $discount ) {
-
- my $discountable;
- if ( $discount->setup ) {
- $discountable += $setup;
- }
- else {
- $hash->{discounted} += $setup;
- }
-
- if ( $discount->percent ) {
- $discountable += $months * $permonth;
- $discountable -= ($discountable * $discount->percent / 100);
- $discountable -= ($permonth - $recur); # correct for prorate
- $hash->{discounted} += $discountable;
- }
- else {
- $discountable += $recur;
- $discountable -= $discount->amount * $recur/$permonth;
-
- $discountable += ($months - 1) * max($permonth - $discount->amount,0);
- }
-
- $hash->{discounted} += $discountable;
- push @{ $hash->{pkgnums} }, $cust_pkg->pkgnum;
- }
- else { #no discount
- $hash->{discounted} += $setup + $recur + ($months - 1) * $permonth;
- $hash->{list_pkgnums} = 1;
- }
- } #if $freq eq '1'
- else { # all non-monthly packages: include current charges only
- $hash->{discounted} += $setup + $recur;
- $hash->{base} += $setup + $recur;
- $hash->{list_pkgnums} = 1;
- }
- } #foreach $cust_bill_pkg
-
- # don't show this line if no packages have discounts at this term
- # or if there are no new charges to apply the discount to
- delete $terms{$months} if $hash->{base} == $hash->{discounted}
- or $hash->{base} == 0;
+ my %plans = $self->discount_plans;
- }
+ $list_pkgnums = grep { $_->list_pkgnums } values %plans;
- $list_pkgnums = grep { $_->{list_pkgnums} > 0 } values %terms;
+ map {
+ my $months = $_;
+ my $plan = $plans{$months};
- foreach my $months (keys %terms) {
- my $hash = $terms{$months};
- my $term_total = sprintf('%.2f', $hash->{discounted});
- # possibly shouldn't include previous balance in these?
- my $percent = sprintf('%.0f', 100 * (1 - $term_total / $hash->{base}) );
+ my $term_total = sprintf('%.2f', $plan->discounted_total);
+ my $percent = sprintf('%.0f',
+ 100 * (1 - $term_total / $plan->base_total) );
my $permonth = sprintf('%.2f', $term_total / $months);
+ my $detail = $self->mt('discount on item'). ' '.
+ join(', ', map { "#$_" } $plan->pkgnums)
+ if $list_pkgnums;
- $hash->{description} = $self->mt('Save [_1]% by paying for [_2] months',
- $percent, $months
- );
- $hash->{amount} = $self->mt('[_1] ([_2] per month)',
- $term_total, $money_char.$permonth
- );
-
- my @detail;
- if ( $list_pkgnums ) {
- push @detail, $self->mt('discount on item'). ' '.
- join(', ', map { "#$_" } @{ $hash->{pkgnums} });
- }
- $hash->{ext_description} = join ', ', @detail;
+ +{
+ description => $self->mt('Save [_1]% by paying for [_2] months',
+ $percent, $months),
+ amount => $self->mt('[_1] ([_2] per month)',
+ $term_total, $money_char.$permonth),
+ ext_description => ($detail || ''),
}
+ } #map
+ sort { $b <=> $a } keys %plans;
- map { $terms{$_} } sort {$b <=> $a} keys %terms;
}
=item call_details [ OPTION => VALUE ... ]
More information about the freeside-commits
mailing list