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 it 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<_>.
125 Note that this guarantee no longer holds if I<follow> or I<follow_fast>
130 There is a variable C<$File::Find::fullname> which holds the absolute
131 pathname of the file with all symbolic links resolved. If the link is
132 a dangling symbolic link, then fullname will be set to C<undef>.
136 This is a no-op on Win32.
140 This is similar to I<follow> except that it may report some files more
141 than once. It does detect cycles, however. Since only symbolic links
142 have to be hashed, this is much cheaper both in space and time. If
143 processing a file more than once (by the user's C<wanted()> function)
144 is worse than just taking time, the option I<follow> should be used.
146 This is also a no-op on Win32.
150 C<follow_skip==1>, which is the default, causes all files which are
151 neither directories nor symbolic links to be ignored if they are about
152 to be processed a second time. If a directory or a symbolic link
153 are about to be processed a second time, File::Find dies.
155 C<follow_skip==0> causes File::Find to die if any file is about to be
156 processed a second time.
158 C<follow_skip==2> causes File::Find to ignore any duplicate files and
159 directories but to proceed normally otherwise.
161 =item C<dangling_symlinks>
163 If true and a code reference, will be called with the symbolic link
164 name and the directory it lives in as arguments. Otherwise, if true
165 and warnings are on, warning "symbolic_link_name is a dangling
166 symbolic link\n" will be issued. If false, the dangling symbolic link
167 will be silently ignored.
171 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
172 function will need to be aware of this, of course. In this case,
173 C<$_> will be the same as C<$File::Find::name>.
177 If find is used in taint-mode (-T command line switch or if EUID != UID
178 or if EGID != GID) then internally directory names have to be untainted
179 before they can be chdir'ed to. Therefore they are checked against a regular
180 expression I<untaint_pattern>. Note that all names passed to the user's
181 I<wanted()> function are still tainted. If this option is used while
182 not in taint-mode, C<untaint> is a no-op.
184 =item C<untaint_pattern>
186 See above. This should be set using the C<qr> quoting operator.
187 The default is set to C<qr|^([-+@\w./]+)$|>.
188 Note that the parentheses are vital.
190 =item C<untaint_skip>
192 If set, a directory which fails the I<untaint_pattern> is skipped,
193 including all its sub-directories. The default is to 'die' in such a case.
197 =head2 The wanted function
199 The C<wanted()> function does whatever verifications you want on
200 each file and directory. Note that despite its name, the C<wanted()>
201 function is a generic callback function, and does B<not> tell
202 File::Find if a file is "wanted" or not. In fact, its return value
205 The wanted function takes no arguments but rather does its work
206 through a collection of variables.
210 =item C<$File::Find::dir> is the current directory name,
212 =item C<$_> is the current filename within that directory
214 =item C<$File::Find::name> is the complete pathname to the file.
218 The above variables have all been localized and may be changed without
219 effecting data outside of the wanted function.
221 For example, when examining the file F</some/path/foo.ext> you will have:
223 $File::Find::dir = /some/path/
225 $File::Find::name = /some/path/foo.ext
227 You are chdir()'d to C<$File::Find::dir> when the function is called,
228 unless C<no_chdir> was specified. Note that when changing to
229 directories is in effect the root directory (F</>) is a somewhat
230 special case inasmuch as the concatenation of C<$File::Find::dir>,
231 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
232 table below summarizes all variants:
234 $File::Find::name $File::Find::dir $_
236 no_chdir=>0 /etc / etc
244 When <follow> or <follow_fast> are in effect, there is
245 also a C<$File::Find::fullname>. The function may set
246 C<$File::Find::prune> to prune the tree unless C<bydepth> was
247 specified. Unless C<follow> or C<follow_fast> is specified, for
248 compatibility reasons (find.pl, find2perl) there are in addition the
249 following globals available: C<$File::Find::topdir>,
250 C<$File::Find::topdev>, C<$File::Find::topino>,
251 C<$File::Find::topmode> and C<$File::Find::topnlink>.
253 This library is useful for the C<find2perl> tool, which when fed,
255 find2perl / -name .nfs\* -mtime +7 \
256 -exec rm -f {} \; -o -fstype nfs -prune
258 produces something like:
262 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
266 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
268 ($File::Find::prune = 1);
271 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
272 filehandle that caches the information from the preceding
273 C<stat()>, C<lstat()>, or filetest.
275 Here's another interesting wanted function. It will find all symbolic
276 links that don't resolve:
279 -l && !-e && print "bogus link: $File::Find::name\n";
282 See also the script C<pfind> on CPAN for a nice application of this
287 If you run your program with the C<-w> switch, or if you use the
288 C<warnings> pragma, File::Find will report warnings for several weird
289 situations. You can disable these warnings by putting the statement
291 no warnings 'File::Find';
293 in the appropriate scope. See L<perllexwarn> for more info about lexical
300 =item $dont_use_nlink
302 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
303 force File::Find to always stat directories. This was used for file systems
304 that do not have an C<nlink> count matching the number of sub-directories.
305 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
306 system) and a couple of others.
308 You shouldn't need to set this variable, since File::Find should now detect
309 such file systems on-the-fly and switch itself to using stat. This works even
310 for parts of your file system, like a mounted CD-ROM.
312 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
316 Be aware that the option to follow symbolic links can be dangerous.
317 Depending on the structure of the directory tree (including symbolic
318 links to directories) you might traverse a given (physical) directory
319 more than once (only if C<follow_fast> is in effect).
320 Furthermore, deleting or changing files in a symbolically linked directory
321 might cause very unpleasant surprises, since you delete or change files
322 in an unknown directory.
332 Mac OS (Classic) users should note a few differences:
338 The path separator is ':', not '/', and the current directory is denoted
339 as ':', not '.'. You should be careful about specifying relative pathnames.
340 While a full path always begins with a volume name, a relative pathname
341 should always begin with a ':'. If specifying a volume name only, a
342 trailing ':' is required.
346 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
347 contains the name of a directory, that name may or may not end with a
348 ':'. Likewise, C<$File::Find::name>, which contains the complete
349 pathname to that directory, and C<$File::Find::fullname>, which holds
350 the absolute pathname of that directory with all symbolic links resolved,
351 may or may not end with a ':'.
355 The default C<untaint_pattern> (see above) on Mac OS is set to
356 C<qr|^(.+)$|>. Note that the parentheses are vital.
360 The invisible system file "Icon\015" is ignored. While this file may
361 appear in every directory, there are some more invisible system files
362 on every volume, which are all located at the volume root level (i.e.
363 "MacintoshHD:"). These system files are B<not> excluded automatically.
364 Your filter may use the following code to recognize invisible files or
365 directories (requires Mac::Files):
369 # invisible() -- returns 1 if file/directory is invisible,
370 # 0 if it's visible or undef if an error occurred
374 my ($fileCat, $fileInfo);
375 my $invisible_flag = 1 << 14;
377 if ( $fileCat = FSpGetCatInfo($file) ) {
378 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
379 return (($fileInfo->fdFlags & $invisible_flag) && 1);
385 Generally, invisible files are system files, unless an odd application
386 decides to use invisible files for its own purposes. To distinguish
387 such files from system files, you have to look at the B<type> and B<creator>
388 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
389 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
390 (see MacPerl.pm for details).
392 Files that appear on the desktop actually reside in an (hidden) directory
393 named "Desktop Folder" on the particular disk volume. Note that, although
394 all desktop files appear to be on the same "virtual" desktop, each disk
395 volume actually maintains its own "Desktop Folder" directory.
401 =head1 BUGS AND CAVEATS
403 Despite the name of the C<finddepth()> function, both C<find()> and
404 C<finddepth()> perform a depth-first search of the directory
409 File::Find used to produce incorrect results if called recursively.
410 During the development of perl 5.8 this bug was fixed.
411 The first fixed version of File::Find was 1.01.
415 our @ISA = qw(Exporter);
416 our @EXPORT = qw(find finddepth);
423 require File::Basename;
426 # Should ideally be my() not our() but local() currently
427 # refuses to operate on lexicals
430 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
431 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
432 $pre_process, $post_process, $dangling_symlinks);
437 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
439 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
443 my $abs_name= $cdir . $fn;
445 if (substr($fn,0,3) eq '../') {
446 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
452 # return the absolute name of a directory or file
453 sub contract_name_Mac {
457 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
459 my $colon_count = length ($1);
460 if ($colon_count == 1) {
461 $abs_name = $cdir . $2;
465 # need to move up the tree, but
466 # only if it's not a volume name
467 for (my $i=1; $i<$colon_count; $i++) {
468 unless ($cdir =~ /^[^:]+:$/) { # volume name
469 $cdir =~ s/[^:]+:$//;
475 $abs_name = $cdir . $2;
482 # $fn may be a valid path to a directory or file or (dangling)
483 # symlink, without a leading ':'
484 if ( (-e $fn) || (-l $fn) ) {
485 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
486 return $fn; # $fn is already an absolute path
489 $abs_name = $cdir . $fn;
493 else { # argh!, $fn is not a valid directory/file
499 sub PathCombine($$) {
500 my ($Base,$Name) = @_;
504 # $Name is the resolved symlink (always a full path on MacOS),
505 # i.e. there's no need to call contract_name_Mac()
508 # (simple) check for recursion
509 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
514 if (substr($Name,0,1) eq '/') {
518 $AbsName= contract_name($Base,$Name);
521 # (simple) check for recursion
522 my $newlen= length($AbsName);
523 if ($newlen <= length($Base)) {
524 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
525 && $AbsName eq substr($Base,0,$newlen))
534 sub Follow_SymLink($) {
537 my ($NewName,$DEV, $INO);
538 ($DEV, $INO)= lstat $AbsName;
541 if ($SLnkSeen{$DEV, $INO}++) {
542 if ($follow_skip < 2) {
543 die "$AbsName is encountered a second time";
549 $NewName= PathCombine($AbsName, readlink($AbsName));
550 unless(defined $NewName) {
551 if ($follow_skip < 2) {
552 die "$AbsName is a recursive symbolic link";
561 ($DEV, $INO) = lstat($AbsName);
562 return undef unless defined $DEV; # dangling symbolic link
565 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
566 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
567 die "$AbsName encountered a second time";
577 our($dir, $name, $fullname, $prune);
578 sub _find_dir_symlnk($$$);
581 # check whether or not a scalar variable is tainted
582 # (code straight from the Camel, 3rd ed., page 561)
585 my $nada = substr($arg, 0, 0); # zero-length
587 eval { eval "# $nada" };
588 return length($@) != 0;
593 die "invalid top directory" unless defined $_[0];
595 # This function must local()ize everything because callbacks may
596 # call find() or finddepth()
599 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
600 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
601 $pre_process, $post_process, $dangling_symlinks);
602 local($dir, $name, $fullname, $prune);
605 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
607 # VMS returns this by default in VMS format which just doesn't
608 # work for the rest of this module.
609 $cwd = VMS::Filespec::unixpath($cwd);
611 # Apparently this is not expected to have a trailing space.
612 # To attempt to make VMS/UNIX conversions mostly reversable,
613 # a trailing slash is needed. The run-time functions ignore the
614 # resulting double slash, but it causes the perl tests to fail.
617 # This comes up in upper case now, but should be lower.
618 # In the future this could be exact case, no need to change.
620 my $cwd_untainted = $cwd;
622 $wanted_callback = $wanted->{wanted};
623 $bydepth = $wanted->{bydepth};
624 $pre_process = $wanted->{preprocess};
625 $post_process = $wanted->{postprocess};
626 $no_chdir = $wanted->{no_chdir};
627 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
628 $follow = $^O eq 'MSWin32' ? 0 :
629 $full_check || $wanted->{follow_fast};
630 $follow_skip = $wanted->{follow_skip};
631 $untaint = $wanted->{untaint};
632 $untaint_pat = $wanted->{untaint_pattern};
633 $untaint_skip = $wanted->{untaint_skip};
634 $dangling_symlinks = $wanted->{dangling_symlinks};
636 # for compatibility reasons (find.pl, find2perl)
637 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
639 # a symbolic link to a directory doesn't increase the link count
640 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
642 my ($abs_dir, $Is_Dir);
645 foreach my $TOP (@_) {
648 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
651 $top_item = ":$top_item"
652 if ( (-d _) && ( $top_item !~ /:/ ) );
653 } elsif ($^O eq 'MSWin32') {
654 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
657 $top_item =~ s|/\z|| unless $top_item eq '/';
665 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
667 if ($top_item eq $File::Find::current_dir) {
671 $abs_dir = contract_name_Mac($cwd, $top_item);
672 unless (defined $abs_dir) {
673 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
680 if (substr($top_item,0,1) eq '/') {
681 $abs_dir = $top_item;
683 elsif ($top_item eq $File::Find::current_dir) {
686 else { # care about any ../
687 $top_item =~ s/\.dir\z//i if $Is_VMS;
688 $abs_dir = contract_name("$cwd/",$top_item);
691 $abs_dir= Follow_SymLink($abs_dir);
692 unless (defined $abs_dir) {
693 if ($dangling_symlinks) {
694 if (ref $dangling_symlinks eq 'CODE') {
695 $dangling_symlinks->($top_item, $cwd);
697 warnings::warnif "$top_item is a dangling symbolic link\n";
704 $top_item =~ s/\.dir\z//i if $Is_VMS;
705 _find_dir_symlnk($wanted, $abs_dir, $top_item);
711 unless (defined $topnlink) {
712 warnings::warnif "Can't stat $top_item: $!\n";
716 $top_item =~ s/\.dir\z//i if $Is_VMS;
717 _find_dir($wanted, $top_item, $topnlink);
726 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
728 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
731 ($dir,$_) = ('./', $top_item);
736 if (( $untaint ) && (is_tainted($dir) )) {
737 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
738 unless (defined $abs_dir) {
739 if ($untaint_skip == 0) {
740 die "directory $dir is still tainted";
748 unless ($no_chdir || chdir $abs_dir) {
749 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
753 $name = $abs_dir . $_; # $File::Find::name
754 $_ = $name if $no_chdir;
756 { $wanted_callback->() }; # protect against wild "next"
760 unless ( $no_chdir ) {
761 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
762 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
763 unless (defined $cwd_untainted) {
764 die "insecure cwd in find(depth)";
768 unless (chdir $cwd_untainted) {
769 die "Can't cd to $cwd: $!\n";
777 # $p_dir : "parent directory"
778 # $nlink : what came back from the stat
780 # chdir (if not no_chdir) to dir
783 my ($wanted, $p_dir, $nlink) = @_;
784 my ($CdLvl,$Level) = (0,0);
787 my ($subcount,$sub_nlink);
789 my $dir_name= $p_dir;
791 my $dir_rel = $File::Find::current_dir;
796 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
797 } elsif ($^O eq 'MSWin32') {
798 $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
799 } elsif ($^O eq 'VMS') {
801 # VMS is returning trailing .dir on directories
802 # and trailing . on files and symbolic links
806 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
808 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
811 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
814 local ($dir, $name, $prune, *DIR);
816 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
818 if (( $untaint ) && (is_tainted($p_dir) )) {
819 ( $udir ) = $p_dir =~ m|$untaint_pat|;
820 unless (defined $udir) {
821 if ($untaint_skip == 0) {
822 die "directory $p_dir is still tainted";
829 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
830 warnings::warnif "Can't cd to $udir: $!\n";
835 # push the starting directory
836 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
839 $p_dir = $dir_pref; # ensure trailing ':'
842 while (defined $SE) {
844 $dir= $p_dir; # $File::Find::dir
845 $name= $dir_name; # $File::Find::name
846 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
847 # prune may happen here
849 { $wanted_callback->() }; # protect against wild "next"
853 # change to that directory
854 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
856 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
857 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
858 unless (defined $udir) {
859 if ($untaint_skip == 0) {
861 die "directory ($p_dir) $dir_rel is still tainted";
864 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
866 } else { # $untaint_skip == 1
871 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
873 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
876 warnings::warnif "Can't cd to (" .
877 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
885 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
888 $dir= $dir_name; # $File::Find::dir
890 # Get the list of files in the current directory.
891 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
892 warnings::warnif "Can't opendir($dir_name): $!\n";
895 @filenames = readdir DIR;
897 @filenames = $pre_process->(@filenames) if $pre_process;
898 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
900 # default: use whatever was specifid
901 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
902 $no_nlink = $avoid_nlink;
903 # if dir has wrong nlink count, force switch to slower stat method
904 $no_nlink = 1 if ($nlink < 2);
906 if ($nlink == 2 && !$no_nlink) {
907 # This dir has no subdirectories.
908 for my $FN (@filenames) {
910 # Big hammer here - Compensate for VMS trailing . and .dir
911 # No win situation until this is changed, but this
912 # will handle the majority of the cases with breaking the fewest
915 $FN =~ s#\.$## if ($FN ne '.');
917 next if $FN =~ $File::Find::skip_pattern;
919 $name = $dir_pref . $FN; # $File::Find::name
920 $_ = ($no_chdir ? $name : $FN); # $_
921 { $wanted_callback->() }; # protect against wild "next"
926 # This dir has subdirectories.
927 $subcount = $nlink - 2;
929 # HACK: insert directories at this position. so as to preserve
930 # the user pre-processed ordering of files.
931 # EG: directory traversal is in user sorted order, not at random.
932 my $stack_top = @Stack;
934 for my $FN (@filenames) {
935 next if $FN =~ $File::Find::skip_pattern;
936 if ($subcount > 0 || $no_nlink) {
937 # Seen all the subdirs?
938 # check for directoriness.
939 # stat is faster for a file in the current directory
940 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
944 $FN =~ s/\.dir\z//i if $Is_VMS;
945 # HACK: replace push to preserve dir traversal order
946 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
947 splice @Stack, $stack_top, 0,
948 [$CdLvl,$dir_name,$FN,$sub_nlink];
951 $name = $dir_pref . $FN; # $File::Find::name
952 $_= ($no_chdir ? $name : $FN); # $_
953 { $wanted_callback->() }; # protect against wild "next"
957 $name = $dir_pref . $FN; # $File::Find::name
958 $_= ($no_chdir ? $name : $FN); # $_
959 { $wanted_callback->() }; # protect against wild "next"
965 while ( defined ($SE = pop @Stack) ) {
966 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
967 if ($CdLvl > $Level && !$no_chdir) {
970 $tmp = (':' x ($CdLvl-$Level)) . ':';
973 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
976 $tmp = join('/',('..') x ($CdLvl-$Level));
978 die "Can't cd to $tmp from $dir_name"
984 # $pdir always has a trailing ':', except for the starting dir,
985 # where $dir_rel eq ':'
986 $dir_name = "$p_dir$dir_rel";
987 $dir_pref = "$dir_name:";
989 elsif ($^O eq 'MSWin32') {
990 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
991 $dir_pref = "$dir_name/";
993 elsif ($^O eq 'VMS') {
994 if ($p_dir =~ m/[\]>]+$/) {
996 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
997 $dir_pref = $dir_name;
1000 $dir_name = "$p_dir/$dir_rel";
1001 $dir_pref = "$dir_name/";
1005 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1006 $dir_pref = "$dir_name/";
1009 if ( $nlink == -2 ) {
1010 $name = $dir = $p_dir; # $File::Find::name / dir
1011 $_ = $File::Find::current_dir;
1012 $post_process->(); # End-of-directory processing
1014 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
1017 if ($dir_rel eq ':') { # must be the top dir, where we started
1018 $name =~ s|:$||; # $File::Find::name
1019 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1021 $dir = $p_dir; # $File::Find::dir
1022 $_ = ($no_chdir ? $name : $dir_rel); # $_
1025 if ( substr($name,-2) eq '/.' ) {
1026 substr($name, length($name) == 2 ? -1 : -2) = '';
1029 $_ = ($no_chdir ? $dir_name : $dir_rel );
1030 if ( substr($_,-2) eq '/.' ) {
1031 substr($_, length($_) == 2 ? -1 : -2) = '';
1034 { $wanted_callback->() }; # protect against wild "next"
1037 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
1047 # $dir_loc : absolute location of a dir
1048 # $p_dir : "parent directory"
1050 # chdir (if not no_chdir) to dir
1052 sub _find_dir_symlnk($$$) {
1053 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1057 my $updir_loc = $dir_loc; # untainted parent directory
1059 my $dir_name = $p_dir;
1062 my $dir_rel = $File::Find::current_dir;
1063 my $byd_flag; # flag for pending stack entry if $bydepth
1068 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1069 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1071 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1072 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1075 local ($dir, $name, $fullname, $prune, *DIR);
1077 unless ($no_chdir) {
1078 # untaint the topdir
1079 if (( $untaint ) && (is_tainted($dir_loc) )) {
1080 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1081 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1082 # hence, we don't need to untaint the parent directory every time we chdir
1084 unless (defined $updir_loc) {
1085 if ($untaint_skip == 0) {
1086 die "directory $dir_loc is still tainted";
1093 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1095 warnings::warnif "Can't cd to $updir_loc: $!\n";
1100 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1103 $p_dir = $dir_pref; # ensure trailing ':'
1106 while (defined $SE) {
1109 # change (back) to parent directory (always untainted)
1110 unless ($no_chdir) {
1111 unless (chdir $updir_loc) {
1112 warnings::warnif "Can't cd to $updir_loc: $!\n";
1116 $dir= $p_dir; # $File::Find::dir
1117 $name= $dir_name; # $File::Find::name
1118 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1119 $fullname= $dir_loc; # $File::Find::fullname
1120 # prune may happen here
1122 lstat($_); # make sure file tests with '_' work
1123 { $wanted_callback->() }; # protect against wild "next"
1127 # change to that directory
1128 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1129 $updir_loc = $dir_loc;
1130 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1131 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1132 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1133 unless (defined $updir_loc) {
1134 if ($untaint_skip == 0) {
1135 die "directory $dir_loc is still tainted";
1142 unless (chdir $updir_loc) {
1143 warnings::warnif "Can't cd to $updir_loc: $!\n";
1149 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1152 $dir = $dir_name; # $File::Find::dir
1154 # Get the list of files in the current directory.
1155 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1156 warnings::warnif "Can't opendir($dir_loc): $!\n";
1159 @filenames = readdir DIR;
1162 for my $FN (@filenames) {
1164 # Big hammer here - Compensate for VMS trailing . and .dir
1165 # No win situation until this is changed, but this
1166 # will handle the majority of the cases with breaking the fewest.
1168 $FN =~ s/\.dir\z//i;
1169 $FN =~ s#\.$## if ($FN ne '.');
1171 next if $FN =~ $File::Find::skip_pattern;
1173 # follow symbolic links / do an lstat
1174 $new_loc = Follow_SymLink($loc_pref.$FN);
1176 # ignore if invalid symlink
1177 unless (defined $new_loc) {
1178 if (!defined -l _ && $dangling_symlinks) {
1179 if (ref $dangling_symlinks eq 'CODE') {
1180 $dangling_symlinks->($FN, $dir_pref);
1182 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1187 $name = $dir_pref . $FN;
1188 $_ = ($no_chdir ? $name : $FN);
1189 { $wanted_callback->() };
1195 $FN =~ s/\.dir\z//i;
1196 $FN =~ s#\.$## if ($FN ne '.');
1197 $new_loc =~ s/\.dir\z//i;
1198 $new_loc =~ s#\.$## if ($new_loc ne '.');
1200 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1203 $fullname = $new_loc; # $File::Find::fullname
1204 $name = $dir_pref . $FN; # $File::Find::name
1205 $_ = ($no_chdir ? $name : $FN); # $_
1206 { $wanted_callback->() }; # protect against wild "next"
1212 while (defined($SE = pop @Stack)) {
1213 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1215 # $p_dir always has a trailing ':', except for the starting dir,
1216 # where $dir_rel eq ':'
1217 $dir_name = "$p_dir$dir_rel";
1218 $dir_pref = "$dir_name:";
1219 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1222 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1223 $dir_pref = "$dir_name/";
1224 $loc_pref = "$dir_loc/";
1226 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1227 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1228 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1229 warnings::warnif "Can't cd to $updir_loc: $!\n";
1233 $fullname = $dir_loc; # $File::Find::fullname
1234 $name = $dir_name; # $File::Find::name
1236 if ($dir_rel eq ':') { # must be the top dir, where we started
1237 $name =~ s|:$||; # $File::Find::name
1238 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1240 $dir = $p_dir; # $File::Find::dir
1241 $_ = ($no_chdir ? $name : $dir_rel); # $_
1244 if ( substr($name,-2) eq '/.' ) {
1245 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1247 $dir = $p_dir; # $File::Find::dir
1248 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1249 if ( substr($_,-2) eq '/.' ) {
1250 substr($_, length($_) == 2 ? -1 : -2) = '';
1254 lstat($_); # make sure file tests with '_' work
1255 { $wanted_callback->() }; # protect against wild "next"
1258 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1268 if ( ref($wanted) eq 'HASH' ) {
1269 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1270 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1272 if ( $wanted->{untaint} ) {
1273 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1274 unless defined $wanted->{untaint_pattern};
1275 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1280 return { wanted => $wanted };
1286 _find_opt(wrap_wanted($wanted), @_);
1290 my $wanted = wrap_wanted(shift);
1291 $wanted->{bydepth} = 1;
1292 _find_opt($wanted, @_);
1296 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1297 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1299 # These are hard-coded for now, but may move to hint files.
1302 $File::Find::dont_use_nlink = 1;
1304 elsif ($^O eq 'MacOS') {
1306 $File::Find::dont_use_nlink = 1;
1307 $File::Find::skip_pattern = qr/^Icon\015\z/;
1308 $File::Find::untaint_pattern = qr|^(.+)$|;
1311 # this _should_ work properly on all platforms
1312 # where File::Find can be expected to work
1313 $File::Find::current_dir = File::Spec->curdir || '.';
1315 $File::Find::dont_use_nlink = 1
1316 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1317 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1320 # Set dont_use_nlink in your hint file if your system's stat doesn't
1321 # report the number of links in a directory as an indication
1322 # of the number of files.
1323 # See, e.g. hints/machten.sh for MachTen 2.2.
1324 unless ($File::Find::dont_use_nlink) {
1326 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1329 # We need a function that checks if a scalar is tainted. Either use the
1330 # Scalar::Util module's tainted() function or our (slower) pure Perl
1331 # fallback is_tainted_pp()
1334 eval { require Scalar::Util };
1335 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;