[comp.unix.admin] ftw.pl+goodies

merlyn@iwarp.intel.com (Randal Schwartz) (09/11/90)

In article <1990Sep10.230742.9600@indetech.com>, david@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@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Welcome to Portland, Oregon, home of the California Raisins!"=/