From radmind
#!/usr/bin/perl -w
# Description : This finds all the transcripts, command files, and reads the
# config file and then determines how many times each transcript
# is referenced. Those transcripts that are referenced zero times
# should be safe to remove. This script attempts to deal
# correctly with "K-in-K" files.
#
# License : GNU GPL version 3
# Author : Paul Ortman <portman@goshen.edu>
# Date : Feb 2008
################################################################################
use strict;
use File::Find ();
my $trans_dir = "/var/radmind/transcript";
my $command_dir = "/var/radmind/command";
my $config_file = "/var/radmind/config";
my @file_dirs = ( "/var/radmind/file", "/var/radmind/file/relative");
# Sanity check the first parameter, and make sure it is given
my $opt = shift;
if (not defined $opt or $opt !~ m/--all|--zero|--dangling/)
{
print "Must use option \"--all\" or \"--zero\" or \"--dangling\"\n";
exit 1;
}
# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*dir = *File::Find::dir;
*prune = *File::Find::prune;
# Hashes for the Transcripts, Kommand files, and a "K-in-K" queue
my %T = ();
my %K = ();
my @deep_K = ();
my @F = ();
# Traverse desired filesystems to find _all_ the transcripts and command files
# in the filesystem
File::Find::find({wanted => \&wanted_T}, $trans_dir);
File::Find::find({wanted => \&wanted_K}, $command_dir);
# Find all the top level .T file dirs
foreach my $file_dir (@file_dirs)
{
my @globvalue = glob ("$file_dir/*.T");
foreach my $gv (@globvalue)
{
push (@F, $gv) if ( -d "$gv" );
}
}
# Parse the radmind config file to find all the starting K files
parse_config_file();
# Parse each used command file from the config, and keep track of 'K-in-K' in an
# additional array.
foreach my $f (keys %K)
{
parse_command_file($f) if ($K{$f}{'ref'} > 0);
}
# Work through every element in the array until the array is empty - fake
# recursion.
while (my $f = pop(@deep_K))
{
#print "$f\n";
parse_command_file($f) if ($K{$f}{'ref'} > 0);
}
# Now, simply print out all the references for all the transcripts
if ($opt =~ m/--zero|--all/)
{
foreach my $f (keys %K)
{
my $i = $K{$f}{'ref'};
print("$i = $f\n") if ($opt =~ m/--zero/ and $i == 0);
print("$i = $f\n") if ($opt =~ m/--all/);
}
foreach my $f (keys %T)
{
my $i = $T{$f}{'ref'};
print("$i = $f\n") if ($opt =~ m/--zero/ and $i == 0);
print("$i = $f\n") if ($opt =~ m/--all/);
}
}
elsif ($opt =~ m/--dangling/)
{
foreach my $f (@F)
{
my $cpath = $f;
$cpath =~ s/file/transcript/;
#next if ( defined $T{$cpath} and $T{$cpath}{'ref'} > 0 );
print "/bin/rm -rf $f;\n" unless ( defined $T{$cpath} );
}
}
exit;
#-------------------------------------------------------------------------------
sub wanted_T
{
if (/^.*\.T\z/s && -f "$name")
{
$T{"$name"}{"ref"} = 0;
}
}
#-------------------------------------------------------------------------------
sub wanted_K
{
if (/^.*\.K\z/s && -f "$name")
{
$K{"$name"}{"ref"} = 0;
}
}
#-------------------------------------------------------------------------------
sub parse_config_file
{
open(my $CONFIG, "< $config_file") or die $!;
while(<$CONFIG>)
{
chomp(); # cut off the newline
next if (m/^\s*#/); # skip blank lines or commented lines
next if (m/^\s*$/); #
my ($comp, $file) = split(/\s+/); # tokenize the line
next unless ($file =~ m/\w/); # make sure something is listed as the file
# Count the references
$K{"$command_dir/$file"}{"ref"}++ if ($file =~ m/\.K$/);
$T{"$trans_dir/$file"}{"ref"}++ if ($file =~ m/\.T$/);
}
close ($CONFIG);
}
#-------------------------------------------------------------------------------
sub parse_command_file
{
my $target = shift;
open(my $CONFIG, "< $target") or die $!;
while(<$CONFIG>)
{
chomp(); # cut off the newline
next if (m/^\s*#/); # skip blank lines or commented lines
next if (m/^\s*$/); #
my ($type, $file) = split(/\s+/); # tokenize the line
next unless ($file =~ m/\w/); # make sure something is listed as the file
# Count the references
if ($type =~ m/k/ and $file =~ m/\.K$/)
{
$K{"$command_dir/$file"}{"ref"}++;
push @deep_K, "$command_dir/$file";
}
if ($type =~ m/p|n/ and $file =~ m/\.T$/)
{
$T{"$trans_dir/$file"}{"ref"}++;
}
}
close ($CONFIG);
}