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