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. The C<&wanted> subroutine is
86 Reports the name of a directory only AFTER all its entries
87 have been reported. Entry point C<finddepth()> is a shortcut for
88 specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
92 The value should be a code reference. This code reference is used to
93 preprocess the current directory. The name of the currently processed
94 directory is in C<$File::Find::dir>. Your preprocessing function is
95 called after C<readdir()>, but before the loop that calls the C<wanted()>
96 function. It is called with a list of strings (actually file/directory
97 names) and is expected to return a list of strings. The code can be
98 used to sort the file/directory names alphabetically, numerically,
99 or to filter out directory entries based on their name alone. When
100 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
104 The value should be a code reference. It is invoked just before leaving
105 the currently processed directory. It is called in void context with no
106 arguments. The name of the current directory is in C<$File::Find::dir>. This
107 hook is handy for summarizing a directory, such as calculating its disk
108 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
113 Causes symbolic links to be followed. Since directory trees with symbolic
114 links (followed) may contain files more than once and may even have
115 cycles, a hash has to be built up with an entry for each file.
116 This might be expensive both in space and time for a large
117 directory tree. See I<follow_fast> and I<follow_skip> below.
118 If either I<follow> or I<follow_fast> is in effect:
124 It is guaranteed that an I<lstat> has been called before the user's
125 C<wanted()> function is called. This enables fast file checks involving S<_>.
126 Note that this guarantee no longer holds if I<follow> or I<follow_fast>
131 There is a variable C<$File::Find::fullname> which holds the absolute
132 pathname of the file with all symbolic links resolved. If the link is
133 a dangling symbolic link, then fullname will be set to C<undef>.
137 This is a no-op on Win32.
141 This is similar to I<follow> except that it may report some files more
142 than once. It does detect cycles, however. Since only symbolic links
143 have to be hashed, this is much cheaper both in space and time. If
144 processing a file more than once (by the user's C<wanted()> function)
145 is worse than just taking time, the option I<follow> should be used.
147 This is also a no-op on Win32.
151 C<follow_skip==1>, which is the default, causes all files which are
152 neither directories nor symbolic links to be ignored if they are about
153 to be processed a second time. If a directory or a symbolic link
154 are about to be processed a second time, File::Find dies.
156 C<follow_skip==0> causes File::Find to die if any file is about to be
157 processed a second time.
159 C<follow_skip==2> causes File::Find to ignore any duplicate files and
160 directories but to proceed normally otherwise.
162 =item C<dangling_symlinks>
164 If true and a code reference, will be called with the symbolic link
165 name and the directory it lives in as arguments. Otherwise, if true
166 and warnings are on, warning "symbolic_link_name is a dangling
167 symbolic link\n" will be issued. If false, the dangling symbolic link
168 will be silently ignored.
172 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
173 function will need to be aware of this, of course. In this case,
174 C<$_> will be the same as C<$File::Find::name>.
178 If find is used in taint-mode (-T command line switch or if EUID != UID
179 or if EGID != GID) then internally directory names have to be untainted
180 before they can be chdir'ed to. Therefore they are checked against a regular
181 expression I<untaint_pattern>. Note that all names passed to the user's
182 I<wanted()> function are still tainted. If this option is used while
183 not in taint-mode, C<untaint> is a no-op.
185 =item C<untaint_pattern>
187 See above. This should be set using the C<qr> quoting operator.
188 The default is set to C<qr|^([-+@\w./]+)$|>.
189 Note that the parentheses are vital.
191 =item C<untaint_skip>
193 If set, a directory which fails the I<untaint_pattern> is skipped,
194 including all its sub-directories. The default is to 'die' in such a case.
198 =head2 The wanted function
200 The C<wanted()> function does whatever verifications you want on
201 each file and directory. Note that despite its name, the C<wanted()>
202 function is a generic callback function, and does B<not> tell
203 File::Find if a file is "wanted" or not. In fact, its return value
206 The wanted function takes no arguments but rather does its work
207 through a collection of variables.
211 =item C<$File::Find::dir> is the current directory name,
213 =item C<$_> is the current filename within that directory
215 =item C<$File::Find::name> is the complete pathname to the file.
219 The above variables have all been localized and may be changed without
220 effecting data outside of the wanted function.
222 For example, when examining the file F</some/path/foo.ext> you will have:
224 $File::Find::dir = /some/path/
226 $File::Find::name = /some/path/foo.ext
228 You are chdir()'d to C<$File::Find::dir> when the function is called,
229 unless C<no_chdir> was specified. Note that when changing to
230 directories is in effect the root directory (F</>) is a somewhat
231 special case inasmuch as the concatenation of C<$File::Find::dir>,
232 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
233 table below summarizes all variants:
235 $File::Find::name $File::Find::dir $_
237 no_chdir=>0 /etc / etc
245 When C<follow> or C<follow_fast> are in effect, there is
246 also a C<$File::Find::fullname>. The function may set
247 C<$File::Find::prune> to prune the tree unless C<bydepth> was
248 specified. Unless C<follow> or C<follow_fast> is specified, for
249 compatibility reasons (find.pl, find2perl) there are in addition the
250 following globals available: C<$File::Find::topdir>,
251 C<$File::Find::topdev>, C<$File::Find::topino>,
252 C<$File::Find::topmode> and C<$File::Find::topnlink>.
254 This library is useful for the C<find2perl> tool, which when fed,
256 find2perl / -name .nfs\* -mtime +7 \
257 -exec rm -f {} \; -o -fstype nfs -prune
259 produces something like:
263 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
267 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
269 ($File::Find::prune = 1);
272 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
273 filehandle that caches the information from the preceding
274 C<stat()>, C<lstat()>, or filetest.
276 Here's another interesting wanted function. It will find all symbolic
277 links that don't resolve:
280 -l && !-e && print "bogus link: $File::Find::name\n";
283 See also the script C<pfind> on CPAN for a nice application of this
288 If you run your program with the C<-w> switch, or if you use the
289 C<warnings> pragma, File::Find will report warnings for several weird
290 situations. You can disable these warnings by putting the statement
292 no warnings 'File::Find';
294 in the appropriate scope. See L<perllexwarn> for more info about lexical
301 =item $dont_use_nlink
303 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
304 force File::Find to always stat directories. This was used for file systems
305 that do not have an C<nlink> count matching the number of sub-directories.
306 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
307 system) and a couple of others.
309 You shouldn't need to set this variable, since File::Find should now detect
310 such file systems on-the-fly and switch itself to using stat. This works even
311 for parts of your file system, like a mounted CD-ROM.
313 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
317 Be aware that the option to follow symbolic links can be dangerous.
318 Depending on the structure of the directory tree (including symbolic
319 links to directories) you might traverse a given (physical) directory
320 more than once (only if C<follow_fast> is in effect).
321 Furthermore, deleting or changing files in a symbolically linked directory
322 might cause very unpleasant surprises, since you delete or change files
323 in an unknown directory.
333 Mac OS (Classic) users should note a few differences:
339 The path separator is ':', not '/', and the current directory is denoted
340 as ':', not '.'. You should be careful about specifying relative pathnames.
341 While a full path always begins with a volume name, a relative pathname
342 should always begin with a ':'. If specifying a volume name only, a
343 trailing ':' is required.
347 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
348 contains the name of a directory, that name may or may not end with a
349 ':'. Likewise, C<$File::Find::name>, which contains the complete
350 pathname to that directory, and C<$File::Find::fullname>, which holds
351 the absolute pathname of that directory with all symbolic links resolved,
352 may or may not end with a ':'.
356 The default C<untaint_pattern> (see above) on Mac OS is set to
357 C<qr|^(.+)$|>. Note that the parentheses are vital.
361 The invisible system file "Icon\015" is ignored. While this file may
362 appear in every directory, there are some more invisible system files
363 on every volume, which are all located at the volume root level (i.e.
364 "MacintoshHD:"). These system files are B<not> excluded automatically.
365 Your filter may use the following code to recognize invisible files or
366 directories (requires Mac::Files):
370 # invisible() -- returns 1 if file/directory is invisible,
371 # 0 if it's visible or undef if an error occurred
375 my ($fileCat, $fileInfo);
376 my $invisible_flag = 1 << 14;
378 if ( $fileCat = FSpGetCatInfo($file) ) {
379 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
380 return (($fileInfo->fdFlags & $invisible_flag) && 1);
386 Generally, invisible files are system files, unless an odd application
387 decides to use invisible files for its own purposes. To distinguish
388 such files from system files, you have to look at the B<type> and B<creator>
389 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
390 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
391 (see MacPerl.pm for details).
393 Files that appear on the desktop actually reside in an (hidden) directory
394 named "Desktop Folder" on the particular disk volume. Note that, although
395 all desktop files appear to be on the same "virtual" desktop, each disk
396 volume actually maintains its own "Desktop Folder" directory.
402 =head1 BUGS AND CAVEATS
404 Despite the name of the C<finddepth()> function, both C<find()> and
405 C<finddepth()> perform a depth-first search of the directory
410 File::Find used to produce incorrect results if called recursively.
411 During the development of perl 5.8 this bug was fixed.
412 The first fixed version of File::Find was 1.01.
420 our @ISA = qw(Exporter);
421 our @EXPORT = qw(find finddepth);
428 require File::Basename;
431 # Should ideally be my() not our() but local() currently
432 # refuses to operate on lexicals
435 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
436 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
437 $pre_process, $post_process, $dangling_symlinks);
442 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
444 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
448 my $abs_name= $cdir . $fn;
450 if (substr($fn,0,3) eq '../') {
451 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
457 # return the absolute name of a directory or file
458 sub contract_name_Mac {
462 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
464 my $colon_count = length ($1);
465 if ($colon_count == 1) {
466 $abs_name = $cdir . $2;
470 # need to move up the tree, but
471 # only if it's not a volume name
472 for (my $i=1; $i<$colon_count; $i++) {
473 unless ($cdir =~ /^[^:]+:$/) { # volume name
474 $cdir =~ s/[^:]+:$//;
480 $abs_name = $cdir . $2;
487 # $fn may be a valid path to a directory or file or (dangling)
488 # symlink, without a leading ':'
489 if ( (-e $fn) || (-l $fn) ) {
490 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
491 return $fn; # $fn is already an absolute path
494 $abs_name = $cdir . $fn;
498 else { # argh!, $fn is not a valid directory/file
504 sub PathCombine($$) {
505 my ($Base,$Name) = @_;
509 # $Name is the resolved symlink (always a full path on MacOS),
510 # i.e. there's no need to call contract_name_Mac()
513 # (simple) check for recursion
514 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
519 if (substr($Name,0,1) eq '/') {
523 $AbsName= contract_name($Base,$Name);
526 # (simple) check for recursion
527 my $newlen= length($AbsName);
528 if ($newlen <= length($Base)) {
529 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
530 && $AbsName eq substr($Base,0,$newlen))
539 sub Follow_SymLink($) {
542 my ($NewName,$DEV, $INO);
543 ($DEV, $INO)= lstat $AbsName;
546 if ($SLnkSeen{$DEV, $INO}++) {
547 if ($follow_skip < 2) {
548 die "$AbsName is encountered a second time";
554 $NewName= PathCombine($AbsName, readlink($AbsName));
555 unless(defined $NewName) {
556 if ($follow_skip < 2) {
557 die "$AbsName is a recursive symbolic link";
566 ($DEV, $INO) = lstat($AbsName);
567 return undef unless defined $DEV; # dangling symbolic link
570 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
571 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
572 die "$AbsName encountered a second time";
582 our($dir, $name, $fullname, $prune);
583 sub _find_dir_symlnk($$$);
586 # check whether or not a scalar variable is tainted
587 # (code straight from the Camel, 3rd ed., page 561)
590 my $nada = substr($arg, 0, 0); # zero-length
592 eval { eval "# $nada" };
593 return length($@) != 0;
598 die "invalid top directory" unless defined $_[0];
600 # This function must local()ize everything because callbacks may
601 # call find() or finddepth()
604 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
605 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
606 $pre_process, $post_process, $dangling_symlinks);
607 local($dir, $name, $fullname, $prune);
610 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
612 # VMS returns this by default in VMS format which just doesn't
613 # work for the rest of this module.
614 $cwd = VMS::Filespec::unixpath($cwd);
616 # Apparently this is not expected to have a trailing space.
617 # To attempt to make VMS/UNIX conversions mostly reversable,
618 # a trailing slash is needed. The run-time functions ignore the
619 # resulting double slash, but it causes the perl tests to fail.
622 # This comes up in upper case now, but should be lower.
623 # In the future this could be exact case, no need to change.
625 my $cwd_untainted = $cwd;
627 $wanted_callback = $wanted->{wanted};
628 $bydepth = $wanted->{bydepth};
629 $pre_process = $wanted->{preprocess};
630 $post_process = $wanted->{postprocess};
631 $no_chdir = $wanted->{no_chdir};
632 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
633 $follow = $^O eq 'MSWin32' ? 0 :
634 $full_check || $wanted->{follow_fast};
635 $follow_skip = $wanted->{follow_skip};
636 $untaint = $wanted->{untaint};
637 $untaint_pat = $wanted->{untaint_pattern};
638 $untaint_skip = $wanted->{untaint_skip};
639 $dangling_symlinks = $wanted->{dangling_symlinks};
641 # for compatibility reasons (find.pl, find2perl)
642 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
644 # a symbolic link to a directory doesn't increase the link count
645 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
647 my ($abs_dir, $Is_Dir);
650 foreach my $TOP (@_) {
653 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
656 $top_item = ":$top_item"
657 if ( (-d _) && ( $top_item !~ /:/ ) );
658 } elsif ($^O eq 'MSWin32') {
659 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
662 $top_item =~ s|/\z|| unless $top_item eq '/';
670 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
672 if ($top_item eq $File::Find::current_dir) {
676 $abs_dir = contract_name_Mac($cwd, $top_item);
677 unless (defined $abs_dir) {
678 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
685 if (substr($top_item,0,1) eq '/') {
686 $abs_dir = $top_item;
688 elsif ($top_item eq $File::Find::current_dir) {
691 else { # care about any ../
692 $top_item =~ s/\.dir\z//i if $Is_VMS;
693 $abs_dir = contract_name("$cwd/",$top_item);
696 $abs_dir= Follow_SymLink($abs_dir);
697 unless (defined $abs_dir) {
698 if ($dangling_symlinks) {
699 if (ref $dangling_symlinks eq 'CODE') {
700 $dangling_symlinks->($top_item, $cwd);
702 warnings::warnif "$top_item is a dangling symbolic link\n";
709 $top_item =~ s/\.dir\z//i if $Is_VMS;
710 _find_dir_symlnk($wanted, $abs_dir, $top_item);
716 unless (defined $topnlink) {
717 warnings::warnif "Can't stat $top_item: $!\n";
721 $top_item =~ s/\.dir\z//i if $Is_VMS;
722 _find_dir($wanted, $top_item, $topnlink);
731 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
733 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
736 ($dir,$_) = ('./', $top_item);
741 if (( $untaint ) && (is_tainted($dir) )) {
742 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
743 unless (defined $abs_dir) {
744 if ($untaint_skip == 0) {
745 die "directory $dir is still tainted";
753 unless ($no_chdir || chdir $abs_dir) {
754 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
758 $name = $abs_dir . $_; # $File::Find::name
759 $_ = $name if $no_chdir;
761 { $wanted_callback->() }; # protect against wild "next"
765 unless ( $no_chdir ) {
766 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
767 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
768 unless (defined $cwd_untainted) {
769 die "insecure cwd in find(depth)";
773 unless (chdir $cwd_untainted) {
774 die "Can't cd to $cwd: $!\n";
782 # $p_dir : "parent directory"
783 # $nlink : what came back from the stat
785 # chdir (if not no_chdir) to dir
788 my ($wanted, $p_dir, $nlink) = @_;
789 my ($CdLvl,$Level) = (0,0);
792 my ($subcount,$sub_nlink);
794 my $dir_name= $p_dir;
796 my $dir_rel = $File::Find::current_dir;
801 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
802 } elsif ($^O eq 'MSWin32') {
803 $dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
804 } elsif ($^O eq 'VMS') {
806 # VMS is returning trailing .dir on directories
807 # and trailing . on files and symbolic links
811 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
813 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
816 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
819 local ($dir, $name, $prune, *DIR);
821 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
823 if (( $untaint ) && (is_tainted($p_dir) )) {
824 ( $udir ) = $p_dir =~ m|$untaint_pat|;
825 unless (defined $udir) {
826 if ($untaint_skip == 0) {
827 die "directory $p_dir is still tainted";
834 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
835 warnings::warnif "Can't cd to $udir: $!\n";
840 # push the starting directory
841 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
844 $p_dir = $dir_pref; # ensure trailing ':'
847 while (defined $SE) {
849 $dir= $p_dir; # $File::Find::dir
850 $name= $dir_name; # $File::Find::name
851 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
852 # prune may happen here
854 { $wanted_callback->() }; # protect against wild "next"
858 # change to that directory
859 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
861 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
862 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
863 unless (defined $udir) {
864 if ($untaint_skip == 0) {
866 die "directory ($p_dir) $dir_rel is still tainted";
869 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
871 } else { # $untaint_skip == 1
876 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
878 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
881 warnings::warnif "Can't cd to (" .
882 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
890 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
893 $dir= $dir_name; # $File::Find::dir
895 # Get the list of files in the current directory.
896 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
897 warnings::warnif "Can't opendir($dir_name): $!\n";
900 @filenames = readdir DIR;
902 @filenames = $pre_process->(@filenames) if $pre_process;
903 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
905 # default: use whatever was specifid
906 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
907 $no_nlink = $avoid_nlink;
908 # if dir has wrong nlink count, force switch to slower stat method
909 $no_nlink = 1 if ($nlink < 2);
911 if ($nlink == 2 && !$no_nlink) {
912 # This dir has no subdirectories.
913 for my $FN (@filenames) {
915 # Big hammer here - Compensate for VMS trailing . and .dir
916 # No win situation until this is changed, but this
917 # will handle the majority of the cases with breaking the fewest
920 $FN =~ s#\.$## if ($FN ne '.');
922 next if $FN =~ $File::Find::skip_pattern;
924 $name = $dir_pref . $FN; # $File::Find::name
925 $_ = ($no_chdir ? $name : $FN); # $_
926 { $wanted_callback->() }; # protect against wild "next"
931 # This dir has subdirectories.
932 $subcount = $nlink - 2;
934 # HACK: insert directories at this position. so as to preserve
935 # the user pre-processed ordering of files.
936 # EG: directory traversal is in user sorted order, not at random.
937 my $stack_top = @Stack;
939 for my $FN (@filenames) {
940 next if $FN =~ $File::Find::skip_pattern;
941 if ($subcount > 0 || $no_nlink) {
942 # Seen all the subdirs?
943 # check for directoriness.
944 # stat is faster for a file in the current directory
945 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
949 $FN =~ s/\.dir\z//i if $Is_VMS;
950 # HACK: replace push to preserve dir traversal order
951 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
952 splice @Stack, $stack_top, 0,
953 [$CdLvl,$dir_name,$FN,$sub_nlink];
956 $name = $dir_pref . $FN; # $File::Find::name
957 $_= ($no_chdir ? $name : $FN); # $_
958 { $wanted_callback->() }; # protect against wild "next"
962 $name = $dir_pref . $FN; # $File::Find::name
963 $_= ($no_chdir ? $name : $FN); # $_
964 { $wanted_callback->() }; # protect against wild "next"
970 while ( defined ($SE = pop @Stack) ) {
971 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
972 if ($CdLvl > $Level && !$no_chdir) {
975 $tmp = (':' x ($CdLvl-$Level)) . ':';
978 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
981 $tmp = join('/',('..') x ($CdLvl-$Level));
983 die "Can't cd to $tmp from $dir_name"
989 # $pdir always has a trailing ':', except for the starting dir,
990 # where $dir_rel eq ':'
991 $dir_name = "$p_dir$dir_rel";
992 $dir_pref = "$dir_name:";
994 elsif ($^O eq 'MSWin32') {
995 $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
996 $dir_pref = "$dir_name/";
998 elsif ($^O eq 'VMS') {
999 if ($p_dir =~ m/[\]>]+$/) {
1001 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
1002 $dir_pref = $dir_name;
1005 $dir_name = "$p_dir/$dir_rel";
1006 $dir_pref = "$dir_name/";
1010 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1011 $dir_pref = "$dir_name/";
1014 if ( $nlink == -2 ) {
1015 $name = $dir = $p_dir; # $File::Find::name / dir
1016 $_ = $File::Find::current_dir;
1017 $post_process->(); # End-of-directory processing
1019 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
1022 if ($dir_rel eq ':') { # must be the top dir, where we started
1023 $name =~ s|:$||; # $File::Find::name
1024 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1026 $dir = $p_dir; # $File::Find::dir
1027 $_ = ($no_chdir ? $name : $dir_rel); # $_
1030 if ( substr($name,-2) eq '/.' ) {
1031 substr($name, length($name) == 2 ? -1 : -2) = '';
1034 $_ = ($no_chdir ? $dir_name : $dir_rel );
1035 if ( substr($_,-2) eq '/.' ) {
1036 substr($_, length($_) == 2 ? -1 : -2) = '';
1039 { $wanted_callback->() }; # protect against wild "next"
1042 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
1052 # $dir_loc : absolute location of a dir
1053 # $p_dir : "parent directory"
1055 # chdir (if not no_chdir) to dir
1057 sub _find_dir_symlnk($$$) {
1058 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1062 my $updir_loc = $dir_loc; # untainted parent directory
1064 my $dir_name = $p_dir;
1067 my $dir_rel = $File::Find::current_dir;
1068 my $byd_flag; # flag for pending stack entry if $bydepth
1073 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1074 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1076 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1077 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1080 local ($dir, $name, $fullname, $prune, *DIR);
1082 unless ($no_chdir) {
1083 # untaint the topdir
1084 if (( $untaint ) && (is_tainted($dir_loc) )) {
1085 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1086 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1087 # hence, we don't need to untaint the parent directory every time we chdir
1089 unless (defined $updir_loc) {
1090 if ($untaint_skip == 0) {
1091 die "directory $dir_loc is still tainted";
1098 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1100 warnings::warnif "Can't cd to $updir_loc: $!\n";
1105 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1108 $p_dir = $dir_pref; # ensure trailing ':'
1111 while (defined $SE) {
1114 # change (back) to parent directory (always untainted)
1115 unless ($no_chdir) {
1116 unless (chdir $updir_loc) {
1117 warnings::warnif "Can't cd to $updir_loc: $!\n";
1121 $dir= $p_dir; # $File::Find::dir
1122 $name= $dir_name; # $File::Find::name
1123 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1124 $fullname= $dir_loc; # $File::Find::fullname
1125 # prune may happen here
1127 lstat($_); # make sure file tests with '_' work
1128 { $wanted_callback->() }; # protect against wild "next"
1132 # change to that directory
1133 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1134 $updir_loc = $dir_loc;
1135 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1136 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1137 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1138 unless (defined $updir_loc) {
1139 if ($untaint_skip == 0) {
1140 die "directory $dir_loc is still tainted";
1147 unless (chdir $updir_loc) {
1148 warnings::warnif "Can't cd to $updir_loc: $!\n";
1154 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1157 $dir = $dir_name; # $File::Find::dir
1159 # Get the list of files in the current directory.
1160 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1161 warnings::warnif "Can't opendir($dir_loc): $!\n";
1164 @filenames = readdir DIR;
1167 for my $FN (@filenames) {
1169 # Big hammer here - Compensate for VMS trailing . and .dir
1170 # No win situation until this is changed, but this
1171 # will handle the majority of the cases with breaking the fewest.
1173 $FN =~ s/\.dir\z//i;
1174 $FN =~ s#\.$## if ($FN ne '.');
1176 next if $FN =~ $File::Find::skip_pattern;
1178 # follow symbolic links / do an lstat
1179 $new_loc = Follow_SymLink($loc_pref.$FN);
1181 # ignore if invalid symlink
1182 unless (defined $new_loc) {
1183 if (!defined -l _ && $dangling_symlinks) {
1184 if (ref $dangling_symlinks eq 'CODE') {
1185 $dangling_symlinks->($FN, $dir_pref);
1187 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1192 $name = $dir_pref . $FN;
1193 $_ = ($no_chdir ? $name : $FN);
1194 { $wanted_callback->() };
1200 $FN =~ s/\.dir\z//i;
1201 $FN =~ s#\.$## if ($FN ne '.');
1202 $new_loc =~ s/\.dir\z//i;
1203 $new_loc =~ s#\.$## if ($new_loc ne '.');
1205 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1208 $fullname = $new_loc; # $File::Find::fullname
1209 $name = $dir_pref . $FN; # $File::Find::name
1210 $_ = ($no_chdir ? $name : $FN); # $_
1211 { $wanted_callback->() }; # protect against wild "next"
1217 while (defined($SE = pop @Stack)) {
1218 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1220 # $p_dir always has a trailing ':', except for the starting dir,
1221 # where $dir_rel eq ':'
1222 $dir_name = "$p_dir$dir_rel";
1223 $dir_pref = "$dir_name:";
1224 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1227 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1228 $dir_pref = "$dir_name/";
1229 $loc_pref = "$dir_loc/";
1231 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1232 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1233 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1234 warnings::warnif "Can't cd to $updir_loc: $!\n";
1238 $fullname = $dir_loc; # $File::Find::fullname
1239 $name = $dir_name; # $File::Find::name
1241 if ($dir_rel eq ':') { # must be the top dir, where we started
1242 $name =~ s|:$||; # $File::Find::name
1243 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1245 $dir = $p_dir; # $File::Find::dir
1246 $_ = ($no_chdir ? $name : $dir_rel); # $_
1249 if ( substr($name,-2) eq '/.' ) {
1250 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1252 $dir = $p_dir; # $File::Find::dir
1253 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1254 if ( substr($_,-2) eq '/.' ) {
1255 substr($_, length($_) == 2 ? -1 : -2) = '';
1259 lstat($_); # make sure file tests with '_' work
1260 { $wanted_callback->() }; # protect against wild "next"
1263 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1273 if ( ref($wanted) eq 'HASH' ) {
1274 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1275 die 'no &wanted subroutine given';
1277 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1278 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1280 if ( $wanted->{untaint} ) {
1281 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1282 unless defined $wanted->{untaint_pattern};
1283 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1287 elsif( ref( $wanted ) eq 'CODE' ) {
1288 return { wanted => $wanted };
1291 die 'no &wanted subroutine given';
1297 _find_opt(wrap_wanted($wanted), @_);
1301 my $wanted = wrap_wanted(shift);
1302 $wanted->{bydepth} = 1;
1303 _find_opt($wanted, @_);
1307 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1308 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1310 # These are hard-coded for now, but may move to hint files.
1313 $File::Find::dont_use_nlink = 1;
1315 elsif ($^O eq 'MacOS') {
1317 $File::Find::dont_use_nlink = 1;
1318 $File::Find::skip_pattern = qr/^Icon\015\z/;
1319 $File::Find::untaint_pattern = qr|^(.+)$|;
1322 # this _should_ work properly on all platforms
1323 # where File::Find can be expected to work
1324 $File::Find::current_dir = File::Spec->curdir || '.';
1326 $File::Find::dont_use_nlink = 1
1327 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1328 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1331 # Set dont_use_nlink in your hint file if your system's stat doesn't
1332 # report the number of links in a directory as an indication
1333 # of the number of files.
1334 # See, e.g. hints/machten.sh for MachTen 2.2.
1335 unless ($File::Find::dont_use_nlink) {
1337 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1340 # We need a function that checks if a scalar is tainted. Either use the
1341 # Scalar::Util module's tainted() function or our (slower) pure Perl
1342 # fallback is_tainted_pp()
1345 eval { require Scalar::Util };
1346 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;