From: mark Date: Wed, 7 Dec 2011 05:50:50 +0000 (+0000) Subject: minor refactor and better safeguards on term discounts, #15068 X-Git-Tag: freeside_2_3_1~109 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=c5e31619e5a3071506cff19578e9e377753a96f4 minor refactor and better safeguards on term discounts, #15068 --- diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 9d7180a0c..99cc1cd6f 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 2ef901a69..ef6dc7bee 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) 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) 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 763f70fbb..364d4a7d8 100644 --- a/FS/FS/cust_main/Billing_Realtime.pm +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -138,7 +138,8 @@ I is a session identifier associated with this payment. I allows payment capture to unlock export jobs -I attempts to take a discount by prepaying for discount_term +I attempts to take a discount by prepaying for discount_term. +The payment will fail if I 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 index 000000000..081f24045 --- /dev/null +++ b/FS/FS/discount_plan.pm @@ -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::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 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 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; diff --git a/FS/MANIFEST b/FS/MANIFEST index c35f33d1f..3cd5c3839 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 000000000..899071bd3 --- /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 0bb86e352..3fd9c79eb 100755 --- a/httemplate/edit/cust_pay.cgi +++ b/httemplate/edit/cust_pay.cgi @@ -43,12 +43,12 @@ <% mt('Amount') |h %> <% $money_char %> - <% mt('by') |h %> <% mt(FS::payby->payname($payby)) |h %> + <% mt('by') |h %> <% mt(FS::payby->payname($payby)) |h %> <& /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 58582675d..e9faeb228 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) ) { - Prepayment for + <% emt('Prepayment for') %> +% if ( $amount_id ) { + +% } - <% 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)' : '', + &> @@ -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'}; diff --git a/httemplate/misc/payment.cgi b/httemplate/misc/payment.cgi index b2baebd07..4a867d28d 100644 --- a/httemplate/misc/payment.cgi +++ b/httemplate/misc/payment.cgi @@ -14,6 +14,7 @@
<% $money_char %> $custnum, - 'cgi' => $cgi + 'amount_id' => 'amount', &> % if ( $payby eq 'CARD' ) {