1 package FS::Misc::prune;
4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
6 use FS::Record qw(dbh qsearch);
7 use FS::cust_credit_refund;
8 #use FS::cust_credit_bill;
9 #use FS::cust_bill_pay;
10 #use FS::cust_pay_refund;
12 @ISA = qw( Exporter );
13 @EXPORT_OK = qw( prune_applications );
17 FS::Misc::prune - misc. pruning subroutines
21 use FS::Misc::prune qw(prune_applications);
29 =item prune_applications OPTION_HASH
31 Removes applications of credits to refunds in the event that the database
32 is corrupt and either the credits or refunds are missing (see
33 L<FS::cust_credit>, L<FS::cust_refund>, and L<FS::cust_credit_refund>).
34 If the OPTION_HASH contains the element 'dry_run' then a report of
35 affected records is returned rather than actually deleting the records.
39 sub prune_applications {
43 local $DEBUG = 1 if exists($options->{debug});
47 0 = (select count(*) from cust_credit
48 where cust_credit_refund.crednum = cust_credit.crednum)
50 0 = (select count(*) from cust_refund
51 where cust_credit_refund.refundnum = cust_refund.refundnum)
55 0 = (select count(*) from cust_credit
56 where cust_credit_bill.crednum = cust_credit.crednum)
58 0 = (select count(*) from cust_bill
59 where cust_credit_bill.invnum = cust_bill.invnum)
63 0 = (select count(*) from cust_bill
64 where cust_bill_pay.invnum = cust_bill.invnum)
66 0 = (select count(*) from cust_pay
67 where cust_bill_pay.paynum = cust_pay.paynum)
71 0 = (select count(*) from cust_pay
72 where cust_pay_refund.paynum = cust_pay.paynum)
74 0 = (select count(*) from cust_refund
75 where cust_pay_refund.refundnum = cust_refund.refundnum)
79 'cust_credit_refund' => { clause => $ccr,
83 # 'cust_credit_bill' => { clause => $ccb,
85 # link2 => 'refundnum',
87 # 'cust_bill_pay' => { clause => $cbp,
89 # link2 => 'refundnum',
91 # 'cust_pay_refund' => { clause => $cpr,
93 # link2 => 'refundnum',
97 if ( exists($options->{dry_run}) ) {
99 foreach my $table (keys %strays) {
100 my $clause = $strays{$table}->{clause};
101 my $link1 = $strays{$table}->{link1};
102 my $link2 = $strays{$table}->{link2};
103 my @rec = qsearch($table, {}, '', $clause);
104 my $keyname = $rec[0]->primary_key if $rec[0];
106 push @response, "$table " .$_->$keyname . " claims attachment to ".
107 "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
112 foreach (keys %strays) {
113 my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
114 warn $statement if $DEBUG;
115 my $sth = $dbh->prepare($statement)