FS/FS/discount_plan.pm

   1 package FS::discount_plan;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use FS::Record qw( qsearch );
   6 use FS::cust_bill;
   7 use FS::cust_bill_pkg;
   8 use FS::discount;
   9 use List::Util qw( max );
  10
  11 =head1 NAME
  12
  13 FS::discount_plan - A term discount as applied to an invoice
  14
  15 =head1 DESCRIPTION
  16
  17 An FS::discount_plan object represents a term prepayment discount
  18 available for an invoice (L<FS::cust_bill>).  FS::discount_plan
  19 objects are non-persistent and do not inherit from FS::Record.
  20
  21 =head1 CLASS METHODS
  22
  23 =over 4
  24
  25 =item new OPTIONS
  26
  27 Calculate a discount plan.  OPTIONS must include:
  28
  29 cust_bill - the invoice to calculate discounts for
  30
  31 months - the number of months to be prepaid
  32
  33 If there are no line items on the invoice eligible for the discount
  34 C<new()> will return undef.
  35
  36 =cut
  37
  38 sub new {
  39   my $class = shift;
  40   my %opt = @_;
  41   %opt = %{ $_[0] } if ( ref $_[0] );
  42
  43   my $cust_bill = $opt{cust_bill}
  44     or die "$me new() requires 'cust_bill'\n";
  45   my $months = $opt{months}
  46     or die "$me new() requires 'months'\n";
  47
  48   my ($previous_balance) = $cust_bill->previous;
  49   my $self = {
  50     pkgnums       => [],
  51     base          => $previous_balance || 0, # sum of charges before discount
  52     discounted    => $previous_balance || 0, # sum of charges after discount
  53     list_pkgnums  => 0, # whether any packages are not discounted
  54   };
  55
  56   foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
  57     my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
  58     my $part_pkg = $cust_pkg->part_pkg or next;
  59     my $freq = $part_pkg->freq;
  60     my $setup = $cust_bill_pkg->setup || 0;
  61     my $recur = $cust_bill_pkg->recur || 0;
  62
  63     if ( $freq eq '1' ) { # monthly recurring package
  64       my $permonth = $part_pkg->base_recur_permonth || 0;
  65
  66       my ($discount) = grep { $_->months == $months }
  67       map { $_->discount } $part_pkg->part_pkg_discount;
  68
  69       $self->{base} += $setup + $recur + ($months - 1) * $permonth;
  70
  71       if ( $discount ) {
  72
  73         my $discountable;
  74         if ( $discount->setup ) {
  75           $discountable += $setup;
  76         }
  77         else {
  78           $self->{discounted} += $setup;
  79         }
  80
  81         if ( $discount->percent ) {
  82           $discountable += $months * $permonth;
  83           $discountable -= ($discountable * $discount->percent / 100);
  84           $discountable -= ($permonth - $recur); # correct for prorate
  85           $self->{discounted} += $discountable;
  86         }
  87         else {
  88           $discountable += $recur;
  89           $discountable -= $discount->amount * $recur/$permonth;
  90           $discountable += ($months - 1) * max($permonth - $discount->amount,0);
  91         }
  92
  93         $self->{discounted} += $discountable;
  94         push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
  95       }
  96       else { #no discount
  97         $self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
  98         $self->{list_pkgnums} = 1;
  99       }
 100     } #if $freq eq '1'
 101     else { # all non-monthly packages: include current charges only
 102       $self->{discounted} += $setup + $recur;
 103       $self->{base} += $setup + $recur;
 104       $self->{list_pkgnums} = 1;
 105     }
 106   } #foreach $cust_bill_pkg
 107
 108   # we've considered all line items; exit if none of them are
 109   # discountable
 110   return undef if $self->{base} == $self->{discounted}
 111                or $self->{base} == 0;
 112
 113   return bless $self, $class;
 114
 115 }
 116
 117 =item all CUST_BILL
 118
 119 For an L<FS::cust_bill> object, return a hash of all available
 120 discount plans, with discount term (months) as the key.
 121
 122 =cut
 123
 124 sub all {
 125   my $class = shift;
 126   my $cust_bill = shift;
 127
 128   my %hash;
 129   foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
 130     my $months = $_->months;
 131     my $discount_plan = $class->new(
 132       cust_bill => $cust_bill,
 133       months => $months
 134     );
 135     $hash{$_->months} = $discount_plan if defined($discount_plan);
 136   }
 137
 138   %hash;
 139 }
 140
 141 =back
 142
 143 =head1 METHODS
 144
 145 =over 4
 146
 147 =item discounted_total
 148
 149 Returns the total price for the term after applying discounts.  This is the
 150 price the customer would have to pay to receive the discount.  Note that
 151 this includes the monthly fees for all packages (including non-discountable
 152 ones) for each month in the term, but only includes fees for other packages
 153 as they appear on the current invoice.
 154
 155 =cut
 156
 157 sub discounted_total {
 158   my $self = shift;
 159   sprintf('%.2f', $self->{discounted});
 160 }
 161
 162 =item base_total
 163
 164 Returns the total price for the term before applying discounts.
 165
 166 =cut
 167
 168 sub base_total {
 169   my $self = shift;
 170   sprintf('%.2f', $self->{base});
 171 }
 172
 173 =item pkgnums
 174
 175 Returns a list of package numbers that are receiving discounts under this
 176 plan.
 177
 178 =cut
 179
 180 sub pkgnums {
 181   my $self = shift;
 182   @{ $self->{pkgnums} };
 183 }
 184
 185 # any others?  don't think so
 186
 187 1;