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 =item prune_applications OPTION_HASH
  26
  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.
  32
  33 =cut
  34
  35 sub prune_applications {
  36   my $options = shift;
  37   my $dbh = dbh
  38
  39   local $DEBUG = 1 if exists($options->{debug});
  40   my $ccr = <<EOW;
  41     WHERE
  42          0 = (select count(*) from cust_credit
  43                where cust_credit_refund.crednum = cust_credit.crednum)
  44       or
  45          0 = (select count(*) from cust_refund
  46                where cust_credit_refund.refundnum = cust_refund.refundnum)
  47 EOW
  48   my $ccb = <<EOW;
  49     WHERE
  50          0 = (select count(*) from cust_credit
  51                where cust_credit_bill.crednum = cust_credit.crednum)
  52       or
  53          0 = (select count(*) from cust_bill
  54                where cust_credit_bill.invnum = cust_bill.invnum)
  55 EOW
  56   my $cbp = <<EOW;
  57     WHERE
  58          0 = (select count(*) from cust_bill
  59                where cust_bill_pay.invnum = cust_bill.invnum)
  60       or
  61          0 = (select count(*) from cust_pay
  62                where cust_bill_pay.paynum = cust_pay.paynum)
  63 EOW
  64   my $cpr = <<EOW;
  65     WHERE
  66          0 = (select count(*) from cust_pay
  67                where cust_pay_refund.paynum = cust_pay.paynum)
  68       or
  69          0 = (select count(*) from cust_refund
  70                where cust_pay_refund.refundnum = cust_refund.refundnum)
  71 EOW
  72
  73   my %strays = (
  74     'cust_credit_refund' => { clause => $ccr,
  75                               link1  => 'crednum',
  76                               link2  => 'refundnum',
  77                             },
  78 #    'cust_credit_bill'   => { clause => $ccb,
  79 #                              link1  => 'crednum',
  80 #                              link2  => 'refundnum',
  81 #                            },
  82 #    'cust_bill_pay'      => { clause => $cbp,
  83 #                              link1  => 'crednum',
  84 #                              link2  => 'refundnum',
  85 #                            },
  86 #    'cust_pay_refund'    => { clause => $cpr,
  87 #                              link1  => 'crednum',
  88 #                              link2  => 'refundnum',
  89 #                            },
  90   );
  91
  92   if ( exists($options->{dry_run}) ) {
  93     my @response = ();
  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];
 100       foreach (@rec) {
 101         push @response, "$table " .$_->$keyname . " claims attachment to ".
 102                "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n";
 103       }
 104     }
 105     return (@response);
 106   } else {
 107     foreach (keys %strays) {
 108       my $statement = "DELETE FROM $_ " . $strays{$_}->{clause};
 109       warn $statement if $DEBUG;
 110       my $sth = $dbh->prepare($statement)
 111         or die $dbh->errstr;
 112       $sth->execute
 113         or die $sth->errstr;
 114     }
 115     return ();
 116   }
 117 }
 118
 119 =back
 120
 121 =head1 BUGS
 122
 123 =cut
 124
 125 1;
 126