FS/FS/cust_main/Billing_Discount.pm

   1 package FS::cust_main::Billing_Discount;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use FS::Record qw( qsearch ); #qsearchs );
   6 use FS::cust_pkg;
   7
   8 # 1 is mostly method/subroutine entry and options
   9 # 2 traces progress of some operations
  10 # 3 is even more information including possibly sensitive data
  11 $DEBUG = 0;
  12 $me = '[FS::cust_main::Billing_Discount]';
  13
  14 =head1 NAME
  15
  16 FS::cust_main::Billing_Discount - Billing discount mixin for cust_main
  17
  18 =head1 SYNOPSIS
  19
  20 =head1 DESCRIPTION
  21
  22 These methods are available on FS::cust_main objects.
  23
  24 =head1 METHODS
  25
  26 =over 4
  27
  28 =item _discount_pkg_and_bill
  29
  30 =cut
  31
  32 sub _discount_pkgs_and_bill {
  33   my $self = shift;
  34
  35   my @cust_bill = $self->cust_bill;
  36   my $cust_bill = pop @cust_bill;
  37   return () unless $cust_bill && $cust_bill->owed;
  38
  39   my @where = ();
  40   push @where, "cust_bill_pkg.invnum = ". $cust_bill->invnum;
  41   push @where, "cust_bill_pkg.pkgpart_override IS NULL";
  42   push @where, "part_pkg.freq = '1'";
  43   push @where, "(cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0)";
  44   push @where, "(cust_pkg.susp   IS NULL OR cust_pkg.susp   = 0)";
  45   push @where, "EXISTS( SELECT 1 FROM part_pkg_discount
  46                           WHERE part_pkg.pkgpart = part_pkg_discount.pkgpart )";
  47   push @where,
  48     "NOT EXISTS (
  49        SELECT 1 FROM cust_bill_pkg_discount
  50          WHERE cust_bill_pkg.billpkgnum = cust_bill_pkg_discount.billpkgnum
  51     )";
  52
  53   my $extra_sql = 'WHERE '. join(' AND ', @where);
  54
  55   my @cust_pkg =
  56     qsearch({
  57       'table' => 'cust_pkg',
  58       'select' => "DISTINCT cust_pkg.*",
  59       'addl_from' => 'JOIN cust_bill_pkg USING(pkgnum) '.
  60                      'JOIN part_pkg USING(pkgpart)',
  61       'hashref' => {},
  62       'extra_sql' => $extra_sql,
  63     });
  64
  65   ($cust_bill, @cust_pkg);
  66 }
  67
  68 =item _discountable_pkgs_at_term
  69
  70 =cut
  71
  72 #this isn't even a method
  73 sub _discountable_pkgs_at_term {
  74   my ($term, @pkgs) = @_;
  75   my $part_pkg = new FS::part_pkg { freq => $term - 1 };
  76   grep { ( !$_->adjourn || $_->adjourn > $part_pkg->add_freq($_->bill) ) &&
  77          ( !$_->expire  || $_->expire  > $part_pkg->add_freq($_->bill) )
  78        }
  79     @pkgs;
  80 }
  81
  82 =item discount_terms
  83
  84 Returns a list of lengths for term discounts
  85
  86 =cut
  87
  88 sub discount_terms {
  89   my $self = shift;
  90
  91   my %terms = ();
  92
  93   my @discount_pkgs = $self->_discount_pkgs_and_bill;
  94   shift @discount_pkgs; #discard bill;
  95
  96   # convert @discount_pkgs (the list of packages that have available discounts)
  97   # to a list of distinct term lengths in months, and strip any decimal places
  98   # from the number of months, not that it should have any
  99   map { $terms{sprintf('%.0f', $_->months)} = 1 }
 100     grep { $_->months && $_->months > 1 }
 101     map { $_->discount }
 102     map { $_->part_pkg->part_pkg_discount }
 103     @discount_pkgs;
 104
 105   return sort { $a <=> $b } keys %terms;
 106
 107 }
 108
 109 =item discount_term_values MONTHS
 110
 111 Returns a list with credit, dollar amount saved, and total bill acheived
 112 by prepaying the most recent invoice for MONTHS.
 113
 114 =cut
 115
 116 # XXX this should work by creating a quotation; then we can finally retire
 117 # the "no_commit" option, which doesn't work with modern tax calculation
 118
 119 sub discount_term_values {
 120   my $self = shift;
 121   my $term = shift;
 122
 123   local($DEBUG) = $FS::cust_main::DEBUG if $FS::cust_main::DEBUG > $DEBUG;
 124
 125   warn "$me discount_term_values called with $term\n" if $DEBUG;
 126
 127   my %result = ();
 128
 129   my @packages = $self->_discount_pkgs_and_bill;
 130   my $cust_bill = shift(@packages);
 131   @packages = _discountable_pkgs_at_term( $term, @packages );
 132   return () unless scalar(@packages);
 133
 134   $_->bill($_->last_bill) foreach @packages;
 135   my @final = map { new FS::cust_pkg { $_->hash } } @packages;
 136
 137   my %options = (
 138                   'recurring_only' => 1,
 139                   'no_usage_reset' => 1,
 140                   'no_commit'      => 1,
 141                 );
 142
 143   my %params =  (
 144                   'return_bill'    => [],
 145                   'pkg_list'       => \@packages,
 146                   'time'           => $cust_bill->_date,
 147                 );
 148
 149   my $error = $self->bill(%options, %params);
 150   die $error if $error; # XXX think about this a bit more
 151
 152   my $credit = 0;
 153   $credit += $_->charged foreach @{$params{return_bill}};
 154   $credit = sprintf('%.2f', $credit);
 155   warn "$me discount_term_values $term credit: $credit\n" if $DEBUG;
 156
 157   %params =  (
 158                'return_bill'    => [],
 159                'pkg_list'       => \@packages,
 160                'time'           => $packages[0]->part_pkg->add_freq($cust_bill->_date)
 161              );
 162
 163   $error = $self->bill(%options, %params);
 164   die $error if $error; # XXX think about this a bit more
 165
 166   my $next = 0;
 167   $next += $_->charged foreach @{$params{return_bill}};
 168   warn "$me discount_term_values $term next: $next\n" if $DEBUG;
 169
 170   %params =  (
 171                'return_bill'    => [],
 172                'pkg_list'       => \@final,
 173                'time'           => $cust_bill->_date,
 174                'freq_override'  => $term,
 175              );
 176
 177   $error = $self->bill(%options, %params);
 178   die $error if $error; # XXX think about this a bit more
 179
 180   my $final = $self->balance - $credit;
 181   $final += $_->charged foreach @{$params{return_bill}};
 182   $final = sprintf('%.2f', $final);
 183   warn "$me discount_term_values $term final: $final\n" if $DEBUG;
 184
 185   my $savings = sprintf('%.2f', $self->balance + ($term - 1) * $next - $final);
 186
 187   ( $credit, $savings, $final );
 188
 189 }
 190
 191 sub discount_terms_hash {
 192   my $self = shift;
 193
 194   my %result = ();
 195   my @terms = $self->discount_terms;
 196   foreach my $term (@terms) {
 197     my @result = $self->discount_term_values($term);
 198     $result{$term} = [ @result ] if scalar(@result);
 199   }
 200
 201   return %result;
 202
 203 }
 204
 205 =back
 206
 207 =head1 BUGS
 208
 209 =head1 SEE ALSO
 210
 211 L<FS::cust_main>, L<FS::cust_main::Billing>
 212
 213 =cut
 214
 215 1;