FS/FS/part_pkg/prorate_calendar.pm

   1 package FS::part_pkg::prorate_calendar;
   2
   3 use strict;
   4 use vars qw(@ISA %info);
   5 use DateTime;
   6 use Tie::IxHash;
   7 use base 'FS::part_pkg::flat';
   8
   9 # weird stuff in here
  10
  11 %info = (
  12   'name' => 'Prorate to specific calendar day(s), then flat-rate',
  13   'shortname' => 'Prorate (calendar cycle)',
  14   'inherit_fields' => [ 'flat', 'usage_Mixin', 'global_Mixin' ],
  15   'fields' => {
  16     'recur_temporality' => {'disabled' => 1},
  17     'sync_bill_date' => {'disabled' => 1},# god help us all
  18
  19     'cutoff_day' => { 'name' => 'Billing day (1 - end of cycle)',
  20                       'default' => 1,
  21                     },
  22
  23     # add_full_period is not allowed
  24
  25     # prorate_round_day is always on
  26     'prorate_round_day' => { 'disabled' => 1 },
  27
  28     'prorate_defer_bill'=> {
  29                         'name' => 'Defer the first bill until the billing day',
  30                         'type' => 'checkbox',
  31                         },
  32     'prorate_verbose' => {
  33                         'name' => 'Show prorate details on the invoice',
  34                         'type' => 'checkbox',
  35                         },
  36   },
  37   'fieldorder' => [ 'cutoff_day', 'prorate_defer_bill', 'prorate_round_day', 'prorate_verbose' ],
  38   'freq' => 'm',
  39   'weight' => 20,
  40 );
  41
  42 my %freq_max_days = ( # the length of the shortest period of each cycle type
  43   '1'   => 28,
  44   '2'   => 59,   # Jan - Feb
  45   '3'   => 90,   # Jan - Mar
  46   '4'   => 120,  # Jan - Apr
  47   '6'   => 181,  # Jan - Jun
  48   '12'  => 365,
  49 );
  50
  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 ],
  57   '6'   => [ 181, 184 ],
  58   '12'  => [ 365 ],
  59 );
  60
  61 sub check {
  62   # yes, this package plan is such a special snowflake it needs its own
  63   # check method.
  64   my $self = shift;
  65
  66   if ( !exists($freq_max_days{$self->freq}) ) {
  67     return 'Prorate (calendar cycle) billing interval must be an integer factor of one year';
  68   }
  69   $self->SUPER::check;
  70 }
  71
  72 sub cutoff_day {
  73   my( $self, $cust_pkg ) = @_;
  74   my @periods = @{ $freq_cutoff_days{$self->freq} };
  75   my @cutoffs = ($self->option('cutoff_day') || 1); # Jan 1 = 1
  76   pop @periods; # we don't care about the last one
  77   foreach (@periods) {
  78     push @cutoffs, $cutoffs[-1] + $_;
  79   }
  80   @cutoffs;
  81 }
  82
  83 sub calc_prorate {
  84   # it's not the same algorithm
  85   my ($self, $cust_pkg, $sdate, $details, $param, @cutoff_days) = @_;
  86   die "no cutoff_day" unless @cutoff_days;
  87   die "prepaid terms not supported with calendar prorate packages"
  88     if $param->{freq_override}; # XXX if we ever use this again
  89
  90   #XXX should we still be doing this with multi-currency support?
  91   my $money_char = FS::Conf->new->config('money_char') || '$';
  92
  93   my $charge = $self->base_recur($cust_pkg, $sdate) || 0;
  94   my $now = DateTime->from_epoch(epoch => $$sdate, time_zone => 'local');
  95
  96   my $add_period = 0;
  97   # if this is the first bill but the bill date has been set
  98   # (by prorate_defer_bill), calculate from the setup date,
  99   # append the setup fee to @$details, and make sure to bill for
 100   # a full period after the bill date.
 101
 102   if ( $self->option('prorate_defer_bill', 1)
 103     and !$cust_pkg->getfield('last_bill')
 104     and $cust_pkg->setup )
 105   {
 106     $param->{'setup_fee'} = $self->calc_setup($cust_pkg, $$sdate, $details);
 107     $now = DateTime->from_epoch(epoch => $cust_pkg->setup, time_zone => 'local');
 108     $add_period = 1;
 109   }
 110
 111   # DON'T sync to the existing billing day; cutoff days work differently here.
 112
 113   $now->truncate(to => 'day');
 114   my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days);
 115
 116   #warn "[prorate_calendar] now = ".$now->ymd.", start = ".$start->ymd.", end = ".$end->ymd."\n";
 117
 118   my $periods = $end->delta_days($now)->delta_days /
 119                 $end->delta_days($start)->delta_days;
 120   if ( $periods < 1 and $add_period ) {
 121     $periods++; # charge for the extra time
 122     $start->add(months => $self->freq); # and push the next bill date forward
 123   }
 124   if ( $self->option('prorate_verbose',1) and $periods > 0 ) {
 125     if ( $periods < 1 ) {
 126       push @$details,
 127         'Prorated (' . $now->strftime('%b %d') .
 128         ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
 129         sprintf('%.2f', $charge * $periods + 0.00000001);
 130     } elsif ( $periods > 1 ) {
 131       push @$details,
 132         'Prorated (' . $now->strftime('%b %d') .
 133         ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
 134         sprintf('%.2f', $charge * ($periods - 1) + 0.00000001),
 135
 136         'First full period: ' . $money_char . sprintf('%.2f', $charge);
 137     } # else exactly one period
 138   }
 139
 140   $$sdate = $start->epoch;
 141   return sprintf('%.2f', $charge * $periods + 0.00000001);
 142 }
 143
 144 sub prorate_setup {
 145   my $self = shift;
 146   my ($cust_pkg, $sdate) = @_;
 147   my @cutoff_days = $self->cutoff_day;
 148   if ( ! $cust_pkg->bill
 149      and $self->option('prorate_defer_bill')
 150      and @cutoff_days )
 151   {
 152     my $now = DateTime->from_epoch(epoch => $sdate, time_zone => 'local');
 153     $now->truncate(to => 'day');
 154     my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days);
 155     if ( $now->compare($start) == 0 ) {
 156       $cust_pkg->setup($start->epoch);
 157       $cust_pkg->bill($start->epoch);
 158     } else {
 159       $cust_pkg->bill($end->epoch);
 160     }
 161     return 1;
 162   } else {
 163     return 0;
 164   }
 165 }
 166
 167 =item calendar_endpoints NOW CUTOFF_DAYS
 168
 169 Given a current date (DateTime object) and a list of cutoff day-of-year
 170 numbers, finds the next upcoming cutoff day (in either the current or the
 171 upcoming year) and the cutoff day before that, and returns them both.
 172
 173 =cut
 174
 175 sub calendar_endpoints {
 176   my $self = shift;
 177   my $now = shift;
 178   my @cutoff_day = sort {$a <=> $b} @_;
 179
 180   my $year = $now->year;
 181   my $day = $now->day_of_year;
 182   # Feb 29 = 60
 183   # For cutoff day purposes, it's the same day as Feb 28
 184   $day-- if $now->is_leap_year and $day >= 60;
 185
 186   # select the first cutoff day that's after the current day
 187   my $i = 0;
 188   while ( $cutoff_day[$i] and $cutoff_day[$i] <= $day ) {
 189     $i++;
 190   }
 191   # $cutoff_day[$i] is now later in the calendar than today
 192   # or today is between the last cutoff day and the end of the year
 193
 194   my ($start, $end);
 195   if ( $i == 0 ) {
 196     # then today is on or before the first cutoff day
 197     $start = DateTime->from_day_of_year(year => $year - 1,
 198                                         day_of_year => $cutoff_day[-1],
 199                                         time_zone => 'local');
 200     $end =   DateTime->from_day_of_year(year => $year,
 201                                         day_of_year => $cutoff_day[0],
 202                                         time_zone => 'local');
 203   } elsif ( $i > 0 and $i < scalar(@cutoff_day) ) {
 204     # today is between two cutoff days
 205     $start = DateTime->from_day_of_year(year => $year,
 206                                         day_of_year => $cutoff_day[$i - 1],
 207                                         time_zone => 'local');
 208     $end =   DateTime->from_day_of_year(year => $year,
 209                                         day_of_year => $cutoff_day[$i],
 210                                         time_zone => 'local');
 211   } else {
 212     # today is after the last cutoff day
 213     $start = DateTime->from_day_of_year(year => $year,
 214                                         day_of_year => $cutoff_day[-1],
 215                                         time_zone => 'local');
 216     $end =   DateTime->from_day_of_year(year => $year + 1,
 217                                         day_of_year => $cutoff_day[0],
 218                                         time_zone => 'local');
 219   }
 220   return ($end, $start);
 221 }
 222
 223 1;