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;
50 cust_bill => $cust_bill,
53 base => $previous_balance || 0, # sum of charges before discount
54 discounted => $previous_balance || 0, # sum of charges after discount
55 list_pkgnums => undef, # whether any packages are not discounted
58 foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
59 my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
60 my $part_pkg = $cust_pkg->part_pkg or next;
61 my $freq = $part_pkg->freq;
62 my $setup = $cust_bill_pkg->setup || 0;
63 my $recur = $cust_bill_pkg->recur || 0;
65 if ( $freq eq '1' ) { # monthly recurring package
66 my $permonth = $part_pkg->base_recur_permonth || 0;
68 my ($discount) = grep { $_->months == $months }
69 map { $_->discount } $part_pkg->part_pkg_discount;
71 $self->{base} += $setup + $recur + ($months - 1) * $permonth;
76 if ( $discount->setup ) {
77 $discountable += $setup;
80 $self->{discounted} += $setup;
83 if ( $discount->percent ) {
84 $discountable += $months * $permonth;
85 $discountable -= ($discountable * $discount->percent / 100);
86 $discountable -= ($permonth - $recur); # correct for prorate
87 $self->{discounted} += $discountable;
90 $discountable += $recur;
91 $discountable -= $discount->amount * $recur/$permonth;
92 $discountable += ($months - 1) * max($permonth - $discount->amount,0);
95 $self->{discounted} += $discountable;
96 push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
99 $self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
100 $self->{list_pkgnums} = 1;
103 else { # all non-monthly packages: include current charges only
104 $self->{discounted} += $setup + $recur;
105 $self->{base} += $setup + $recur;
106 $self->{list_pkgnums} = 1;
108 } #foreach $cust_bill_pkg
110 # we've considered all line items; exit if none of them are
112 return undef if $self->{base} == $self->{discounted}
113 or $self->{base} == 0;
115 return bless $self, $class;
121 For an L<FS::cust_bill> object, return a hash of all available
122 discount plans, with discount term (months) as the key.
128 my $cust_bill = shift;
131 foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
132 my $months = $_->months;
133 my $discount_plan = $class->new(
134 cust_bill => $cust_bill,
137 $hash{$_->months} = $discount_plan if defined($discount_plan);
149 =item discounted_total
151 Returns the total price for the term after applying discounts. This is the
152 price the customer would have to pay to receive the discount. Note that
153 this includes the monthly fees for all packages (including non-discountable
154 ones) for each month in the term, but only includes fees for other packages
155 as they appear on the current invoice.
159 sub discounted_total {
161 sprintf('%.2f', $self->{discounted});
166 Returns the total price for the term before applying discounts.
172 sprintf('%.2f', $self->{base});
177 Returns a list of package numbers that are receiving discounts under this
184 @{ $self->{pkgnums} };
189 Returns a true value if any packages listed on the invoice do not
190 receive a discount, either because there isn't one at the specified
191 term length or because they're not monthly recurring packages.
197 $self->{list_pkgnums};
200 # any others? don't think so