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