5 use warnings::register;
11 # Modified to ensure sub-directory traversal order is not inverded by stack
12 # push and pops. That is remains in the same order as in the directory file,
13 # or user pre-processing (EG:sorted).
18 File::Find - Traverse a directory tree.
23 find(\&wanted, @directories_to_search);
27 finddepth(\&wanted, @directories_to_search);
31 find({ wanted => \&process, follow => 1 }, '.');
35 These are functions for searching through directory trees doing work
36 on each file found similar to the Unix I<find> command. File::Find
37 exports two functions, C<find> and C<finddepth>. They work similarly
38 but have subtle differences.
44 find(\&wanted, @directories);
45 find(\%options, @directories);
47 C<find()> does a depth-first search over the given C<@directories> in
48 the order they are given. For each file or directory found, it calls
49 the C<&wanted> subroutine. (See below for details on how to use the
50 C<&wanted> function). Additionally, for each directory found, it will
51 C<chdir()> into that directory and continue the search, invoking the
52 C<&wanted> function on each file or subdirectory in the directory.
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
59 C<finddepth()> works just like C<find()> except that is invokes the
60 C<&wanted> function for a directory I<after> invoking it for the
61 directory's contents. It does a postorder traversal instead of a
62 preorder traversal, working from the bottom of the directory tree up
63 where C<find()> works from the top of the tree down.
69 The first argument to C<find()> is either a code reference to your
70 C<&wanted> function, or a hash reference describing the operations
71 to be performed for each file. The
72 code reference is described in L<The wanted function> below.
74 Here are the possible keys for the hash:
80 The value should be a code reference. This code reference is
81 described in L<The wanted function> below.
85 Reports the name of a directory only AFTER all its entries
86 have been reported. Entry point C<finddepth()> is a shortcut for
87 specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
91 The value should be a code reference. This code reference is used to
92 preprocess the current directory. The name of the currently processed
93 directory is in C<$File::Find::dir>. Your preprocessing function is
94 called after C<readdir()>, but before the loop that calls the C<wanted()>
95 function. It is called with a list of strings (actually file/directory
96 names) and is expected to return a list of strings. The code can be
97 used to sort the file/directory names alphabetically, numerically,
98 or to filter out directory entries based on their name alone. When
99 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
103 The value should be a code reference. It is invoked just before leaving
104 the currently processed directory. It is called in void context with no
105 arguments. The name of the current directory is in C<$File::Find::dir>. This
106 hook is handy for summarizing a directory, such as calculating its disk
107 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
112 Causes symbolic links to be followed. Since directory trees with symbolic
113 links (followed) may contain files more than once and may even have
114 cycles, a hash has to be built up with an entry for each file.
115 This might be expensive both in space and time for a large
116 directory tree. See I<follow_fast> and I<follow_skip> below.
117 If either I<follow> or I<follow_fast> is in effect:
123 It is guaranteed that an I<lstat> has been called before the user's
124 C<wanted()> function is called. This enables fast file checks involving S< _>.
128 There is a variable C<$File::Find::fullname> which holds the absolute
129 pathname of the file with all symbolic links resolved. If the link is
130 a dangling symbolic link, then fullname will be set to C<undef>.
134 This is a no-op on Win32.
138 This is similar to I<follow> except that it may report some files more
139 than once. It does detect cycles, however. Since only symbolic links
140 have to be hashed, this is much cheaper both in space and time. If
141 processing a file more than once (by the user's C<wanted()> function)
142 is worse than just taking time, the option I<follow> should be used.
144 This is also a no-op on Win32.
148 C<follow_skip==1>, which is the default, causes all files which are
149 neither directories nor symbolic links to be ignored if they are about
150 to be processed a second time. If a directory or a symbolic link
151 are about to be processed a second time, File::Find dies.
153 C<follow_skip==0> causes File::Find to die if any file is about to be
154 processed a second time.
156 C<follow_skip==2> causes File::Find to ignore any duplicate files and
157 directories but to proceed normally otherwise.
159 =item C<dangling_symlinks>
161 If true and a code reference, will be called with the symbolic link
162 name and the directory it lives in as arguments. Otherwise, if true
163 and warnings are on, warning "symbolic_link_name is a dangling
164 symbolic link\n" will be issued. If false, the dangling symbolic link
165 will be silently ignored.
169 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
170 function will need to be aware of this, of course. In this case,
171 C<$_> will be the same as C<$File::Find::name>.
175 If find is used in taint-mode (-T command line switch or if EUID != UID
176 or if EGID != GID) then internally directory names have to be untainted
177 before they can be chdir'ed to. Therefore they are checked against a regular
178 expression I<untaint_pattern>. Note that all names passed to the user's
179 I<wanted()> function are still tainted. If this option is used while
180 not in taint-mode, C<untaint> is a no-op.
182 =item C<untaint_pattern>
184 See above. This should be set using the C<qr> quoting operator.
185 The default is set to C<qr|^([-+@\w./]+)$|>.
186 Note that the parentheses are vital.
188 =item C<untaint_skip>
190 If set, a directory which fails the I<untaint_pattern> is skipped,
191 including all its sub-directories. The default is to 'die' in such a case.
195 =head2 The wanted function
197 The C<wanted()> function does whatever verifications you want on
198 each file and directory. Note that despite its name, the C<wanted()>
199 function is a generic callback function, and does B<not> tell
200 File::Find if a file is "wanted" or not. In fact, its return value
203 The wanted function takes no arguments but rather does its work
204 through a collection of variables.
208 =item C<$File::Find::dir> is the current directory name,
210 =item C<$_> is the current filename within that directory
212 =item C<$File::Find::name> is the complete pathname to the file.
216 Don't modify these variables.
218 For example, when examining the file F</some/path/foo.ext> you will have:
220 $File::Find::dir = /some/path/
222 $File::Find::name = /some/path/foo.ext
224 You are chdir()'d to C<$File::Find::dir> when the function is called,
225 unless C<no_chdir> was specified. Note that when changing to
226 directories is in effect the root directory (F</>) is a somewhat
227 special case inasmuch as the concatenation of C<$File::Find::dir>,
228 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
229 table below summarizes all variants:
231 $File::Find::name $File::Find::dir $_
233 no_chdir=>0 /etc / etc
241 When <follow> or <follow_fast> are in effect, there is
242 also a C<$File::Find::fullname>. The function may set
243 C<$File::Find::prune> to prune the tree unless C<bydepth> was
244 specified. Unless C<follow> or C<follow_fast> is specified, for
245 compatibility reasons (find.pl, find2perl) there are in addition the
246 following globals available: C<$File::Find::topdir>,
247 C<$File::Find::topdev>, C<$File::Find::topino>,
248 C<$File::Find::topmode> and C<$File::Find::topnlink>.
250 This library is useful for the C<find2perl> tool, which when fed,
252 find2perl / -name .nfs\* -mtime +7 \
253 -exec rm -f {} \; -o -fstype nfs -prune
255 produces something like:
259 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
263 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
265 ($File::Find::prune = 1);
268 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
269 filehandle that caches the information from the preceding
270 C<stat()>, C<lstat()>, or filetest.
272 Here's another interesting wanted function. It will find all symbolic
273 links that don't resolve:
276 -l && !-e && print "bogus link: $File::Find::name\n";
279 See also the script C<pfind> on CPAN for a nice application of this
284 If you run your program with the C<-w> switch, or if you use the
285 C<warnings> pragma, File::Find will report warnings for several weird
286 situations. You can disable these warnings by putting the statement
288 no warnings 'File::Find';
290 in the appropriate scope. See L<perllexwarn> for more info about lexical
297 =item $dont_use_nlink
299 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
300 force File::Find to always stat directories. This was used for file systems
301 that do not have an C<nlink> count matching the number of sub-directories.
302 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
303 system) and a couple of others.
305 You shouldn't need to set this variable, since File::Find should now detect
306 such file systems on-the-fly and switch itself to using stat. This works even
307 for parts of your file system, like a mounted CD-ROM.
309 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
313 Be aware that the option to follow symbolic links can be dangerous.
314 Depending on the structure of the directory tree (including symbolic
315 links to directories) you might traverse a given (physical) directory
316 more than once (only if C<follow_fast> is in effect).
317 Furthermore, deleting or changing files in a symbolically linked directory
318 might cause very unpleasant surprises, since you delete or change files
319 in an unknown directory.
329 Mac OS (Classic) users should note a few differences:
335 The path separator is ':', not '/', and the current directory is denoted
336 as ':', not '.'. You should be careful about specifying relative pathnames.
337 While a full path always begins with a volume name, a relative pathname
338 should always begin with a ':'. If specifying a volume name only, a
339 trailing ':' is required.
343 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
344 contains the name of a directory, that name may or may not end with a
345 ':'. Likewise, C<$File::Find::name>, which contains the complete
346 pathname to that directory, and C<$File::Find::fullname>, which holds
347 the absolute pathname of that directory with all symbolic links resolved,
348 may or may not end with a ':'.
352 The default C<untaint_pattern> (see above) on Mac OS is set to
353 C<qr|^(.+)$|>. Note that the parentheses are vital.
357 The invisible system file "Icon\015" is ignored. While this file may
358 appear in every directory, there are some more invisible system files
359 on every volume, which are all located at the volume root level (i.e.
360 "MacintoshHD:"). These system files are B<not> excluded automatically.
361 Your filter may use the following code to recognize invisible files or
362 directories (requires Mac::Files):
366 # invisible() -- returns 1 if file/directory is invisible,
367 # 0 if it's visible or undef if an error occurred
371 my ($fileCat, $fileInfo);
372 my $invisible_flag = 1 << 14;
374 if ( $fileCat = FSpGetCatInfo($file) ) {
375 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
376 return (($fileInfo->fdFlags & $invisible_flag) && 1);
382 Generally, invisible files are system files, unless an odd application
383 decides to use invisible files for its own purposes. To distinguish
384 such files from system files, you have to look at the B<type> and B<creator>
385 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
386 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
387 (see MacPerl.pm for details).
389 Files that appear on the desktop actually reside in an (hidden) directory
390 named "Desktop Folder" on the particular disk volume. Note that, although
391 all desktop files appear to be on the same "virtual" desktop, each disk
392 volume actually maintains its own "Desktop Folder" directory.
398 =head1 BUGS AND CAVEATS
400 Despite the name of the C<finddepth()> function, both C<find()> and
401 C<finddepth()> perform a depth-first search of the directory
406 File::Find used to produce incorrect results if called recursively.
407 During the development of perl 5.8 this bug was fixed.
408 The first fixed version of File::Find was 1.01.
412 our @ISA = qw(Exporter);
413 our @EXPORT = qw(find finddepth);
420 require File::Basename;
423 # Should ideally be my() not our() but local() currently
424 # refuses to operate on lexicals
427 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
428 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
429 $pre_process, $post_process, $dangling_symlinks);
434 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
436 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
440 my $abs_name= $cdir . $fn;
442 if (substr($fn,0,3) eq '../') {
443 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
449 # return the absolute name of a directory or file
450 sub contract_name_Mac {
454 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
456 my $colon_count = length ($1);
457 if ($colon_count == 1) {
458 $abs_name = $cdir . $2;
462 # need to move up the tree, but
463 # only if it's not a volume name
464 for (my $i=1; $i<$colon_count; $i++) {
465 unless ($cdir =~ /^[^:]+:$/) { # volume name
466 $cdir =~ s/[^:]+:$//;
472 $abs_name = $cdir . $2;
479 # $fn may be a valid path to a directory or file or (dangling)
480 # symlink, without a leading ':'
481 if ( (-e $fn) || (-l $fn) ) {
482 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
483 return $fn; # $fn is already an absolute path
486 $abs_name = $cdir . $fn;
490 else { # argh!, $fn is not a valid directory/file
496 sub PathCombine($$) {
497 my ($Base,$Name) = @_;
501 # $Name is the resolved symlink (always a full path on MacOS),
502 # i.e. there's no need to call contract_name_Mac()
505 # (simple) check for recursion
506 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
511 if (substr($Name,0,1) eq '/') {
515 $AbsName= contract_name($Base,$Name);
518 # (simple) check for recursion
519 my $newlen= length($AbsName);
520 if ($newlen <= length($Base)) {
521 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
522 && $AbsName eq substr($Base,0,$newlen))
531 sub Follow_SymLink($) {
534 my ($NewName,$DEV, $INO);
535 ($DEV, $INO)= lstat $AbsName;
538 if ($SLnkSeen{$DEV, $INO}++) {
539 if ($follow_skip < 2) {
540 die "$AbsName is encountered a second time";
546 $NewName= PathCombine($AbsName, readlink($AbsName));
547 unless(defined $NewName) {
548 if ($follow_skip < 2) {
549 die "$AbsName is a recursive symbolic link";
558 ($DEV, $INO) = lstat($AbsName);
559 return undef unless defined $DEV; # dangling symbolic link
562 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
563 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
564 die "$AbsName encountered a second time";
574 our($dir, $name, $fullname, $prune);
575 sub _find_dir_symlnk($$$);
578 # check whether or not a scalar variable is tainted
579 # (code straight from the Camel, 3rd ed., page 561)
582 my $nada = substr($arg, 0, 0); # zero-length
584 eval { eval "# $nada" };
585 return length($@) != 0;
590 die "invalid top directory" unless defined $_[0];
592 # This function must local()ize everything because callbacks may
593 # call find() or finddepth()
596 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
597 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
598 $pre_process, $post_process, $dangling_symlinks);
599 local($dir, $name, $fullname, $prune);
602 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
603 my $cwd_untainted = $cwd;
605 $wanted_callback = $wanted->{wanted};
606 $bydepth = $wanted->{bydepth};
607 $pre_process = $wanted->{preprocess};
608 $post_process = $wanted->{postprocess};
609 $no_chdir = $wanted->{no_chdir};
610 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
611 $follow = $^O eq 'MSWin32' ? 0 :
612 $full_check || $wanted->{follow_fast};
613 $follow_skip = $wanted->{follow_skip};
614 $untaint = $wanted->{untaint};
615 $untaint_pat = $wanted->{untaint_pattern};
616 $untaint_skip = $wanted->{untaint_skip};
617 $dangling_symlinks = $wanted->{dangling_symlinks};
619 # for compatibility reasons (find.pl, find2perl)
620 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
622 # a symbolic link to a directory doesn't increase the link count
623 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
625 my ($abs_dir, $Is_Dir);
628 foreach my $TOP (@_) {
631 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
634 $top_item = ":$top_item"
635 if ( (-d _) && ( $top_item !~ /:/ ) );
636 } elsif ($^O eq 'MSWin32') {
637 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
640 $top_item =~ s|/\z|| unless $top_item eq '/';
648 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
650 if ($top_item eq $File::Find::current_dir) {
654 $abs_dir = contract_name_Mac($cwd, $top_item);
655 unless (defined $abs_dir) {
656 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
663 if (substr($top_item,0,1) eq '/') {
664 $abs_dir = $top_item;
666 elsif ($top_item eq $File::Find::current_dir) {
669 else { # care about any ../
670 $abs_dir = contract_name("$cwd/",$top_item);
673 $abs_dir= Follow_SymLink($abs_dir);
674 unless (defined $abs_dir) {
675 if ($dangling_symlinks) {
676 if (ref $dangling_symlinks eq 'CODE') {
677 $dangling_symlinks->($top_item, $cwd);
679 warnings::warnif "$top_item is a dangling symbolic link\n";
686 _find_dir_symlnk($wanted, $abs_dir, $top_item);
692 unless (defined $topnlink) {
693 warnings::warnif "Can't stat $top_item: $!\n";
697 $top_item =~ s/\.dir\z//i if $Is_VMS;
698 _find_dir($wanted, $top_item, $topnlink);
707 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
709 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
712 ($dir,$_) = ('./', $top_item);
717 if (( $untaint ) && (is_tainted($dir) )) {
718 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
719 unless (defined $abs_dir) {
720 if ($untaint_skip == 0) {
721 die "directory $dir is still tainted";
729 unless ($no_chdir || chdir $abs_dir) {
730 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
734 $name = $abs_dir . $_; # $File::Find::name
735 $_ = $name if $no_chdir;
737 { $wanted_callback->() }; # protect against wild "next"
741 unless ( $no_chdir ) {
742 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
743 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
744 unless (defined $cwd_untainted) {
745 die "insecure cwd in find(depth)";
749 unless (chdir $cwd_untainted) {
750 die "Can't cd to $cwd: $!\n";
758 # $p_dir : "parent directory"
759 # $nlink : what came back from the stat
761 # chdir (if not no_chdir) to dir
764 my ($wanted, $p_dir, $nlink) = @_;
765 my ($CdLvl,$Level) = (0,0);
768 my ($subcount,$sub_nlink);
770 my $dir_name= $p_dir;
772 my $dir_rel = $File::Find::current_dir;
777 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
778 } elsif ($^O eq 'MSWin32') {
779 $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
782 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
785 local ($dir, $name, $prune, *DIR);
787 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
789 if (( $untaint ) && (is_tainted($p_dir) )) {
790 ( $udir ) = $p_dir =~ m|$untaint_pat|;
791 unless (defined $udir) {
792 if ($untaint_skip == 0) {
793 die "directory $p_dir is still tainted";
800 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
801 warnings::warnif "Can't cd to $udir: $!\n";
806 # push the starting directory
807 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
810 $p_dir = $dir_pref; # ensure trailing ':'
813 while (defined $SE) {
815 $dir= $p_dir; # $File::Find::dir
816 $name= $dir_name; # $File::Find::name
817 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
818 # prune may happen here
820 { $wanted_callback->() }; # protect against wild "next"
824 # change to that directory
825 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
827 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
828 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
829 unless (defined $udir) {
830 if ($untaint_skip == 0) {
832 die "directory ($p_dir) $dir_rel is still tainted";
835 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
837 } else { # $untaint_skip == 1
842 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
844 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
847 warnings::warnif "Can't cd to (" .
848 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
856 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
859 $dir= $dir_name; # $File::Find::dir
861 # Get the list of files in the current directory.
862 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
863 warnings::warnif "Can't opendir($dir_name): $!\n";
866 @filenames = readdir DIR;
868 @filenames = $pre_process->(@filenames) if $pre_process;
869 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
871 # default: use whatever was specifid
872 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
873 $no_nlink = $avoid_nlink;
874 # if dir has wrong nlink count, force switch to slower stat method
875 $no_nlink = 1 if ($nlink < 2);
877 if ($nlink == 2 && !$no_nlink) {
878 # This dir has no subdirectories.
879 for my $FN (@filenames) {
880 next if $FN =~ $File::Find::skip_pattern;
882 $name = $dir_pref . $FN; # $File::Find::name
883 $_ = ($no_chdir ? $name : $FN); # $_
884 { $wanted_callback->() }; # protect against wild "next"
889 # This dir has subdirectories.
890 $subcount = $nlink - 2;
892 # HACK: insert directories at this position. so as to preserve
893 # the user pre-processed ordering of files.
894 # EG: directory traversal is in user sorted order, not at random.
895 my $stack_top = @Stack;
897 for my $FN (@filenames) {
898 next if $FN =~ $File::Find::skip_pattern;
899 if ($subcount > 0 || $no_nlink) {
900 # Seen all the subdirs?
901 # check for directoriness.
902 # stat is faster for a file in the current directory
903 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
907 $FN =~ s/\.dir\z//i if $Is_VMS;
908 # HACK: replace push to preserve dir traversal order
909 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
910 splice @Stack, $stack_top, 0,
911 [$CdLvl,$dir_name,$FN,$sub_nlink];
914 $name = $dir_pref . $FN; # $File::Find::name
915 $_= ($no_chdir ? $name : $FN); # $_
916 { $wanted_callback->() }; # protect against wild "next"
920 $name = $dir_pref . $FN; # $File::Find::name
921 $_= ($no_chdir ? $name : $FN); # $_
922 { $wanted_callback->() }; # protect against wild "next"
928 while ( defined ($SE = pop @Stack) ) {
929 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
930 if ($CdLvl > $Level && !$no_chdir) {
933 $tmp = (':' x ($CdLvl-$Level)) . ':';
936 $tmp = join('/',('..') x ($CdLvl-$Level));
938 die "Can't cd to $dir_name" . $tmp
944 # $pdir always has a trailing ':', except for the starting dir,
945 # where $dir_rel eq ':'
946 $dir_name = "$p_dir$dir_rel";
947 $dir_pref = "$dir_name:";
949 elsif ($^O eq 'MSWin32') {
950 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
951 $dir_pref = "$dir_name/";
954 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
955 $dir_pref = "$dir_name/";
958 if ( $nlink == -2 ) {
959 $name = $dir = $p_dir; # $File::Find::name / dir
960 $_ = $File::Find::current_dir;
961 $post_process->(); # End-of-directory processing
963 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
966 if ($dir_rel eq ':') { # must be the top dir, where we started
967 $name =~ s|:$||; # $File::Find::name
968 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
970 $dir = $p_dir; # $File::Find::dir
971 $_ = ($no_chdir ? $name : $dir_rel); # $_
974 if ( substr($name,-2) eq '/.' ) {
975 substr($name, length($name) == 2 ? -1 : -2) = '';
978 $_ = ($no_chdir ? $dir_name : $dir_rel );
979 if ( substr($_,-2) eq '/.' ) {
980 substr($_, length($_) == 2 ? -1 : -2) = '';
983 { $wanted_callback->() }; # protect against wild "next"
986 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
996 # $dir_loc : absolute location of a dir
997 # $p_dir : "parent directory"
999 # chdir (if not no_chdir) to dir
1001 sub _find_dir_symlnk($$$) {
1002 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1006 my $updir_loc = $dir_loc; # untainted parent directory
1008 my $dir_name = $p_dir;
1011 my $dir_rel = $File::Find::current_dir;
1012 my $byd_flag; # flag for pending stack entry if $bydepth
1017 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1018 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1020 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1021 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1024 local ($dir, $name, $fullname, $prune, *DIR);
1026 unless ($no_chdir) {
1027 # untaint the topdir
1028 if (( $untaint ) && (is_tainted($dir_loc) )) {
1029 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1030 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1031 # hence, we don't need to untaint the parent directory every time we chdir
1033 unless (defined $updir_loc) {
1034 if ($untaint_skip == 0) {
1035 die "directory $dir_loc is still tainted";
1042 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1044 warnings::warnif "Can't cd to $updir_loc: $!\n";
1049 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1052 $p_dir = $dir_pref; # ensure trailing ':'
1055 while (defined $SE) {
1058 # change (back) to parent directory (always untainted)
1059 unless ($no_chdir) {
1060 unless (chdir $updir_loc) {
1061 warnings::warnif "Can't cd to $updir_loc: $!\n";
1065 $dir= $p_dir; # $File::Find::dir
1066 $name= $dir_name; # $File::Find::name
1067 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1068 $fullname= $dir_loc; # $File::Find::fullname
1069 # prune may happen here
1071 lstat($_); # make sure file tests with '_' work
1072 { $wanted_callback->() }; # protect against wild "next"
1076 # change to that directory
1077 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1078 $updir_loc = $dir_loc;
1079 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1080 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1081 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1082 unless (defined $updir_loc) {
1083 if ($untaint_skip == 0) {
1084 die "directory $dir_loc is still tainted";
1091 unless (chdir $updir_loc) {
1092 warnings::warnif "Can't cd to $updir_loc: $!\n";
1098 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1101 $dir = $dir_name; # $File::Find::dir
1103 # Get the list of files in the current directory.
1104 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1105 warnings::warnif "Can't opendir($dir_loc): $!\n";
1108 @filenames = readdir DIR;
1111 for my $FN (@filenames) {
1112 next if $FN =~ $File::Find::skip_pattern;
1114 # follow symbolic links / do an lstat
1115 $new_loc = Follow_SymLink($loc_pref.$FN);
1117 # ignore if invalid symlink
1118 unless (defined $new_loc) {
1119 if ($dangling_symlinks) {
1120 if (ref $dangling_symlinks eq 'CODE') {
1121 $dangling_symlinks->($FN, $dir_pref);
1123 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1128 $name = $dir_pref . $FN;
1129 $_ = ($no_chdir ? $name : $FN);
1130 { $wanted_callback->() };
1135 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1138 $fullname = $new_loc; # $File::Find::fullname
1139 $name = $dir_pref . $FN; # $File::Find::name
1140 $_ = ($no_chdir ? $name : $FN); # $_
1141 { $wanted_callback->() }; # protect against wild "next"
1147 while (defined($SE = pop @Stack)) {
1148 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1150 # $p_dir always has a trailing ':', except for the starting dir,
1151 # where $dir_rel eq ':'
1152 $dir_name = "$p_dir$dir_rel";
1153 $dir_pref = "$dir_name:";
1154 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1157 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1158 $dir_pref = "$dir_name/";
1159 $loc_pref = "$dir_loc/";
1161 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1162 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1163 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1164 warnings::warnif "Can't cd to $updir_loc: $!\n";
1168 $fullname = $dir_loc; # $File::Find::fullname
1169 $name = $dir_name; # $File::Find::name
1171 if ($dir_rel eq ':') { # must be the top dir, where we started
1172 $name =~ s|:$||; # $File::Find::name
1173 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1175 $dir = $p_dir; # $File::Find::dir
1176 $_ = ($no_chdir ? $name : $dir_rel); # $_
1179 if ( substr($name,-2) eq '/.' ) {
1180 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1182 $dir = $p_dir; # $File::Find::dir
1183 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1184 if ( substr($_,-2) eq '/.' ) {
1185 substr($_, length($_) == 2 ? -1 : -2) = '';
1189 lstat($_); # make sure file tests with '_' work
1190 { $wanted_callback->() }; # protect against wild "next"
1193 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1203 if ( ref($wanted) eq 'HASH' ) {
1204 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1205 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1207 if ( $wanted->{untaint} ) {
1208 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1209 unless defined $wanted->{untaint_pattern};
1210 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1215 return { wanted => $wanted };
1221 _find_opt(wrap_wanted($wanted), @_);
1225 my $wanted = wrap_wanted(shift);
1226 $wanted->{bydepth} = 1;
1227 _find_opt($wanted, @_);
1231 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1232 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1234 # These are hard-coded for now, but may move to hint files.
1237 $File::Find::dont_use_nlink = 1;
1239 elsif ($^O eq 'MacOS') {
1241 $File::Find::dont_use_nlink = 1;
1242 $File::Find::skip_pattern = qr/^Icon\015\z/;
1243 $File::Find::untaint_pattern = qr|^(.+)$|;
1246 # this _should_ work properly on all platforms
1247 # where File::Find can be expected to work
1248 $File::Find::current_dir = File::Spec->curdir || '.';
1250 $File::Find::dont_use_nlink = 1
1251 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1252 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1255 # Set dont_use_nlink in your hint file if your system's stat doesn't
1256 # report the number of links in a directory as an indication
1257 # of the number of files.
1258 # See, e.g. hints/machten.sh for MachTen 2.2.
1259 unless ($File::Find::dont_use_nlink) {
1261 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1264 # We need a function that checks if a scalar is tainted. Either use the
1265 # Scalar::Util module's tainted() function or our (slower) pure Perl
1266 # fallback is_tainted_pp()
1269 eval { require Scalar::Util };
1270 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;