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