1 package FS::discount_plan;
4 use vars qw( $DEBUG $me );
5 use FS::Record qw( qsearch );
9 use List::Util qw( max );
13 FS::discount_plan - A term discount as applied to an invoice
17 An FS::discount_plan object represents a term prepayment discount
18 available for an invoice (L<FS::cust_bill>). FS::discount_plan
19 objects are non-persistent and do not inherit from FS::Record.
27 Calculate a discount plan. OPTIONS must include:
29 cust_bill - the invoice to calculate discounts for
31 months - the number of months to be prepaid
33 If there are no line items on the invoice eligible for the discount
34 C<new()> will return undef.
41 %opt = %{ $_[0] } if ( ref $_[0] );
43 my $cust_bill = $opt{cust_bill}
44 or die "$me new() requires 'cust_bill'\n";
45 my $months = $opt{months}
46 or die "$me new() requires 'months'\n";
48 my ($previous_balance) = $cust_bill->previous;
51 base => $previous_balance || 0, # sum of charges before discount
52 discounted => $previous_balance || 0, # sum of charges after discount
53 list_pkgnums => 0, # whether any packages are not discounted
56 foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
57 my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
58 my $part_pkg = $cust_pkg->part_pkg or next;
59 my $freq = $part_pkg->freq;
60 my $setup = $cust_bill_pkg->setup || 0;
61 my $recur = $cust_bill_pkg->recur || 0;
63 if ( $freq eq '1' ) { # monthly recurring package
64 my $permonth = $part_pkg->base_recur_permonth || 0;
66 my ($discount) = grep { $_->months == $months }
67 map { $_->discount } $part_pkg->part_pkg_discount;
69 $self->{base} += $setup + $recur + ($months - 1) * $permonth;
74 if ( $discount->setup ) {
75 $discountable += $setup;
78 $self->{discounted} += $setup;
81 if ( $discount->percent ) {
82 $discountable += $months * $permonth;
83 $discountable -= ($discountable * $discount->percent / 100);
84 $discountable -= ($permonth - $recur); # correct for prorate
85 $self->{discounted} += $discountable;
88 $discountable += $recur;
89 $discountable -= $discount->amount * $recur/$permonth;
90 $discountable += ($months - 1) * max($permonth - $discount->amount,0);
93 $self->{discounted} += $discountable;
94 push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
97 $self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
98 $self->{list_pkgnums} = 1;
101 else { # all non-monthly packages: include current charges only
102 $self->{discounted} += $setup + $recur;
103 $self->{base} += $setup + $recur;
104 $self->{list_pkgnums} = 1;
106 } #foreach $cust_bill_pkg
108 # we've considered all line items; exit if none of them are
110 return undef if $self->{base} == $self->{discounted}
111 or $self->{base} == 0;
113 return bless $self, $class;
119 For an L<FS::cust_bill> object, return a hash of all available
120 discount plans, with discount term (months) as the key.
126 my $cust_bill = shift;
129 foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
130 my $months = $_->months;
131 my $discount_plan = $class->new(
132 cust_bill => $cust_bill,
135 $hash{$_->months} = $discount_plan if defined($discount_plan);
147 =item discounted_total
149 Returns the total price for the term after applying discounts. This is the
150 price the customer would have to pay to receive the discount. Note that
151 this includes the monthly fees for all packages (including non-discountable
152 ones) for each month in the term, but only includes fees for other packages
153 as they appear on the current invoice.
157 sub discounted_total {
159 sprintf('%.2f', $self->{discounted});
164 Returns the total price for the term before applying discounts.
170 sprintf('%.2f', $self->{base});
175 Returns a list of package numbers that are receiving discounts under this
182 @{ $self->{pkgnums} };
185 # any others? don't think so