1 package FS::part_pkg::prorate_calendar;
4 use vars qw(@ISA %info);
7 use base 'FS::part_pkg::flat';
12 'name' => 'Prorate to specific calendar day(s), then flat-rate',
13 'shortname' => 'Prorate (calendar cycle)',
14 'inherit_fields' => [ 'flat', 'usage_Mixin', 'global_Mixin' ],
16 'recur_temporality' => {'disabled' => 1},
17 'sync_bill_date' => {'disabled' => 1},# god help us all
19 'cutoff_day' => { 'name' => 'Billing day (1 - end of cycle)',
23 # add_full_period is not allowed
25 # prorate_round_day is always on
26 'prorate_round_day' => { 'disabled' => 1 },
28 'prorate_defer_bill'=> {
29 'name' => 'Defer the first bill until the billing day',
32 'prorate_verbose' => {
33 'name' => 'Show prorate details on the invoice',
37 'fieldorder' => [ 'cutoff_day', 'prorate_defer_bill', 'prorate_round_day', 'prorate_verbose' ],
42 my %freq_max_days = ( # the length of the shortest period of each cycle type
44 '2' => 59, # Jan - Feb
45 '3' => 90, # Jan - Mar
46 '4' => 120, # Jan - Apr
47 '6' => 181, # Jan - Jun
51 my %freq_cutoff_days = (
52 '1' => [ 31, 28, 31, 30, 31, 30,
53 31, 31, 30, 31, 30, 31 ],
54 '2' => [ 59, 61, 61, 62, 61, 61 ],
55 '3' => [ 90, 91, 92, 92 ],
56 '4' => [ 120, 123, 122 ],
62 # yes, this package plan is such a special snowflake it needs its own
66 if ( !exists($freq_max_days{$self->freq}) ) {
67 return 'Prorate (calendar cycle) billing interval must be an integer factor of one year';
73 my( $self, $cust_pkg ) = @_;
74 my @periods = @{ $freq_cutoff_days{$self->freq} };
75 my $prorate_day = $cust_pkg->cust_main->prorate_day
76 || $self->option('cutoff_day')
79 my @cutoffs = ($prorate_day);
80 pop @periods; # we don't care about the last one
82 push @cutoffs, $cutoffs[-1] + $_;
88 # it's not the same algorithm
89 my ($self, $cust_pkg, $sdate, $details, $param, @cutoff_days) = @_;
90 die "no cutoff_day" unless @cutoff_days;
91 die "prepaid terms not supported with calendar prorate packages"
92 if $param->{freq_override}; # XXX if we ever use this again
94 #XXX should we still be doing this with multi-currency support?
95 my $money_char = FS::Conf->new->config('money_char') || '$';
97 my $charge = $self->base_recur($cust_pkg, $sdate) || 0;
98 my $now = DateTime->from_epoch(epoch => $$sdate, time_zone => 'local');
101 # if this is the first bill but the bill date has been set
102 # (by prorate_defer_bill), calculate from the setup date,
103 # append the setup fee to @$details, and make sure to bill for
104 # a full period after the bill date.
106 if ( $self->option('prorate_defer_bill', 1)
107 and !$cust_pkg->getfield('last_bill')
108 and $cust_pkg->setup )
110 $param->{'setup_fee'} = $self->calc_setup($cust_pkg, $$sdate, $details);
111 $now = DateTime->from_epoch(epoch => $cust_pkg->setup, time_zone => 'local');
115 # DON'T sync to the existing billing day; cutoff days work differently here.
117 $now->truncate(to => 'day');
118 my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days);
120 #warn "[prorate_calendar] now = ".$now->ymd.", start = ".$start->ymd.", end = ".$end->ymd."\n";
122 my $periods = $end->delta_days($now)->delta_days /
123 $end->delta_days($start)->delta_days;
124 if ( $periods < 1 and $add_period ) {
125 $periods++; # charge for the extra time
126 $start->add(months => $self->freq); # and push the next bill date forward
128 if ( $self->option('prorate_verbose',1) and $periods > 0 ) {
129 if ( $periods < 1 ) {
131 'Prorated (' . $now->strftime('%b %d') .
132 ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
133 sprintf('%.2f', $charge * $periods + 0.00000001);
134 } elsif ( $periods > 1 ) {
136 'Prorated (' . $now->strftime('%b %d') .
137 ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
138 sprintf('%.2f', $charge * ($periods - 1) + 0.00000001),
140 'First full period: ' . $money_char . sprintf('%.2f', $charge);
141 } # else exactly one period
144 $$sdate = $start->epoch;
145 return sprintf('%.2f', $charge * $periods + 0.00000001);
150 my ($cust_pkg, $sdate) = @_;
151 my @cutoff_days = $self->cutoff_day;
152 if ( ! $cust_pkg->bill
153 and $self->option('prorate_defer_bill')
156 my $now = DateTime->from_epoch(epoch => $sdate, time_zone => 'local');
157 $now->truncate(to => 'day');
158 my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days);
159 if ( $now->compare($start) == 0 ) {
160 $cust_pkg->setup($start->epoch);
161 $cust_pkg->bill($start->epoch);
163 $cust_pkg->bill($end->epoch);
171 =item calendar_endpoints NOW CUTOFF_DAYS
173 Given a current date (DateTime object) and a list of cutoff day-of-year
174 numbers, finds the next upcoming cutoff day (in either the current or the
175 upcoming year) and the cutoff day before that, and returns them both.
179 sub calendar_endpoints {
182 my @cutoff_day = sort {$a <=> $b} @_;
184 my $year = $now->year;
185 my $day = $now->day_of_year;
187 # For cutoff day purposes, it's the same day as Feb 28
188 $day-- if $now->is_leap_year and $day >= 60;
190 # select the first cutoff day that's after the current day
192 while ( $cutoff_day[$i] and $cutoff_day[$i] <= $day ) {
195 # $cutoff_day[$i] is now later in the calendar than today
196 # or today is between the last cutoff day and the end of the year
200 # then today is on or before the first cutoff day
201 $start = DateTime->from_day_of_year(year => $year - 1,
202 day_of_year => $cutoff_day[-1],
203 time_zone => 'local');
204 $end = DateTime->from_day_of_year(year => $year,
205 day_of_year => $cutoff_day[0],
206 time_zone => 'local');
207 } elsif ( $i > 0 and $i < scalar(@cutoff_day) ) {
208 # today is between two cutoff days
209 $start = DateTime->from_day_of_year(year => $year,
210 day_of_year => $cutoff_day[$i - 1],
211 time_zone => 'local');
212 $end = DateTime->from_day_of_year(year => $year,
213 day_of_year => $cutoff_day[$i],
214 time_zone => 'local');
216 # today is after the last cutoff day
217 $start = DateTime->from_day_of_year(year => $year,
218 day_of_year => $cutoff_day[-1],
219 time_zone => 'local');
220 $end = DateTime->from_day_of_year(year => $year + 1,
221 day_of_year => $cutoff_day[0],
222 time_zone => 'local');
224 return ($end, $start);