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