dangling cust_credit_refund not allowed

3 files changed, 171 insertions, 1 deletions

diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm
index a535ecebf..e2143cf80 100644
--- a/FS/FS/Misc.pm
+++ b/FS/FS/Misc.pm
@@ -4,12 +4,17 @@ use strict;
 use vars qw ( @ISA @EXPORT_OK $DEBUG );
 use Exporter;
 use Carp;
+use FS::Record qw(dbh qsearch);
+use FS::cust_credit_refund;
+#use FS::cust_credit_bill;
+#use FS::cust_bill_pay;
+#use FS::cust_pay_refund;
 use Data::Dumper;
 
 @ISA = qw( Exporter );
 @EXPORT_OK = qw( send_email send_fax
                  states_hash counties state_label
-                 card_types
+                 card_types prune_applications
                );
 
 $DEBUG = 0;
@@ -468,6 +473,100 @@ sub card_types {
   \%card_types;
 }
 
+=item prune_applications OPTION_HASH
+
+Removes applications of credits to refunds in the event that the database
+is corrupt and either the credits or refunds are missing (see
+L<FS::cust_credit>, L<FS::cust_refund>, and L<FS::cust_credit_refund>).
+If the OPTION_HASH contains the element 'dry_run' then a report of
+affected records is returned rather than actually deleting the records.
+
+=cut
+
+sub prune_applications {
+  my $options = shift;
+  my $dbh = dbh
+
+  local $DEBUG = 1 if exists($options->{debug});
+  my $ccr = <<EOW;
+    WHERE
+         0 = (select count(*) from cust_credit
+               where cust_credit_refund.crednum = cust_credit.crednum)
+      or 
+         0 = (select count(*) from cust_refund
+               where cust_credit_refund.refundnum = cust_refund.refundnum)
+EOW
+  my $ccb = <<EOW;
+    WHERE
+         0 = (select count(*) from cust_credit
+               where cust_credit_bill.crednum = cust_credit.crednum)
+      or 
+         0 = (select count(*) from cust_bill
+               where cust_credit_bill.invnum = cust_bill.invnum)
+EOW
+  my $cbp = <<EOW;
+    WHERE
+         0 = (select count(*) from cust_bill
+               where cust_bill_pay.invnum = cust_bill.invnum)
+      or 
+         0 = (select count(*) from cust_pay
+               where cust_bill_pay.paynum = cust_pay.paynum)
+EOW
+  my $cpr = <<EOW;
+    WHERE
+         0 = (select count(*) from cust_pay
+               where cust_pay_refund.paynum = cust_pay.paynum)
+      or 
+         0 = (select count(*) from cust_refund
+               where cust_pay_refund.refundnum = cust_refund.refundnum)
+EOW
+
+  my %strays = (
+    'cust_credit_refund' => { clause => $ccr,
+                              link1  => 'crednum',
+                              link2  => 'refundnum',
+                            },
+#    'cust_credit_bill'   => { clause => $ccb,
+#                              link1  => 'crednum',
+#                              link2  => 'refundnum',
+#                            },
+#    'cust_bill_pay'      => { clause => $cbp,
+#                              link1  => 'crednum',
+#                              link2  => 'refundnum',
+#                            },
+#    'cust_pay_refund'    => { clause => $cpr,
+#                              link1  => 'crednum',
+#                              link2  => 'refundnum',
+#                            },
+  );
+
+  if ( exists($options->{dry_run}) ) {
+    my @response = ();
+    foreach my $table (keys %strays) {
+      my $clause = $strays{$table}->{clause};
+      my $link1  = $strays{$table}->{link1};
+      my $link2  = $strays{$table}->{link2};
+      my @rec = qsearch($table, {}, '', $clause);
+      my $keyname = $rec[0]->primary_key if $rec[0];
+      foreach (@rec) {
+        push @response, "$table " .$_->$keyname . " claims attachment to ".
+               "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
+      }
+    }
+    return (@response);
+  } else {
+    foreach (keys %strays) {
+      my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
+      warn $statement if $DEBUG;
+      my $sth = $dbh->prepare($statement)
+        or die $dbh->errstr;
+      $sth->execute
+        or die $sth->errstr;
+    }
+    return ();
+  }
+}
+
 =back
 
 =head1 BUGS
diff --git a/FS/bin/freeside-prune-applications b/FS/bin/freeside-prune-applications
new file mode 100755
index 000000000..b459da55e
--- /dev/null
+++ b/FS/bin/freeside-prune-applications
@@ -0,0 +1,63 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($opt_d $opt_q $opt_v);  # $opt_n instead of $opt_d?
+use vars qw($DEBUG $DRY_RUN);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup checkeuid);
+use FS::Misc qw(prune_applications);
+
+die "Not running uid freeside!" unless checkeuid();
+
+getopts("dq");
+
+$DEBUG = !$opt_q;
+#$DEBUG = $opt_v;
+
+$DRY_RUN = $opt_d;
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup($user);
+
+my $hashref = {};
+
+$hashref->{dry_run} = 1 if $DRY_RUN;
+$hashref->{debug} = 1 if $DEBUG;
+
+print join "\n", prune_applications($hashref);
+print "\n" if $DRY_RUN;
+
+$dbh->commit or die $dbh->errstr;
+
+###
+
+sub usage {
+  die "Usage:\n  freeside-prune-applications [ -d ] [ -q | -v ] user\n"; 
+}
+
+=head1 NAME
+
+freeside-prune-applications - Removes stray applications of credit, payment to
+                              bills, refunds, etc.
+
+=head1 SYNOPSIS
+
+  freeside-prune-applications [ -d ] [ -q | -v ]
+
+=head1 DESCRIPTION
+
+Reads your existing database schema and updates it to match the current schema,
+adding any columns or tables necessary.
+
+  [ -d ]: Dry run; display affected records (to STDOUT) only, but do not
+          remove them.
+
+  [ -q ]: Run quietly.  This may become the default at some point.
+
+  [ -v ]: Run verbosely, sending debugging information to STDERR.  This is the
+          current default.
+
+=head1 SEE ALSO
+
+=cut
+
diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade
index 5c646fec2..db58c117c 100755
--- a/FS/bin/freeside-upgrade
+++ b/FS/bin/freeside-upgrade
@@ -8,6 +8,7 @@ use DBIx::DBSchema 0.31;
 use FS::UID qw(adminsuidsetup checkeuid datasrc );  #getsecrets);
 use FS::CurrentUser;
 use FS::Schema qw( dbdef dbdef_dist reload_dbdef );
+use FS::Misc qw(prune_applications);
 
 die "Not running uid freeside!" unless checkeuid();
 
@@ -40,6 +41,13 @@ if ( $DRY_RUN ) {
   dbdef->update_schema( dbdef_dist, $dbh );
 }
 
+my $hashref = {};
+$hashref->{dry_run} = 1 if $DRY_RUN;
+$hashref->{debug} = 1 if $DEBUG;
+print join "\n", prune_applications($hashref);
+print "\n" if $DRY_RUN;
+
+
 $dbh->commit or die $dbh->errstr;
 
 dbdef_create($dbh, $dbdef_file);