one-time referral credits

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index d1253d2..187a6f9 100644 (file)
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -1377,6 +1377,12 @@ httemplate/docs/config.html
     'type'        => 'checkbox',
   },
 
+  { 'key'         => 'referral_credit',
+    'section'     => 'billing',
+    'description' => "Enables one-time referral credits in the amount of one month <i>referred</i> customer's recurring fee (irregardless of frequency).",
+    'type'        => 'checkbox',
+  },
+
 );
 
 1;

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 9144a81..60556a5 100644 (file)
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -2659,6 +2659,19 @@ sub referral_cust_pkg {
       $self->referral_cust_main($depth);
 }
 
+=item referring_cust_main
+
+Returns the single cust_main record for the customer who referred this customer
+(referral_custnum), or false.
+
+=cut
+
+sub referring_cust_main {
+  my $self = shift;
+  return '' unless $self->referral_custnum;
+  qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
+}
+
 =item credit AMOUNT, REASON
 
 Applies a credit to this customer.  If there is an error, returns the error,

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index ced1423..5705ac2 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -141,7 +141,7 @@ Create a new billing item.  To add the item to the database, see L<"insert">.
 
 sub table { 'cust_pkg'; }
 
-=item insert
+=item insert [ OPTION => VALUE ... ]
 
 Adds this billing item to the database ("Orders" the item).  If there is an
 error, returns the error, otherwise returns false.
@@ -150,6 +150,73 @@ If the additional field I<promo_code> is defined instead of I<pkgpart>, it
 will be used to look up the package definition and agent restrictions will be
 ignored.
 
+The following options are available: I<change>
+
+I<change>, if set true, supresses any referral credit to a referring customer.
+
+=cut
+
+sub insert {
+  my( $self, %options ) = @_;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $error = $self->SUPER::insert;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  my $conf = new FS::Conf;
+  my $cust_main = $self->cust_main;
+  my $part_pkg = $self->part_pkg;
+  if ( $conf->exists('referral_credit')
+       && $cust_main->referral_custnum
+       && ! $options{'change'}
+       && $part_pkg->freq !~ /^0\D?$/
+     )
+  {
+    my $referring_cust_main = $cust_main->referring_cust_main;
+    if ( $referring_cust_main->status ne 'cancelled' ) {
+      my $error;
+      if ( $part_pkg->freq !~ /^\d+$/ ) {
+        warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
+             ' for package '. $self->pkgnum.
+             ' ( customer '. $self->custnum. ')'.
+             ' - One-time referral credits not (yet) available for '.
+             ' packages with '. $part_pkg->freq_pretty. ' frequency';
+      } else {
+
+        my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
+        my $error =
+          $referring_cust_main->credit( $amount,
+                                        'Referral credit for '. $cust_main->name
+                                      );
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "Error crediting customer ". $cust_main->referral_custnum.
+               " for referral: $error";
+        }
+
+      }
+
+    }
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
 =item delete
 
 This method now works but you probably shouldn't use it.
@@ -982,12 +1049,13 @@ sub order {
   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
   return "Customer not found: $custnum" unless $cust_main;
 
+  my $change = scalar(@$remove_pkgnum) != 0;
+
   # Create the new packages.
-  my $cust_pkg;
-  foreach (@$pkgparts) {
-    $cust_pkg = new FS::cust_pkg { custnum => $custnum,
-                                   pkgpart => $_ };
-    $error = $cust_pkg->insert;
+  foreach my $pkgpart (@$pkgparts) {
+    my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
+                                      pkgpart => $pkgpart };
+    $error = $cust_pkg->insert( 'change' => $change );
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
       return $error;

diff --git a/FS/FS/part_pkg/flat.pm b/FS/FS/part_pkg/flat.pm
index b62aebd..5721edd 100644 (file)
--- a/FS/FS/part_pkg/flat.pm
+++ b/FS/FS/part_pkg/flat.pm
@@ -29,7 +29,12 @@ sub calc_setup {
 }
 
 sub calc_recur {
-  my($self, $cust_pkg ) = @_;
+  my $self = shift;
+  $self->base_recur(@_);
+}
+
+sub base_recur {
+  my($self, $cust_pkg) = @_;
   $self->option('recur_fee');
 }
 

diff --git a/FS/FS/part_pkg/sesmon_hour.pm b/FS/FS/part_pkg/sesmon_hour.pm
index 0367b2b..1f62631 100644 (file)
--- a/FS/FS/part_pkg/sesmon_hour.pm
+++ b/FS/FS/part_pkg/sesmon_hour.pm
@@ -44,4 +44,9 @@ sub is_free_options {
   qw( setup_fee recur_fee recur_hourly_charge );
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;

diff --git a/FS/FS/part_pkg/sesmon_minute.pm b/FS/FS/part_pkg/sesmon_minute.pm
index 7cafbe0..86affa7 100644 (file)
--- a/FS/FS/part_pkg/sesmon_minute.pm
+++ b/FS/FS/part_pkg/sesmon_minute.pm
@@ -43,4 +43,9 @@ sub is_free_options {
   qw( setup_fee recur_fee recur_minly_charge );
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;

diff --git a/FS/FS/part_pkg/sql_external.pm b/FS/FS/part_pkg/sql_external.pm
index 8da4d31..96071fa 100644 (file)
--- a/FS/FS/part_pkg/sql_external.pm
+++ b/FS/FS/part_pkg/sql_external.pm
@@ -64,4 +64,9 @@ sub is_free {
   0;
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;

diff --git a/FS/FS/part_pkg/sql_generic.pm b/FS/FS/part_pkg/sql_generic.pm
index b7c7008..d1233e9 100644 (file)
--- a/FS/FS/part_pkg/sql_generic.pm
+++ b/FS/FS/part_pkg/sql_generic.pm
@@ -75,4 +75,9 @@ sub is_free_options {
   qw( setup_fee recur_flat recur_unit_charge );
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;

diff --git a/FS/FS/part_pkg/sqlradacct_hour.pm b/FS/FS/part_pkg/sqlradacct_hour.pm
index a2550e2..76533d5 100644 (file)
--- a/FS/FS/part_pkg/sqlradacct_hour.pm
+++ b/FS/FS/part_pkg/sqlradacct_hour.pm
@@ -112,4 +112,9 @@ sub is_free_options {
       recur_input_charge recur_output_charge recur_total_charge );
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;

diff --git a/FS/FS/part_pkg/voip_sqlradacct.pm b/FS/FS/part_pkg/voip_sqlradacct.pm
index 3f044eb..b9db39f 100644 (file)
--- a/FS/FS/part_pkg/voip_sqlradacct.pm
+++ b/FS/FS/part_pkg/voip_sqlradacct.pm
@@ -181,5 +181,10 @@ sub is_free {
   0;
 }
 
+sub base_recur {
+  my($self, $cust_pkg) = @_;
+  $self->option('recur_flat');
+}
+
 1;