X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Freason.pm;h=d87911e222e1bdaf4719849b6594ab5c8b2e3aea;hp=864804d265d7f6217a435e652c03aee9e427b711;hb=f822e27a1e00594332ffa487a1c284234c5580a6;hpb=3ece1c396f23e04cd659f1085f6eeee8bdfd846f

diff --git a/FS/FS/reason.pm b/FS/FS/reason.pm
index 864804d26..d87911e22 100644
--- 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
-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 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.
 
+=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
@@ -116,19 +125,30 @@ sub check {
   ;
   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')
-          || $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 {
-    foreach (qw(unsuspend_pkgpart unsuspend_hold unused_credit)) {
+    foreach (qw(unsuspend_pkgpart unsuspend_hold feepart
+                fee_on_unsuspend fee_hold)) {
       $self->set($_ => '');
     }
   }
 
+  if ( $class eq 'S' or $class eq 'C' ) {
+    $error = $self->ut_flag('unused_credit');
+  } else {
+    $self->set('unused_credit', '');
+  }
+
   $self->SUPER::check;
 }
 
@@ -142,6 +162,80 @@ sub reasontype {
   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
@@ -174,7 +268,7 @@ sub new_or_existing {
     }
   } 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;
@@ -192,7 +286,6 @@ sub new_or_existing {
   $reason;
 }
 
-
 =head1 BUGS
 
 =head1 SEE ALSO