TranscriptCleanup.pl

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";

# Sanity check the first parameter, and make sure it is given
my $opt = shift;
if (not defined $opt or $opt !~ m/--all|--zero/)
{
   print "Must use option \"--all\" or \"--zero\"\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 = ();


# 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);


# 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
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/);
}

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);
}