merlyn@iwarp.intel.com (Randal L. Schwartz) (02/22/91)
In article <1991Feb21.133315.25700@uvaarpa.Virginia.EDU>, frech@mwraaa (Norman R. Frech CPLS) writes: | Has anyone written a perl version of find? I have rewritten my backup | to tape routines in perl and use multiple finds to generate the | catalog. I have started working on the find subroutines and I thought | if someone already has this code I could save some time and effort. I'm using ftw.pl from below every day, and beta-testing ftw2.pl. I'd recommend ftw2.pl if it works, but can't vouch for its robustness yet. By the way, I'm definitely interested in bug reports. I might get ftw2 into 4.0 (nudging Larry) if I get on it fast enough. :-) #! /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 ftw2.pl # Wrapped by merlyn@iwarpse on Thu Feb 21 09:43:04 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'\" \(2183 characters\) sed "s/^X//" >'ftw.pl' <<'END_OF_FILE' X## ftw.pl rev 3.0 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 ftw { X local($path, $fn) = @_; X local(*CHILD); X local($preslash) = $/; X local($/); X local($_); X # flushing STDOUT: X local($preselect) = select(STDOUT); X local($prepipe) = $|; X $| = 1; X print ""; X $| = $prepipe; X select($preselect); X # end flushing STDOUT X $CHILD = open(CHILD,'-|'); X die "ftw: Cannot fork ($!)" unless defined $CHILD; X unless ($CHILD) { # I am the child X $| = 1; # don't buffer stdout X chdir $path || die "Cannot cd to $path ($!)"; X &ftw'helper($path); X exit 0; X } X # I am the parent X $/ = "\000"; X while (<CHILD>) { X chop; X { X local($/) = $preslash; X do $fn("".$_); X } X } X close(CHILD); X} X Xsub ftw'helper { X # expects to be cd'ed to $DIR X local(*DIR); ($DIR) = @_; X $DIR = "" if $DIR eq "/"; # no "//..."! X local($dev, $ino, $mode, $nlink) = stat('.'); X local($_,$name); X X opendir(DIR,'.') || die "Cannot open $DIR ($!)"; X local(@filenames) = sort readdir(DIR); X closedir(DIR); X X if ($nlink == 2) { X print grep(!/^\.\.?$/ && s#[^\000]+#$DIR/$&\000#, @filenames); X } else { X for (@filenames) { X next if /^\.\.?$/; X $name = "$DIR/$_"; X print $name,"\000"; X next unless ! -l $_ && -d _ && -r _ && -x _; X next if $dev != (stat(_))[$[+0]; # "-xdev" X unless (chdir $_) { X warn "Cannot chdir to $name ($!)"; X next; X } X &ftw'helper($name); X chdir '..'; X } X } X} 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 ftw_root { X local($ftw_root'fn) = @_; X local(@ftw_root'devlist) = ('/'); X local($_); X while ($_ = shift @ftw_root'devlist) { X &ftw($_,"ftw_root'helper"); X } X} X Xsub ftw_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(@ftw_root'devlist,$file); X } X do $ftw_root'fn("".$file); X} X X1; END_OF_FILE if test 2183 -ne `wc -c <'ftw.pl'`; then echo shar: \"'ftw.pl'\" unpacked with wrong size! fi # end of 'ftw.pl' fi if test -f 'ftw2.pl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ftw2.pl'\" else echo shar: Extracting \"'ftw2.pl'\" \(1590 characters\) sed "s/^X//" >'ftw2.pl' <<'END_OF_FILE' X## ftw.pl rev 4.0alpha 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 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 local($devlist) = ('/'); X local($_); X while ($_ = shift @devlist) { X &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 1590 -ne `wc -c <'ftw2.pl'`; then echo shar: \"'ftw2.pl'\" unpacked with wrong size! fi # end of 'ftw2.pl' fi echo shar: End of shell archive. exit 0 print "Just another Perl hacker," # OK, so I'm unimaginative. :-) -- /=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'..."====/
allbery@NCoast.ORG (Brandon S. Allbery KB8JRR) (02/26/91)
As quoted from <1991Feb21.174657.3357@iwarp.intel.com> by merlyn@iwarp.intel.com (Randal L. Schwartz): +--------------- | In article <1991Feb21.133315.25700@uvaarpa.Virginia.EDU>, frech@mwraaa (Norman R. Frech CPLS) writes: | | Has anyone written a perl version of find? I have rewritten my backup | | to tape routines in perl and use multiple finds to generate the | | catalog. I have started working on the find subroutines and I thought | | if someone already has this code I could save some time and effort. | | I'm using ftw.pl from below every day, and beta-testing ftw2.pl. I'd | recommend ftw2.pl if it works, but can't vouch for its robustness yet. +--------------- Since the "find" on the machine at work is broken, I ended up reimplementing most of find in Perl. In fact, scratch the "most"; while I haven't finished debugging it yet, it at least attempts to support almost everything I've seen in any find --- and then some. "find.pl . -type f -eval 'chmod 644, $_'", anyone? And -mount/-xdev, -print0/-glob (the latter for csh weenies :-), -tar (after all, System V find has -cpio, may as well have equal time), -local, -nosym, -prune, etc. (Yeah, this is the one that caused me to develop that *-hack for lists of lists. Have you ever given any thought to how find has to do its thing? Especially in the presence of -o and !? I ended up parsing the arguments into a list of predicate lists, then recursively running a predicate evaluator on each file and directory found.) I will try to make an effort to get this, archive.pl/buffer.pl, and terminfo.pl over to ncoast for posting tomorrow. However, only terminfo.pl has been fully debugged (although archive.pl and buffer.pl are pretty close to being certified). In particular, find.pl hasn't had all that much testing done to it and it may be some time before I would consider it clean. I may well decide to hold on to find.pl until I have it done. BTW, what say you folks to -require? It would cause a specified file to be loaded immediately, for use in -eval. One could then define a complex routine to determine what to do to a file, -require it, and then -eval it. ++Brandon -- Me: Brandon S. Allbery VHF/UHF: KB8JRR on 220, 2m, 440 Internet: allbery@NCoast.ORG Packet: KB8JRR @ WA8BXN America OnLine: KB8JRR AMPR: KB8JRR.AmPR.ORG [44.70.4.88] uunet!usenet.ins.cwru.edu!ncoast!allbery Delphi: ALLBERY
lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (02/27/91)
In article <1991Feb26.011953.3017@NCoast.ORG> allbery@ncoast.ORG (Brandon S. Allbery KB8JRR) writes:
: (Yeah, this is the one that caused me to develop that *-hack for lists of
: lists. Have you ever given any thought to how find has to do its thing?
: Especially in the presence of -o and !? I ended up parsing the arguments into
: a list of predicate lists, then recursively running a predicate evaluator on
: each file and directory found.)
Why not just translate it to a Perl subroutine and eval that? Recursion,
(), &&, || and ! available for free.
Larrytchrist@convex.COM (Tom Christiansen) (02/27/91)
From the keyboard of lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall): :Why not just translate it to a Perl subroutine and eval that? Recursion, :(), &&, || and ! available for free. Laziness strikes again. :-) --tom -- "UNIX was not designed to stop you from doing stupid things, because that would also stop you from doing clever things." -- Doug Gwyn Tom Christiansen tchrist@convex.com convex!tchrist
allbery@NCoast.ORG (Brandon S. Allbery KB8JRR) (03/02/91)
As quoted from <11596@jpl-devvax.JPL.NASA.GOV> by lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall): +--------------- | In article <1991Feb26.011953.3017@NCoast.ORG> allbery@ncoast.ORG (Brandon S. Allbery KB8JRR) writes: | : Especially in the presence of -o and !? I ended up parsing the arguments into | : a list of predicate lists, then recursively running a predicate evaluator on | : each file and directory found.) | | Why not just translate it to a Perl subroutine and eval that? Recursion, | (), &&, || and ! available for free. +--------------- Doable, but I was in need of a fast solution and the predicate list was actually faster for me to put together. Besides, I can trap a fatal error in one clause, treat it as a fail, and continue. Partial failure is better than complete failure. (The primary case of a fatal error is one of the clauses I added: -eval.) ++Brandon -- Me: Brandon S. Allbery VHF/UHF: KB8JRR on 220, 2m, 440 Internet: allbery@NCoast.ORG Packet: KB8JRR @ WA8BXN America OnLine: KB8JRR AMPR: KB8JRR.AmPR.ORG [44.70.4.88] uunet!usenet.ins.cwru.edu!ncoast!allbery Delphi: ALLBERY