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 find() does a breadth-first search over the given @directories in the
48 order they are given. In essence, it works from the top down.
50 For each file or directory found the &wanted subroutine is called (see
51 below for details). Additionally, for each directory found it will go
52 into that directory and continue the search.
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
59 finddepth() works just like find() except it does a depth-first search.
60 It works from the bottom of the directory tree up.
66 The first argument to find() is either a hash reference describing the
67 operations to be performed for each file, or a code reference. The
68 code reference is described in L<The wanted function> below.
70 Here are the possible keys for the hash:
76 The value should be a code reference. This code reference is
77 described in L<The wanted function> below.
81 Reports the name of a directory only AFTER all its entries
82 have been reported. Entry point finddepth() is a shortcut for
83 specifying C<{ bydepth =E<gt> 1 }> in the first argument of find().
87 The value should be a code reference. This code reference is used to
88 preprocess the current directory. The name of currently processed
89 directory is in $File::Find::dir. Your preprocessing function is
90 called after readdir() but before the loop that calls the wanted()
91 function. It is called with a list of strings (actually file/directory
92 names) and is expected to return a list of strings. The code can be
93 used to sort the file/directory names alphabetically, numerically,
94 or to filter out directory entries based on their name alone. When
95 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
99 The value should be a code reference. It is invoked just before leaving
100 the currently processed directory. It is called in void context with no
101 arguments. The name of the current directory is in $File::Find::dir. This
102 hook is handy for summarizing a directory, such as calculating its disk
103 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
108 Causes symbolic links to be followed. Since directory trees with symbolic
109 links (followed) may contain files more than once and may even have
110 cycles, a hash has to be built up with an entry for each file.
111 This might be expensive both in space and time for a large
112 directory tree. See I<follow_fast> and I<follow_skip> below.
113 If either I<follow> or I<follow_fast> is in effect:
119 It is guaranteed that an I<lstat> has been called before the user's
120 I<wanted()> function is called. This enables fast file checks involving S< _>.
124 There is a variable C<$File::Find::fullname> which holds the absolute
125 pathname of the file with all symbolic links resolved
131 This is similar to I<follow> except that it may report some files more
132 than once. It does detect cycles, however. Since only symbolic links
133 have to be hashed, this is much cheaper both in space and time. If
134 processing a file more than once (by the user's I<wanted()> function)
135 is worse than just taking time, the option I<follow> should be used.
139 C<follow_skip==1>, which is the default, causes all files which are
140 neither directories nor symbolic links to be ignored if they are about
141 to be processed a second time. If a directory or a symbolic link
142 are about to be processed a second time, File::Find dies.
143 C<follow_skip==0> causes File::Find to die if any file is about to be
144 processed a second time.
145 C<follow_skip==2> causes File::Find to ignore any duplicate files and
146 directories but to proceed normally otherwise.
148 =item C<dangling_symlinks>
150 If true and a code reference, will be called with the symbolic link
151 name and the directory it lives in as arguments. Otherwise, if true
152 and warnings are on, warning "symbolic_link_name is a dangling
153 symbolic link\n" will be issued. If false, the dangling symbolic link
154 will be silently ignored.
158 Does not C<chdir()> to each directory as it recurses. The wanted()
159 function will need to be aware of this, of course. In this case,
160 C<$_> will be the same as C<$File::Find::name>.
164 If find is used in taint-mode (-T command line switch or if EUID != UID
165 or if EGID != GID) then internally directory names have to be untainted
166 before they can be chdir'ed to. Therefore they are checked against a regular
167 expression I<untaint_pattern>. Note that all names passed to the user's
168 I<wanted()> function are still tainted. If this option is used while
169 not in taint-mode, C<untaint> is a no-op.
171 =item C<untaint_pattern>
173 See above. This should be set using the C<qr> quoting operator.
174 The default is set to C<qr|^([-+@\w./]+)$|>.
175 Note that the parentheses are vital.
177 =item C<untaint_skip>
179 If set, a directory which fails the I<untaint_pattern> is skipped,
180 including all its sub-directories. The default is to 'die' in such a case.
184 =head2 The wanted function
186 The wanted() function does whatever verifications you want on each
187 file and directory. It takes no arguments but rather does its work
188 through a collection of variables.
192 =item C<$File::Find::dir> is the current directory name,
194 =item C<$_> is the current filename within that directory
196 =item C<$File::Find::name> is the complete pathname to the file.
200 Don't modify these variables.
202 For example, when examining the file /some/path/foo.ext you will have:
204 $File::Find::dir = /some/path/
206 $File::Find::name = /some/path/foo.ext
208 You are chdir()'d toC<$File::Find::dir> when the function is called,
209 unless C<no_chdir> was specified. Note that when changing to
210 directories is in effect the root directory (F</>) is a somewhat
211 special case inasmuch as the concatenation of C<$File::Find::dir>,
212 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
213 table below summarizes all variants:
215 $File::Find::name $File::Find::dir $_
217 no_chdir=>0 /etc / etc
225 When <follow> or <follow_fast> are in effect, there is
226 also a C<$File::Find::fullname>. The function may set
227 C<$File::Find::prune> to prune the tree unless C<bydepth> was
228 specified. Unless C<follow> or C<follow_fast> is specified, for
229 compatibility reasons (find.pl, find2perl) there are in addition the
230 following globals available: C<$File::Find::topdir>,
231 C<$File::Find::topdev>, C<$File::Find::topino>,
232 C<$File::Find::topmode> and C<$File::Find::topnlink>.
234 This library is useful for the C<find2perl> tool, which when fed,
236 find2perl / -name .nfs\* -mtime +7 \
237 -exec rm -f {} \; -o -fstype nfs -prune
239 produces something like:
243 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
247 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
249 ($File::Find::prune = 1);
252 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
253 filehandle that caches the information from the preceding
254 stat(), lstat(), or filetest.
256 Here's another interesting wanted function. It will find all symbolic
257 links that don't resolve:
260 -l && !-e && print "bogus link: $File::Find::name\n";
263 See also the script C<pfind> on CPAN for a nice application of this
268 If you run your program with the C<-w> switch, or if you use the
269 C<warnings> pragma, File::Find will report warnings for several weird
270 situations. You can disable these warnings by putting the statement
272 no warnings 'File::Find';
274 in the appropriate scope. See L<perllexwarn> for more info about lexical
281 =item $dont_use_nlink
283 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
284 force File::Find to always stat directories. This was used for file systems
285 that do not have an C<nlink> count matching the number of sub-directories.
286 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
287 system) and a couple of others.
289 You shouldn't need to set this variable, since File::Find should now detect
290 such file systems on-the-fly and switch itself to using stat. This works even
291 for parts of your file system, like a mounted CD-ROM.
293 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
297 Be aware that the option to follow symbolic links can be dangerous.
298 Depending on the structure of the directory tree (including symbolic
299 links to directories) you might traverse a given (physical) directory
300 more than once (only if C<follow_fast> is in effect).
301 Furthermore, deleting or changing files in a symbolically linked directory
302 might cause very unpleasant surprises, since you delete or change files
303 in an unknown directory.
313 Mac OS (Classic) users should note a few differences:
319 The path separator is ':', not '/', and the current directory is denoted
320 as ':', not '.'. You should be careful about specifying relative pathnames.
321 While a full path always begins with a volume name, a relative pathname
322 should always begin with a ':'. If specifying a volume name only, a
323 trailing ':' is required.
327 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
328 contains the name of a directory, that name may or may not end with a
329 ':'. Likewise, C<$File::Find::name>, which contains the complete
330 pathname to that directory, and C<$File::Find::fullname>, which holds
331 the absolute pathname of that directory with all symbolic links resolved,
332 may or may not end with a ':'.
336 The default C<untaint_pattern> (see above) on Mac OS is set to
337 C<qr|^(.+)$|>. Note that the parentheses are vital.
341 The invisible system file "Icon\015" is ignored. While this file may
342 appear in every directory, there are some more invisible system files
343 on every volume, which are all located at the volume root level (i.e.
344 "MacintoshHD:"). These system files are B<not> excluded automatically.
345 Your filter may use the following code to recognize invisible files or
346 directories (requires Mac::Files):
350 # invisible() -- returns 1 if file/directory is invisible,
351 # 0 if it's visible or undef if an error occurred
355 my ($fileCat, $fileInfo);
356 my $invisible_flag = 1 << 14;
358 if ( $fileCat = FSpGetCatInfo($file) ) {
359 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
360 return (($fileInfo->fdFlags & $invisible_flag) && 1);
366 Generally, invisible files are system files, unless an odd application
367 decides to use invisible files for its own purposes. To distinguish
368 such files from system files, you have to look at the B<type> and B<creator>
369 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
370 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
371 (see MacPerl.pm for details).
373 Files that appear on the desktop actually reside in an (hidden) directory
374 named "Desktop Folder" on the particular disk volume. Note that, although
375 all desktop files appear to be on the same "virtual" desktop, each disk
376 volume actually maintains its own "Desktop Folder" directory.
384 File::Find used to produce incorrect results if called recursively.
385 During the development of perl 5.8 this bug was fixed.
386 The first fixed version of File::Find was 1.01.
390 our @ISA = qw(Exporter);
391 our @EXPORT = qw(find finddepth);
398 require File::Basename;
401 # Should ideally be my() not our() but local() currently
402 # refuses to operate on lexicals
405 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
406 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
407 $pre_process, $post_process, $dangling_symlinks);
412 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
414 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
418 my $abs_name= $cdir . $fn;
420 if (substr($fn,0,3) eq '../') {
421 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
427 # return the absolute name of a directory or file
428 sub contract_name_Mac {
432 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
434 my $colon_count = length ($1);
435 if ($colon_count == 1) {
436 $abs_name = $cdir . $2;
440 # need to move up the tree, but
441 # only if it's not a volume name
442 for (my $i=1; $i<$colon_count; $i++) {
443 unless ($cdir =~ /^[^:]+:$/) { # volume name
444 $cdir =~ s/[^:]+:$//;
450 $abs_name = $cdir . $2;
457 # $fn may be a valid path to a directory or file or (dangling)
458 # symlink, without a leading ':'
459 if ( (-e $fn) || (-l $fn) ) {
460 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
461 return $fn; # $fn is already an absolute path
464 $abs_name = $cdir . $fn;
468 else { # argh!, $fn is not a valid directory/file
474 sub PathCombine($$) {
475 my ($Base,$Name) = @_;
479 # $Name is the resolved symlink (always a full path on MacOS),
480 # i.e. there's no need to call contract_name_Mac()
483 # (simple) check for recursion
484 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
489 if (substr($Name,0,1) eq '/') {
493 $AbsName= contract_name($Base,$Name);
496 # (simple) check for recursion
497 my $newlen= length($AbsName);
498 if ($newlen <= length($Base)) {
499 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
500 && $AbsName eq substr($Base,0,$newlen))
509 sub Follow_SymLink($) {
512 my ($NewName,$DEV, $INO);
513 ($DEV, $INO)= lstat $AbsName;
516 if ($SLnkSeen{$DEV, $INO}++) {
517 if ($follow_skip < 2) {
518 die "$AbsName is encountered a second time";
524 $NewName= PathCombine($AbsName, readlink($AbsName));
525 unless(defined $NewName) {
526 if ($follow_skip < 2) {
527 die "$AbsName is a recursive symbolic link";
536 ($DEV, $INO) = lstat($AbsName);
537 return undef unless defined $DEV; # dangling symbolic link
540 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
541 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
542 die "$AbsName encountered a second time";
552 our($dir, $name, $fullname, $prune);
553 sub _find_dir_symlnk($$$);
556 # check whether or not a scalar variable is tainted
557 # (code straight from the Camel, 3rd ed., page 561)
560 my $nada = substr($arg, 0, 0); # zero-length
562 eval { eval "# $nada" };
563 return length($@) != 0;
568 die "invalid top directory" unless defined $_[0];
570 # This function must local()ize everything because callbacks may
571 # call find() or finddepth()
574 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
575 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
576 $pre_process, $post_process, $dangling_symlinks);
577 local($dir, $name, $fullname, $prune, $_);
579 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
580 my $cwd_untainted = $cwd;
582 $wanted_callback = $wanted->{wanted};
583 $bydepth = $wanted->{bydepth};
584 $pre_process = $wanted->{preprocess};
585 $post_process = $wanted->{postprocess};
586 $no_chdir = $wanted->{no_chdir};
587 $full_check = $wanted->{follow};
588 $follow = $full_check || $wanted->{follow_fast};
589 $follow_skip = $wanted->{follow_skip};
590 $untaint = $wanted->{untaint};
591 $untaint_pat = $wanted->{untaint_pattern};
592 $untaint_skip = $wanted->{untaint_skip};
593 $dangling_symlinks = $wanted->{dangling_symlinks};
595 # for compatibility reasons (find.pl, find2perl)
596 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
598 # a symbolic link to a directory doesn't increase the link count
599 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
601 my ($abs_dir, $Is_Dir);
604 foreach my $TOP (@_) {
608 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
609 $top_item = ":$top_item"
610 if ( (-d _) && ( $top_item !~ /:/ ) );
613 $top_item =~ s|/\z|| unless $top_item eq '/';
614 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
622 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
624 if ($top_item eq $File::Find::current_dir) {
628 $abs_dir = contract_name_Mac($cwd, $top_item);
629 unless (defined $abs_dir) {
630 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
637 if (substr($top_item,0,1) eq '/') {
638 $abs_dir = $top_item;
640 elsif ($top_item eq $File::Find::current_dir) {
643 else { # care about any ../
644 $abs_dir = contract_name("$cwd/",$top_item);
647 $abs_dir= Follow_SymLink($abs_dir);
648 unless (defined $abs_dir) {
649 if ($dangling_symlinks) {
650 if (ref $dangling_symlinks eq 'CODE') {
651 $dangling_symlinks->($top_item, $cwd);
653 warnings::warnif "$top_item is a dangling symbolic link\n";
660 _find_dir_symlnk($wanted, $abs_dir, $top_item);
666 unless (defined $topnlink) {
667 warnings::warnif "Can't stat $top_item: $!\n";
671 $top_item =~ s/\.dir\z//i if $Is_VMS;
672 _find_dir($wanted, $top_item, $topnlink);
681 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
683 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
686 ($dir,$_) = ('./', $top_item);
691 if (( $untaint ) && (is_tainted($dir) )) {
692 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
693 unless (defined $abs_dir) {
694 if ($untaint_skip == 0) {
695 die "directory $dir is still tainted";
703 unless ($no_chdir || chdir $abs_dir) {
704 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
708 $name = $abs_dir . $_; # $File::Find::name
709 $_ = $name if $no_chdir;
711 { $wanted_callback->() }; # protect against wild "next"
715 unless ( $no_chdir ) {
716 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
717 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
718 unless (defined $cwd_untainted) {
719 die "insecure cwd in find(depth)";
723 unless (chdir $cwd_untainted) {
724 die "Can't cd to $cwd: $!\n";
732 # $p_dir : "parent directory"
733 # $nlink : what came back from the stat
735 # chdir (if not no_chdir) to dir
738 my ($wanted, $p_dir, $nlink) = @_;
739 my ($CdLvl,$Level) = (0,0);
742 my ($subcount,$sub_nlink);
744 my $dir_name= $p_dir;
746 my $dir_rel = $File::Find::current_dir;
751 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
754 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
757 local ($dir, $name, $prune, *DIR);
759 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
761 if (( $untaint ) && (is_tainted($p_dir) )) {
762 ( $udir ) = $p_dir =~ m|$untaint_pat|;
763 unless (defined $udir) {
764 if ($untaint_skip == 0) {
765 die "directory $p_dir is still tainted";
772 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
773 warnings::warnif "Can't cd to $udir: $!\n";
778 # push the starting directory
779 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
782 $p_dir = $dir_pref; # ensure trailing ':'
785 while (defined $SE) {
787 $dir= $p_dir; # $File::Find::dir
788 $name= $dir_name; # $File::Find::name
789 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
790 # prune may happen here
792 { $wanted_callback->() }; # protect against wild "next"
796 # change to that directory
797 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
799 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
800 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
801 unless (defined $udir) {
802 if ($untaint_skip == 0) {
804 die "directory ($p_dir) $dir_rel is still tainted";
807 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
809 } else { # $untaint_skip == 1
814 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
816 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
819 warnings::warnif "Can't cd to (" .
820 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
828 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
831 $dir= $dir_name; # $File::Find::dir
833 # Get the list of files in the current directory.
834 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
835 warnings::warnif "Can't opendir($dir_name): $!\n";
838 @filenames = readdir DIR;
840 @filenames = $pre_process->(@filenames) if $pre_process;
841 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
843 # default: use whatever was specifid
844 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
845 $no_nlink = $avoid_nlink;
846 # if dir has wrong nlink count, force switch to slower stat method
847 $no_nlink = 1 if ($nlink < 2);
849 if ($nlink == 2 && !$no_nlink) {
850 # This dir has no subdirectories.
851 for my $FN (@filenames) {
852 next if $FN =~ $File::Find::skip_pattern;
854 $name = $dir_pref . $FN; # $File::Find::name
855 $_ = ($no_chdir ? $name : $FN); # $_
856 { $wanted_callback->() }; # protect against wild "next"
861 # This dir has subdirectories.
862 $subcount = $nlink - 2;
864 # HACK: insert directories at this position. so as to preserve
865 # the user pre-processed ordering of files.
866 # EG: directory traversal is in user sorted order, not at random.
867 my $stack_top = @Stack;
869 for my $FN (@filenames) {
870 next if $FN =~ $File::Find::skip_pattern;
871 if ($subcount > 0 || $no_nlink) {
872 # Seen all the subdirs?
873 # check for directoriness.
874 # stat is faster for a file in the current directory
875 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
879 $FN =~ s/\.dir\z//i if $Is_VMS;
880 # HACK: replace push to preserve dir traversal order
881 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
882 splice @Stack, $stack_top, 0,
883 [$CdLvl,$dir_name,$FN,$sub_nlink];
886 $name = $dir_pref . $FN; # $File::Find::name
887 $_= ($no_chdir ? $name : $FN); # $_
888 { $wanted_callback->() }; # protect against wild "next"
892 $name = $dir_pref . $FN; # $File::Find::name
893 $_= ($no_chdir ? $name : $FN); # $_
894 { $wanted_callback->() }; # protect against wild "next"
900 while ( defined ($SE = pop @Stack) ) {
901 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
902 if ($CdLvl > $Level && !$no_chdir) {
905 $tmp = (':' x ($CdLvl-$Level)) . ':';
908 $tmp = join('/',('..') x ($CdLvl-$Level));
910 die "Can't cd to $dir_name" . $tmp
916 # $pdir always has a trailing ':', except for the starting dir,
917 # where $dir_rel eq ':'
918 $dir_name = "$p_dir$dir_rel";
919 $dir_pref = "$dir_name:";
922 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
923 $dir_pref = "$dir_name/";
926 if ( $nlink == -2 ) {
927 $name = $dir = $p_dir; # $File::Find::name / dir
928 $_ = $File::Find::current_dir;
929 $post_process->(); # End-of-directory processing
931 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
934 if ($dir_rel eq ':') { # must be the top dir, where we started
935 $name =~ s|:$||; # $File::Find::name
936 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
938 $dir = $p_dir; # $File::Find::dir
939 $_ = ($no_chdir ? $name : $dir_rel); # $_
942 if ( substr($name,-2) eq '/.' ) {
943 substr($name, length($name) == 2 ? -1 : -2) = '';
946 $_ = ($no_chdir ? $dir_name : $dir_rel );
947 if ( substr($_,-2) eq '/.' ) {
948 substr($_, length($_) == 2 ? -1 : -2) = '';
951 { $wanted_callback->() }; # protect against wild "next"
954 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
964 # $dir_loc : absolute location of a dir
965 # $p_dir : "parent directory"
967 # chdir (if not no_chdir) to dir
969 sub _find_dir_symlnk($$$) {
970 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
974 my $updir_loc = $dir_loc; # untainted parent directory
976 my $dir_name = $p_dir;
979 my $dir_rel = $File::Find::current_dir;
980 my $byd_flag; # flag for pending stack entry if $bydepth
985 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
986 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
988 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
989 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
992 local ($dir, $name, $fullname, $prune, *DIR);
996 if (( $untaint ) && (is_tainted($dir_loc) )) {
997 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
998 # once untainted, $updir_loc is pushed on the stack (as parent directory);
999 # hence, we don't need to untaint the parent directory every time we chdir
1001 unless (defined $updir_loc) {
1002 if ($untaint_skip == 0) {
1003 die "directory $dir_loc is still tainted";
1010 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1012 warnings::warnif "Can't cd to $updir_loc: $!\n";
1017 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1020 $p_dir = $dir_pref; # ensure trailing ':'
1023 while (defined $SE) {
1026 # change (back) to parent directory (always untainted)
1027 unless ($no_chdir) {
1028 unless (chdir $updir_loc) {
1029 warnings::warnif "Can't cd to $updir_loc: $!\n";
1033 $dir= $p_dir; # $File::Find::dir
1034 $name= $dir_name; # $File::Find::name
1035 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1036 $fullname= $dir_loc; # $File::Find::fullname
1037 # prune may happen here
1039 lstat($_); # make sure file tests with '_' work
1040 { $wanted_callback->() }; # protect against wild "next"
1044 # change to that directory
1045 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1046 $updir_loc = $dir_loc;
1047 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1048 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1049 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1050 unless (defined $updir_loc) {
1051 if ($untaint_skip == 0) {
1052 die "directory $dir_loc is still tainted";
1059 unless (chdir $updir_loc) {
1060 warnings::warnif "Can't cd to $updir_loc: $!\n";
1066 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1069 $dir = $dir_name; # $File::Find::dir
1071 # Get the list of files in the current directory.
1072 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1073 warnings::warnif "Can't opendir($dir_loc): $!\n";
1076 @filenames = readdir DIR;
1079 for my $FN (@filenames) {
1080 next if $FN =~ $File::Find::skip_pattern;
1082 # follow symbolic links / do an lstat
1083 $new_loc = Follow_SymLink($loc_pref.$FN);
1085 # ignore if invalid symlink
1086 next unless defined $new_loc;
1089 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1092 $fullname = $new_loc; # $File::Find::fullname
1093 $name = $dir_pref . $FN; # $File::Find::name
1094 $_ = ($no_chdir ? $name : $FN); # $_
1095 { $wanted_callback->() }; # protect against wild "next"
1101 while (defined($SE = pop @Stack)) {
1102 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1104 # $p_dir always has a trailing ':', except for the starting dir,
1105 # where $dir_rel eq ':'
1106 $dir_name = "$p_dir$dir_rel";
1107 $dir_pref = "$dir_name:";
1108 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1111 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1112 $dir_pref = "$dir_name/";
1113 $loc_pref = "$dir_loc/";
1115 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1116 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1117 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1118 warnings::warnif "Can't cd to $updir_loc: $!\n";
1122 $fullname = $dir_loc; # $File::Find::fullname
1123 $name = $dir_name; # $File::Find::name
1125 if ($dir_rel eq ':') { # must be the top dir, where we started
1126 $name =~ s|:$||; # $File::Find::name
1127 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1129 $dir = $p_dir; # $File::Find::dir
1130 $_ = ($no_chdir ? $name : $dir_rel); # $_
1133 if ( substr($name,-2) eq '/.' ) {
1134 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1136 $dir = $p_dir; # $File::Find::dir
1137 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1138 if ( substr($_,-2) eq '/.' ) {
1139 substr($_, length($_) == 2 ? -1 : -2) = '';
1143 lstat($_); # make sure file tests with '_' work
1144 { $wanted_callback->() }; # protect against wild "next"
1147 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1157 if ( ref($wanted) eq 'HASH' ) {
1158 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1159 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1161 if ( $wanted->{untaint} ) {
1162 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1163 unless defined $wanted->{untaint_pattern};
1164 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1169 return { wanted => $wanted };
1175 _find_opt(wrap_wanted($wanted), @_);
1179 my $wanted = wrap_wanted(shift);
1180 $wanted->{bydepth} = 1;
1181 _find_opt($wanted, @_);
1185 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1186 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1188 # These are hard-coded for now, but may move to hint files.
1191 $File::Find::dont_use_nlink = 1;
1193 elsif ($^O eq 'MacOS') {
1195 $File::Find::dont_use_nlink = 1;
1196 $File::Find::skip_pattern = qr/^Icon\015\z/;
1197 $File::Find::untaint_pattern = qr|^(.+)$|;
1200 # this _should_ work properly on all platforms
1201 # where File::Find can be expected to work
1202 $File::Find::current_dir = File::Spec->curdir || '.';
1204 $File::Find::dont_use_nlink = 1
1205 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1206 $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1209 # Set dont_use_nlink in your hint file if your system's stat doesn't
1210 # report the number of links in a directory as an indication
1211 # of the number of files.
1212 # See, e.g. hints/machten.sh for MachTen 2.2.
1213 unless ($File::Find::dont_use_nlink) {
1215 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1218 # We need a function that checks if a scalar is tainted. Either use the
1219 # Scalar::Util module's tainted() function or our (slower) pure Perl
1220 # fallback is_tainted_pp()
1223 eval { require Scalar::Util };
1224 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;