FS/FS/Misc/prune.pm

   1 package FS::Misc::prune;
   2
   3 use strict;
   4 use vars qw ( @ISA @EXPORT_OK $DEBUG );
   5 use Exporter;
   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;
  11
  12 @ISA = qw( Exporter );
  13 @EXPORT_OK = qw( prune_applications );
  14
  15 =head1 NAME
  16
  17 FS::Misc::prune - misc. pruning subroutines
  18
  19 =head1 SYNOPSIS
  20
  21 use FS::Misc::prune qw(prune_applications);
  22
  23 prune_applications();
  24
  25 =head1 SUBROUTINES
  26
  27 =over 4
  28
  29 =item prune_applications OPTION_HASH
  30
  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.
  36
  37 =cut
  38
  39 sub prune_applications {
  40   my $options = shift;
  41   my $dbh = dbh;
  42
  43   local $DEBUG = 1 if exists($options->{debug});
  44
  45   my $ccr = <<EOW;
  46     WHERE
  47          0 = (select count(*) from cust_credit
  48                where cust_credit_refund.crednum = cust_credit.crednum)
  49       or
  50          0 = (select count(*) from cust_refund
  51                where cust_credit_refund.refundnum = cust_refund.refundnum)
  52 EOW
  53   my $ccb = <<EOW;
  54     WHERE
  55          0 = (select count(*) from cust_credit
  56                where cust_credit_bill.crednum = cust_credit.crednum)
  57       or
  58          0 = (select count(*) from cust_bill
  59                where cust_credit_bill.invnum = cust_bill.invnum)
  60 EOW
  61   my $cbp = <<EOW;
  62     WHERE
  63          0 = (select count(*) from cust_bill
  64                where cust_bill_pay.invnum = cust_bill.invnum)
  65       or
  66          0 = (select count(*) from cust_pay
  67                where cust_bill_pay.paynum = cust_pay.paynum)
  68 EOW
  69   my $cpr = <<EOW;
  70     WHERE
  71          0 = (select count(*) from cust_pay
  72                where cust_pay_refund.paynum = cust_pay.paynum)
  73       or
  74          0 = (select count(*) from cust_refund
  75                where cust_pay_refund.refundnum = cust_refund.refundnum)
  76 EOW
  77
  78   my %strays = (
  79     'cust_credit_refund' => { clause => $ccr,
  80                               link1  => 'crednum',
  81                               link2  => 'refundnum',
  82                             },
  83 #    'cust_credit_bill'   => { clause => $ccb,
  84 #                              link1  => 'crednum',
  85 #                              link2  => 'refundnum',
  86 #                            },
  87 #    'cust_bill_pay'      => { clause => $cbp,
  88 #                              link1  => 'crednum',
  89 #                              link2  => 'refundnum',
  90 #                            },
  91 #    'cust_pay_refund'    => { clause => $cpr,
  92 #                              link1  => 'crednum',
  93 #                              link2  => 'refundnum',
  94 #                            },
  95   );
  96
  97   if ( exists($options->{dry_run}) ) {
  98     my @response = ();
  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];
 105       foreach (@rec) {
 106         push @response, "$table " .$_->$keyname . " claims attachment to ".
 107                "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
 108       }
 109     }
 110     return (@response);
 111   } else {
 112     foreach (keys %strays) {
 113       my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
 114       warn $statement if $DEBUG;
 115       my $sth = $dbh->prepare($statement)
 116         or die $dbh->errstr;
 117       $sth->execute
 118         or die $sth->errstr;
 119     }
 120     return ();
 121   }
 122 }
 123
 124 =back
 125
 126 =head1 BUGS
 127
 128 =cut
 129
 130 1;
 131