add action to discount the referring customer's package, RT#20143

3 files changed, 132 insertions, 2 deletions

diff --git a/FS/FS/cust_pkg_discount.pm b/FS/FS/cust_pkg_discount.pm
index 5f4d0dccf..d82d94990 100644
--- a/FS/FS/cust_pkg_discount.pm
+++ b/FS/FS/cust_pkg_discount.pm
@@ -164,7 +164,7 @@ sub check {
     $self->ut_numbern('pkgdiscountnum')
     || $self->ut_foreign_key('pkgnum', 'cust_pkg', 'pkgnum')
     || $self->ut_foreign_key('discountnum', 'discount', 'discountnum' )
-    || $self->ut_float('months_used') #actually decimal, but this will do
+    || $self->ut_sfloat('months_used') #actually decimal, but this will do
     || $self->ut_numbern('end_date')
     || $self->ut_alphan('otaker')
     || $self->ut_numbern('usernum')
@@ -202,7 +202,7 @@ sub discount {
   qsearchs('discount', { 'discountnum' => $self->discountnum } );
 }
 
-=item increment_months_used
+=item increment_months_used MONTHS
 
 Increments months_used by the given parameter
 
@@ -216,6 +216,31 @@ sub increment_months_used {
   $self->replace();
 }
 
+=item decrement_months_used MONTHS
+
+Decrement months_used by the given parameter
+
+(Note: as in, extending the length of the discount.  Typically only used to
+stack/extend a discount when the customer package has one active already.)
+
+=cut
+
+sub decrement_months_used {
+  my( $self, $recharged ) = @_;
+  #UPDATE cust_pkg_discount SET months_used = months_used - ?
+  #leaves no history, and billing is mutexed per-customer
+
+  #we're run from part_event/Action/referral_pkg_discount on behalf of a
+  # different customer, so we need to grab this customer's mutex.
+  #   incidentally, that's some inelegant encapsulation breaking shit, and a
+  #   great argument in favor of native-DB trigger history so we can trust
+  #   in normal ACID like the SQL above instead of this
+  $self->cust_pkg->cust_main->select_for_update;
+
+  $self->months_used( $self->months_used - $recharged );
+  $self->replace();
+}
+
 =item status
 
 =cut
diff --git a/FS/FS/part_event/Action/referral_pkg_billdate.pm b/FS/FS/part_event/Action/referral_pkg_billdate.pm
index 40d94e2d5..6b485e59b 100644
--- a/FS/FS/part_event/Action/referral_pkg_billdate.pm
+++ b/FS/FS/part_event/Action/referral_pkg_billdate.pm
@@ -21,6 +21,8 @@ sub option_fields {
   );
 }
 
+#false laziness w/referral_pkg_discount, probably should make
+# Mixin/referral_pkg.pm if we need changes or anything else in this vein
 sub do_action {
   my( $self, $cust_object, $cust_event ) = @_;
 
@@ -39,6 +41,8 @@ sub do_action {
 
   my $cust_pkg = $cust_pkg[0]; #only one
 
+  #end of false laziness
+
   my $bill = $cust_pkg->bill || $cust_pkg->setup || time;
 
   $cust_pkg->bill(
diff --git a/FS/FS/part_event/Action/referral_pkg_discount.pm b/FS/FS/part_event/Action/referral_pkg_discount.pm
new file mode 100644
index 000000000..2ff1b35fb
--- /dev/null
+++ b/FS/FS/part_event/Action/referral_pkg_discount.pm
@@ -0,0 +1,101 @@
+package FS::part_event::Action::referral_pkg_discount;
+
+use strict;
+use base qw( FS::part_event::Action );
+
+sub description { "Discount the referring customer's package"; }
+
+#sub eventtable_hashref {
+#}
+
+sub option_fields {
+  (
+    'if_pkgpart'  => { 'label'    => 'Only packages',
+                       'type'     => 'select-part_pkg',
+                       'multiple' => 1,
+                     },
+    'discountnum' => { 'label'    => 'Discount',
+                       'type'     => 'select-table', #we don't handle the select-discount create a discount case
+                       'table'    => 'discount',
+                       'name_col' => 'description', #well, method
+                       'order_by' => 'ORDER BY discountnum', #requied because name_col is a method
+                       'hashref'  => { 'disabled' => '',
+                                       'months'   => { op=>'!=', value=>'0' },
+                                     },
+                       'disable_empty' => 1,
+                     },
+  );
+}
+
+#false laziness w/referral_pkg_billdate, probably should make
+# Mixin/referral_pkg.pm if we need changes or anything else in this vein
+sub do_action {
+  my( $self, $cust_object, $cust_event ) = @_;
+
+  my $cust_main = $self->cust_main($cust_object);
+
+  return 'No referring customer' unless $cust_main->referral_custnum;
+
+  my $referring_cust_main = $cust_main->referring_cust_main;
+  #return 'Referring customer is cancelled'
+  #  if $referring_cust_main->status eq 'cancelled';
+
+  my %if_pkgpart = map { $_=>1 } split(/\s*,\s*/, $self->option('if_pkgpart') );
+  my @cust_pkg = grep $if_pkgpart{ $_->pkgpart },
+                      $referring_cust_main->billing_pkgs;
+  return 'No qualifying billing package definition' unless @cust_pkg;
+
+  my $cust_pkg = $cust_pkg[0]; #only one
+
+  #end of false laziness
+
+  my @cust_pkg_discount = $cust_pkg->cust_pkg_discount_active;
+  my @my_cust_pkg_discount =
+    grep { $_->discountnum == $self->option('discountnum') } @cust_pkg_discount;
+
+  if ( @my_cust_pkg_discount ) { #increment the existing one instead
+
+    die "guru meditation #and: multiple discounts"
+      if scalar(@my_cust_pkg_discount) > 1;
+ 
+    my $cust_pkg_discount = $my_cust_pkg_discount[0];
+    my $discount = $cust_pkg_discount->discount;
+    die "guru meditation #goob: can't extended non-expiring discount"
+      if $discount->months == 0;
+
+    my $error = $cust_pkg_discount->decrement_months_used( $discount->months );
+    die "Error extending discount: $error\n" if $error;
+
+  } elsif ( @cust_pkg_discount ) {
+
+    #"stacked" discount case not possible from UI, not handled, so prevent
+    # against creating one here.  i guess we could try to find a different
+    # @cust_pkg above if this case needed to be handled better?
+    die "Can't discount an already discounted package";
+
+  } else { #normal case, create a new one
+
+    my $cust_pkg_discount = new FS::cust_pkg_discount {
+      'pkgnum'      => $cust_pkg->pkgnum,
+      'discountnum' => $self->option('discountnum'),
+      'months_used' => 0,
+      #'end_date'    => '',
+      #we dont handle the create a new discount case
+      #'_type'       => scalar($cgi->param('discountnum__type')),
+      #'amount'      => scalar($cgi->param('discountnum_amount')),
+      #'percent'     => scalar($cgi->param('discountnum_percent')),
+      #'months'      => scalar($cgi->param('discountnum_months')),
+      #'setup'       => scalar($cgi->param('discountnum_setup')),
+      ##'linked'       => scalar($cgi->param('discountnum_linked')),
+      ##'disabled'    => $self->discountnum_disabled,
+    };
+    my $error = $cust_pkg_discount->insert;
+    die "Error discounting package: $error\n" if $error;
+
+  }
+
+  '';
+
+}
+
+1;