made a typo applying patch from pbowen

[freeside.git] / FS / FS / cust_pkg.pm

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index ced1423..0c39f68 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'; }
 
 
 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.
 
 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.
 
 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.
 =item delete
 
 This method now works but you probably shouldn't use it.


@@ -309,6 +376,16 @@ sub cancel {
     }
   }
 
     }
   }
 

+  # Add a credit for remaining service
+  my $remaining_value= $self->calc_remain();
+  if ($remaining_value > 0) {
+    my $error = $self->credit($remaining_value, 'Credit for service remaining');
+    if ($error) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error crediting customer for service remaining: $error";
+    }                                                                          
+  }                                                                            
+

   unless ( $self->getfield('cancel') ) {
     my %hash = $self->hash;
     $hash{'cancel'} = time;
   unless ( $self->getfield('cancel') ) {
     my %hash = $self->hash;
     $hash{'cancel'} = time;


@@ -525,6 +602,30 @@ sub calc_recur {
   $self->part_pkg->calc_recur($self, @_);
 }
 
   $self->part_pkg->calc_recur($self, @_);
 }
 

+=item calc_remain
+
+Calls the I<calc_remain> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_remain {
+  my $self = shift;
+  $self->part_pkg->calc_remain($self, @_);
+}
+
+=item calc_cancel
+
+Calls the I<calc_cancel> of the FS::part_pkg object associated with this
+billing item.
+
+=cut
+
+sub calc_cancel {
+  my $self = shift;
+  $self->part_pkg->calc_cancel($self, @_);
+}
+

 =item cust_svc [ SVCPART ]
 
 Returns the services for this package, as FS::cust_svc objects (see
 =item cust_svc [ SVCPART ]
 
 Returns the services for this package, as FS::cust_svc objects (see


@@ -982,12 +1083,13 @@ sub order {
   my $cust_main = qsearchs('cust_main', { custnum => $custnum });
   return "Customer not found: $custnum" unless $cust_main;
 
   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.
   # 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;
     if ($error) {
       $dbh->rollback if $oldAutoCommit;
       return $error;