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