1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
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 = {
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($cust_pkg) || 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 > 0 ) {
$discountable += $months * $permonth;
$discountable -= ($discountable * $discount->percent / 100);
$discountable -= ($permonth - $recur); # correct for prorate
$self->{discounted} += $discountable;
}
elsif ( $discount->amount > 0 ) {
$discountable += $recur;
$discountable -= $discount->amount * $recur/$permonth;
$discountable += ($months - 1) * max($permonth - $discount->amount,0);
$self->{discounted} += $discountable;
}
else {
warn "discountnum ".$discount->discountnum.
" has no amount or percentage, ignored\n";
$self->{discounted} = $self->{base};
}
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} };
}
=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;
|
