Monday, September 20, 2010

Perl script to find unique file extensions in directory and all its subdirectories

original post @ http://bschandramohan.blogspot.com/2007/10/perl-script-to-find-unique-file_30.html @ 10/30/2007 12:46:00 PM

I am totally new to Perl.. so this was fun writing:

Invoke it with the directory you want to search for.

#!/usr/bin/perl -w

#Finds all the unique extensions in the current directory and its subdirectory(recursive).
#author: Chandra Mohan
use File::Basename;

sub recurse($) {
  my($path) = @_;

  ## append a trailing / if it's not there
  $path .= '/' if($path !~ /\/$/);

  ## loop through the files contained in the directory
  for my $eachFile (glob($path.'*')) {

    ## if the file is a directory
    if( -d $eachFile) {
      ## pass the directory to the routine ( recursion )
      recurse($eachFile);
    } else {
      ## Find file's extension
   my(undef, undef, $ftype) = fileparse($eachFile,qr"\.[^.]*");
   ## Add extension to the global array.
   $filetypes[$i++] = toLower($ftype);
    }
  }
}

# &toLower(string); --- convert string into lower case
sub toLower($) {
   local($string) = $_[0];
   $string =~ tr/A-Z/a-z/;
   $string;
}

#define Global variables
our @filetypes = ("");
our $i = 0;

## initial call ... $ARGV[0] is the first command line argument
recurse($ARGV[0]);

system "cls";

undef %saw;
@out = sort grep(!$saw{$_}++, @filetypes);
print "@out\n";

No comments:

Post a Comment