SUMNER, Peter wrote:
> Hello to you all,
>
> Further to my previous post, I have been trying to get PERL to walk through
> an entire directory structure and identify files from directories.
>
> Has anyone a snippet of code to walk your way completely through a directory
> tree on a Win32 machine?
Not sure what you have in mind for 'identify', but you can always use
File::Find or a recursive directory listing sub like this:
#!perl -w --
use strict;
use Cwd;
our %A; # get commandline switches into %A
for (my $ii = 0; $ii < @ARGV; ) {
last if $ARGV[$ii] =~ /^--$/;
if ($ARGV[$ii] !~ /^-{1,2}(.*)$/) { $ii++; next; }
my $arg = $1; splice @ARGV, $ii, 1;
if ($arg =~ /^([\w]+)=(.*)$/) { $A{$1} = $2; } else { $A{$1}++; }
}
my $DEF_DIR_PREFIX = '->';
my $DEF_FILE_PREFIX = '';
my $DEF_INDENT = ' ';
my $act_path = $A{ap} || 0;
my $debug = $A{d} || 0;
my $dirs_first = $A{df} || 0;
my $dirs_last = $A{dl} || 0;
my $dir_prefix = $A{dp} || $DEF_DIR_PREFIX;
my $file_prefix = $A{fp} || $DEF_FILE_PREFIX;
my $inc_path = $A{ip} || 0;
my $indent = $A{in} || $DEF_INDENT;
my $verbose = $A{v} || 0;
if ($debug) {
print <<EOD;
*** act_path = '$act_path'
*** debug = '$debug'
*** dirs_first = '$dirs_first'
*** dirs_last = '$dirs_last'
*** dir_prefix = '$dir_prefix'
*** file_prefix = '$file_prefix'
*** inc_path = '$inc_path'
*** verbose = '$verbose'
EOD
}
my $usage = <<EOD;
Usage: $0 [-ap] [-d] [-df] [-dl] [-dp] [-fp] [-in=''] [-ip] [-v] \\
[<dir-list> ... ]
-ap print full actual path to dir
-d debug
-df dirs first in each dir
-dl dirs last in each dir
-dp dir line prefix (def: '$DEF_DIR_PREFIX')
-fp file line prefix (def: '$DEF_FILE_PREFIX')
-in indent prefix (def: '$DEF_INDENT')
-ip include full path dir in file printout
-v vebose print (empty dirs etc)
<dir-list> list of dirs to recurse (may be abs or rel)
EOD
die $usage if $A{h} or $A{help};
$ARGV[0] = '.' if not @ARGV;
my $cwd = getcwd;
my @cwd = split /[\\\/]/, $cwd;
pop @cwd; # remove last dir
print "*** CWD: $cwd -> @cwd\n" if $debug;
foreach (@ARGV) {
print "*** ARGV: $_\n" if $debug;
s#\\#/#g; # use UNIX paths
print "*** ARGV: $_\n" if $debug;
if ($act_path) {
s/^\.$/$cwd/;
my $ii = 0;
s#\.\.[\\\/]([^./])#$cwd[$ii-- - 1]/$1#g;
if ($ii < 0) {
$_ = "$cwd[$ii]/$_" while $ii-- > 0 - @cwd;
print "*** ARGV: $_\n" if $debug;
}
}
print "$_\n";
list_dir (1, $_);
}
exit;
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub list_dir {
my $level = shift;
my $dir = shift;
local *DIR;
print "*** recurse: $dir\n" if $debug;
my $prefix = $indent x $level;
opendir DIR, $dir or die "opendir $dir: $!";
my @file_list = readdir DIR;
closedir DIR;
if (@file_list < 3) {
print "$prefix<Empty>\n" if $verbose;
return;
}
my @dirs;
my @files;
foreach my $file (sort @file_list) {
next if $file =~ /^\.{1,2}$/;
my $path = "$dir/$file";
if (-f $path) {
if ($dirs_first) {
push @files, $inc_path ? "$dir/$file" : $file;
} else {
printf "%s%s%s\n", $prefix, $file_prefix,
$inc_path ? "$dir/$file" : $file;
}
} elsif (-d $path) {
if ($dirs_last) {
push @dirs, $path;
} else {
printf "%s%s%s\n", $prefix, $dir_prefix, $path;
list_dir ($level+1, $path);
}
} else {
print $indent x $level, "Not file or dir '$path'\n";
}
}
if ($dirs_first) {
foreach (sort @files) {
printf "%s%s$_\n", $prefix, $file_prefix;
}
}
if ($dirs_last) {
foreach (sort @dirs) {
printf "%s%s%s\n", $prefix, $dir_prefix, $_;
list_dir ($level+1, $_);
}
}
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
__END__
--
,-/- __ _ _ $Bill Luebkert Mailto:[EMAIL PROTECTED]
(_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED]
/ ) /--< o // // Castle of Medieval Myth & Magic http://www.todbe.com/
-/-' /___/_<_</_</_ http://dbecoll.tripod.com/ (My Perl/Lakers stuff)
_______________________________________________
Perl-Win32-Admin mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
