summaryrefslogtreecommitdiff
path: root/lib/File
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2013-07-03 11:11:06 +0200
committerNicholas Clark <nick@ccl4.org>2013-07-05 20:26:26 +0200
commit6de85bb45a5ea25528026a26cac854ee4dcdcd45 (patch)
tree417070253c406257fa2f8fbe7b4166f1064f956f /lib/File
parente12eeff833d221009aa2e2a6d745f2c1812f2f77 (diff)
downloadperl-6de85bb45a5ea25528026a26cac854ee4dcdcd45.tar.gz
Move File::Find from lib/ to ext/
Diffstat (limited to 'lib/File')
-rw-r--r--lib/File/Find.pm1127
-rw-r--r--lib/File/Find/t/find.t977
-rw-r--r--lib/File/Find/t/taint.t371
3 files changed, 0 insertions, 2475 deletions
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
deleted file mode 100644
index 99b868ebda..0000000000
--- a/lib/File/Find.pm
+++ /dev/null
@@ -1,1127 +0,0 @@
-package File::Find;
-use 5.006;
-use strict;
-use warnings;
-use warnings::register;
-our $VERSION = '1.24';
-require Exporter;
-require Cwd;
-
-#
-# Modified to ensure sub-directory traversal order is not inverted by stack
-# push and pops. That is remains in the same order as in the directory file,
-# or user pre-processing (EG:sorted).
-#
-
-=head1 NAME
-
-File::Find - Traverse a directory tree.
-
-=head1 SYNOPSIS
-
- use File::Find;
- find(\&wanted, @directories_to_search);
- sub wanted { ... }
-
- use File::Find;
- finddepth(\&wanted, @directories_to_search);
- sub wanted { ... }
-
- use File::Find;
- find({ wanted => \&process, follow => 1 }, '.');
-
-=head1 DESCRIPTION
-
-These are functions for searching through directory trees doing work
-on each file found similar to the Unix I<find> command. File::Find
-exports two functions, C<find> and C<finddepth>. They work similarly
-but have subtle differences.
-
-=over 4
-
-=item B<find>
-
- find(\&wanted, @directories);
- find(\%options, @directories);
-
-C<find()> does a depth-first search over the given C<@directories> in
-the order they are given. For each file or directory found, it calls
-the C<&wanted> subroutine. (See below for details on how to use the
-C<&wanted> function). Additionally, for each directory found, it will
-C<chdir()> into that directory and continue the search, invoking the
-C<&wanted> function on each file or subdirectory in the directory.
-
-=item B<finddepth>
-
- finddepth(\&wanted, @directories);
- finddepth(\%options, @directories);
-
-C<finddepth()> works just like C<find()> except that it invokes the
-C<&wanted> function for a directory I<after> invoking it for the
-directory's contents. It does a postorder traversal instead of a
-preorder traversal, working from the bottom of the directory tree up
-where C<find()> works from the top of the tree down.
-
-=back
-
-=head2 %options
-
-The first argument to C<find()> is either a code reference to your
-C<&wanted> function, or a hash reference describing the operations
-to be performed for each file. The
-code reference is described in L<The wanted function> below.
-
-Here are the possible keys for the hash:
-
-=over 3
-
-=item C<wanted>
-
-The value should be a code reference. This code reference is
-described in L<The wanted function> below. The C<&wanted> subroutine is
-mandatory.
-
-=item C<bydepth>
-
-Reports the name of a directory only AFTER all its entries
-have been reported. Entry point C<finddepth()> is a shortcut for
-specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
-
-=item C<preprocess>
-
-The value should be a code reference. This code reference is used to
-preprocess the current directory. The name of the currently processed
-directory is in C<$File::Find::dir>. Your preprocessing function is
-called after C<readdir()>, but before the loop that calls the C<wanted()>
-function. It is called with a list of strings (actually file/directory
-names) and is expected to return a list of strings. The code can be
-used to sort the file/directory names alphabetically, numerically,
-or to filter out directory entries based on their name alone. When
-I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
-
-=item C<postprocess>
-
-The value should be a code reference. It is invoked just before leaving
-the currently processed directory. It is called in void context with no
-arguments. The name of the current directory is in C<$File::Find::dir>. This
-hook is handy for summarizing a directory, such as calculating its disk
-usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
-no-op.
-
-=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 L</follow_fast> and L</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
-C<wanted()> function is called. This enables fast file checks involving S<_>.
-Note that this guarantee no longer holds if I<follow> or I<follow_fast>
-are not set.
-
-=item *
-
-There is a variable C<$File::Find::fullname> which holds the absolute
-pathname of the file with all symbolic links resolved. If the link is
-a dangling symbolic link, then fullname will be set to C<undef>.
-
-=back
-
-This is a no-op on Win32.
-
-=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 C<wanted()> function)
-is worse than just taking time, the option I<follow> should be used.
-
-This is also a no-op on Win32.
-
-=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
-directories but to proceed normally otherwise.
-
-=item C<dangling_symlinks>
-
-If true and a code reference, will be called with the symbolic link
-name and the directory it lives in as arguments. Otherwise, if true
-and warnings are on, warning "symbolic_link_name is a dangling
-symbolic link\n" will be issued. If false, the dangling symbolic link
-will be silently ignored.
-
-=item C<no_chdir>
-
-Does not C<chdir()> to each directory as it recurses. The C<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 chdir'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. If this option is used while
-not in taint-mode, C<untaint> is a no-op.
-
-=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 parentheses are vital.
-
-=item C<untaint_skip>
-
-If set, a directory which fails the I<untaint_pattern> is skipped,
-including all its sub-directories. The default is to 'die' in such a case.
-
-=back
-
-=head2 The wanted function
-
-The C<wanted()> function does whatever verifications you want on
-each file and directory. Note that despite its name, the C<wanted()>
-function is a generic callback function, and does B<not> tell
-File::Find if a file is "wanted" or not. In fact, its return value
-is ignored.
-
-The wanted function takes no arguments but rather does its work
-through a collection of variables.
-
-=over 4
-
-=item C<$File::Find::dir> is the current directory name,
-
-=item C<$_> is the current filename within that directory
-
-=item C<$File::Find::name> is the complete pathname to the file.
-
-=back
-
-The above variables have all been localized and may be changed without
-affecting data outside of the wanted function.
-
-For example, when examining the file F</some/path/foo.ext> you will have:
-
- $File::Find::dir = /some/path/
- $_ = foo.ext
- $File::Find::name = /some/path/foo.ext
-
-You are chdir()'d to C<$File::Find::dir> when the function is called,
-unless C<no_chdir> was specified. Note that when changing to
-directories is in effect the root directory (F</>) is a somewhat
-special case inasmuch as the concatenation of C<$File::Find::dir>,
-C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
-table below summarizes all variants:
-
- $File::Find::name $File::Find::dir $_
- default / / .
- no_chdir=>0 /etc / etc
- /etc/x /etc x
-
- no_chdir=>1 / / /
- /etc / /etc
- /etc/x /etc /etc/x
-
-
-When C<follow> or C<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);
- }
-
-Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
-filehandle that caches the information from the preceding
-C<stat()>, C<lstat()>, or filetest.
-
-Here's another interesting wanted function. It will find all symbolic
-links that don't resolve:
-
- sub wanted {
- -l && !-e && print "bogus link: $File::Find::name\n";
- }
-
-Note that you may mix directories and (non-directory) files in the list of
-directories to be searched by the C<wanted()> function.
-
- find(\&wanted, "./foo", "./bar", "./baz/epsilon");
-
-In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
-evaluated by C<wanted()>.
-
-See also the script C<pfind> on CPAN for a nice application of this
-module.
-
-=head1 WARNINGS
-
-If you run your program with the C<-w> switch, or if you use the
-C<warnings> pragma, File::Find will report warnings for several weird
-situations. You can disable these warnings by putting the statement
-
- no warnings 'File::Find';
-
-in the appropriate scope. See L<perllexwarn> for more info about lexical
-warnings.
-
-=head1 CAVEAT
-
-=over 2
-
-=item $dont_use_nlink
-
-You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
-force File::Find to always stat directories. This was used for file systems
-that do not have an C<nlink> count matching the number of sub-directories.
-Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
-system) and a couple of others.
-
-You shouldn't need to set this variable, since File::Find should now detect
-such file systems on-the-fly and switch itself to using stat. This works even
-for parts of your file system, like a mounted CD-ROM.
-
-If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
-
-=item symlinks
-
-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.
-
-=back
-
-=head1 BUGS AND CAVEATS
-
-Despite the name of the C<finddepth()> function, both C<find()> and
-C<finddepth()> perform a depth-first search of the directory
-hierarchy.
-
-=head1 HISTORY
-
-File::Find used to produce incorrect results if called recursively.
-During the development of perl 5.8 this bug was fixed.
-The first fixed version of File::Find was 1.01.
-
-=head1 SEE ALSO
-
-find, find2perl.
-
-=cut
-
-our @ISA = qw(Exporter);
-our @EXPORT = qw(find finddepth);
-
-
-use strict;
-my $Is_VMS;
-my $Is_Win32;
-
-require File::Basename;
-require File::Spec;
-
-# Should ideally be my() not our() but local() currently
-# refuses to operate on lexicals
-
-our %SLnkSeen;
-our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
- $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
- $pre_process, $post_process, $dangling_symlinks);
-
-sub contract_name {
- my ($cdir,$fn) = @_;
-
- return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
-
- $cdir = substr($cdir,0,rindex($cdir,'/')+1);
-
- $fn =~ s|^\./||;
-
- my $abs_name= $cdir . $fn;
-
- if (substr($fn,0,3) eq '../') {
- 1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
- }
-
- return $abs_name;
-}
-
-sub PathCombine($$) {
- my ($Base,$Name) = @_;
- my $AbsName;
-
- if (substr($Name,0,1) eq '/') {
- $AbsName= $Name;
- }
- else {
- $AbsName= contract_name($Base,$Name);
- }
-
- # (simple) check for recursion
- my $newlen= length($AbsName);
- if ($newlen <= length($Base)) {
- if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
- && $AbsName eq substr($Base,0,$newlen))
- {
- return undef;
- }
- }
- return $AbsName;
-}
-
-sub Follow_SymLink($) {
- my ($AbsName) = @_;
-
- my ($NewName,$DEV, $INO);
- ($DEV, $INO)= lstat $AbsName;
-
- while (-l _) {
- if ($SLnkSeen{$DEV, $INO}++) {
- if ($follow_skip < 2) {
- die "$AbsName is encountered a second time";
- }
- else {
- return undef;
- }
- }
- $NewName= PathCombine($AbsName, readlink($AbsName));
- unless(defined $NewName) {
- if ($follow_skip < 2) {
- die "$AbsName is a recursive symbolic link";
- }
- else {
- return undef;
- }
- }
- else {
- $AbsName= $NewName;
- }
- ($DEV, $INO) = lstat($AbsName);
- return undef unless defined $DEV; # dangling symbolic link
- }
-
- if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
- if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
- die "$AbsName encountered a second time";
- }
- else {
- return undef;
- }
- }
-
- return $AbsName;
-}
-
-our($dir, $name, $fullname, $prune);
-sub _find_dir_symlnk($$$);
-sub _find_dir($$$);
-
-# check whether or not a scalar variable is tainted
-# (code straight from the Camel, 3rd ed., page 561)
-sub is_tainted_pp {
- my $arg = shift;
- my $nada = substr($arg, 0, 0); # zero-length
- local $@;
- eval { eval "# $nada" };
- return length($@) != 0;
-}
-
-sub _find_opt {
- my $wanted = shift;
- die "invalid top directory" unless defined $_[0];
-
- # This function must local()ize everything because callbacks may
- # call find() or finddepth()
-
- local %SLnkSeen;
- local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
- $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
- $pre_process, $post_process, $dangling_symlinks);
- local($dir, $name, $fullname, $prune);
- local *_ = \my $a;
-
- my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
- if ($Is_VMS) {
- # VMS returns this by default in VMS format which just doesn't
- # work for the rest of this module.
- $cwd = VMS::Filespec::unixpath($cwd);
-
- # Apparently this is not expected to have a trailing space.
- # To attempt to make VMS/UNIX conversions mostly reversible,
- # a trailing slash is needed. The run-time functions ignore the
- # resulting double slash, but it causes the perl tests to fail.
- $cwd =~ s#/\z##;
-
- # This comes up in upper case now, but should be lower.
- # In the future this could be exact case, no need to change.
- }
- my $cwd_untainted = $cwd;
- my $check_t_cwd = 1;
- $wanted_callback = $wanted->{wanted};
- $bydepth = $wanted->{bydepth};
- $pre_process = $wanted->{preprocess};
- $post_process = $wanted->{postprocess};
- $no_chdir = $wanted->{no_chdir};
- $full_check = $Is_Win32 ? 0 : $wanted->{follow};
- $follow = $Is_Win32 ? 0 :
- $full_check || $wanted->{follow_fast};
- $follow_skip = $wanted->{follow_skip};
- $untaint = $wanted->{untaint};
- $untaint_pat = $wanted->{untaint_pattern};
- $untaint_skip = $wanted->{untaint_skip};
- $dangling_symlinks = $wanted->{dangling_symlinks};
-
- # for compatibility reasons (find.pl, find2perl)
- local our ($topdir, $topdev, $topino, $topmode, $topnlink);
-
- # a symbolic link to a directory doesn't increase the link count
- $avoid_nlink = $follow || $File::Find::dont_use_nlink;
-
- my ($abs_dir, $Is_Dir);
-
- Proc_Top_Item:
- foreach my $TOP (@_) {
- my $top_item = $TOP;
- $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
-
- ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
-
- if ($Is_Win32) {
- $top_item =~ s|[/\\]\z||
- unless $top_item =~ m{^(?:\w:)?[/\\]$};
- }
- else {
- $top_item =~ s|/\z|| unless $top_item eq '/';
- }
-
- $Is_Dir= 0;
-
- if ($follow) {
-
- if (substr($top_item,0,1) eq '/') {
- $abs_dir = $top_item;
- }
- elsif ($top_item eq $File::Find::current_dir) {
- $abs_dir = $cwd;
- }
- else { # care about any ../
- $top_item =~ s/\.dir\z//i if $Is_VMS;
- $abs_dir = contract_name("$cwd/",$top_item);
- }
- $abs_dir= Follow_SymLink($abs_dir);
- unless (defined $abs_dir) {
- if ($dangling_symlinks) {
- if (ref $dangling_symlinks eq 'CODE') {
- $dangling_symlinks->($top_item, $cwd);
- } else {
- warnings::warnif "$top_item is a dangling symbolic link\n";
- }
- }
- next Proc_Top_Item;
- }
-
- if (-d _) {
- $top_item =~ s/\.dir\z//i if $Is_VMS;
- _find_dir_symlnk($wanted, $abs_dir, $top_item);
- $Is_Dir= 1;
- }
- }
- else { # no follow
- $topdir = $top_item;
- unless (defined $topnlink) {
- warnings::warnif "Can't stat $top_item: $!\n";
- next Proc_Top_Item;
- }
- if (-d _) {
- $top_item =~ s/\.dir\z//i if $Is_VMS;
- _find_dir($wanted, $top_item, $topnlink);
- $Is_Dir= 1;
- }
- else {
- $abs_dir= $top_item;
- }
- }
-
- unless ($Is_Dir) {
- unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
- ($dir,$_) = ('./', $top_item);
- }
-
- $abs_dir = $dir;
- if (( $untaint ) && (is_tainted($dir) )) {
- ( $abs_dir ) = $dir =~ m|$untaint_pat|;
- unless (defined $abs_dir) {
- if ($untaint_skip == 0) {
- die "directory $dir is still tainted";
- }
- else {
- next Proc_Top_Item;
- }
- }
- }
-
- unless ($no_chdir || chdir $abs_dir) {
- warnings::warnif "Couldn't chdir $abs_dir: $!\n";
- next Proc_Top_Item;
- }
-
- $name = $abs_dir . $_; # $File::Find::name
- $_ = $name if $no_chdir;
-
- { $wanted_callback->() }; # protect against wild "next"
-
- }
-
- unless ( $no_chdir ) {
- if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
- ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
- unless (defined $cwd_untainted) {
- die "insecure cwd in find(depth)";
- }
- $check_t_cwd = 0;
- }
- unless (chdir $cwd_untainted) {
- die "Can't cd to $cwd: $!\n";
- }
- }
- }
-}
-
-# 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 ($wanted, $p_dir, $nlink) = @_;
- my ($CdLvl,$Level) = (0,0);
- my @Stack;
- my @filenames;
- my ($subcount,$sub_nlink);
- my $SE= [];
- my $dir_name= $p_dir;
- my $dir_pref;
- my $dir_rel = $File::Find::current_dir;
- my $tainted = 0;
- my $no_nlink;
-
- if ($Is_Win32) {
- $dir_pref
- = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
- } elsif ($Is_VMS) {
-
- # VMS is returning trailing .dir on directories
- # and trailing . on files and symbolic links
- # in UNIX syntax.
- #
-
- $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
-
- $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
- }
- else {
- $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
- }
-
- local ($dir, $name, $prune, *DIR);
-
- unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
- my $udir = $p_dir;
- if (( $untaint ) && (is_tainted($p_dir) )) {
- ( $udir ) = $p_dir =~ m|$untaint_pat|;
- unless (defined $udir) {
- if ($untaint_skip == 0) {
- die "directory $p_dir is still tainted";
- }
- else {
- return;
- }
- }
- }
- unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
- warnings::warnif "Can't cd to $udir: $!\n";
- return;
- }
- }
-
- # push the starting directory
- push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
-
- while (defined $SE) {
- unless ($bydepth) {
- $dir= $p_dir; # $File::Find::dir
- $name= $dir_name; # $File::Find::name
- $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
- # prune may happen here
- $prune= 0;
- { $wanted_callback->() }; # protect against wild "next"
- next if $prune;
- }
-
- # change to that directory
- unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
- my $udir= $dir_rel;
- if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
- ( $udir ) = $dir_rel =~ m|$untaint_pat|;
- unless (defined $udir) {
- if ($untaint_skip == 0) {
- die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
- } else { # $untaint_skip == 1
- next;
- }
- }
- }
- unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
- warnings::warnif "Can't cd to (" .
- ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
- next;
- }
- $CdLvl++;
- }
-
- $dir= $dir_name; # $File::Find::dir
-
- # Get the list of files in the current directory.
- unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
- warnings::warnif "Can't opendir($dir_name): $!\n";
- next;
- }
- @filenames = readdir DIR;
- closedir(DIR);
- @filenames = $pre_process->(@filenames) if $pre_process;
- push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
-
- # default: use whatever was specified
- # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
- $no_nlink = $avoid_nlink;
- # if dir has wrong nlink count, force switch to slower stat method
- $no_nlink = 1 if ($nlink < 2);
-
- if ($nlink == 2 && !$no_nlink) {
- # This dir has no subdirectories.
- for my $FN (@filenames) {
- if ($Is_VMS) {
- # Big hammer here - Compensate for VMS trailing . and .dir
- # No win situation until this is changed, but this
- # will handle the majority of the cases with breaking the fewest
-
- $FN =~ s/\.dir\z//i;
- $FN =~ s#\.$## if ($FN ne '.');
- }
- next if $FN =~ $File::Find::skip_pattern;
-
- $name = $dir_pref . $FN; # $File::Find::name
- $_ = ($no_chdir ? $name : $FN); # $_
- { $wanted_callback->() }; # protect against wild "next"
- }
-
- }
- else {
- # This dir has subdirectories.
- $subcount = $nlink - 2;
-
- # HACK: insert directories at this position. so as to preserve
- # the user pre-processed ordering of files.
- # EG: directory traversal is in user sorted order, not at random.
- my $stack_top = @Stack;
-
- for my $FN (@filenames) {
- next if $FN =~ $File::Find::skip_pattern;
- if ($subcount > 0 || $no_nlink) {
- # Seen all the subdirs?
- # check for directoriness.
- # stat is faster for a file in the current directory
- $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
-
- if (-d _) {
- --$subcount;
- $FN =~ s/\.dir\z//i if $Is_VMS;
- # HACK: replace push to preserve dir traversal order
- #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
- splice @Stack, $stack_top, 0,
- [$CdLvl,$dir_name,$FN,$sub_nlink];
- }
- else {
- $name = $dir_pref . $FN; # $File::Find::name
- $_= ($no_chdir ? $name : $FN); # $_
- { $wanted_callback->() }; # protect against wild "next"
- }
- }
- else {
- $name = $dir_pref . $FN; # $File::Find::name
- $_= ($no_chdir ? $name : $FN); # $_
- { $wanted_callback->() }; # protect against wild "next"
- }
- }
- }
- }
- continue {
- while ( defined ($SE = pop @Stack) ) {
- ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
- if ($CdLvl > $Level && !$no_chdir) {
- my $tmp;
- if ($Is_VMS) {
- $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
- }
- else {
- $tmp = join('/',('..') x ($CdLvl-$Level));
- }
- die "Can't cd to $tmp from $dir_name"
- unless chdir ($tmp);
- $CdLvl = $Level;
- }
-
- if ($Is_Win32) {
- $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
- ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
- $dir_pref = "$dir_name/";
- }
- elsif ($^O eq 'VMS') {
- if ($p_dir =~ m/[\]>]+$/) {
- $dir_name = $p_dir;
- $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
- $dir_pref = $dir_name;
- }
- else {
- $dir_name = "$p_dir/$dir_rel";
- $dir_pref = "$dir_name/";
- }
- }
- else {
- $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
- $dir_pref = "$dir_name/";
- }
-
- if ( $nlink == -2 ) {
- $name = $dir = $p_dir; # $File::Find::name / dir
- $_ = $File::Find::current_dir;
- $post_process->(); # End-of-directory processing
- }
- elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
- $name = $dir_name;
- if ( substr($name,-2) eq '/.' ) {
- substr($name, length($name) == 2 ? -1 : -2) = '';
- }
- $dir = $p_dir;
- $_ = ($no_chdir ? $dir_name : $dir_rel );
- if ( substr($_,-2) eq '/.' ) {
- substr($_, length($_) == 2 ? -1 : -2) = '';
- }
- { $wanted_callback->() }; # protect against wild "next"
- }
- else {
- push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
- 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 ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
- my @Stack;
- my @filenames;
- my $new_loc;
- my $updir_loc = $dir_loc; # untainted parent directory
- my $SE = [];
- my $dir_name = $p_dir;
- my $dir_pref;
- my $loc_pref;
- my $dir_rel = $File::Find::current_dir;
- my $byd_flag; # flag for pending stack entry if $bydepth
- my $tainted = 0;
- my $ok = 1;
-
- $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
- $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
-
- local ($dir, $name, $fullname, $prune, *DIR);
-
- unless ($no_chdir) {
- # untaint the topdir
- if (( $untaint ) && (is_tainted($dir_loc) )) {
- ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
- # once untainted, $updir_loc is pushed on the stack (as parent directory);
- # hence, we don't need to untaint the parent directory every time we chdir
- # to it later
- unless (defined $updir_loc) {
- if ($untaint_skip == 0) {
- die "directory $dir_loc is still tainted";
- }
- else {
- return;
- }
- }
- }
- $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
- unless ($ok) {
- warnings::warnif "Can't cd to $updir_loc: $!\n";
- return;
- }
- }
-
- push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
-
- while (defined $SE) {
-
- unless ($bydepth) {
- # change (back) to parent directory (always untainted)
- unless ($no_chdir) {
- unless (chdir $updir_loc) {
- warnings::warnif "Can't cd to $updir_loc: $!\n";
- next;
- }
- }
- $dir= $p_dir; # $File::Find::dir
- $name= $dir_name; # $File::Find::name
- $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
- $fullname= $dir_loc; # $File::Find::fullname
- # 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
- unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
- $updir_loc = $dir_loc;
- if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
- # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
- ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
- unless (defined $updir_loc) {
- if ($untaint_skip == 0) {
- die "directory $dir_loc is still tainted";
- }
- else {
- next;
- }
- }
- }
- unless (chdir $updir_loc) {
- warnings::warnif "Can't cd to $updir_loc: $!\n";
- next;
- }
- }
-
- $dir = $dir_name; # $File::Find::dir
-
- # Get the list of files in the current directory.
- unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
- warnings::warnif "Can't opendir($dir_loc): $!\n";
- next;
- }
- @filenames = readdir DIR;
- closedir(DIR);
-
- for my $FN (@filenames) {
- if ($Is_VMS) {
- # Big hammer here - Compensate for VMS trailing . and .dir
- # No win situation until this is changed, but this
- # will handle the majority of the cases with breaking the fewest.
-
- $FN =~ s/\.dir\z//i;
- $FN =~ s#\.$## if ($FN ne '.');
- }
- next if $FN =~ $File::Find::skip_pattern;
-
- # follow symbolic links / do an lstat
- $new_loc = Follow_SymLink($loc_pref.$FN);
-
- # ignore if invalid symlink
- unless (defined $new_loc) {
- if (!defined -l _ && $dangling_symlinks) {
- if (ref $dangling_symlinks eq 'CODE') {
- $dangling_symlinks->($FN, $dir_pref);
- } else {
- warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
- }
- }
-
- $fullname = undef;
- $name = $dir_pref . $FN;
- $_ = ($no_chdir ? $name : $FN);
- { $wanted_callback->() };
- next;
- }
-
- if (-d _) {
- if ($Is_VMS) {
- $FN =~ s/\.dir\z//i;
- $FN =~ s#\.$## if ($FN ne '.');
- $new_loc =~ s/\.dir\z//i;
- $new_loc =~ s#\.$## if ($new_loc ne '.');
- }
- push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
- }
- else {
- $fullname = $new_loc; # $File::Find::fullname
- $name = $dir_pref . $FN; # $File::Find::name
- $_ = ($no_chdir ? $name : $FN); # $_
- { $wanted_callback->() }; # protect against wild "next"
- }
- }
-
- }
- continue {
- while (defined($SE = pop @Stack)) {
- ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
- $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
- $dir_pref = "$dir_name/";
- $loc_pref = "$dir_loc/";
- if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
- unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
- unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
- warnings::warnif "Can't cd to $updir_loc: $!\n";
- next;
- }
- }
- $fullname = $dir_loc; # $File::Find::fullname
- $name = $dir_name; # $File::Find::name
- if ( substr($name,-2) eq '/.' ) {
- substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
- }
- $dir = $p_dir; # $File::Find::dir
- $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
- if ( substr($_,-2) eq '/.' ) {
- substr($_, length($_) == 2 ? -1 : -2) = '';
- }
-
- lstat($_); # make sure file tests with '_' work
- { $wanted_callback->() }; # protect against wild "next"
- }
- else {
- push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
- last;
- }
- }
- }
-}
-
-
-sub wrap_wanted {
- my $wanted = shift;
- if ( ref($wanted) eq 'HASH' ) {
- unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
- die 'no &wanted subroutine given';
- }
- if ( $wanted->{follow} || $wanted->{follow_fast}) {
- $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
- }
- if ( $wanted->{untaint} ) {
- $wanted->{untaint_pattern} = $File::Find::untaint_pattern
- unless defined $wanted->{untaint_pattern};
- $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
- }
- return $wanted;
- }
- elsif( ref( $wanted ) eq 'CODE' ) {
- return { wanted => $wanted };
- }
- else {
- die 'no &wanted subroutine given';
- }
-}
-
-sub find {
- my $wanted = shift;
- _find_opt(wrap_wanted($wanted), @_);
-}
-
-sub finddepth {
- my $wanted = wrap_wanted(shift);
- $wanted->{bydepth} = 1;
- _find_opt($wanted, @_);
-}
-
-# default
-$File::Find::skip_pattern = qr/^\.{1,2}\z/;
-$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
-
-# These are hard-coded for now, but may move to hint files.
-if ($^O eq 'VMS') {
- $Is_VMS = 1;
- $File::Find::dont_use_nlink = 1;
-}
-elsif ($^O eq 'MSWin32') {
- $Is_Win32 = 1;
-}
-
-# this _should_ work properly on all platforms
-# where File::Find can be expected to work
-$File::Find::current_dir = File::Spec->curdir || '.';
-
-$File::Find::dont_use_nlink = 1
- if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
- $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto';
-
-# 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.
-unless ($File::Find::dont_use_nlink) {
- require Config;
- $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
-}
-
-# We need a function that checks if a scalar is tainted. Either use the
-# Scalar::Util module's tainted() function or our (slower) pure Perl
-# fallback is_tainted_pp()
-{
- local $@;
- eval { require Scalar::Util };
- *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
-}
-
-1;
diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t
deleted file mode 100644
index 62ec81e947..0000000000
--- a/lib/File/Find/t/find.t
+++ /dev/null
@@ -1,977 +0,0 @@
-#!./perl
-use strict;
-use Cwd;
-
-my %Expect_File = (); # what we expect for $_
-my %Expect_Name = (); # what we expect for $File::Find::name/fullname
-my %Expect_Dir = (); # what we expect for $File::Find::dir
-my $symlink_exists = eval { symlink("",""); 1 };
-my ($warn_msg, @files, $file);
-
-
-BEGIN {
- require File::Spec;
- if ($ENV{PERL_CORE}) {
- # May be doing dynamic loading while @INC is all relative
- @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC;
- }
- $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; };
-
- if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') {
- # This is a hack - at present File::Find does not produce native names
- # on Win32 or VMS, so force File::Spec to use Unix names.
- # must be set *before* importing File::Find
- require File::Spec::Unix;
- @File::Spec::ISA = 'File::Spec::Unix';
- }
- require File::Find;
- import File::Find;
-}
-
-my $test_count = 98;
-$test_count += 119 if $symlink_exists;
-$test_count += 26 if $^O eq 'MSWin32';
-$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists;
-
-print "1..$test_count\n";
-#if ( $symlink_exists ) { print "1..199\n"; }
-#else { print "1..85\n"; }
-
-my $orig_dir = cwd();
-
-# Uncomment this to see where File::Find is chdir'ing to. Helpful for
-# debugging its little jaunts around the filesystem.
-# BEGIN {
-# use Cwd;
-# *CORE::GLOBAL::chdir = sub ($) {
-# my($file, $line) = (caller)[1,2];
-#
-# printf "# cwd: %s\n", cwd();
-# print "# chdir: @_ from $file at $line\n";
-# my($return) = CORE::chdir($_[0]);
-# printf "# newcwd: %s\n", cwd();
-#
-# return $return;
-# };
-# }
-
-cleanup();
-
-$::count_taint = 0;
-find({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
- File::Spec->curdir);
-if ($::count_taint == 1) {
- print "ok 1\n";
-} else {
- print "not ok 1 # found $::count_taint files named 'taint.t'\n";
-}
-
-$::count_taint = 0;
-finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } },
- File::Spec->curdir);
-if ($::count_taint == 1) {
- print "ok 2\n";
-} else {
- print "not ok 2 # found $::count_taint files named 'taint.t'\n";
-}
-
-my $case = 2;
-my $FastFileTests_OK = 0;
-
-sub cleanup {
- chdir($orig_dir);
- my $need_updir = 0;
- if (-d dir_path('for_find')) {
- $need_updir = 1 if chdir(dir_path('for_find'));
- }
- if (-d dir_path('fa')) {
- unlink file_path('fa', 'fa_ord'),
- file_path('fa', 'fsl'),
- file_path('fa', 'faa', 'faa_ord'),
- file_path('fa', 'fab', 'fab_ord'),
- file_path('fa', 'fab', 'faba', 'faba_ord'),
- file_path('fa', 'fac', 'faca'),
- file_path('fb', 'fb_ord'),
- file_path('fb', 'fba', 'fba_ord'),
- file_path('fb', 'fbc', 'fbca');
- rmdir dir_path('fa', 'faa');
- rmdir dir_path('fa', 'fab', 'faba');
- rmdir dir_path('fa', 'fab');
- rmdir dir_path('fa', 'fac');
- rmdir dir_path('fa');
- rmdir dir_path('fb', 'fba');
- rmdir dir_path('fb', 'fbc');
- rmdir dir_path('fb');
- }
- if (-d dir_path('fc')) {
- unlink (
- file_path('fc', 'fca', 'match_alpha'),
- file_path('fc', 'fca', 'match_beta'),
- file_path('fc', 'fcb', 'match_gamma'),
- file_path('fc', 'fcb', 'delta'),
- file_path('fc', 'fcc', 'match_epsilon'),
- file_path('fc', 'fcc', 'match_zeta'),
- file_path('fc', 'fcc', 'eta'),
- );
- rmdir dir_path('fc', 'fca');
- rmdir dir_path('fc', 'fcb');
- rmdir dir_path('fc', 'fcc');
- rmdir dir_path('fc');
- }
- if ($need_updir) {
- my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir;
- chdir($updir);
- }
- if (-d dir_path('for_find')) {
- rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n";
- }
-}
-
-END {
- cleanup();
-}
-
-sub Check($) {
- $case++;
- if ($_[0]) { print "ok $case\n"; }
- else { print "not ok $case\n"; }
-}
-
-sub CheckDie($) {
- $case++;
- if ($_[0]) { print "ok $case\n"; }
- else { print "not ok $case\n $!\n"; exit 0; }
-}
-
-sub touch {
- CheckDie( open(my $T,'>',$_[0]) );
-}
-
-sub MkDir($$) {
- CheckDie( mkdir($_[0],$_[1]) );
-}
-
-sub wanted_File_Dir {
- printf "# \$File::Find::dir => '$File::Find::dir'\t\$_ => '$_'\n";
- s#\.$## if ($^O eq 'VMS' && $_ ne '.');
- s/(.dir)?$//i if ($^O eq 'VMS' && -d _);
- Check( $Expect_File{$_} );
- if ( $FastFileTests_OK ) {
- delete $Expect_File{ $_}
- unless ( $Expect_Dir{$_} && ! -d _ );
- } else {
- delete $Expect_File{$_}
- unless ( $Expect_Dir{$_} && ! -d $_ );
- }
-}
-
-sub wanted_File_Dir_prune {
- &wanted_File_Dir;
- $File::Find::prune=1 if $_ eq 'faba';
-}
-
-sub wanted_Name {
- my $n = $File::Find::name;
- $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.');
- print "# \$File::Find::name => '$n'\n";
- my $i = rindex($n,'/');
- my $OK = exists($Expect_Name{$n});
- if ( $OK ) {
- $OK= exists($Expect_Name{substr($n,0,$i)}) if $i >= 0;
- }
- Check($OK);
- delete $Expect_Name{$n};
-}
-
-sub wanted_File {
- print "# \$_ => '$_'\n";
- s#\.$## if ($^O eq 'VMS' && $_ ne '.');
- my $i = rindex($_,'/');
- my $OK = exists($Expect_File{ $_});
- if ( $OK ) {
- $OK= exists($Expect_File{ substr($_,0,$i)}) if $i >= 0;
- }
- Check($OK);
- delete $Expect_File{ $_};
-}
-
-sub simple_wanted {
- print "# \$File::Find::dir => '$File::Find::dir'\n";
- print "# \$_ => '$_'\n";
-}
-
-sub noop_wanted {}
-
-sub my_preprocess {
- @files = @_;
- print "# --preprocess--\n";
- print "# \$File::Find::dir => '$File::Find::dir' \n";
- foreach $file (@files) {
- $file =~ s/\.(dir)?$//i if $^O eq 'VMS';
- print "# $file \n";
- delete $Expect_Dir{ $File::Find::dir }->{$file};
- }
- print "# --end preprocess--\n";
- Check(scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0);
- if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) {
- delete $Expect_Dir{ $File::Find::dir }
- }
- return @files;
-}
-
-sub my_postprocess {
- print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n";
- delete $Expect_Dir{ $File::Find::dir};
-}
-
-
-# Use dir_path() to specify a directory path that's expected for
-# $File::Find::dir (%Expect_Dir). Also use it in file operations like
-# chdir, rmdir etc.
-#
-# dir_path() concatenates directory names to form a *relative*
-# directory path, independent from the platform it's run on, although
-# there are limitations. Don't try to create an absolute path,
-# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). As a special case, you can pass it a "."
-# as first argument, to create a directory path like "./fa/dir". If there's
-# no second argument, this function will return "./"
-
-sub dir_path {
- my $first_arg = shift @_;
-
- if ($first_arg eq '.') {
- return './' unless @_;
- my $path = File::Spec->catdir(@_);
- # add leading "./"
- $path = "./$path";
- return $path;
- } else { # $first_arg ne '.'
- return $first_arg unless @_; # return plain filename
- return File::Spec->catdir($first_arg, @_); # relative path
- }
-}
-
-
-# Use topdir() to specify a directory path that you want to pass to
-# find/finddepth. Historically topdir() differed on Mac OS classic.
-
-*topdir = \&dir_path;
-
-
-# Use file_path() to specify a file path that's expected for $_
-# (%Expect_File). Also suitable for file operations like unlink etc.
-#
-# file_path() concatenates directory names (if any) and a filename to
-# form a *relative* file path (the last argument is assumed to be a
-# file). It's independent from the platform it's run on, although
-# there are limitations. As a special case, you can pass it a "." as
-# first argument, to create a file path like "./fa/file" on operating
-# systems. If there's no second argument, this function will return the
-# string "./"
-
-sub file_path {
- my $first_arg = shift @_;
-
- if ($first_arg eq '.') {
- return './' unless @_;
- my $path = File::Spec->catfile(@_);
- # add leading "./"
- $path = "./$path";
- return $path;
- } else { # $first_arg ne '.'
- return $first_arg unless @_; # return plain filename
- return File::Spec->catfile($first_arg, @_); # relative path
- }
-}
-
-
-# Use file_path_name() to specify a file path that's expected for
-# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
-# option is in effect, $_ is the same as $File::Find::Name. In that
-# case, also use this function to specify a file path that's expected
-# for $_.
-#
-# Historically file_path_name differed on Mac OS classic.
-
-*file_path_name = \&file_path;
-
-
-
-MkDir( dir_path('for_find'), 0770 );
-CheckDie(chdir( dir_path('for_find')));
-MkDir( dir_path('fa'), 0770 );
-MkDir( dir_path('fb'), 0770 );
-touch( file_path('fb', 'fb_ord') );
-MkDir( dir_path('fb', 'fba'), 0770 );
-touch( file_path('fb', 'fba', 'fba_ord') );
-CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
-touch( file_path('fa', 'fa_ord') );
-
-MkDir( dir_path('fa', 'faa'), 0770 );
-touch( file_path('fa', 'faa', 'faa_ord') );
-MkDir( dir_path('fa', 'fab'), 0770 );
-touch( file_path('fa', 'fab', 'fab_ord') );
-MkDir( dir_path('fa', 'fab', 'faba'), 0770 );
-touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
-
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
- file_path('fa_ord') => 1, file_path('fab') => 1,
- file_path('fab_ord') => 1, file_path('faba') => 1,
- file_path('faa') => 1, file_path('faa_ord') => 1);
-
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
- dir_path('fab') => 1, dir_path('faba') => 1,
- dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') );
-Check( scalar(keys %Expect_File) == 0 );
-
-
-print "# check re-entrancy\n";
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
- file_path('fa_ord') => 1, file_path('fab') => 1,
- file_path('fab_ord') => 1, file_path('faba') => 1,
- file_path('faa') => 1, file_path('faa_ord') => 1);
-
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
- dir_path('fab') => 1, dir_path('faba') => 1,
- dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-
-File::Find::find( {wanted => sub { wanted_File_Dir_prune();
- File::Find::find( {wanted => sub
- {} }, File::Spec->curdir ); } },
- topdir('fa') );
-
-Check( scalar(keys %Expect_File) == 0 );
-
-
-# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
-
-%Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fa_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1,);
-
-delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = (dir_path('fa') => 1,
- dir_path('fa', 'faa') => 1,
- dir_path('fa', 'fab') => 1,
- dir_path('fa', 'fab', 'faba') => 1,
- dir_path('fb') => 1,
- dir_path('fb', 'fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') }
- unless $symlink_exists;
-
-File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1},
- topdir('fa') ); Check( scalar(keys %Expect_File) == 0 );
-
-
-%Expect_File = ();
-
-%Expect_Name = (File::Spec->curdir => 1,
- file_path_name('.', 'fa') => 1,
- file_path_name('.', 'fa', 'fsl') => 1,
- file_path_name('.', 'fa', 'fa_ord') => 1,
- file_path_name('.', 'fa', 'fab') => 1,
- file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
- file_path_name('.', 'fa', 'fab', 'faba') => 1,
- file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('.', 'fa', 'faa') => 1,
- file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
- file_path_name('.', 'fb') => 1,
- file_path_name('.', 'fb', 'fba') => 1,
- file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
- file_path_name('.', 'fb', 'fb_ord') => 1);
-
-delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists;
-%Expect_Dir = ();
-File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir );
-Check( scalar(keys %Expect_Name) == 0 );
-
-
-# no_chdir is in effect, hence we use file_path_name to specify the
-# expected paths for %Expect_File
-
-%Expect_File = (File::Spec->curdir => 1,
- file_path_name('.', 'fa') => 1,
- file_path_name('.', 'fa', 'fsl') => 1,
- file_path_name('.', 'fa', 'fa_ord') => 1,
- file_path_name('.', 'fa', 'fab') => 1,
- file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
- file_path_name('.', 'fa', 'fab', 'faba') => 1,
- file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('.', 'fa', 'faa') => 1,
- file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
- file_path_name('.', 'fb') => 1,
- file_path_name('.', 'fb', 'fba') => 1,
- file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
- file_path_name('.', 'fb', 'fb_ord') => 1);
-
-delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists;
-%Expect_Name = ();
-%Expect_Dir = ();
-
-File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1},
- File::Spec->curdir );
-
-Check( scalar(keys %Expect_File) == 0 );
-
-
-print "# check preprocess\n";
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir = (
- File::Spec->curdir => {fa => 1, fb => 1},
- dir_path('.', 'fa') => {faa => 1, fab => 1, fa_ord => 1},
- dir_path('.', 'fa', 'faa') => {faa_ord => 1},
- dir_path('.', 'fa', 'fab') => {faba => 1, fab_ord => 1},
- dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1},
- dir_path('.', 'fb') => {fba => 1, fb_ord => 1},
- dir_path('.', 'fb', 'fba') => {fba_ord => 1}
- );
-
-File::Find::find( {wanted => \&noop_wanted,
- preprocess => \&my_preprocess}, File::Spec->curdir );
-
-Check( scalar(keys %Expect_Dir) == 0 );
-
-
-print "# check postprocess\n";
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir = (
- File::Spec->curdir => 1,
- dir_path('.', 'fa') => 1,
- dir_path('.', 'fa', 'faa') => 1,
- dir_path('.', 'fa', 'fab') => 1,
- dir_path('.', 'fa', 'fab', 'faba') => 1,
- dir_path('.', 'fb') => 1,
- dir_path('.', 'fb', 'fba') => 1
- );
-
-File::Find::find( {wanted => \&noop_wanted,
- postprocess => \&my_postprocess}, File::Spec->curdir );
-
-Check( scalar(keys %Expect_Dir) == 0 );
-
-{
- print "# checking argument localization\n";
-
- ### this checks the fix of perlbug [19977] ###
- my @foo = qw( a b c d e f );
- my %pre = map { $_ => } @foo;
-
- File::Find::find( sub { } , 'fa' ) for @foo;
- delete $pre{$_} for @foo;
-
- Check( scalar( keys %pre ) == 0 );
-}
-
-# see thread starting
-# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-02/msg00351.html
-{
- print "# checking that &_ and %_ are still accessible and that\n",
- "# tie magic on \$_ is not triggered\n";
-
- my $true_count;
- my $sub = 0;
- sub _ {
- ++$sub;
- }
- my $tie_called = 0;
-
- package Foo;
- sub STORE {
- ++$tie_called;
- }
- sub FETCH {return 'N'};
- sub TIESCALAR {bless []};
- package main;
-
- Check( scalar( keys %_ ) == 0 );
- my @foo = 'n';
- tie $foo[0], "Foo";
-
- File::Find::find( sub { $true_count++; $_{$_}++; &_; } , 'fa' ) for @foo;
- untie $_;
-
- Check( $tie_called == 0);
- Check( scalar( keys %_ ) == $true_count );
- Check( $sub == $true_count );
- Check( scalar( @foo ) == 1);
- Check( $foo[0] eq 'N' );
-}
-
-if ( $symlink_exists ) {
- print "# --- symbolic link tests --- \n";
- $FastFileTests_OK= 1;
-
-
- # Verify that File::Find::find will call wanted even if the topdir of
- # is a symlink to a directory, and it shouldn't follow the link
- # unless follow is set, which it isn't in this case
- %Expect_File = ( file_path('fsl') => 1 );
- %Expect_Name = ();
- %Expect_Dir = ();
- File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') );
- Check( scalar(keys %Expect_File) == 0 );
-
-
- %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1,
- file_path('fsl') => 1, file_path('fb_ord') => 1,
- file_path('fba') => 1, file_path('fba_ord') => 1,
- file_path('fab') => 1, file_path('fab_ord') => 1,
- file_path('faba') => 1, file_path('faa') => 1,
- file_path('faa_ord') => 1);
-
- %Expect_Name = ();
-
- %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1,
- dir_path('faa') => 1, dir_path('fab') => 1,
- dir_path('faba') => 1, dir_path('fb') => 1,
- dir_path('fba') => 1);
-
- File::Find::find( {wanted => \&wanted_File_Dir_prune,
- follow_fast => 1}, topdir('fa') );
-
- Check( scalar(keys %Expect_File) == 0 );
-
-
- # no_chdir is in effect, hence we use file_path_name to specify
- # the expected paths for %Expect_File
-
- %Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa', 'fa_ord') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1);
-
- %Expect_Name = ();
-
- %Expect_Dir = (dir_path('fa') => 1,
- dir_path('fa', 'faa') => 1,
- dir_path('fa', 'fab') => 1,
- dir_path('fa', 'fab', 'faba') => 1,
- dir_path('fb') => 1,
- dir_path('fb', 'fba') => 1);
-
- File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
- no_chdir => 1}, topdir('fa') );
-
- Check( scalar(keys %Expect_File) == 0 );
-
- %Expect_File = ();
-
- %Expect_Name = (file_path_name('fa') => 1,
- file_path_name('fa', 'fa_ord') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1);
-
- %Expect_Dir = ();
-
- File::Find::finddepth( {wanted => \&wanted_Name,
- follow_fast => 1}, topdir('fa') );
-
- Check( scalar(keys %Expect_Name) == 0 );
-
- # no_chdir is in effect, hence we use file_path_name to specify
- # the expected paths for %Expect_File
-
- %Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa', 'fa_ord') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1);
-
- %Expect_Name = ();
- %Expect_Dir = ();
-
- File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1,
- no_chdir => 1}, topdir('fa') );
-
- Check( scalar(keys %Expect_File) == 0 );
-
-
- print "# check dangling symbolic links\n";
- MkDir( dir_path('dangling_dir'), 0770 );
- CheckDie( symlink( dir_path('dangling_dir'),
- file_path('dangling_dir_sl') ) );
- rmdir dir_path('dangling_dir');
- touch(file_path('dangling_file'));
- CheckDie( symlink('../dangling_file','fa/dangling_file_sl') );
- unlink file_path('dangling_file');
-
- {
- # these tests should also emit a warning
- use warnings;
-
- %Expect_File = (File::Spec->curdir => 1,
- file_path('dangling_file_sl') => 1,
- file_path('fa_ord') => 1,
- file_path('fsl') => 1,
- file_path('fb_ord') => 1,
- file_path('fba') => 1,
- file_path('fba_ord') => 1,
- file_path('fab') => 1,
- file_path('fab_ord') => 1,
- file_path('faba') => 1,
- file_path('faba_ord') => 1,
- file_path('faa') => 1,
- file_path('faa_ord') => 1);
-
- %Expect_Name = ();
- %Expect_Dir = ();
- undef $warn_msg;
-
- File::Find::find( {wanted => \&wanted_File, follow => 1,
- dangling_symlinks =>
- sub { $warn_msg = "$_[0] is a dangling symbolic link" }
- },
- topdir('dangling_dir_sl'), topdir('fa') );
-
- Check( scalar(keys %Expect_File) == 0 );
- Check( $warn_msg =~ m|dangling_file_sl is a dangling symbolic link| );
- unlink file_path('fa', 'dangling_file_sl'),
- file_path('dangling_dir_sl');
-
- }
-
-
- print "# check recursion\n";
- CheckDie( symlink('../faa','fa/faa/faa_sl') );
- undef $@;
- eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
- no_chdir => 1}, topdir('fa') ); };
- Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link|i );
- unlink file_path('fa', 'faa', 'faa_sl');
-
-
- print "# check follow_skip (file)\n";
- CheckDie( symlink('./fa_ord','fa/fa_ord_sl') ); # symlink to a file
- undef $@;
-
- eval {File::Find::finddepth( {wanted => \&simple_wanted,
- follow => 1,
- follow_skip => 0, no_chdir => 1},
- topdir('fa') );};
-
- Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time|i );
-
-
- # no_chdir is in effect, hence we use file_path_name to specify
- # the expected paths for %Expect_File
-
- %Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa', 'fa_ord') => 2,
- # We may encounter the symlink first
- file_path_name('fa', 'fa_ord_sl') => 2,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1);
-
- %Expect_Name = ();
-
- %Expect_Dir = (dir_path('fa') => 1,
- dir_path('fa', 'faa') => 1,
- dir_path('fa', 'fab') => 1,
- dir_path('fa', 'fab', 'faba') => 1,
- dir_path('fb') => 1,
- dir_path('fb','fba') => 1);
-
- File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
- follow_skip => 1, no_chdir => 1},
- topdir('fa') );
- Check( scalar(keys %Expect_File) == 0 );
- unlink file_path('fa', 'fa_ord_sl');
-
-
- print "# check follow_skip (directory)\n";
- CheckDie( symlink('./faa','fa/faa_sl') ); # symlink to a directory
- undef $@;
-
- eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
- follow_skip => 0, no_chdir => 1},
- topdir('fa') );};
-
- Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i );
-
-
- undef $@;
-
- eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
- follow_skip => 1, no_chdir => 1},
- topdir('fa') );};
-
- Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time|i );
-
- # no_chdir is in effect, hence we use file_path_name to specify
- # the expected paths for %Expect_File
-
- %Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa', 'fa_ord') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1,
- # We may actually encounter the symlink first.
- file_path_name('fa', 'faa_sl') => 1,
- file_path_name('fa', 'faa_sl', 'faa_ord') => 1);
-
- %Expect_Name = ();
-
- %Expect_Dir = (dir_path('fa') => 1,
- dir_path('fa', 'faa') => 1,
- dir_path('fa', 'fab') => 1,
- dir_path('fa', 'fab', 'faba') => 1,
- dir_path('fb') => 1,
- dir_path('fb', 'fba') => 1);
-
- File::Find::find( {wanted => \&wanted_File_Dir, follow => 1,
- follow_skip => 2, no_chdir => 1}, topdir('fa') );
-
- # If we encountered the symlink first, then the entries corresponding to
- # the real name remain, if the real name first then the symlink
- my @names = sort keys %Expect_File;
- Check( @names == 1 );
- # Normalise both to the original name
- s/_sl// foreach @names;
- Check ($names[0] eq file_path_name('fa', 'faa', 'faa_ord'));
- unlink file_path('fa', 'faa_sl');
-
-}
-
-
-# Win32 checks - [perl #41555]
-if ($^O eq 'MSWin32') {
- require File::Spec::Win32;
- my ($volume) = File::Spec::Win32->splitpath($orig_dir, 1);
- print STDERR "VOLUME = $volume\n";
-
- # with chdir
- %Expect_File = (File::Spec->curdir => 1,
- file_path('fsl') => 1,
- file_path('fa_ord') => 1,
- file_path('fab') => 1,
- file_path('fab_ord') => 1,
- file_path('faba') => 1,
- file_path('faba_ord') => 1,
- file_path('faa') => 1,
- file_path('faa_ord') => 1);
-
- delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
- %Expect_Name = ();
-
- %Expect_Dir = (dir_path('fa') => 1,
- dir_path('faa') => 1,
- dir_path('fab') => 1,
- dir_path('faba') => 1,
- dir_path('fb') => 1,
- dir_path('fba') => 1);
-
-
-
- File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa'));
- Check( scalar(keys %Expect_File) == 0 );
-
- # no_chdir
- %Expect_File = ($volume . file_path_name('fa') => 1,
- $volume . file_path_name('fa', 'fsl') => 1,
- $volume . file_path_name('fa', 'fa_ord') => 1,
- $volume . file_path_name('fa', 'fab') => 1,
- $volume . file_path_name('fa', 'fab', 'fab_ord') => 1,
- $volume . file_path_name('fa', 'fab', 'faba') => 1,
- $volume . file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- $volume . file_path_name('fa', 'faa') => 1,
- $volume . file_path_name('fa', 'faa', 'faa_ord') => 1);
-
-
- delete $Expect_File{ $volume . file_path_name('fa', 'fsl') } unless $symlink_exists;
- %Expect_Name = ();
-
- %Expect_Dir = ($volume . dir_path('fa') => 1,
- $volume . dir_path('fa', 'faa') => 1,
- $volume . dir_path('fa', 'fab') => 1,
- $volume . dir_path('fa', 'fab', 'faba') => 1);
-
- File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa'));
- Check( scalar(keys %Expect_File) == 0 );
-}
-
-
-if ($symlink_exists) { # Issue 68260
- print "# BUG 68260\n";
- MkDir (dir_path ('fa', 'fac'), 0770);
- MkDir (dir_path ('fb', 'fbc'), 0770);
- touch (file_path ('fa', 'fac', 'faca'));
- CheckDie (symlink ('..////../fa/fac/faca', 'fb/fbc/fbca'));
-
- use warnings;
- my $dangling_symlink;
- local $SIG {__WARN__} = sub {
- local $" = " ";
- $dangling_symlink ++ if "@_" =~ /dangling symbolic link/;
- };
-
- File::Find::find (
- {
- wanted => sub {1;},
- follow => 1,
- follow_skip => 2,
- dangling_symlinks => 1,
- },
- File::Spec -> curdir
- );
-
- Check (!$dangling_symlink);
-}
-
-print "# RT 59750\n";
-MkDir( dir_path('fc'), 0770 );
-MkDir( dir_path('fc', 'fca'), 0770 );
-MkDir( dir_path('fc', 'fcb'), 0770 );
-MkDir( dir_path('fc', 'fcc'), 0770 );
-touch( file_path('fc', 'fca', 'match_alpha') );
-touch( file_path('fc', 'fca', 'match_beta') );
-touch( file_path('fc', 'fcb', 'match_gamma') );
-touch( file_path('fc', 'fcb', 'delta') );
-touch( file_path('fc', 'fcc', 'match_epsilon') );
-touch( file_path('fc', 'fcc', 'match_zeta') );
-touch( file_path('fc', 'fcc', 'eta') );
-
-my @files_from_mixed = ();
-sub wantmatch {
- if ( $File::Find::name =~ m/match/ ) {
- push @files_from_mixed, $_;
- print "# \$_ => '$_'\n";
- }
-}
-find( \&wantmatch, (
- dir_path('fc', 'fca'),
- dir_path('fc', 'fcb'),
- dir_path('fc', 'fcc'),
-) );
-Check( scalar(@files_from_mixed) == 5 );
-
-@files_from_mixed = ();
-find( \&wantmatch, (
- dir_path('fc', 'fca'),
- dir_path('fc', 'fcb'),
- file_path('fc', 'fcc', 'match_epsilon'),
- file_path('fc', 'fcc', 'eta'),
-) );
-Check( scalar(@files_from_mixed) == 4 );
-
-if ($^O eq 'MSWin32') {
- # Check F:F:f correctly handles a root directory path.
- # Rather than processing the entire drive (!), simply test that the
- # first file passed to the wanted routine is correct and then bail out.
- $orig_dir =~ /^(\w:)/ or die "expected a drive: $orig_dir";
- my $drive = $1;
-
- # Determine the file in the root directory which would be
- # first if processed in sorted order. Create one if necessary.
- my $expected_first_file;
- opendir(ROOT_DIR, "/") or die "cannot opendir /: $!\n";
- foreach my $f (sort readdir ROOT_DIR) {
- if (-f "/$f") {
- $expected_first_file = $f;
- last;
- }
- }
- closedir ROOT_DIR;
- my $created_file;
- unless (defined $expected_first_file) {
- $expected_first_file = '__perl_File_Find_test.tmp';
- open(F, ">", "/$expected_first_file") && close(F)
- or die "cannot create file in root directory: $!\n";
- $created_file = 1;
- }
-
- # Run F:F:f with/without no_chdir for each possible style of root path.
- # NB. If HOME were "/", then an inadvertent chdir('') would fluke the
- # expected result, so ensure it is something else:
- local $ENV{HOME} = $orig_dir;
- foreach my $no_chdir (0, 1) {
- foreach my $root_dir ("/", "\\", "$drive/", "$drive\\") {
- eval {
- File::Find::find({
- 'no_chdir' => $no_chdir,
- 'preprocess' => sub { return sort @_ },
- 'wanted' => sub {
- -f or return; # the first call is for $root_dir itself.
- my $got = $File::Find::name;
- my $exp = "$root_dir$expected_first_file";
- print "# no_chdir=$no_chdir $root_dir '$got'\n";
- Check($got eq $exp);
- die "done"; # don't process the entire drive!
- },
- }, $root_dir);
- };
- # If F:F:f did not die "done" then it did not Check() either.
- unless ($@ and $@ =~ /done/) {
- print "# no_chdir=$no_chdir $root_dir ",
- ($@ ? "error: $@" : "no files found"), "\n";
- Check(0);
- }
- }
- }
- if ($created_file) {
- unlink("/$expected_first_file")
- or warn "can't unlink /$expected_first_file: $!\n";
- }
-}
diff --git a/lib/File/Find/t/taint.t b/lib/File/Find/t/taint.t
deleted file mode 100644
index 9d78ae0632..0000000000
--- a/lib/File/Find/t/taint.t
+++ /dev/null
@@ -1,371 +0,0 @@
-#!./perl -T
-use strict;
-use Test::More;
-BEGIN {
- plan(
- ${^TAINT}
- ? (tests => 45)
- : (skip_all => "A perl without taint support")
- );
-}
-
-my %Expect_File = (); # what we expect for $_
-my %Expect_Name = (); # what we expect for $File::Find::name/fullname
-my %Expect_Dir = (); # what we expect for $File::Find::dir
-my ($cwd, $cwd_untainted);
-
-BEGIN {
- require File::Spec;
- if ($ENV{PERL_CORE}) {
- # May be doing dynamic loading while @INC is all relative
- @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC;
- }
-}
-
-use Config;
-
-BEGIN {
- if ($^O ne 'VMS') {
- for (keys %ENV) { # untaint ENV
- ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
- }
- }
-
- # Remove insecure directories from PATH
- my @path;
- my $sep = $Config{path_sep};
- foreach my $dir (split(/\Q$sep/,$ENV{'PATH'}))
- {
- ##
- ## Match the directory taint tests in mg.c::Perl_magic_setenv()
- ##
- push(@path,$dir) unless (length($dir) >= 256
- or
- substr($dir,0,1) ne "/"
- or
- (stat $dir)[2] & 002);
- }
- $ENV{'PATH'} = join($sep,@path);
-}
-
-my $symlink_exists = eval { symlink("",""); 1 };
-
-use File::Find;
-use File::Spec;
-use Cwd;
-
-my $orig_dir = cwd();
-( my $orig_dir_untainted ) = $orig_dir =~ m|^(.+)$|; # untaint it
-
-cleanup();
-
-my $found;
-find({wanted => sub { ++$found if $_ eq 'taint.t' },
- untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
-
-is($found, 1, 'taint.t found once');
-$found = 0;
-
-finddepth({wanted => sub { ++$found if $_ eq 'taint.t'; },
- untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
-
-is($found, 1, 'taint.t found once again');
-
-my $case = 2;
-my $FastFileTests_OK = 0;
-
-sub cleanup {
- chdir($orig_dir_untainted);
- my $need_updir = 0;
- if (-d dir_path('for_find')) {
- $need_updir = 1 if chdir(dir_path('for_find'));
- }
- if (-d dir_path('fa')) {
- unlink file_path('fa', 'fa_ord'),
- file_path('fa', 'fsl'),
- file_path('fa', 'faa', 'faa_ord'),
- file_path('fa', 'fab', 'fab_ord'),
- file_path('fa', 'fab', 'faba', 'faba_ord'),
- file_path('fb', 'fb_ord'),
- file_path('fb', 'fba', 'fba_ord');
- rmdir dir_path('fa', 'faa');
- rmdir dir_path('fa', 'fab', 'faba');
- rmdir dir_path('fa', 'fab');
- rmdir dir_path('fa');
- rmdir dir_path('fb', 'fba');
- rmdir dir_path('fb');
- }
- if ($need_updir) {
- my $updir = $^O eq 'VMS' ? File::Spec::VMS->updir() : File::Spec->updir;
- chdir($updir);
- }
- if (-d dir_path('for_find')) {
- rmdir dir_path('for_find') or print "# Can't rmdir for_find: $!\n";
- }
-}
-
-END {
- cleanup();
-}
-
-sub touch {
- ok( open(my $T,'>',$_[0]), "Opened $_[0] successfully" );
-}
-
-sub MkDir($$) {
- ok( mkdir($_[0],$_[1]), "Created directory $_[0] successfully" );
-}
-
-sub wanted_File_Dir {
- print "# \$File::Find::dir => '$File::Find::dir'\n";
- print "# \$_ => '$_'\n";
- s#\.$## if ($^O eq 'VMS' && $_ ne '.');
- s/(.dir)?$//i if ($^O eq 'VMS' && -d _);
- ok( $Expect_File{$_}, "Expected and found $File::Find::name" );
- if ( $FastFileTests_OK ) {
- delete $Expect_File{ $_}
- unless ( $Expect_Dir{$_} && ! -d _ );
- } else {
- delete $Expect_File{$_}
- unless ( $Expect_Dir{$_} && ! -d $_ );
- }
-}
-
-sub wanted_File_Dir_prune {
- &wanted_File_Dir;
- $File::Find::prune=1 if $_ eq 'faba';
-}
-
-sub simple_wanted {
- print "# \$File::Find::dir => '$File::Find::dir'\n";
- print "# \$_ => '$_'\n";
-}
-
-
-# Use dir_path() to specify a directory path that's expected for
-# $File::Find::dir (%Expect_Dir). Also use it in file operations like
-# chdir, rmdir etc.
-#
-# dir_path() concatenates directory names to form a *relative*
-# directory path, independent from the platform it's run on, although
-# there are limitations. Don't try to create an absolute path,
-# because that may fail on operating systems that have the concept of
-# volume names (e.g. Mac OS). As a special case, you can pass it a "."
-# as first argument, to create a directory path like "./fa/dir". If there's
-# no second argument this function will return the string "./"
-
-sub dir_path {
- my $first_arg = shift @_;
-
- if ($first_arg eq '.') {
- return './' unless @_;
- my $path = File::Spec->catdir(@_);
- # add leading "./"
- $path = "./$path";
- return $path;
- } else { # $first_arg ne '.'
- return $first_arg unless @_; # return plain filename
- my $fname = File::Spec->catdir($first_arg, @_); # relative path
- $fname = VMS::Filespec::unixpath($fname) if $^O eq 'VMS';
- return $fname;
- }
-}
-
-
-# Use topdir() to specify a directory path that you want to pass to
-# find/finddepth. Historically topdir() differed on Mac OS classic.
-
-*topdir = \&dir_path;
-
-
-# Use file_path() to specify a file path that's expected for $_
-# (%Expect_File). Also suitable for file operations like unlink etc.
-#
-# file_path() concatenates directory names (if any) and a filename to
-# form a *relative* file path (the last argument is assumed to be a
-# file). It's independent from the platform it's run on, although
-# there are limitations. As a special case, you can pass it a "." as
-# first argument, to create a file path like "./fa/file". If there's no
-# second argument, this function will return the string "./" otherwise.
-
-sub file_path {
- my $first_arg = shift @_;
-
- if ($first_arg eq '.') {
- return './' unless @_;
- my $path = File::Spec->catfile(@_);
- # add leading "./"
- $path = "./$path";
- return $path;
- } else { # $first_arg ne '.'
- return $first_arg unless @_; # return plain filename
- my $fname = File::Spec->catfile($first_arg, @_); # relative path
- $fname = VMS::Filespec::unixify($fname) if $^O eq 'VMS';
- return $fname;
- }
-}
-
-
-# Use file_path_name() to specify a file path that's expected for
-# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
-# option is in effect, $_ is the same as $File::Find::Name. In that
-# case, also use this function to specify a file path that's expected
-# for $_.
-#
-# Historically file_path_name differed on Mac OS classic.
-
-*file_path_name = \&file_path;
-
-
-MkDir( dir_path('for_find'), 0770 );
-ok( chdir( dir_path('for_find')), 'successful chdir() to for_find' );
-
-$cwd = cwd(); # save cwd
-( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
-
-MkDir( dir_path('fa'), 0770 );
-MkDir( dir_path('fb'), 0770 );
-touch( file_path('fb', 'fb_ord') );
-MkDir( dir_path('fb', 'fba'), 0770 );
-touch( file_path('fb', 'fba', 'fba_ord') );
-SKIP: {
- skip "Creating symlink", 1, unless $symlink_exists;
- ok( symlink('../fb','fa/fsl'), 'Created symbolic link' );
-}
-touch( file_path('fa', 'fa_ord') );
-
-MkDir( dir_path('fa', 'faa'), 0770 );
-touch( file_path('fa', 'faa', 'faa_ord') );
-MkDir( dir_path('fa', 'fab'), 0770 );
-touch( file_path('fa', 'fab', 'fab_ord') );
-MkDir( dir_path('fa', 'fab', 'faba'), 0770 );
-touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
-
-print "# check untainting (no follow)\n";
-
-# untainting here should work correctly
-
-%Expect_File = (File::Spec->curdir => 1, file_path('fsl') =>
- 1,file_path('fa_ord') => 1, file_path('fab') => 1,
- file_path('fab_ord') => 1, file_path('faba') => 1,
- file_path('faa') => 1, file_path('faa_ord') => 1);
-delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
-%Expect_Name = ();
-
-%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
- dir_path('fab') => 1, dir_path('faba') => 1,
- dir_path('fb') => 1, dir_path('fba') => 1);
-
-delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
-
-File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
- untaint_pattern => qr|^(.+)$|}, topdir('fa') );
-
-is(scalar keys %Expect_File, 0, 'Found all expected files');
-
-
-# don't untaint at all, should die
-%Expect_File = ();
-%Expect_Name = ();
-%Expect_Dir = ();
-undef $@;
-eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
-like( $@, qr|Insecure dependency|, 'Tainted directory causes death (good)' );
-chdir($cwd_untainted);
-
-
-# untaint pattern doesn't match, should die
-undef $@;
-
-eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
- untaint_pattern => qr|^(NO_MATCH)$|},
- topdir('fa') );};
-
-like( $@, qr|is still tainted|, 'Bad untaint pattern causes death (good)' );
-chdir($cwd_untainted);
-
-
-# untaint pattern doesn't match, should die when we chdir to cwd
-print "# check untaint_skip (No follow)\n";
-undef $@;
-
-eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
- untaint_skip => 1, untaint_pattern =>
- qr|^(NO_MATCH)$|}, topdir('fa') );};
-
-print "# $@" if $@;
-#$^D = 8;
-like( $@, qr|insecure cwd|, 'Bad untaint pattern causes death in cwd (good)' );
-
-chdir($cwd_untainted);
-
-
-SKIP: {
- skip "Symbolic link tests", 17, unless $symlink_exists;
- print "# --- symbolic link tests --- \n";
- $FastFileTests_OK= 1;
-
- print "# check untainting (follow)\n";
-
- # untainting here should work correctly
- # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
-
- %Expect_File = (file_path_name('fa') => 1,
- file_path_name('fa','fa_ord') => 1,
- file_path_name('fa', 'fsl') => 1,
- file_path_name('fa', 'fsl', 'fb_ord') => 1,
- file_path_name('fa', 'fsl', 'fba') => 1,
- file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
- file_path_name('fa', 'fab') => 1,
- file_path_name('fa', 'fab', 'fab_ord') => 1,
- file_path_name('fa', 'fab', 'faba') => 1,
- file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
- file_path_name('fa', 'faa') => 1,
- file_path_name('fa', 'faa', 'faa_ord') => 1);
-
- %Expect_Name = ();
-
- %Expect_Dir = (dir_path('fa') => 1,
- dir_path('fa', 'faa') => 1,
- dir_path('fa', 'fab') => 1,
- dir_path('fa', 'fab', 'faba') => 1,
- dir_path('fb') => 1,
- dir_path('fb', 'fba') => 1);
-
- File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
- no_chdir => 1, untaint => 1, untaint_pattern =>
- qr|^(.+)$| }, topdir('fa') );
-
- is( scalar(keys %Expect_File), 0, 'Found all files in symlink test' );
-
-
- # don't untaint at all, should die
- undef $@;
-
- eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
- topdir('fa') );};
-
- like( $@, qr|Insecure dependency|, 'Not untainting causes death (good)' );
- chdir($cwd_untainted);
-
- # untaint pattern doesn't match, should die
- undef $@;
-
- eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
- untaint => 1, untaint_pattern =>
- qr|^(NO_MATCH)$|}, topdir('fa') );};
-
- like( $@, qr|is still tainted|, 'Bat untaint pattern causes death (good)' );
- chdir($cwd_untainted);
-
- # untaint pattern doesn't match, should die when we chdir to cwd
- print "# check untaint_skip (Follow)\n";
- undef $@;
-
- eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
- untaint_skip => 1, untaint_pattern =>
- qr|^(NO_MATCH)$|}, topdir('fa') );};
- like( $@, qr|insecure cwd|, 'Cwd not untainted with bad pattern (good)' );
-
- chdir($cwd_untainted);
-}