summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--FS/FS/Mason.pm1
-rw-r--r--FS/FS/cust_bill.pm127
-rw-r--r--FS/FS/cust_main/Billing_Realtime.pm21
-rw-r--r--FS/FS/discount_plan.pm202
-rw-r--r--FS/MANIFEST2
-rw-r--r--FS/t/discount_plan.t5
-rwxr-xr-xhttemplate/edit/cust_pay.cgi4
-rw-r--r--httemplate/elements/tr-select-discount_term.html45
-rw-r--r--httemplate/misc/payment.cgi3
9 files changed, 305 insertions, 105 deletions
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 9d7180a..99cc1cd 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -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 ) {
diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm
index 2ef901a..ef6dc7b 100644
--- a/FS/FS/cust_bill.pm
+++ b/FS/FS/cust_bill.pm
@@ -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 ... ]
diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm
index 7c31204..f9f90a7 100644
--- a/FS/FS/cust_main/Billing_Realtime.pm
+++ b/FS/FS/cust_main/Billing_Realtime.pm
@@ -141,7 +141,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.
@@ -415,6 +416,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
index 0000000..4f97e33
--- /dev/null
+++ b/FS/FS/discount_plan.pm
@@ -0,0 +1,202 @@
+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 = {
+ cust_bill => $cust_bill,
+ months => $months,
+ pkgnums => [],
+ base => $previous_balance || 0, # sum of charges before discount
+ discounted => $previous_balance || 0, # sum of charges after discount
+ list_pkgnums => undef, # 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} };
+}
+
+=item list_pkgnums
+
+Returns a true value if any packages listed on the invoice do not
+receive a discount, either because there isn't one at the specified
+term length or because they're not monthly recurring packages.
+
+=cut
+
+sub list_pkgnums {
+ my $self = shift;
+ $self->{list_pkgnums};
+}
+
+# any others? don't think so
+
+1;
diff --git a/FS/MANIFEST b/FS/MANIFEST
index c35f33d..3cd5c38 100644
--- a/FS/MANIFEST
+++ b/FS/MANIFEST
@@ -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
index 0000000..899071b
--- /dev/null
+++ b/FS/t/discount_plan.t
@@ -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";
diff --git a/httemplate/edit/cust_pay.cgi b/httemplate/edit/cust_pay.cgi
index 0bb86e3..3fd9c79 100755
--- a/httemplate/edit/cust_pay.cgi
+++ b/httemplate/edit/cust_pay.cgi
@@ -43,12 +43,12 @@
<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' ) {
diff --git a/httemplate/elements/tr-select-discount_term.html b/httemplate/elements/tr-select-discount_term.html
index 5858267..e9faeb2 100644
--- a/httemplate/elements/tr-select-discount_term.html
+++ b/httemplate/elements/tr-select-discount_term.html
@@ -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>
diff --git a/httemplate/misc/payment.cgi b/httemplate/misc/payment.cgi
index b2baebd..4a867d2 100644
--- a/httemplate/misc/payment.cgi
+++ b/httemplate/misc/payment.cgi
@@ -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' ) {