minor refactor and better safeguards on term discounts, #15068
authormark <mark>
Wed, 7 Dec 2011 05:50:50 +0000 (05:50 +0000)
committermark <mark>
Wed, 7 Dec 2011 05:50:50 +0000 (05:50 +0000)
FS/FS/Mason.pm
FS/FS/cust_bill.pm
FS/FS/cust_main/Billing_Realtime.pm
FS/FS/discount_plan.pm [new file with mode: 0644]
FS/MANIFEST
FS/t/discount_plan.t [new file with mode: 0644]
httemplate/edit/cust_pay.cgi
httemplate/elements/tr-select-discount_term.html
httemplate/misc/payment.cgi

index 9d7180a..99cc1cd 100644 (file)
@@ -298,6 +298,7 @@ if ( -e $addl_handler_use_file ) {
   use FS::rate_tier;
   use FS::rate_tier_detail;
   use FS::radius_attr;
+  use FS::discount_plan;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {
index 2ef901a..ef6dc7b 100644 (file)
@@ -43,6 +43,7 @@ use FS::bill_batch;
 use FS::cust_bill_batch;
 use FS::cust_bill_pay_pkg;
 use FS::cust_credit_bill_pkg;
+use FS::discount_plan;
 use FS::L10N;
 
 @ISA = qw( FS::cust_main_Mixin FS::Record );
@@ -748,6 +749,18 @@ sub cust_bill_batch {
   qsearch('cust_bill_batch', { 'invnum' => $self->invnum });
 }
 
+=item discount_plans
+
+Returns all discount plans (L<FS::discount_plan>) for this invoice, as a 
+hash keyed by term length.
+
+=cut
+
+sub discount_plans {
+  my $self = shift;
+  FS::discount_plan->all($self);
+}
+
 =item tax
 
 Returns the tax amount (see L<FS::cust_bill_pkg>) for this invoice.
@@ -5218,108 +5231,34 @@ a setup fee if the discount is allowed to apply to setup fees.
 
 sub _items_discounts_avail {
   my $self = shift;
-  my %terms;
   my $list_pkgnums = 0; # if any packages are not eligible for all discounts
-  my ($previous_balance) = $self->previous;
-
-  foreach (qsearch('discount',{ 'months' => { op => '>', value => 1} })) {
-    $terms{$_->months} = {
-      pkgnums       => [],
-      base          => $previous_balance || 0, # pre-discount sum of charges
-      discounted    => $previous_balance || 0, # post-discount sum
-      list_pkgnums  => 0, # whether any packages are not discounted
-    }
-  }
-  foreach my $months (keys %terms) {
-    my $hash = $terms{$months};
-
-    # tricky, because packages may not all be eligible for the same discounts
-    foreach my $cust_bill_pkg ( $self->cust_bill_pkg ) {
-      my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
-      my $part_pkg = $cust_pkg->part_pkg or next;
-      my $freq = $part_pkg->freq;
-      my $setup = $cust_bill_pkg->setup || 0;
-      my $recur = $cust_bill_pkg->recur || 0;
-
-      if ( $freq eq '1' ) { #monthly
-        my $permonth = $part_pkg->base_recur_permonth || 0;
 
-        my ($discount) = grep { $_->months == $months } 
-                         map { $_->discount } $part_pkg->part_pkg_discount;
+  my %plans = $self->discount_plans;
 
-        $hash->{base} += $setup + $recur + ($months - 1) * $permonth;
+  $list_pkgnums = grep { $_->list_pkgnums } values %plans;
 
-        if ( $discount ) {
+  map {
+    my $months = $_;
+    my $plan = $plans{$months};
 
-          my $discountable;
-          if ( $discount->setup ) {
-            $discountable += $setup;
-          }
-          else {
-            $hash->{discounted} += $setup;
-          }
-
-          if ( $discount->percent ) {
-            $discountable += $months * $permonth;
-            $discountable -= ($discountable * $discount->percent / 100);
-            $discountable -= ($permonth - $recur); # correct for prorate
-            $hash->{discounted} += $discountable;
-          }
-          else {
-            $discountable += $recur;
-            $discountable -= $discount->amount * $recur/$permonth;
-
-            $discountable += ($months - 1) * max($permonth - $discount->amount,0);
-          }
-
-          $hash->{discounted} += $discountable;
-          push @{ $hash->{pkgnums} }, $cust_pkg->pkgnum;
-        }
-        else { #no discount
-          $hash->{discounted} += $setup + $recur + ($months - 1) * $permonth;
-          $hash->{list_pkgnums} = 1;
-        }
-      } #if $freq eq '1'
-      else { # all non-monthly packages: include current charges only
-        $hash->{discounted} += $setup + $recur;
-        $hash->{base} += $setup + $recur;
-        $hash->{list_pkgnums} = 1;
-      }
-    } #foreach $cust_bill_pkg
-
-    # don't show this line if no packages have discounts at this term
-    # or if there are no new charges to apply the discount to
-    delete $terms{$months} if $hash->{base} == $hash->{discounted}
-                           or $hash->{base} == 0;
-
-  }
-
-  $list_pkgnums = grep { $_->{list_pkgnums} > 0 } values %terms;
-
-  foreach my $months (keys %terms) {
-    my $hash = $terms{$months};
-    my $term_total = sprintf('%.2f', $hash->{discounted});
-    # possibly shouldn't include previous balance in these?
-    my $percent = sprintf('%.0f', 100 * (1 - $term_total / $hash->{base}) );
+    my $term_total = sprintf('%.2f', $plan->discounted_total);
+    my $percent = sprintf('%.0f', 
+                          100 * (1 - $term_total / $plan->base_total) );
     my $permonth = sprintf('%.2f', $term_total / $months);
-
-    $hash->{description} = $self->mt('Save [_1]% by paying for [_2] months',
-      $percent, $months
-    );
-    $hash->{amount} = $self->mt('[_1] ([_2] per month)', 
-      $term_total, $money_char.$permonth
-    );
-
-    my @detail;
-    if ( $list_pkgnums ) {
-      push @detail, $self->mt('discount on item'). ' '.
-                join(', ', map { "#$_" } @{ $hash->{pkgnums} });
+    my $detail = $self->mt('discount on item'). ' '.
+                 join(', ', map { "#$_" } $plan->pkgnums)
+      if $list_pkgnums;
+
+    +{
+      description => $self->mt('Save [_1]% by paying for [_2] months',
+                                $percent, $months),
+      amount      => $self->mt('[_1] ([_2] per month)', 
+                                $term_total, $money_char.$permonth),
+      ext_description => ($detail || ''),
     }
-    $hash->{ext_description} = join ', ', @detail;
-  }
+  } #map
+  sort { $b <=> $a } keys %plans;
 
-  map { $terms{$_} } sort {$b <=> $a} keys %terms;
 }
 
 =item call_details [ OPTION => VALUE ... ]
index 763f70f..364d4a7 100644 (file)
@@ -138,7 +138,8 @@ I<session_id> is a session identifier associated with this payment.
 
 I<depend_jobnum> allows payment capture to unlock export jobs
 
-I<discount_term> attempts to take a discount by prepaying for discount_term
+I<discount_term> attempts to take a discount by prepaying for discount_term.
+The payment will fail if I<amount> is incorrect for this discount term.
 
 A direct (Business::OnlinePayment) transaction will return nothing on success,
 or an error message on failure.
@@ -412,6 +413,24 @@ sub realtime_bop {
   return "Banned credit card" if $ban && $ban->bantype ne 'warn';
 
   ###
+  # check for term discount validity
+  ###
+
+  my $discount_term = $options{discount_term};
+  if ( $discount_term ) {
+    my $bill = ($self->cust_bill)[-1]
+      or return "Can't apply a term discount to an unbilled customer";
+    my $plan = FS::discount_plan->new(
+      cust_bill => $bill,
+      months    => $discount_term
+    ) or return "No discount available for term '$discount_term'";
+    
+    if ( $plan->discounted_total != $options{amount} ) {
+      return "Incorrect term prepayment amount (term $discount_term, amount $options{amount}, requires ".$plan->discounted_total.")";
+    }
+  }
+
+  ###
   # massage data
   ###
 
diff --git a/FS/FS/discount_plan.pm b/FS/FS/discount_plan.pm
new file mode 100644 (file)
index 0000000..081f240
--- /dev/null
@@ -0,0 +1,187 @@
+package FS::discount_plan;
+
+use strict;
+use vars qw( $DEBUG $me );
+use FS::Record qw( qsearch );
+use FS::cust_bill;
+use FS::cust_bill_pkg;
+use FS::discount;
+use List::Util qw( max );
+
+=head1 NAME
+
+FS::discount_plan - A term discount as applied to an invoice
+
+=head1 DESCRIPTION
+
+An FS::discount_plan object represents a term prepayment discount 
+available for an invoice (L<FS::cust_bill>).  FS::discount_plan 
+objects are non-persistent and do not inherit from FS::Record.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new OPTIONS
+
+Calculate a discount plan.  OPTIONS must include:
+
+cust_bill - the invoice to calculate discounts for
+
+months - the number of months to be prepaid
+
+If there are no line items on the invoice eligible for the discount
+C<new()> will return undef.
+
+=cut
+
+sub new {
+  my $class = shift;
+  my %opt = @_;
+  %opt = %{ $_[0] } if ( ref $_[0] );
+
+  my $cust_bill = $opt{cust_bill}
+    or die "$me new() requires 'cust_bill'\n";
+  my $months = $opt{months}
+    or die "$me new() requires 'months'\n";
+
+  my ($previous_balance) = $cust_bill->previous;
+  my $self = {
+    pkgnums       => [],
+    base          => $previous_balance || 0, # sum of charges before discount
+    discounted    => $previous_balance || 0, # sum of charges after discount
+    list_pkgnums  => 0, # whether any packages are not discounted
+  };
+
+  foreach my $cust_bill_pkg ( $cust_bill->cust_bill_pkg ) {
+    my $cust_pkg = $cust_bill_pkg->cust_pkg or next;
+    my $part_pkg = $cust_pkg->part_pkg or next;
+    my $freq = $part_pkg->freq;
+    my $setup = $cust_bill_pkg->setup || 0;
+    my $recur = $cust_bill_pkg->recur || 0;
+
+    if ( $freq eq '1' ) { # monthly recurring package
+      my $permonth = $part_pkg->base_recur_permonth || 0;
+
+      my ($discount) = grep { $_->months == $months }
+      map { $_->discount } $part_pkg->part_pkg_discount;
+
+      $self->{base} += $setup + $recur + ($months - 1) * $permonth;
+
+      if ( $discount ) {
+
+        my $discountable;
+        if ( $discount->setup ) {
+          $discountable += $setup;
+        }
+        else {
+          $self->{discounted} += $setup;
+        }
+
+        if ( $discount->percent ) {
+          $discountable += $months * $permonth;
+          $discountable -= ($discountable * $discount->percent / 100);
+          $discountable -= ($permonth - $recur); # correct for prorate
+          $self->{discounted} += $discountable;
+        }
+        else {
+          $discountable += $recur;
+          $discountable -= $discount->amount * $recur/$permonth;
+          $discountable += ($months - 1) * max($permonth - $discount->amount,0);
+        }
+
+        $self->{discounted} += $discountable;
+        push @{ $self->{pkgnums} }, $cust_pkg->pkgnum;
+      }
+      else { #no discount
+        $self->{discounted} += $setup + $recur + ($months - 1) * $permonth;
+        $self->{list_pkgnums} = 1;
+      }
+    } #if $freq eq '1'
+    else { # all non-monthly packages: include current charges only
+      $self->{discounted} += $setup + $recur;
+      $self->{base} += $setup + $recur;
+      $self->{list_pkgnums} = 1;
+    }
+  } #foreach $cust_bill_pkg
+
+  # we've considered all line items; exit if none of them are 
+  # discountable
+  return undef if $self->{base} == $self->{discounted} 
+               or $self->{base} == 0;
+
+  return bless $self, $class;
+
+}
+
+=item all CUST_BILL
+
+For an L<FS::cust_bill> object, return a hash of all available 
+discount plans, with discount term (months) as the key.
+
+=cut
+
+sub all {
+  my $class = shift;
+  my $cust_bill = shift;
+  
+  my %hash;
+  foreach (qsearch('discount', { 'months' => { op => '>', value => 1 } })) {
+    my $months = $_->months;
+    my $discount_plan = $class->new(
+      cust_bill => $cust_bill,
+      months => $months
+    );
+    $hash{$_->months} = $discount_plan if defined($discount_plan);
+  }
+
+  %hash;
+}
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item discounted_total
+
+Returns the total price for the term after applying discounts.  This is the 
+price the customer would have to pay to receive the discount.  Note that 
+this includes the monthly fees for all packages (including non-discountable
+ones) for each month in the term, but only includes fees for other packages
+as they appear on the current invoice.
+
+=cut
+
+sub discounted_total {
+  my $self = shift;
+  sprintf('%.2f', $self->{discounted});
+}
+
+=item base_total
+
+Returns the total price for the term before applying discounts.
+
+=cut
+
+sub base_total {
+  my $self = shift;
+  sprintf('%.2f', $self->{base});
+}
+
+=item pkgnums
+
+Returns a list of package numbers that are receiving discounts under this 
+plan.
+
+=cut
+
+sub pkgnums {
+  my $self = shift;
+  @{ $self->{pkgnums} };
+}
+
+# any others?  don't think so
+
+1;
index c35f33d..3cd5c38 100644 (file)
@@ -502,6 +502,8 @@ FS/h_svc_www.pm
 t/h_svc_www.t
 FS/discount.pm
 t/discount.t
+FS/discount_plan.pm
+t/discount_plan.t
 FS/cust_pkg_discount.pm
 t/cust_pkg_discount.t
 FS/cust_bill_pkg_discount.pm
diff --git a/FS/t/discount_plan.t b/FS/t/discount_plan.t
new file mode 100644 (file)
index 0000000..899071b
--- /dev/null
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::discount_plan;
+$loaded=1;
+print "ok 1\n";
index 0bb86e3..3fd9c79 100755 (executable)
 <TR>
   <TD ALIGN="right"><% mt('Amount') |h %></TD>
   <TD BGCOLOR="#ffffff" ALIGN="right"><% $money_char %></TD>
-  <TD><INPUT TYPE="text" NAME="paid" VALUE="<% $paid %>" SIZE=8 MAXLENGTH=9> <% mt('by') |h %> <B><% mt(FS::payby->payname($payby)) |h %></B></TD>
+  <TD><INPUT TYPE="text" NAME="paid" ID="paid" VALUE="<% $paid %>" SIZE=8 MAXLENGTH=9> <% mt('by') |h %> <B><% mt(FS::payby->payname($payby)) |h %></B></TD>
 </TR>
 
   <& /elements/tr-select-discount_term.html,
                'custnum' => $custnum,
-               'cgi'     => $cgi
+               'amount_id' => 'paid',
   &>
 
 % if ( $payby eq 'BILL' ) { 
index 5858267..e9faeb2 100644 (file)
@@ -1,12 +1,33 @@
 % if ( scalar(@discount_term) ) {
   <TR>
-    <TD ALIGN="right">Prepayment for</TD>
+    <TD ALIGN="right"><% emt('Prepayment for') %></TD>
+%  if ( $amount_id ) {
+    <SCRIPT type="text/javascript">
+var discounted_total = <% encode_json \%discounted_total %>;
+function change_discount_term(what) {
+  var new_term = what.value;
+  var amount_field = document.getElementById('<% $amount_id %>');
+  if(new_term == "") {
+    amount_field.readOnly = false;
+    amount_field.value = '';
+  }
+  else {
+    amount_field.value = discounted_total[new_term];
+    amount_field.readOnly = true;
+  }
+}
+</SCRIPT>
+% }
     <TD COLSPAN=2>
-      <% include('select-discount_term.html',
-                   'discount_term' => \@discount_term,
-                   'cgi'           => $opt{'cgi'},
-                )
-      %>
+      <& select.html,
+        field   => 'discount_term',
+        id      => 'discount_term',
+        options => [ '', @discount_term ],
+        labels  => { '' => mt('1 month'), 
+                     map { $_ => mt('[_1] months', $_) } @discount_term },
+        curr_value => '',
+        onchange => $amount_id ? 'change_discount_term(this)' : '',
+      &>
     </TD>
   </TR>
 
@@ -20,6 +41,16 @@ my $custnum = $opt{'custnum'};
 my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
   or die "unknown custnum $custnum\n";
 
-my @discount_term = $cust_main->discount_terms;
+my @discount_term = ();
+my %discounted_total = ();
+my $last_bill = ($cust_main->cust_bill)[-1];
+if ( $last_bill ) { # if not, there are no discounts possible
+  my %plans = $last_bill->discount_plans;
+  @discount_term = sort { $a <=> $b } keys %plans;
+  %discounted_total = map { $_, $plans{$_}->discounted_total } @discount_term;
+}
+
+# the DOM id of an input to be disabled/populated with the amount due
+my $amount_id = $opt{'amount_id'};
 
 </%init>
index b2baebd..4a867d2 100644 (file)
@@ -14,6 +14,7 @@
     <TD COLSPAN=7>
       <TABLE><TR><TD BGCOLOR="#ffffff">
         <% $money_char %><INPUT NAME     = "amount"
+                                ID       = "amount"
                                 TYPE     = "text"
                                 VALUE    = "<% $amount %>"
                                 SIZE     = 8
@@ -67,7 +68,7 @@
 
 <& /elements/tr-select-discount_term.html,
              'custnum' => $custnum,
-             'cgi'     => $cgi
+             'amount_id' => 'amount',
 &>
 
 % if ( $payby eq 'CARD' ) {