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' => 23,
  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 $prorate_day = $cust_pkg->cust_main->prorate_day
  76                     || $self->option('cutoff_day')
  77                     || 1;
  78
  79   my @cutoffs = ($prorate_day);
  80   pop @periods; # we don't care about the last one
  81   foreach (@periods) {
  82     push @cutoffs, $cutoffs[-1] + $_;
  83   }
  84   @cutoffs;
  85 }
  86
  87 sub calc_prorate {
  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
  93
  94   #XXX should we still be doing this with multi-currency support?
  95   my $money_char = FS::Conf->new->config('money_char') || '$';
  96
  97   my $charge = $self->base_recur($cust_pkg, $sdate) || 0;
  98   my $now = DateTime->from_epoch(epoch => $$sdate, time_zone => 'local');
  99
 100   my $add_period = 0;
 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.
 105
 106   if ( $self->option('prorate_defer_bill', 1)
 107     and !$cust_pkg->getfield('last_bill')
 108     and $cust_pkg->setup )
 109   {
 110     $param->{'setup_fee'} = $self->calc_setup($cust_pkg, $$sdate, $details);
 111     $now = DateTime->from_epoch(epoch => $cust_pkg->setup, time_zone => 'local');
 112     $add_period = 1;
 113   }
 114
 115   # DON'T sync to the existing billing day; cutoff days work differently here.
 116
 117   $now->truncate(to => 'day');
 118   my ($end, $start) = $self->calendar_endpoints($now, @cutoff_days);
 119
 120   #warn "[prorate_calendar] now = ".$now->ymd.", start = ".$start->ymd.", end = ".$end->ymd."\n";
 121
 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
 127   }
 128   if ( $self->option('prorate_verbose',1) and $periods > 0 ) {
 129     if ( $periods < 1 ) {
 130       push @$details,
 131         'Prorated (' . $now->strftime('%b %d') .
 132         ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
 133         sprintf('%.2f', $charge * $periods + 0.00000001);
 134     } elsif ( $periods > 1 ) {
 135       push @$details,
 136         'Prorated (' . $now->strftime('%b %d') .
 137         ' - ' . $end->strftime('%b %d') . '): ' . $money_char .
 138         sprintf('%.2f', $charge * ($periods - 1) + 0.00000001),
 139
 140         'First full period: ' . $money_char . sprintf('%.2f', $charge);
 141     } # else exactly one period
 142   }
 143
 144   $$sdate = $start->epoch;
 145   return sprintf('%.2f', $charge * $periods + 0.00000001);
 146 }
 147
 148 sub prorate_setup {
 149   my $self = shift;
 150   my ($cust_pkg, $sdate) = @_;
 151   my @cutoff_days = $self->cutoff_day;
 152   if ( ! $cust_pkg->bill
 153      and $self->option('prorate_defer_bill')
 154      and @cutoff_days )
 155   {
 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);
 162     } else {
 163       $cust_pkg->bill($end->epoch);
 164     }
 165     return 1;
 166   } else {
 167     return 0;
 168   }
 169 }
 170
 171 =item calendar_endpoints NOW CUTOFF_DAYS
 172
 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.
 176
 177 =cut
 178
 179 sub calendar_endpoints {
 180   my $self = shift;
 181   my $now = shift;
 182   my @cutoff_day = sort {$a <=> $b} @_;
 183
 184   my $year = $now->year;
 185   my $day = $now->day_of_year;
 186   # Feb 29 = 60
 187   # For cutoff day purposes, it's the same day as Feb 28
 188   $day-- if $now->is_leap_year and $day >= 60;
 189
 190   # select the first cutoff day that's after the current day
 191   my $i = 0;
 192   while ( $cutoff_day[$i] and $cutoff_day[$i] <= $day ) {
 193     $i++;
 194   }
 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
 197
 198   my ($start, $end);
 199   if ( $i == 0 ) {
 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');
 215   } else {
 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');
 223   }
 224   return ($end, $start);
 225 }
 226
 227 1;