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!"=/