[freeside-commits] branch master updated. 73689cc60458a87931d2d3d304d650d69bcf690c
Mitch Jackson
mitch at freeside.biz
Fri Feb 9 22:19:39 PST 2018
The branch, master has been updated
via 73689cc60458a87931d2d3d304d650d69bcf690c (commit)
from d45dd4a826f314fb5459747590d3e11cd80c211f (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 73689cc60458a87931d2d3d304d650d69bcf690c
Author: Mitch Jackson <mitch at freeside.biz>
Date: Sat Feb 10 00:05:16 2018 -0600
RT# 79284 Option to set/carry recur discount at Change Package
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 7d683235b..f11beec7d 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -6,7 +6,7 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API
);
use strict;
-use Carp qw(cluck);
+use Carp qw(cluck croak);
use Scalar::Util qw( blessed );
use List::Util qw(min max sum);
use Tie::IxHash;
@@ -2372,8 +2372,20 @@ sub change {
$same_pkgpart = 0;
}
- if ($opt->{'waive_setup'}) { $self->set('waive_setup', $opt->{'waive_setup'}) }
- else { $self->set('waive_setup', ''); }
+ # Discounts:
+ # When a new discount level is specified in $opt:
+ # If new discountnum matches old discountnum, months_used/end_date are
+ # carried over as the discount is applied to the new cust_pkg
+ #
+ # Legacy behavior:
+ # Unless discount-related fields have been set within $opt, change()
+ # sets no discounts on the changed packages unless the new pkgpart is the
+ # same as the old pkgpart. In that case, discounts from the old cust_pkg
+ # are copied onto the new cust_pkg
+
+ # Read discount fields from $opt
+ my %new_discount = $self->_parse_new_discounts($opt);
+ $self->set(waive_setup => $opt->{waive_setup} ? $opt->{waive_setup} : '');
# Before going any further here: if the package is still in the pre-setup
# state, it's safe to modify it in place. No need to charge/credit for
@@ -2429,6 +2441,22 @@ sub change {
} # done transferring services
+ # Set waive_setup as directed
+ if ( !$error && exists $opt->{waive_setup} ) {
+ $self->set(waive_setup => $opt->{waive_setup});
+ $error = $self->replace;
+ }
+
+ # Set discounts if explicitly specified in $opt
+ if ( !$error && %new_discount ) {
+ $error = $self->change_discount(%new_discount);
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
$dbh->commit if $oldAutoCommit;
return $self;
@@ -2618,8 +2646,18 @@ sub change {
}
}
- # transfer discounts, if we're not changing pkgpart
- if ( $same_pkgpart ) {
+ if (%new_discount && !$error) {
+
+ # If discounts were explicitly specified in $opt
+ $error = $cust_pkg->change_discount(%new_discount);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "applying discounts: $error";
+ }
+
+ } elsif ( $same_pkgpart ) {
+
+ # transfer discounts, if we're not changing pkgpart
foreach my $old_discount ($self->cust_pkg_discount_active) {
# don't remove the old discount, we may still need to bill that package.
my $new_discount = new FS::cust_pkg_discount {
@@ -2836,6 +2874,20 @@ sub change_later {
$opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
}
+ # Discounts:
+ # Applies discounts to the newly created future_change package
+ #
+ # If a new discount is the same as the old discount, carry over the
+ # old discount's months_used/end_date fields too
+ #
+ # Legacy behavior:
+ # Legacy behavior was to create the next package with no discount.
+ # This behavior is preserved. Without the discount fields in $opt,
+ # the new package will be created with no discounts.
+
+ # parse discount information from $opt
+ my %new_discount = $self->_parse_new_discounts($opt);
+
if ( $self->change_to_pkgnum ) {
my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
my $new_pkgpart = $opt->{'pkgpart'}
@@ -2873,6 +2925,16 @@ sub change_later {
$change_to->set('start_date', $date);
$error = $self->replace || $change_to->replace;
}
+
+ if ( !$error && exists $opt->{waive_setup} ) {
+ $change_to->set(waive_setup => $opt->{waive_setup} );
+ $error = $change_to->insert();
+ }
+
+ if ( !$error && %new_discount ) {
+ $error = $change_to->change_discount(%new_discount);
+ }
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
@@ -2906,11 +2968,17 @@ sub change_later {
} );
$error = $new->insert('change' => 1,
'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+
+ if ( !$error && %new_discount ) {
+ $error = $new->change_discount(%new_discount);
+ }
+
if ( !$error ) {
$self->set('change_to_pkgnum', $new->pkgnum);
$self->set('expire', $date);
$error = $self->replace;
}
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
} else {
@@ -2920,6 +2988,66 @@ sub change_later {
$error;
}
+# Helper method reads $opt hashref from change() and change_later()
+# Returns a hash of %new_discount suitable for passing to change_discount()
+sub _parse_new_discounts {
+ my ($self, $opt) = @_;
+
+ croak "Bad parameter list" unless ref $opt;
+
+ my %old_discount =
+ map { $_->setuprecur => $_ }
+ qsearch('cust_pkg_discount', {
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ my %new_discount;
+ for my $type(qw|setup recur|) {
+
+ if (exists $opt->{"${type}_discountnum"}) {
+ $new_discount{$type} = {
+ discountnum => $opt->{"${type}_discountnum"},
+ amount => $opt->{"${type}_discountnum_amount"},
+ percent => $opt->{"${type}_discountnum_percent"},
+ };
+ }
+
+ # Specified discountnum same as old discountnum, carry over addl fields
+ if (
+ exists $opt->{"${type}_discountnum"}
+ && exists $old_discount{$type}
+ && $opt->{"${type}_discountnum"} eq $old_discount{$type}->discountnum
+ ){
+ $new_discount{$type}->{months} = $old_discount{$type}->months;
+ $new_discount{$type}->{end_date} = $old_discount{$type}->end_date;
+ }
+
+ # No new discount specified, carryover old discount
+ # If we wanted to abandon legacy behavior, and always carry old discounts
+ # uncomment this:
+
+ # if (!exists $new_discount{$type} && $old_discount{$type}) {
+ # $new_discount{$type} = {
+ # discountnum => $old_discount{$type}->discountnum,
+ # amount => $old_discount{$type}->amount,
+ # percent => $old_discount{$type}->percent,
+ # months => $old_discount{$type}->months,
+ # end_date => $old_discount{$type}->end_date,
+ # };
+ # }
+ }
+
+ if ($DEBUG) {
+ warn "_parse_new_discounts(), pkgnum: ".$self->pkgnum." \n";
+ warn "Determine \%old_discount, \%new_discount: \n";
+ warn Dumper(\%old_discount);
+ warn Dumper(\%new_discount);
+ }
+
+ %new_discount;
+}
+
=item abort_change
Cancels a future package change scheduled by C<change_later>.
@@ -4731,6 +4859,149 @@ sub insert_discount {
'';
}
+=item change_discount %opt
+
+Method checks if the given values represent a change in either setup or
+discount level. If so, the existing discounts are revoked, the new
+discounts are recorded.
+
+Usage:
+
+$error = change_discount(
+ setup => {
+
+ # -1: Indicates a "custom discount"
+ # 0: Indicates to remove any discount
+ # >0: discountnum to apply
+ discountnum => [-1, 0, discountnum],
+
+ # When discountnum is "-1" to indicate custom discount, include
+ # the additional fields:
+ amount => AMOUNT_DISCOUNT
+ percent => PERCENTAGE_DISCOUNT
+ months => -1,
+ },
+
+ recur => {...}
+);
+
+
+=cut
+
+sub change_discount {
+ my ($self, %opt) = @_;
+ return "change_discount() called with bad \%opt"
+ unless %opt;
+
+ for (keys %opt) {
+ return "change_discount() called with unknown bad key $_"
+ unless $_ eq 'setup' || $_ eq 'recur';
+ }
+
+ my @old_discount =
+ qsearch('cust_pkg_discount',{
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ if ($DEBUG) {
+ warn "change_discount() pkgnum: ".$self->pkgnum." \n";
+ warn "change_discount() \%opt: \n";
+ warn Dumper(\%opt);
+ }
+
+ my @to_be_disabled;
+
+ for my $type (qw|setup recur|) {
+ next unless ref $opt{$type};
+ my %change = %{$opt{$type}};
+
+ return "change_discount() called with bad \$opt($type)"
+ unless $change{discountnum} =~ /^-?\d+$/;
+
+ if ($change{discountnum} eq 0) {
+ # Removing old discount
+
+ delete $opt{$type};
+ push @to_be_disabled, grep {$_->setuprecur eq $type} @old_discount;
+ } else {
+
+ if (
+ grep {
+ $_->discountnum eq $change{discountnum}
+ && $_->setuprecur eq $type
+ } @old_discount
+ ){
+ # Duplicate, disregard this entry
+ delete $opt{$type};
+ next;
+ } else {
+ # Mark any discounts we're replacing
+ push @to_be_disabled, grep{ $_->setuprecur eq $type} @old_discount;
+ }
+
+ }
+ }
+
+
+ # If we still have changes queued, pass them to insert_discount()
+ # by setting values into object fields
+ for my $type (keys %opt) {
+ $self->set("${type}_discountnum", $opt{$type}->{discountnum});
+
+ if ($opt{$type}->{discountnum} eq '-1') {
+ $self->set("${type}_discountnum_${_}", $opt{$type}->{$_})
+ for qw(amount percent months);
+ }
+
+ }
+
+ if ($DEBUG) {
+ warn "change_discount() \% opt before insert \n";
+ warn Dumper \%opt;
+ warn "\@to_be_disabled \n";
+ warn Dumper \@to_be_disabled;
+ }
+
+ # Roll these updates into a transaction
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error;
+
+ # The "waive setup fee" flag has traditionally been handled by setting
+ # $cust_pkg->waive_setup_fee = Y. This has been appropriately, and separately
+ # handled, and it operates on a differetnt table than cust_pkg_discount,
+ # so the "-2 for waive setup fee" option is not being reimplemented
+ # here. Perhaps this may change later.
+ #
+ # When a setup discount is entered, we still need unset waive_setup
+ if ( $opt{setup} && $opt{setup} > -2 && $self->waive_setup ) {
+ $self->set(waive_setup => '');
+ $error = $self->replace();
+ }
+
+ # Create new discounts
+ $error ||= $self->insert_discount();
+
+ # Disabling old discounts
+ for my $tbd (@to_be_disabled) {
+ unless ($error) {
+ $tbd->set(disabled => 'Y');
+ $error = $tbd->replace();
+ }
+ }
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit if $oldAutoCommit;
+ return undef;
+}
+
=item set_usage USAGE_VALUE_HASHREF
USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
@@ -5700,4 +5971,3 @@ L<FS::pkg_svc>, schema.html from the base documentation
=cut
1;
-
diff --git a/httemplate/edit/process/change-cust_pkg.html b/httemplate/edit/process/change-cust_pkg.html
index 7fcc1da07..02b01f8de 100644
--- a/httemplate/edit/process/change-cust_pkg.html
+++ b/httemplate/edit/process/change-cust_pkg.html
@@ -40,19 +40,54 @@ if ( $cgi->param('locationnum') == -1 ) {
$change{'cust_location'} = $cust_location;
}
+my $error;
+
+# Discounts:
+# setup_discountnum and change_discountnum may contain one of the following:
+# - "-1" Represents the 'other' option. Results in a new entry to the
+# discount table.
+# - "-2" Represents the "waive setup fee" option. Sets cust_pkg.waive_setup = Y
+# - int Represents the id for a discount row: discount.discountnum
+# my %discount;
+# $change{waive_setup} = '';
+# for my $type (qw|setup recur|) {
+# my $dnum = $cgi->param("${type}_discountnum");
+
+# if ($dnum eq '-2' && $type eq 'setup') {
+# $change{waive_setup} = 'Y';
+# } elsif ($val =~ /^-?\d+$/) {
+# $discount{$type} = {discountnum => $dnum};
+# if ($dnum eq '-1') {
+# $discount{$type}->{amount} = $cgi->param("${type}_discountnum_amount");
+# $discount{$type}->{percent} = $cgi->param("${type}_discountnum_percent");
+# }
+# } else {
+# # Shouldn't happen without funny business
+# $error = "Bad value ${type}_discountnum ($val)";
+# }
+# }
+
+
$change{waive_setup} = '';
+for my $type (qw|setup_discountnum recur_discountnum|) {
+ my $dnum = $cgi->param($type);
-if ( $cgi->param('setup_discountnum') =~ /^(-?\d+)$/ ) {
- if ( $1 == -2 ) {
+ if ($dnum eq '-2' && $type eq 'setup_discountnum') {
+ # Waive Discount
$change{waive_setup} = 'Y';
+ } elsif ($dnum =~ /^-?\d+$/) {
+ # Set discountnum
+ $change{$type} = $dnum;
+ $change{"${type}_amount"} = $cgi->param("${type}_amount");
+ $change{"${type}_percent"} = $cgi->param("${type}_percent");
+ } elsif ($dnum eq '') {
+ # Set discount as no discount
+ $change{"${type}"} = 0;
} else {
- $change{setup_discountnum} = $1;
- $change{setup_discountnum_amount} = $cgi->param('setup_discountnum_amount');
- $change{setup_discountnum_percent} = $cgi->param('setup_discountnum_percent');
+ $error = "Bad value ${type}_discountnum ($dnum)";
}
}
-my $error;
my $now = time;
if (defined($cgi->param('contract_end'))) {
$change{'contract_end'} = parse_datetime($cgi->param('contract_end'));
diff --git a/httemplate/misc/change_pkg.cgi b/httemplate/misc/change_pkg.cgi
index 243da9308..2470ee135 100755
--- a/httemplate/misc/change_pkg.cgi
+++ b/httemplate/misc/change_pkg.cgi
@@ -90,7 +90,13 @@
% if ( $discount_cust_pkg || $waive_setup_fee ) {
<FONT CLASS="fsinnerbox-title"><% mt('Discounting') |h %></FONT>
<TABLE CLASS="fsinnerbox">
- <& /elements/tr-select-pkg-discount.html, disable_recur => 1, &>
+ <& /elements/tr-select-pkg-discount.html,
+ curr_value_setup => $discount{setup},
+ curr_value_recur => $discount{recur},
+ disable_setup => 0,
+ disable_recur => 0,
+ disable_waive_setup => 0
+ &>
</TABLE><BR>
% }
@@ -168,4 +174,14 @@ if ( $cust_pkg->change_to_pkgnum ) {
}
$title = "Edit Scheduled Package Change";
}
+
+# Get current values of discounts for selectboxes
+my %discount = (setup => undef, recur => undef);
+$discount{$_->setuprecur} = $_->discountnum
+ for qsearch('cust_pkg_discount', {
+ pkgnum => $cust_pkg->pkgnum,
+ disabled => '',
+ });
+$discount{setup} = '-2' if $cust_pkg->waive_setup;
+
</%init>
-----------------------------------------------------------------------
Summary of changes:
FS/FS/cust_pkg.pm | 282 ++++++++++++++++++++++++++-
httemplate/edit/process/change-cust_pkg.html | 47 ++++-
httemplate/misc/change_pkg.cgi | 18 +-
3 files changed, 334 insertions(+), 13 deletions(-)
More information about the freeside-commits
mailing list