e8d42b9ca8a25ea38ea3bc959ea71cf82473fda0
[freeside.git] / FS / FS / part_pkg / prorate_Mixin.pm
1 package FS::part_pkg::prorate_Mixin;
2
3 use strict;
4 use vars qw( %info );
5 use Time::Local qw( timelocal timelocal_nocheck );
6 use Date::Format qw( time2str );
7 use List::Util qw( min );
8
9 %info = ( 
10   'disabled'  => 1,
11   # define all fields that are referenced in this code
12   'fields' => {
13     'add_full_period' => { 
14                 'name' => 'When prorating first month, also bill for one full '.
15                           'period after that',
16                 'type' => 'checkbox',
17     },
18     'prorate_round_day' => { 
19                 'name' => 'When prorating, round to the nearest full day',
20                 'type' => 'checkbox',
21     },
22     'prorate_defer_bill' => {
23                 'name' => 'When prorating, defer the first bill until the '.
24                           'billing day',
25                 'type' => 'checkbox',
26     },
27     'prorate_verbose' => {
28                 'name' => 'Show prorate details on the invoice',
29                 'type' => 'checkbox',
30     },
31   },
32   'fieldorder' => [ qw(prorate_defer_bill prorate_round_day 
33                        add_full_period prorate_verbose) ],
34 );
35
36 sub fieldorder {
37   @{ $info{'fieldorder'} }
38 }
39
40 =head1 NAME
41
42 FS::part_pkg::prorate_Mixin - Mixin class for part_pkg:: classes that 
43 need to prorate partial months
44
45 =head1 SYNOPSIS
46
47 package FS::part_pkg::...;
48 use base qw( FS::part_pkg::prorate_Mixin );
49
50 sub calc_recur {
51   ...
52   if( conditions that trigger prorate ) {
53     # sets $$sdate and $param->{'months'}, returns the prorated charge
54     $charges = $self->calc_prorate($cust_pkg, $sdate, $param, $cutoff_day);
55   } 
56   ...
57 }
58
59 =head METHODS
60
61 =item calc_prorate CUST_PKG SDATE DETAILS PARAM CUTOFF_DAY
62
63 Takes all the arguments of calc_recur.  Calculates a prorated charge from 
64 the $sdate to the cutoff day for this package definition, and sets the $sdate 
65 and $param->{months} accordingly.  base_recur() will be called to determine 
66 the base price per billing cycle.
67
68 Options:
69 - add_full_period: Bill for the time up to the prorate day plus one full
70   billing period after that.
71 - prorate_round_day: Round the current time to the nearest full day, 
72   instead of using the exact time.
73 - prorate_defer_bill: Don't bill the prorate interval until the prorate 
74   day arrives.
75 - prorate_verbose: Generate details to explain the prorate calculations.
76
77 =cut
78
79 sub calc_prorate {
80   my ($self, $cust_pkg, $sdate, $details, $param, @cutoff_days) = @_;
81   die "no cutoff_day" unless @cutoff_days;
82   die "can't prorate non-monthly package\n" if $self->freq =~ /\D/;
83
84   my $money_char = FS::Conf->new->config('money_char') || '$';
85
86   my $charge = $self->base_recur($cust_pkg, $sdate) || 0;
87
88   my $add_period = $self->option('add_full_period',1);
89
90   my $mnow = $$sdate;
91
92   # if this is the first bill but the bill date has been set
93   # (by prorate_defer_bill), calculate from the setup date,
94   # append the setup fee to @$details, and make sure to bill for 
95   # a full period after the bill date.
96   if ( $self->option('prorate_defer_bill',1)
97          && ! $cust_pkg->getfield('last_bill') 
98          && $cust_pkg->setup
99      )
100   {
101     #warn "[calc_prorate] #".$cust_pkg->pkgnum.": running deferred setup\n";
102     $param->{'setup_fee'} = $self->calc_setup($cust_pkg, $$sdate, $details);
103     $mnow = $cust_pkg->setup;
104     $add_period = 1;
105   }
106
107   # if the customer already has a billing day-of-month established,
108   # and it's a valid cutoff day, try to respect it
109   my $next_bill_day;
110   if ( my $next_bill = $cust_pkg->cust_main->next_bill_date ) {
111     $next_bill_day = (localtime($next_bill))[3];
112     if ( grep {$_ == $next_bill_day} @cutoff_days ) {
113       # by removing all other cutoff days from the list
114       @cutoff_days = ($next_bill_day);
115     }
116   }
117
118   my ($mend, $mstart);
119   ($mnow, $mend, $mstart) = $self->_endpoints($mnow, @cutoff_days);
120
121   # next bill date will be figured as $$sdate + one period
122   $$sdate = $mstart;
123
124   my $permonth = $charge / $self->freq;
125   my $months = ( ( $self->freq - 1 ) + ($mend-$mnow) / ($mend-$mstart) );
126   # after this, $self->freq - 1 < $months <= $self->freq
127
128   # add a full period if currently billing for a partial period
129   # or periods up to freq_override if billing for an override interval
130   if ( ($param->{'freq_override'} || 0) > 1 ) {
131     $months += $param->{'freq_override'} - 1;
132     # freq_override - 1 correct here?
133     # (probably only if freq == 1, yes?)
134   } elsif ( $add_period && $months < $self->freq ) {
135
136     # 'add_period' is a misnomer.
137     # we add enough to make the total at least a full period
138     $months++;
139     $$sdate = $self->add_freq($mstart, 1);
140     # now $self->freq <= $months <= $self->freq + 1
141     # (note that this only happens if $months < $self->freq to begin with)
142
143   }
144
145   if ( $self->option('prorate_verbose',1) and $months > 0 ) {
146     if ( $months < $self->freq ) {
147       # we are billing a fractional period only
148       #       # (though maybe not a fractional month)
149       my $period_end = $self->add_freq($mstart);
150       push @$details, 
151       'Prorated (' . time2str('%b %d', $mnow) .
152       ' - ' . time2str('%b %d', $period_end) . '): ' . $money_char .
153       sprintf('%.2f', $permonth * $months + 0.00000001 );
154
155     } elsif ( $months > $self->freq ) {
156       # we are billing MORE than a full period
157       push @$details,
158
159       'Prorated (' . time2str('%b %d', $mnow) .
160       ' - ' . time2str('%b %d', $mend) . '): ' . $money_char .
161       sprintf('%.2f', $permonth * ($months - $self->freq + 0.0000001)),
162
163       'First full period: ' . $money_char .
164       sprintf('%.2f', $permonth * $self->freq);
165     } # else $months == $self->freq, and no prorating has happened
166   }
167
168   $param->{'months'} = $months;
169                                                   #so 1.005 rounds to 1.01
170   $charge = sprintf('%.2f', $permonth * $months + 0.00000001 );
171
172   return sprintf('%.2f', $charge);
173 }
174
175 =item prorate_setup CUST_PKG SDATE
176
177 Set up the package.  This only has an effect if prorate_defer_bill is 
178 set, in which case it postpones the next bill to the cutoff day.
179
180 =cut
181
182 sub prorate_setup {
183   my $self = shift;
184   my ($cust_pkg, $sdate) = @_;
185   my @cutoff_days = $self->cutoff_day($cust_pkg);
186   if ( ! $cust_pkg->bill
187       and $self->option('prorate_defer_bill',1)
188       and @cutoff_days
189   ) {
190     my ($mnow, $mend, $mstart) = $self->_endpoints($sdate, @cutoff_days);
191     # If today is the cutoff day, set the next bill and setup both to 
192     # midnight today, so that the customer will be billed normally for a 
193     # month starting today.
194     if ( $mnow - $mstart < 86400 ) {
195       $cust_pkg->setup($mstart);
196       $cust_pkg->bill($mstart);
197     }
198     else {
199       $cust_pkg->bill($mend);
200     }
201     return 1;
202   }
203   return 0;
204 }
205
206 =item _endpoints TIME CUTOFF_DAY
207
208 Given a current time and a day of the month to prorate to, return three 
209 times: the start of the prorate interval (usually the current time), the
210 end of the prorate interval (i.e. the cutoff date), and the time one month 
211 before the end of the prorate interval.
212
213 =cut
214
215 sub _endpoints {
216   my $self = shift;
217   my $mnow = shift;
218   my @cutoff_days = sort {$a <=> $b} @_;
219
220   # only works for freq >= 1 month; probably can't be fixed
221   my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($mnow))[0..5];
222   if( $self->option('prorate_round_day',1) ) {
223     # If the time is 12:00-23:59, move to the next day by adding 18 
224     # hours to $mnow.  Because of DST this can end up from 05:00 to 18:59
225     # but it's always within the next day.
226     $mnow += 64800 if $hour >= 12;
227     # Get the new day, month, and year.
228     ($mday,$mon,$year) = (localtime($mnow))[3..5];
229     # Then set $mnow to midnight on that day.
230     $mnow = timelocal(0,0,0,$mday,$mon,$year);
231   }
232   my $mend;
233   my $mstart;
234   # select the first cutoff day that's on or after the current day
235   my $cutoff_day = min( grep { $_ >= $mday } @cutoff_days );
236   # if today is after the last cutoff, choose the first one
237   $cutoff_day ||= $cutoff_days[0];
238
239   # then, if today is on or after the selected day, set period to
240   # (cutoff day this month) - (cutoff day next month)
241   if ( $mday >= $cutoff_day ) {
242     $mend = 
243       timelocal_nocheck(0,0,0,$cutoff_day,$mon == 11 ? 0 : $mon + 1,$year+($mon==11));
244     $mstart =
245       timelocal_nocheck(0,0,0,$cutoff_day,$mon,$year);
246   }
247   # otherwise, set period to (cutoff day last month) - (cutoff day this month)
248   else {
249     $mend = 
250       timelocal_nocheck(0,0,0,$cutoff_day,$mon,$year);
251     $mstart = 
252       timelocal_nocheck(0,0,0,$cutoff_day,$mon == 0 ? 11 : $mon - 1,$year-($mon==0));
253   }
254   return ($mnow, $mend, $mstart);
255 }
256
257 1;