RT# 83450 - fixed rateplan export

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

diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index 864804d..176e24c 100644 (file)
--- a/FS/FS/reason.pm
+++ b/FS/FS/reason.pm
@@ -50,16 +50,25 @@ FS::Record.  The following fields are currently supported:
 L<FS::part_pkg>) of a package to be ordered when the package is unsuspended.
 Typically this will be some kind of reactivation fee.  Attaching it to 
 a suspension reason allows the reactivation fee to be charged for some
 L<FS::part_pkg>) of a package to be ordered when the package is unsuspended.
 Typically this will be some kind of reactivation fee.  Attaching it to 
 a suspension reason allows the reactivation fee to be charged for some

-suspensions but not others.
+suspensions but not others. DEPRECATED.

 
 =item unsuspend_hold - 'Y' or ''.  If unsuspend_pkgpart is set, this tells
 whether to bill the unsuspend package immediately ('') or to wait until 
 the customer's next invoice ('Y').
 
 
 =item unsuspend_hold - 'Y' or ''.  If unsuspend_pkgpart is set, this tells
 whether to bill the unsuspend package immediately ('') or to wait until 
 the customer's next invoice ('Y').
 

-=item unused_credit - 'Y' or ''. For suspension reasons only (for now).
+=item unused_credit - 'Y' or ''. For suspension or cancellation reasons.

 If enabled, the customer will be credited for their remaining time on 
 suspension.
 
 If enabled, the customer will be credited for their remaining time on 
 suspension.
 

+=item feepart - for suspension reasons, the feepart of a fee to be
+charged when a package is suspended for this reason.
+
+=item fee_hold - 'Y' or ''. If feepart is set, tells whether to bill the fee
+immediately ('') or wait until the customer's next invoice ('Y').
+
+=item fee_on_unsuspend - If feepart is set, tells whether to charge the fee
+on suspension ('') or unsuspension ('Y').
+

 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS


@@ -116,19 +125,30 @@ sub check {
   ;
   return $error if $error;
 
   ;
   return $error if $error;
 

-  if ( $self->reasontype->class eq 'S' ) {
+  my $class = $self->reasontype->class;
+
+  if ( $class eq 'S' ) {

     $error = $self->ut_numbern('unsuspend_pkgpart')
           || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
           || $self->ut_flag('unsuspend_hold')
     $error = $self->ut_numbern('unsuspend_pkgpart')
           || $self->ut_foreign_keyn('unsuspend_pkgpart', 'part_pkg', 'pkgpart')
           || $self->ut_flag('unsuspend_hold')

-          || $self->ut_flag('unused_credit')
+          || $self->ut_foreign_keyn('feepart', 'part_fee', 'feepart')
+          || $self->ut_flag('fee_on_unsuspend')
+          || $self->ut_flag('fee_hold')

     ;
     return $error if $error;
   } else {
     ;
     return $error if $error;
   } else {

-    foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit)) {
+    foreach (qw(unsuspend_pkgpart unsuspend_hold feepart
+                fee_on_unsuspend fee_hold)) {

       $self->set($_ => '');
     }
   }
 
       $self->set($_ => '');
     }
   }
 

+  if ( $class eq 'S' or $class eq 'C' ) {
+    $error = $self->ut_flag('unused_credit');
+  } else {
+    $self->set('unused_credit', '');
+  }
+

   $self->SUPER::check;
 }
 
   $self->SUPER::check;
 }
 


@@ -142,6 +162,80 @@ sub reasontype {
   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 }
 
   qsearchs( 'reason_type', { 'typenum' => shift->reason_type } );
 }
 

+=item merge
+
+Accepts an arrayref of reason objects, to be merged into this reason.
+Reasons must all have the same reason_type class as this one.
+Matching reasonnums will be replaced in the following tables:
+
+  cust_bill_void
+  cust_bill_pkg_void
+  cust_credit
+  cust_credit_void
+  cust_pay_void
+  cust_pkg_reason
+  cust_refund
+
+=cut
+
+sub merge {
+  my ($self,$reasons) = @_;
+  return "Bad input for merge" unless ref($reasons) eq 'ARRAY';
+
+  my $class = $self->reasontype->class;
+
+  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;
+  foreach my $reason (@$reasons) {
+    last if $error;
+    next if $reason->reasonnum eq $self->reasonnum;
+    $error = "Mismatched reason type class"    
+      unless $reason->reasontype->class eq $class;
+    foreach my $table ( qw(
+      cust_bill_void
+      cust_bill_pkg_void
+      cust_credit
+      cust_credit_void
+      cust_pay_void
+      cust_pkg_reason
+      cust_refund
+    )) {
+      last if $error;
+      my @fields = ('reasonnum');
+      push(@fields, 'void_reasonnum') if $table eq 'cust_credit_void';
+      foreach my $field (@fields) {
+        last if $error;
+        foreach my $obj ( qsearch($table,{ $field => $reason->reasonnum }) ) {
+          last if $error;
+          $obj->set($field,$self->reasonnum);
+          $error = $obj->replace;
+        }
+      }
+    }
+    $error ||= $reason->delete;
+  }
+
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
+
+}
+

 =back
 
 =head1 CLASS METHODS
 =back
 
 =head1 CLASS METHODS


@@ -174,7 +268,7 @@ sub new_or_existing {
     }
   } else {
     my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});
     }
   } else {
     my %hash = ('class' => $opt{'class'}, 'type' => $opt{'type'});

-    my $reason_type = qsearchs('reason_type', \%hash)
+    $reason_type = qsearchs('reason_type', \%hash)

                       || FS::reason_type->new(\%hash);
 
     $error = $reason_type->insert unless $reason_type->typenum;
                       || FS::reason_type->new(\%hash);
 
     $error = $reason_type->insert unless $reason_type->typenum;


@@ -192,9 +286,12 @@ sub new_or_existing {
   $reason;
 }
 
   $reason;
 }
 

-

 =head1 BUGS
 
 =head1 BUGS
 

+The reason_type column should have been typenum, and then that cascaded into
+a bunch of other stupidity where that conflicts with the autogenerated methos
+and so we need our own manual and inconsistently named reasontype method.
+

 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.
 =head1 SEE ALSO
 
 L<FS::Record>, schema.html from the base documentation.