From ee2ee290c82013f870e2b23e4235e70998e59ee1 Mon Sep 17 00:00:00 2001 From: mark Date: Wed, 7 Dec 2011 05:50:33 +0000 Subject: minor refactor and better safeguards on term discounts, #15068 --- FS/FS/discount_plan.pm | 202 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) create mode 100644 FS/FS/discount_plan.pm (limited to 'FS/FS/discount_plan.pm') diff --git a/FS/FS/discount_plan.pm b/FS/FS/discount_plan.pm new file mode 100644 index 0000000..4f97e33 --- /dev/null +++ b/FS/FS/discount_plan.pm @@ -0,0 +1,202 @@ +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::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 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 = { + cust_bill => $cust_bill, + months => $months, + pkgnums => [], + base => $previous_balance || 0, # sum of charges before discount + discounted => $previous_balance || 0, # sum of charges after discount + list_pkgnums => undef, # 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 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} }; +} + +=item list_pkgnums + +Returns a true value if any packages listed on the invoice do not +receive a discount, either because there isn't one at the specified +term length or because they're not monthly recurring packages. + +=cut + +sub list_pkgnums { + my $self = shift; + $self->{list_pkgnums}; +} + +# any others? don't think so + +1; -- cgit v1.1