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