merlyn@iwarp.intel.com (Randal L. Schwartz) (03/02/91)
ftw_root in ftw2.pl was totally bogus, and ftw's beginning at "/" had
a double "/" (like the old V7 find :-). Anyway, I smashed both of
those down, and came up with this. This is ftw2.pl, but I'm dropping
support for the old "second-process" version. This one appears to run
faster, but if you get some timing numbers, let me know.
What I need now is an agreement on a code or method that
"function-name" can do so that you get the equivalent of "-prune" in
find. I'm still thinking about that one. (Maybe a "die" with a
null-string arg? Or "prune" as an arg? Suggestions invited.)
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: ftw.pl
# Wrapped by merlyn@iwarpse on Fri Mar 1 14:28:35 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ftw.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ftw.pl'\"
else
echo shar: Extracting \"'ftw.pl'\" \(1684 characters\)
sed "s/^X//" >'ftw.pl' <<'END_OF_FILE'
X## ftw.pl rev 4.0
X
Xpackage ftw;
X
X# &ftw("path","function-name")
X# calls &function-name("path/file") for each name returned by the
X# equivalent of "find path -xdev -print"
X
Xsub main'ftw {
X local($path, $fn) = @_;
X
X $fn =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
X if (-d $path) {
X &helper($path);
X } elsif (-e $path) {
X do $fn("$path");
X }
X}
X
Xsub helper {
X local($path) = @_;
X
X local($dev, $ino, $mode, $nlink) = stat($path);
X local($_,*DIR);
X opendir(DIR,$path) || die "Cannot open $DIR ($!)";
X local(@filenames) = sort grep(!/^\.\.?$/, readdir(DIR));
X closedir(DIR);
X $path = "" if $path eq "/"; # don't double the /!
X
X if ($nlink == 2) {
X for (@filenames) {
X do $fn("$path/$_");
X }
X } else {
X for (@filenames) {
X $_ = "$path/$_";
X do $fn("$_"); # cannot pass $_ as lvalue
X next unless ! -l $_ && -d _ && -r _ && -x _;
X next if $dev != (stat(_))[$[+0]; # "-xdev"
X &helper("$_"); # recurse if directory
X }
X }
X}
X
Xpackage ftw_root;
X
X# &ftw_root("function-name")
X# calls &function-name("/file",stat("/file")) for each name
X# returned by the equivalent of "find / -fstype nfs -prune -o -print"
X# note that stat buffer _ is correct during the call (unlike &ftw() above)
X
Xsub main'ftw_root {
X local($fn) = @_;
X $fn =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
X local(@devlist) = ('/');
X local($_);
X while ($_ = shift @devlist) {
X &main'ftw($_,"root_helper");
X }
X}
X
Xsub root_helper {
X local($file) = @_;
X local(@s) = lstat($file);
X return unless @s;
X local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
X $atime,$mtime,$ctime,$blksize,$blocks) = @s;
X if (($ino == 2) && ($dev > 0) && ($dev < 16384)) {
X push(@devlist,$file);
X }
X do $fn("$file"); # don't pass $file as an lvalue
X}
X
X1;
END_OF_FILE
if test 1684 -ne `wc -c <'ftw.pl'`; then
echo shar: \"'ftw.pl'\" unpacked with wrong size!
fi
# end of 'ftw.pl'
fi
echo shar: End of shell archive.
exit 0
print "Just another Perl hacker,"
--
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III |
| merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Intel: putting the 'backward' in 'backward compatible'..."====/