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});
43 0 = (select count(*) from cust_credit
44 where cust_credit_refund.crednum = cust_credit.crednum)
46 0 = (select count(*) from cust_refund
47 where cust_credit_refund.refundnum = cust_refund.refundnum)
51 0 = (select count(*) from cust_credit
52 where cust_credit_bill.crednum = cust_credit.crednum)
54 0 = (select count(*) from cust_bill
55 where cust_credit_bill.invnum = cust_bill.invnum)
59 0 = (select count(*) from cust_bill
60 where cust_bill_pay.invnum = cust_bill.invnum)
62 0 = (select count(*) from cust_pay
63 where cust_bill_pay.paynum = cust_pay.paynum)
67 0 = (select count(*) from cust_pay
68 where cust_pay_refund.paynum = cust_pay.paynum)
70 0 = (select count(*) from cust_refund
71 where cust_pay_refund.refundnum = cust_refund.refundnum)
75 'cust_credit_refund' => { clause => $ccr,
79 # 'cust_credit_bill' => { clause => $ccb,
81 # link2 => 'refundnum',
83 # 'cust_bill_pay' => { clause => $cbp,
85 # link2 => 'refundnum',
87 # 'cust_pay_refund' => { clause => $cpr,
89 # link2 => 'refundnum',
93 if ( exists($options->{dry_run}) ) {
95 foreach my $table (keys %strays) {
96 my $clause = $strays{$table}->{clause};
97 my $link1 = $strays{$table}->{link1};
98 my $link2 = $strays{$table}->{link2};
99 my @rec = qsearch($table, {}, '', $clause);
100 my $keyname = $rec[0]->primary_key if $rec[0];
102 push @response, "$table " .$_->$keyname . " claims attachment to ".
103 "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
108 foreach (keys %strays) {
109 my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
110 warn $statement if $DEBUG;
111 my $sth = $dbh->prepare($statement)