ftw.pl+goodies (was Re: Looking for reaper skeleton)
Randal Schwartz
merlyn at iwarp.intel.com
Tue Sep 11 12:50:32 AEST 1990
In article <1990Sep10.230742.9600 at indetech.com>, david at indetech (David Kuder) writes:
| Or: Does anyone have a skeleton for a find equivalent written in Perl?
| I think I could do what I want from that.
Here's what I'm using to walk all the local disk on a system,
consisting of two parts... code that calls ftw.pl, and code that *is*
ftw.pl. This is tested (and in heavy use!) on SunOS4.1 and Ultrix
2.0, but may not properly recognize NFS mounts under other
environments. (Hack as needed.)
================================================== begin main
do '/local/merlyn/lib/perl/ftw.pl' || die 'ftw.pl: ' . ($@||$!);
sub eachfile {
local($_) = @_;
local(@s) = lstat($_);
return unless @s;
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = @s;
if (($ino == 2) && ($dev > 0) && ($dev < 16384)) {
## no NFS please!
# print "### $_ mount noted\n";
push(@ARGV,$_);
}
return if $seen{$ino}++;
## at this point, you are looking at a file with the
## stat structure set... do with as you will
}
@ARGV = "/";
while ($fs = shift) {
%seen = ();
%total = ();
&ftw($fs,"eachfile");
}
exit 0;
================================================== end main
================================================== begin ftw.pl
## ftw.pl rev 2.2
# &ftw("path","function-name")
# calls &function-name("path/file") for each name returned by the
# equivalent of "find path -xdev -print"
#
# to traverse all local disk, start with "/", and recall &ftw with
# any file that stats as ino==2, and dev between 0 and 16384
sub ftw {
local($path, $fn) = @_;
local(*CHILD);
local($preslash) = $/;
local($/);
local($_);
# flushing STDOUT:
local($preselect) = select(STDOUT);
local($prepipe) = $|;
$| = 1;
print "";
$| = $prepipe;
select($preselect);
# end flushing STDOUT
$CHILD = open(CHILD,'-|');
die "ftw: Cannot fork ($!)" unless defined $CHILD;
unless ($CHILD) { # I am the child
$| = 1; # don't buffer stdout
chdir $path || die "Cannot cd to $path ($!)";
&ftw'helper($path);
exit 0;
}
# I am the parent
$/ = "\000";
while (<CHILD>) {
chop;
{
local($/) = $preslash;
do $fn("".$_);
}
}
close(CHILD);
}
sub ftw'helper {
# expects to be cd'ed to $DIR
local(*DIR); ($DIR) = @_;
$DIR = "" if $DIR eq "/"; # no "//..."!
local($dev, $ino, $mode, $nlink) = stat('.');
local($_,$name);
opendir(DIR,'.') || die "Cannot open $DIR ($!)";
local(@filenames) = sort readdir(DIR);
closedir(DIR);
if ($nlink == 2) {
print grep(!/^\.\.?$/ && s#[^\000]+#$DIR/$&\000#, @filenames);
} else {
for (@filenames) {
next if /^\.\.?$/;
$name = "$DIR/$_";
print $name,"\000";
next unless ! -l $_ && -d _ && -r _ && -x _;
next if $dev != (stat(_))[$[+0]; # "-xdev"
unless (chdir $_) {
warn "Cannot chdir to $name ($!)";
next;
}
&ftw'helper($name);
chdir '..';
}
}
}
1;
================================================== end ftw.pl
print "Just another Perl [book] hacker,"
--
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III |
| merlyn at iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Welcome to Portland, Oregon, home of the California Raisins!"=/
More information about the Comp.unix.admin
mailing list