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);
25 =item prune_applications OPTION_HASH
27 Removes applications of credits to refunds in the event that the database
28 is corrupt and either the credits or refunds are missing (see
29 L<FS::cust_credit>, L<FS::cust_refund>, and L<FS::cust_credit_refund>).
30 If the OPTION_HASH contains the element 'dry_run' then a report of
31 affected records is returned rather than actually deleting the records.
35 sub prune_applications {
39 local $DEBUG = 1 if exists($options->{debug});
42 0 = (select count(*) from cust_credit
43 where cust_credit_refund.crednum = cust_credit.crednum)
45 0 = (select count(*) from cust_refund
46 where cust_credit_refund.refundnum = cust_refund.refundnum)
50 0 = (select count(*) from cust_credit
51 where cust_credit_bill.crednum = cust_credit.crednum)
53 0 = (select count(*) from cust_bill
54 where cust_credit_bill.invnum = cust_bill.invnum)
58 0 = (select count(*) from cust_bill
59 where cust_bill_pay.invnum = cust_bill.invnum)
61 0 = (select count(*) from cust_pay
62 where cust_bill_pay.paynum = cust_pay.paynum)
66 0 = (select count(*) from cust_pay
67 where cust_pay_refund.paynum = cust_pay.paynum)
69 0 = (select count(*) from cust_refund
70 where cust_pay_refund.refundnum = cust_refund.refundnum)
74 'cust_credit_refund' => { clause => $ccr,
78 # 'cust_credit_bill' => { clause => $ccb,
80 # link2 => 'refundnum',
82 # 'cust_bill_pay' => { clause => $cbp,
84 # link2 => 'refundnum',
86 # 'cust_pay_refund' => { clause => $cpr,
88 # link2 => 'refundnum',
92 if ( exists($options->{dry_run}) ) {
94 foreach my $table (keys %strays) {
95 my $clause = $strays{$table}->{clause};
96 my $link1 = $strays{$table}->{link1};
97 my $link2 = $strays{$table}->{link2};
98 my @rec = qsearch($table, {}, '', $clause);
99 my $keyname = $rec[0]->primary_key if $rec[0];
101 push @response, "$table " .$_->$keyname . " claims attachment to ".
102 "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
107 foreach (keys %strays) {
108 my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
109 warn $statement if $DEBUG;
110 my $sth = $dbh->prepare($statement)