From e1d6655b9607b22ab98fb710bf463ed3e2fedf5e Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 1 Mar 2007 17:47:46 +0000 Subject: [PATCH] adding FS::Misc::prune --- FS/FS/Misc/prune.pm | 126 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) create mode 100644 FS/FS/Misc/prune.pm diff --git a/FS/FS/Misc/prune.pm b/FS/FS/Misc/prune.pm new file mode 100644 index 000000000..634cd8a6c --- /dev/null +++ b/FS/FS/Misc/prune.pm @@ -0,0 +1,126 @@ +package FS::Misc::prune; + +use strict; +use vars qw ( @ISA @EXPORT_OK $DEBUG ); +use Exporter; +use FS::Record qw(dbh qsearch); +use FS::cust_credit_refund; +#use FS::cust_credit_bill; +#use FS::cust_bill_pay; +#use FS::cust_pay_refund; + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( prune applications ); + +=head1 NAME + +FS::Misc::prune - misc. pruning subroutines + +=head1 SYNOPSIS + +use FS::Misc::prune qw(prune_applications); + +prune_applications(); + +=item prune_applications OPTION_HASH + +Removes applications of credits to refunds in the event that the database +is corrupt and either the credits or refunds are missing (see +L, L, and L). +If the OPTION_HASH contains the element 'dry_run' then a report of +affected records is returned rather than actually deleting the records. + +=cut + +sub prune_applications { + my $options = shift; + my $dbh = dbh + + local $DEBUG = 1 if exists($options->{debug}); + my $ccr = < { clause => $ccr, + link1 => 'crednum', + link2 => 'refundnum', + }, +# 'cust_credit_bill' => { clause => $ccb, +# link1 => 'crednum', +# link2 => 'refundnum', +# }, +# 'cust_bill_pay' => { clause => $cbp, +# link1 => 'crednum', +# link2 => 'refundnum', +# }, +# 'cust_pay_refund' => { clause => $cpr, +# link1 => 'crednum', +# link2 => 'refundnum', +# }, + ); + + if ( exists($options->{dry_run}) ) { + my @response = (); + foreach my $table (keys %strays) { + my $clause = $strays{$table}->{clause}; + my $link1 = $strays{$table}->{link1}; + my $link2 = $strays{$table}->{link2}; + my @rec = qsearch($table, {}, '', $clause); + my $keyname = $rec[0]->primary_key if $rec[0]; + foreach (@rec) { + push @response, "$table " .$_->$keyname . " claims attachment to ". + "$link1 " . $_->$link1 . " and $link2 " . $_->$link2 . "\n"; + } + } + return (@response); + } else { + foreach (keys %strays) { + my $statement = "DELETE FROM $_ " . $strays{$_}->{clause}; + warn $statement if $DEBUG; + my $sth = $dbh->prepare($statement) + or die $dbh->errstr; + $sth->execute + or die $sth->errstr; + } + return (); + } +} + +=back + +=head1 BUGS + +=cut + +1; + -- 2.11.0