when refunding against a specific card payment, use the card details from the payment...

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

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index ced1423..e3724a3 100644 (file)
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -12,6 +12,7 @@ use FS::type_pkgs;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::h_cust_svc;
 use FS::pkg_svc;
 use FS::cust_bill_pkg;
 use FS::h_cust_svc;

+use FS::reg_code;

 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }
 
 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
 # setup }


@@ -141,7 +142,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 +151,82 @@ 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;
+  }
+
+  #if ( $self->reg_code ) {
+  #  my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
+  #  $error = $reg_code->delete;
+  #  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.


@@ -222,7 +299,17 @@ sub check {
   ;
   return $error if $error;
 
   ;
   return $error if $error;
 

-  if ( $self->promo_code ) {
+  if ( $self->reg_code ) {
+
+    unless ( grep { $self->pkgpart == $_->pkgpart }
+             map  { $_->reg_code_pkg }
+             qsearchs( 'reg_code', { 'code'     => $self->reg_code,
+                                     'agentnum' => $self->cust_main->agentnum })
+           ) {
+      return "Unknown registraiton code";
+    }
+
+  } elsif ( $self->promo_code ) {

 
     my $promo_part_pkg =
       qsearchs('part_pkg', {
 
     my $promo_part_pkg =
       qsearchs('part_pkg', {


@@ -230,7 +317,6 @@ sub check {
         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
       } );
     return 'Unknown promotional code' unless $promo_part_pkg;
         'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
       } );
     return 'Unknown promotional code' unless $promo_part_pkg;

-    $self->pkgpart($promo_part_pkg->pkgpart);

 
   } else { 
 
 
   } else { 
 


@@ -309,6 +395,20 @@ sub cancel {
     }
   }
 
     }
   }
 

+  # Add a credit for remaining service
+  my $remaining_value = $self->calc_remain();
+  if ( $remaining_value > 0 ) {
+    my $error = $self->cust_main->credit(
+      $remaining_value,
+      'Credit for unused time on'. $self->part_pkg->pkg,
+    );
+    if ($error) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error crediting customer \$$remaining_value for unused time on".
+             $self->part_pkg->pkg. ": $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 +625,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 +1106,24 @@ 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 @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
+                         @$remove_pkgnum;
+
+  my $change = scalar(@old_cust_pkg) != 0;
+
+  my %hash = (); 
+  if ( scalar(@old_cust_pkg) == 1 ) {
+    #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
+    $hash{'setup'} = time;
+  }
+

   # 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,
+                                      %hash,
+                                    };
+    $error = $cust_pkg->insert( 'change' => $change );

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


@@ -998,8 +1134,7 @@ sub order {
   # created packages.
 
   # Transfer services and cancel old packages.
   # created packages.
 
   # Transfer services and cancel old packages.

-  foreach my $old_pkgnum (@$remove_pkgnum) {
-    my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum });
+  foreach my $old_pkg (@old_cust_pkg) {

 
     foreach my $new_pkg (@$return_cust_pkg) {
       $error = $old_pkg->transfer($new_pkg);
 
     foreach my $new_pkg (@$return_cust_pkg) {
       $error = $old_pkg->transfer($new_pkg);