RT# 33362 - fixed Argument 1d is not numeric when trying to discount daily recuring...
[freeside.git] / FS / FS / part_pkg / discount_Mixin.pm
1 package FS::part_pkg::discount_Mixin;
2
3 use strict;
4 use vars qw( %info );
5 use Time::Local qw( timelocal );
6 use List::Util  qw( min );
7 use FS::Record qw( qsearchs );
8 use FS::cust_pkg;
9 use FS::cust_bill_pkg_discount;
10
11 %info = ( 'disabled' => 1 );
12
13 =head1 NAME
14
15 FS::part_pkg::discount_Mixin - Mixin class for part_pkg:: classes that 
16 can be discounted.
17
18 =head1 SYNOPSIS
19
20 package FS::part_pkg::...;
21 use base qw( FS::part_pkg::discount_Mixin );
22
23 sub calc_recur {
24   ...
25   my $discount = $self->calc_discount($cust_pkg, $$sdate, $details, $param);
26   $charge -= $discount;
27   ...
28 }
29
30 =head METHODS
31
32 =item calc_discount CUST_PKG, SDATE, DETAILS_ARRAYREF, PARAM_HASHREF
33
34 Takes all the arguments of calc_recur.  Calculates and returns the amount 
35 by which to reduce the charge; also increments months used on the discount.
36
37 If there is a setup fee, this will be called once with 'setup_charge' => the
38 setup fee amount (and should return the discount to be applied to the setup
39 charge, if any), and again without it (for the recurring fee discount). 
40 PARAM_HASHREF carries over between the two invocations.
41
42 =cut
43
44 sub calc_discount {
45   my($self, $cust_pkg, $sdate, $details, $param ) = @_;
46   my $conf = new FS::Conf;
47
48   my $br = $self->base_recur($cust_pkg, $sdate);
49
50   ## can not multiply non monthly recurring frequency so skip.
51   unless ($cust_pkg->part_pkg->freq !~ /^\d+$/) {
52     $br += $param->{'override_charges'} * ($cust_pkg->part_pkg->freq || 0) if $param->{'override_charges'};
53   }
54
55   my $tot_discount = 0;
56   #UI enforces just 1 for now, will need ordering when they can be stacked
57
58   if ( $param->{freq_override} ) {
59     # When a customer pays for more than one month at a time to receive a 
60     # term discount, freq_override is set to the number of months.
61     my $real_part_pkg = new FS::part_pkg { $self->hash };
62     $real_part_pkg->pkgpart($param->{real_pkgpart} || $self->pkgpart);
63     # Find a discount with that duration...
64     my @discount = grep { $_->months == $param->{freq_override} }
65                     map { $_->discount } $real_part_pkg->part_pkg_discount;
66     my $discount = shift @discount;
67     # and default to bill that many months at once.
68     $param->{months} = $param->{freq_override} unless $param->{months};
69     my $error;
70     if ($discount) {
71       # Then set the cust_pkg discount.
72       if ($discount->months == $param->{months}) {
73         $cust_pkg->discountnum($discount->discountnum);
74         $error = $cust_pkg->insert_discount;
75       } else {
76         $cust_pkg->discountnum(-1);
77         foreach ( qw( amount percent months ) ) {
78           my $method = "discountnum_$_";
79           $cust_pkg->$method($discount->$_);
80         }
81         $error = $cust_pkg->insert_discount;
82       }
83       die "error discounting using part_pkg_discount: $error" if $error;
84     }
85   }
86
87   my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active;
88   foreach my $cust_pkg_discount ( @cust_pkg_discount ) {
89     my $discount_left;
90     my $discount = $cust_pkg_discount->discount;
91     #UI enforces one or the other (for now?  probably for good)
92     # $chg_months: the number of months we are charging recur for
93     # $months: $chg_months or the months left on the discount, whchever is less
94
95     my $chg_months = 1;
96     unless ($cust_pkg->part_pkg->freq !~ /^\d+$/) {
97       $chg_months = $cust_pkg->part_pkg->freq || 1;
98     }
99     if ( defined($param->{'months'}) ) { # then override
100       $chg_months = $param->{'months'};
101     }
102
103     my $months = $chg_months;
104     if ( $discount->months ) {
105       $months = min( $chg_months,
106                      $discount->months - $cust_pkg_discount->months_used );
107     }
108
109     # $amount is now the (estimated) discount amount on the recurring charge.
110     # if it's a percent discount, that's base recur * percentage.
111
112     my $amount = 0;
113
114     if (defined $param->{'setup_charge'}) {
115
116         # we are calculating the setup discount.
117         # if this discount doesn't apply to setup fees, skip it.
118         # if it's a percent discount, set $amount = percent * setup_charge.
119         # if it's a flat amount discount for one month:
120         # - if the discount amount > setup_charge, then set it to setup_charge,
121         #   and set 'discount_left_recur' to the difference.
122         # - otherwise set it to just the discount amount.
123         # if it's a flat amount discount for other than one month:
124         # - skip the discount. unsure, leaving it alone for now.
125
126         next unless $discount->setup;
127
128         $months = 0; # never count a setup discount as a month of discount
129                      # (the recur discount in the same month should do it)
130
131         if ( $discount->percent > 0 ) {
132             $amount = $discount->percent * $param->{'setup_charge'} / 100;
133         } elsif ( $discount->amount > 0 ) {
134             # apply the discount amount, up to a maximum of the setup charge
135             $amount = min($discount->amount, $param->{'setup_charge'});
136             $discount_left = sprintf('%.2f', $discount->amount - $amount);
137             # transfer remainder of discount, if any, to recur
138             $param->{'discount_left_recur'}{$discount->discountnum} = $discount_left;
139         } 
140
141     } else {
142       
143       # we are calculating a recurring fee discount. estimate the recurring
144       # fee. Note we use $months here rather than $chg_months so that if the
145       # remaining discount amount is for less time than the package period,
146       # the "estimated recurring fee" is only for as long as the discount
147       # lasts.
148
149       # can not multiply non monthly recurring frequency so skip.
150       next if $self->freq !~ /^\d+$/;
151
152       my $recur_charge = $br * $months / $self->freq;
153       # round this, because the real recur charge is rounded
154       $recur_charge = sprintf('%.2f', $recur_charge);
155
156       # if it's a percentage discount, calculate it based on that estimate.
157       # otherwise use the flat amount.
158       
159       if ( $discount->percent > 0 ) {
160         $amount = $recur_charge * $discount->percent / 100;
161       } elsif ( $discount->amount > 0
162                 and $cust_pkg->pkgpart == $param->{'real_pkgpart'} ) {
163         $amount = $discount->amount * $months;
164       }
165
166       if ( exists $param->{'discount_left_recur'}{$discount->discountnum} ) {
167         # there is a discount_left_recur entry for this discountnum, so this
168         # is the second (recur) pass on the discount.  use up transferred
169         # remainder of discount from setup.
170         #
171         # note that discount_left_recur can now be zero.
172         $amount = $param->{'discount_left_recur'}{$discount->discountnum};
173         $param->{'discount_left_recur'}{$discount->discountnum} = 0;
174         $months = 1; # XXX really? not $chg_months?
175       }
176       #elsif (    $discount->setup
177       #          && ($discount->months || 0) == 1
178       #          && $discount->amount > 0
179       #        ) {
180       #    next;
181       #
182       #    RT #11512: bugfix to prevent applying flat discount to both setup
183       #    and recur. The original implementation ignored discount_left_recur
184       #    if it was zero, so if the setup fee used up the entire flat 
185       #    discount, the recurring charge would get to use the entire flat
186       #    discount also. This bugfix was a kludge. Instead, we now allow
187       #    discount_left_recur to be zero in that case, and then the available
188       #    recur discount is zero. 
189       #}
190
191       # transfer remainder of discount, if any, to setup
192       # this is used when the recur phase wants to add a setup fee
193       # (prorate_defer_bill): the "discount_left_setup" amount will
194       # be subtracted in _make_lines.
195       if ( $discount->setup && $discount->amount > 0
196           && ($discount->months || 0) != 1
197          )
198       {
199         # $amount is no longer permonth at this point! correct. very good.
200         $discount_left = $amount - $recur_charge; # backward, as above
201         if ( $discount_left > 0 ) {
202           $amount = $recur_charge;
203           $param->{'discount_left_setup'}{$discount->discountnum} = 
204             0 - $discount_left;
205         }
206       }
207
208       # cap the discount amount at the recur charge
209       $amount = min($amount, $recur_charge);
210
211       # if this is the base pkgpart, schedule increment_months_used to run at
212       # the end of billing. (addon packages haven't been calculated yet, so
213       # don't let the discount expire during the billing process. RT#17045.)
214       if ( $cust_pkg->pkgpart == $param->{'real_pkgpart'} ) {
215         push @{ $param->{precommit_hooks} }, sub {
216           my $error = $cust_pkg_discount->increment_months_used($months);
217           die "error discounting: $error" if $error;
218         };
219       }
220
221     }
222
223     $amount = sprintf('%.2f', $amount + 0.00000001 ); #so 1.005 rounds to 1.01
224
225     next unless $amount > 0;
226
227     #record details in cust_bill_pkg_discount
228     my $cust_bill_pkg_discount = new FS::cust_bill_pkg_discount {
229       'pkgdiscountnum' => $cust_pkg_discount->pkgdiscountnum,
230       'amount'         => $amount,
231       'months'         => $months,
232       # XXX should have a 'setuprecur' (and on 4.x, it does)
233     };
234     push @{ $param->{'discounts'} }, $cust_bill_pkg_discount;
235     $tot_discount += $amount;
236
237   }
238
239   sprintf('%.2f', $tot_discount);
240 }
241
242 1;