Find.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
use 5.005_64;
require Exporter;
require Cwd;
=head1 NAME
find - traverse a file tree
finddepth - traverse a directory structure depth-first
=head1 SYNOPSIS
use File::Find;
find(\&wanted, '/foo', '/bar');
sub wanted { ... }
use File::Find;
finddepth(\&wanted, '/foo', '/bar');
sub wanted { ... }
use File::Find;
find({ wanted => \&process, follow => 1 }, '.');
=head1 DESCRIPTION
The first argument to find() is either a hash reference describing the
operations to be performed for each file, or a code reference.
Here are the possible keys for the hash:
=over 3
=item C<wanted>
The value should be a code reference. This code reference is called
I<the wanted() function> below.
=item C<bydepth>
Reports the name of a directory only AFTER all its entries
have been reported. Entry point finddepth() is a shortcut for
specifying C<{ bydepth => 1 }> in the first argument of find().
=item C<preprocess>
The value should be a code reference. This code reference is used to
preprocess a directory; it is called after readdir() but before the loop that
calls the wanted() function. It is called with a list of strings and is
expected to return a list of strings. The code can be used to sort the
strings alphabetically, numerically, or to filter out directory entries based
on their name alone.
=item C<postprocess>
The value should be a code reference. It is invoked just before leaving the
current directory. It is called in void context with no arguments. The name
of the current directory is in $File::Find::dir. This hook is handy for
summarizing a directory, such as calculating its disk usage.
=item C<follow>
Causes symbolic links to be followed. Since directory trees with symbolic
links (followed) may contain files more than once and may even have
cycles, a hash has to be built up with an entry for each file.
This might be expensive both in space and time for a large
directory tree. See I<follow_fast> and I<follow_skip> below.
If either I<follow> or I<follow_fast> is in effect:
=over 6
=item *
It is guaranteed that an I<lstat> has been called before the user's
I<wanted()> function is called. This enables fast file checks involving S< _>.
=item *
There is a variable C<$File::Find::fullname> which holds the absolute
pathname of the file with all symbolic links resolved
=back
=item C<follow_fast>
This is similar to I<follow> except that it may report some files more
than once. It does detect cycles, however. Since only symbolic links
have to be hashed, this is much cheaper both in space and time. If
processing a file more than once (by the user's I<wanted()> function)
is worse than just taking time, the option I<follow> should be used.
=item C<follow_skip>
C<follow_skip==1>, which is the default, causes all files which are
neither directories nor symbolic links to be ignored if they are about
to be processed a second time. If a directory or a symbolic link
are about to be processed a second time, File::Find dies.
C<follow_skip==0> causes File::Find to die if any file is about to be
processed a second time.
C<follow_skip==2> causes File::Find to ignore any duplicate files and
dirctories but to proceed normally otherwise.
=item C<no_chdir>
Does not C<chdir()> to each directory as it recurses. The wanted()
function will need to be aware of this, of course. In this case,
C<$_> will be the same as C<$File::Find::name>.
=item C<untaint>
If find is used in taint-mode (-T command line switch or if EUID != UID
or if EGID != GID) then internally directory names have to be untainted
before they can be cd'ed to. Therefore they are checked against a regular
expression I<untaint_pattern>. Note that all names passed to the
user's I<wanted()> function are still tainted.
=item C<untaint_pattern>
See above. This should be set using the C<qr> quoting operator.
The default is set to C<qr|^([-+@\w./]+)$|>.
Note that the parantheses are vital.
=item C<untaint_skip>
If set, directories (subtrees) which fail the I<untaint_pattern>
are skipped. The default is to 'die' in such a case.
=back
The wanted() function does whatever verifications you want.
C<$File::Find::dir> contains the current directory name, and C<$_> the
current filename within that directory. C<$File::Find::name> contains
the complete pathname to the file. You are chdir()'d to
C<$File::Find::dir> when the function is called, unless C<no_chdir>
was specified. When <follow> or <follow_fast> are in effect, there is
also a C<$File::Find::fullname>. The function may set
C<$File::Find::prune> to prune the tree unless C<bydepth> was
specified. Unless C<follow> or C<follow_fast> is specified, for
compatibility reasons (find.pl, find2perl) there are in addition the
following globals available: C<$File::Find::topdir>,
C<$File::Find::topdev>, C<$File::Find::topino>,
C<$File::Find::topmode> and C<$File::Find::topnlink>.
This library is useful for the C<find2perl> tool, which when fed,
find2perl / -name .nfs\* -mtime +7 \
-exec rm -f {} \; -o -fstype nfs -prune
produces something like:
sub wanted {
/^\.nfs.*\z/s &&
(($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
int(-M _) > 7 &&
unlink($_)
||
($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
$dev < 0 &&
($File::Find::prune = 1);
}
Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
since AFS cheats.
Here's another interesting wanted function. It will find all symlinks
that don't resolve:
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
}
See also the script C<pfind> on CPAN for a nice application of this
module.
=head1 CAVEAT
Be aware that the option to follow symbolic links can be dangerous.
Depending on the structure of the directory tree (including symbolic
links to directories) you might traverse a given (physical) directory
more than once (only if C<follow_fast> is in effect).
Furthermore, deleting or changing files in a symbolically linked directory
might cause very unpleasant surprises, since you delete or change files
in an unknown directory.
=cut
use strict;
my $Is_VMS;
my %SLnkSeen;
$pre_process, $post_process);
sub contract_name {
$fn =~ s|^\./||;
do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|);
}
return $abs_name;
}
sub PathCombine($$) {
my $AbsName;
}
else {
}
# (simple) check for recursion
{
return undef;
}
}
return $AbsName;
}
sub Follow_SymLink($) {
my ($AbsName) = @_;
while (-l _) {
if ($follow_skip < 2) {
die "$AbsName is encountered a second time";
}
else {
return undef;
}
}
unless(defined $NewName) {
if ($follow_skip < 2) {
die "$AbsName is a recursive symbolic link";
}
else {
return undef;
}
}
else {
}
return undef unless defined $DEV; # dangling symbolic link
}
if ($follow_skip < 1) {
die "$AbsName encountered a second time";
}
else {
return undef;
}
}
return $AbsName;
}
sub _find_dir_symlnk($$$);
sub _find_dir($$$);
sub _find_opt {
my $wanted = shift;
die "invalid top directory" unless defined $_[0];
my $cwd_untainted = $cwd;
# for compatability reasons (find.pl, find2perl)
# a symbolic link to a directory doesn't increase the link count
if ( $untaint ) {
die "insecure cwd in find(depth)" unless defined($cwd_untainted);
}
foreach my $TOP (@_) {
$Is_Dir= 0;
if ($follow) {
}
elsif ($top_item eq '.') {
}
else { # care about any ../
}
unless (defined $abs_dir) {
warn "$top_item is a dangling symbolic link\n";
next Proc_Top_Item;
}
if (-d _) {
$Is_Dir= 1;
}
}
else { # no follow
unless (defined $topnlink) {
warn "Can't stat $top_item: $!\n";
next Proc_Top_Item;
}
if (-d _) {
$Is_Dir= 1;
}
else {
}
}
unless ($Is_Dir) {
}
if ($untaint) {
my $abs_dir_save = $abs_dir;
unless (defined $abs_dir) {
if ($untaint_skip == 0) {
die "directory $abs_dir_save is still tainted";
}
else {
next Proc_Top_Item;
}
}
}
warn "Couldn't chdir $abs_dir: $!\n";
next Proc_Top_Item;
}
{ &$wanted_callback }; # protect against wild "next"
}
$no_chdir or chdir $cwd_untainted;
}
}
# API:
# $wanted
# $p_dir : "parent directory"
# $nlink : what came back from the stat
# preconditions:
# chdir (if not no_chdir) to dir
sub _find_dir($$$) {
my @Stack;
my @filenames;
my $SE= [];
if ($untaint) {
unless (defined $udir) {
if ($untaint_skip == 0) {
die "directory $p_dir is still tainted";
}
else {
return;
}
}
}
unless (chdir $udir) {
warn "Can't cd to $udir: $!\n";
return;
}
}
while (defined $SE) {
unless ($bydepth) {
# prune may happen here
$prune= 0;
{ &$wanted_callback }; # protect against wild "next"
next if $prune;
}
# change to that directory
if ($untaint) {
unless (defined $udir) {
if ($untaint_skip == 0) {
die "directory ("
. "/) $dir_rel is still tainted";
}
}
}
unless (chdir $udir) {
warn "Can't cd to ("
. "/) $udir : $!\n";
next;
}
$CdLvl++;
}
# Get the list of files in the current directory.
warn "Can't opendir($dir_name): $!\n";
next;
}
closedir(DIR);
# This dir has no subdirectories.
{ &$wanted_callback }; # protect against wild "next"
}
}
else {
# This dir has subdirectories.
# Seen all the subdirs?
# check for directoriness.
# stat is faster for a file in the current directory
if (-d _) {
--$subcount;
}
else {
{ &$wanted_callback }; # protect against wild "next"
}
}
else {
{ &$wanted_callback }; # protect against wild "next"
}
}
}
}
continue {
die "Can't cd to $dir_name" . $tmp
unless chdir ($tmp);
}
$dir_pref = "$dir_name/";
if ( $nlink == -2 ) {
$_ = ".";
&$post_process; # End-of-directory processing
$name =~ s|/\.$||;
}
if ( substr($_,-2) eq '/.' ) {
s|/\.$||;
}
{ &$wanted_callback }; # protect against wild "next"
} else {
last;
}
}
}
}
# API:
# $wanted
# $dir_loc : absolute location of a dir
# $p_dir : "parent directory"
# preconditions:
# chdir (if not no_chdir) to dir
sub _find_dir_symlnk($$$) {
my @Stack;
my @filenames;
my $new_loc;
my $SE = [];
my $byd_flag; # flag for pending stack entry if $bydepth
if ($untaint) {
unless (defined $udir) {
if ($untaint_skip == 0) {
die "directory $dir_loc is still tainted";
}
else {
return;
}
}
}
unless (chdir $udir) {
warn "Can't cd to $udir: $!\n";
return;
}
}
while (defined $SE) {
unless ($bydepth) {
# change to parent directory
unless ($no_chdir) {
if ($untaint) {
}
unless (chdir $udir) {
warn "Can't cd to $udir: $!\n";
next;
}
}
# prune may happen here
$prune= 0;
lstat($_); # make sure file tests with '_' work
{ &$wanted_callback }; # protect against wild "next"
next if $prune;
}
# change to that directory
if ($untaint) {
unless (defined $udir ) {
if ($untaint_skip == 0) {
die "directory $dir_loc is still tainted";
}
else {
next;
}
}
}
unless (chdir $udir) {
warn "Can't cd to $udir: $!\n";
next;
}
}
# Get the list of files in the current directory.
warn "Can't opendir($dir_loc): $!\n";
next;
}
closedir(DIR);
# follow symbolic links / do an lstat
# ignore if invalid symlink
next unless defined $new_loc;
if (-d _) {
}
else {
{ &$wanted_callback }; # protect against wild "next"
}
}
}
continue {
$dir_pref = "$dir_name/";
$loc_pref = "$dir_loc/";
if ($untaint) {
}
unless (chdir $udir) {
warn "Can't cd to $udir: $!\n";
next;
}
}
$name =~ s|/\.$||;
}
if ( substr($_,-2) eq '/.' ) {
s|/\.$||;
}
lstat($_); # make sure file tests with '_' work
{ &$wanted_callback }; # protect against wild "next"
} else {
last;
}
}
}
}
sub wrap_wanted {
my $wanted = shift;
if ( ref($wanted) eq 'HASH' ) {
}
$wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|
unless defined $wanted->{untaint_pattern};
}
return $wanted;
}
else {
}
}
sub find {
my $wanted = shift;
%SLnkSeen= (); # free memory
}
sub finddepth {
my $wanted = wrap_wanted(shift);
%SLnkSeen= (); # free memory
}
# These are hard-coded for now, but may move to hint files.
if ($^O eq 'VMS') {
$Is_VMS = 1;
}
if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
$^O eq 'cygwin' || $^O eq 'epoc';
# Set dont_use_nlink in your hint file if your system's stat doesn't
# report the number of links in a directory as an indication
# of the number of files.
# See, e.g. hints/machten.sh for MachTen 2.2.
require Config;
}
1;