About a week ago, I posted a question about a recursive directory
enumeration function that I was having trouble with, and Tobias
Hoellrich wrote back and pointed out my ridiculous oversight. I thought
that I would post the resulting code as a point of interest. It is kinda
bloated with a bunch of presentation stuff, but I wanted to be able to
prove that it worked.
Some people posted that I should just use File::Find, and I am sure that
is probably true, but my need is simple and I thought that it would be
fun to write. And yes, I know that there are numerous things left out
such as following symlinks, but this will be used on Windows.
One thing I'm worried about is that the routine opens each directory and
does not close it until it is done, so I have nested directories open at
the same time. I've seen examples where people just suck the whole
directory into an array then close it, but this method seems to work
well.
=============================================
use strict;
use warnings;
use Cwd;
# Un-buffer STDOUT & STDERR.
select((select(STDOUT), $| = 1)[0]);
select((select(STDERR), $| = 1)[0]);
# These vars control the char used for the display indention and
# also how many chars the indention should be. You can also specify
# the character used for the empty space between the file name and
# the file size display.
my $prefixChar = ' ';
my $prefixLength = 2;
my $prefixFactor = 0;
my $totalString = '=== Total for: ';
my $BetweenFileAndSizeChar = ' ';
my $wantsexit = 0;
my $screenWidth = 80;
my $fileSizeLength = 14; # Number of chars reserved for displaying the
file size.
my $fileNameLength = $screenWidth - $fileSizeLength;
my $fileNameSizeLength = 2;
# Establish some interrupt handlers.
my $signame = '';
$SIG{INT} = sub {$signame = $_[0]; $wantsexit = 1;}; # CTRL-C.
$SIG{BREAK} = sub {$signame = $_[0]; $wantsexit = 1;}; # CTRL-BREAK,
CTRL-ScrollLock.
# Extract the target directory from the cmd line arg,
# then convert all '\' chars into '/' for consistency.
my $cwd = cwd();
(my $targetdir = $ARGV[0] ? $ARGV[0] : $cwd) =~ s/\\/\//g;
# Add a trailing '/' to the directory path if it is missing.
unless ($targetdir =~ /\/$/) {$targetdir .= '/';}
# EnumerateDirectory does all of the work, including printing of the
results.
#
enumerateDirectory($targetdir, $prefixFactor);
# ---------------------------------------------------------
# This routine enumerates the files in the target directory
# and traverses the directory tree downwards recursively,
# presumably as far as it may go before running out of memory.
#
# While processing directories, maintain a prefix factor which
# controls the indention of the file and directory display.
#
sub enumerateDirectory
{
my ($targetdir, $prefixFactor) = @_;
my ($nxtfile, $filename, $filesize, $thisLevelFileTotal) = ('', '', 0,
0);
my $currentdir = $targetdir;
# Shave off the very last directory name from the full path.
($currentdir = $targetdir) =~ s/.+\/(.+)$/$1/;
# Open the target directory. The first time this routine is
# called, it scans the top directory that the user specified.
# On subsequent instances, the routine is called with whatever
# directory that is being descended into during the enumeration
# process.
#
if (opendir(my $currentDir, $targetdir))
{
# Enumerate each file in the current directory.
#
while (defined($nxtfile = readdir($currentDir)))
{
# Take action on user generated break requests.
if ($wantsexit) {die "\nUser abort on $signame.\n\n";}
# If the current file is a directory, follow this logic.
if (-d $targetdir.$nxtfile)
{
# If the directory is '.' or '..' then ignore it.
next if $nxtfile =~ /^\.{1,2}$/;
# If the directory name returned by readdir() is missing a
trailing '/', then add it.
$nxtfile .= '/' unless $nxtfile =~ /\/$/;
# Display the directory name then increment the prefix factor.
print "\n", $prefixChar x $prefixFactor, "$nxtfile\n";
$prefixFactor += $prefixLength;
# -------------- THE RECURSION IS HERE ----------------------#
$thisLevelFileTotal += enumerateDirectory($targetdir.$nxtfile,
$prefixFactor);
# -----------------------------------------------------------#
# Upon return from the recursive call, decrement the prefix
factor.
$prefixFactor -= $prefixLength if $prefixFactor;
}
else
{
# If here, we have an ordinary file. Display it and accumulate
filesize.
$thisLevelFileTotal += (-s $targetdir.$nxtfile);
$filesize = pad(commafy(-s $targetdir.$nxtfile),
$fileSizeLength, ' ', 'r');
$filename = (length $nxtfile <= ($fileNameLength -
$prefixFactor))
?
pad($nxtfile, ($fileNameLength - $prefixFactor), '
', 'l')
:
$nxtfile;
print +($prefixChar x $prefixFactor), $filename,
($BetweenFileAndSizeChar x $fileNameSizeLength), $filesize, "\n";
}
}
# After completely enumerating each directory, be sure to close the
directory handle.
close $currentDir;
# Display the dotted line that appears just above the total line.
print +($BetweenFileAndSizeChar x $fileNameLength),
($BetweenFileAndSizeChar x $fileNameSizeLength), ('-' x
$fileSizeLength), "\n";
# Display the current directory size total.
my $thisTotal = $totalString . $currentdir;
print +($prefixChar x $prefixFactor), $thisTotal, ' ' x
$fileNameSizeLength,
($BetweenFileAndSizeChar x ($fileNameLength -
length($thisTotal) - $prefixFactor)),
pad(commafy($thisLevelFileTotal), $fileSizeLength, ' ', 'r'),
"\n\n";
}
return $thisLevelFileTotal;
}
#-----------------------------------------------------------
# CALL with (string, length of return str, <pad char>, <justification
'r' | 'l')
#
# Pads a string with blanks (or whatever).
# Takes 4 args:
# 1. The string you want padded (required).
# 2. The resulting length (default is 10).
# 3. The char to use for padding (default is 'space').
# 4. Justification. Default is 'r' for right-justified,
# which fills the left side with the pad character.
sub pad
{
my ($str, $len, $padchar, $just) = @_;
$len = $len ? $len : 10;
$just = ($just =~ /[lL]/) ? lc $just : 'r';
$padchar = $padchar eq '' ? ' ' : substr($padchar, 0, 1);
if ($str eq '') {$str = '0';}
if (length($str) < $len)
{
if ($just eq 'l') {$str .= $padchar x ($len - length($str));}
else {$str = ($padchar x ($len - length($str))) . $str;}
}
else
{
if ($just eq 'l')
{
$str = substr $str, 0, $len; $str =~ s/\s+$//g;
if (length($str) < $len) {$str .= $padchar x ($len -
length($str));}
}
else
{
$str = substr $str, -$len; $str =~ s/^\s+//g;
if (length($str) < $len) {$str = ($padchar x ($len -
length($str))) . $str;}
}
}
return $str;
}
#-----------------------------------------------------------
# CALL with (number).
#
# RETURNS the call number with commas inserted every 3 digits
# (but not in decimal part).
#
sub commafy
{
(my $rtnval = reverse shift) =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $rtnval;
}
_______________________________________________
Perl-Win32-Users mailing list
Perl-Win32-Users@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
