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 7d68323..f11beec 100644 (file)
--- 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 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;
 use Scalar::Util qw( blessed );
 use List::Util qw(min max sum);
 use Tie::IxHash;


@@ -2372,8 +2372,20 @@ sub change {
     $same_pkgpart = 0;
   }
 
     $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 
 
   # 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
 
 
     } # 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;
 
     $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 {
     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;
   }
 
     $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'}
   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;
     }
       $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;
     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));
   } );
   $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 ) {
     $self->set('change_to_pkgnum', $new->pkgnum);
     $self->set('expire', $date);
     $error = $self->replace;
   }

+

   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
   } else {
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
   } else {


@@ -2920,6 +2988,66 @@ sub change_later {
   $error;
 }
 
   $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>.
 =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
 =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;
 =cut
 
 1;

-

diff --git a/httemplate/edit/process/change-cust_pkg.html b/httemplate/edit/process/change-cust_pkg.html
index 7fcc1da..02b01f8 100644 (file)
--- 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;
 }
 
   $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} = '';
 $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';
     $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 {
   } 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'));
 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 243da93..2470ee1 100755 (executable)
--- 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">
 % 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>
 
 % }
   </TABLE><BR>
 
 % }


@@ -168,4 +174,14 @@ if ( $cust_pkg->change_to_pkgnum ) {
   }
   $title = "Edit Scheduled Package Change";
 }
   }
   $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>
 </%init>