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     cust_bill     => $cust_bill,
  51     months        => $months,
  52     pkgnums       => [],
  53     base          => $previous_balance || 0, # sum of charges before discount
  54     discounted    => $previous_balance || 0, # sum of charges after discount
  55     list_pkgnums  => undef, # whether any packages are not discounted
  56   };
  57
  58   foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
  59     my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
  60     my $part_pkg = $cust_pkg->part_pkg or next;
  61     my $freq = $part_pkg->freq;
  62     my $setup = $cust_bill_pkg->setup || 0;
  63     my $recur = $cust_bill_pkg->recur || 0;
  64
  65     if ( $freq eq '1' ) { # monthly recurring package
  66       my $permonth = $part_pkg->base_recur_permonth || 0;
  67
  68       my ($discount) = grep { $_->months == $months }
  69       map { $_->discount } $part_pkg->part_pkg_discount;
  70
  71       $self->{base} += $setup + $recur + ($months - 1) * $permonth;
  72
  73       if ( $discount ) {
  74
  75         my $discountable;
  76         if ( $discount->setup ) {
  77           $discountable += $setup;
  78         }
  79         else {
  80           $self->{discounted} += $setup;
  81         }
  82
  83         if ( $discount->percent ) {
  84           $discountable += $months * $permonth;
  85           $discountable -= ($discountable * $discount->percent / 100);
  86           $discountable -= ($permonth - $recur); # correct for prorate
  87           $self->{discounted} += $discountable;
  88         }
  89         else {
  90           $discountable += $recur;
  91           $discountable -= $discount->amount * $recur/$permonth;
  92           $discountable += ($months - 1) * max($permonth - $discount->amount,0);
  93         }
  94
  95         $self->{discounted} += $discountable;
  96         push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
  97       }
  98       else { #no discount
  99         $self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
 100         $self->{list_pkgnums} = 1;
 101       }
 102     } #if $freq eq '1'
 103     else { # all non-monthly packages: include current charges only
 104       $self->{discounted} += $setup + $recur;
 105       $self->{base} += $setup + $recur;
 106       $self->{list_pkgnums} = 1;
 107     }
 108   } #foreach $cust_bill_pkg
 109
 110   # we've considered all line items; exit if none of them are
 111   # discountable
 112   return undef if $self->{base} == $self->{discounted}
 113                or $self->{base} == 0;
 114
 115   return bless $self, $class;
 116
 117 }
 118
 119 =item all CUST_BILL
 120
 121 For an L<FS::cust_bill> object, return a hash of all available
 122 discount plans, with discount term (months) as the key.
 123
 124 =cut
 125
 126 sub all {
 127   my $class = shift;
 128   my $cust_bill = shift;
 129
 130   my %hash;
 131   foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
 132     my $months = $_->months;
 133     my $discount_plan = $class->new(
 134       cust_bill => $cust_bill,
 135       months => $months
 136     );
 137     $hash{$_->months} = $discount_plan if defined($discount_plan);
 138   }
 139
 140   %hash;
 141 }
 142
 143 =back
 144
 145 =head1 METHODS
 146
 147 =over 4
 148
 149 =item discounted_total
 150
 151 Returns the total price for the term after applying discounts.  This is the
 152 price the customer would have to pay to receive the discount.  Note that
 153 this includes the monthly fees for all packages (including non-discountable
 154 ones) for each month in the term, but only includes fees for other packages
 155 as they appear on the current invoice.
 156
 157 =cut
 158
 159 sub discounted_total {
 160   my $self = shift;
 161   sprintf('%.2f', $self->{discounted});
 162 }
 163
 164 =item base_total
 165
 166 Returns the total price for the term before applying discounts.
 167
 168 =cut
 169
 170 sub base_total {
 171   my $self = shift;
 172   sprintf('%.2f', $self->{base});
 173 }
 174
 175 =item pkgnums
 176
 177 Returns a list of package numbers that are receiving discounts under this
 178 plan.
 179
 180 =cut
 181
 182 sub pkgnums {
 183   my $self = shift;
 184   @{ $self->{pkgnums} };
 185 }
 186
 187 =item list_pkgnums
 188
 189 Returns a true value if any packages listed on the invoice do not
 190 receive a discount, either because there isn't one at the specified
 191 term length or because they're not monthly recurring packages.
 192
 193 =cut
 194
 195 sub list_pkgnums {
 196   my $self = shift;
 197   $self->{list_pkgnums};
 198 }
 199
 200 # any others?  don't think so
 201
 202 1;