5 use warnings::register;
12 find - traverse a file tree
14 finddepth - traverse a directory structure depth-first
19 find(\&wanted, '/foo', '/bar');
23 finddepth(\&wanted, '/foo', '/bar');
27 find({ wanted => \&process, follow => 1 }, '.');
31 The first argument to find() is either a hash reference describing the
32 operations to be performed for each file, or a code reference.
34 Here are the possible keys for the hash:
40 The value should be a code reference. This code reference is called
41 I<the wanted() function> below.
45 Reports the name of a directory only AFTER all its entries
46 have been reported. Entry point finddepth() is a shortcut for
47 specifying C<{ bydepth =E<gt> 1 }> in the first argument of find().
51 The value should be a code reference. This code reference is used to
52 preprocess the current directory. The name of currently processed
53 directory is in $File::Find::dir. Your preprocessing function is
54 called after readdir() but before the loop that calls the wanted()
55 function. It is called with a list of strings (actually file/directory
56 names) and is expected to return a list of strings. The code can be
57 used to sort the file/directory names alphabetically, numerically,
58 or to filter out directory entries based on their name alone. When
59 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
63 The value should be a code reference. It is invoked just before leaving
64 the currently processed directory. It is called in void context with no
65 arguments. The name of the current directory is in $File::Find::dir. This
66 hook is handy for summarizing a directory, such as calculating its disk
67 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
72 Causes symbolic links to be followed. Since directory trees with symbolic
73 links (followed) may contain files more than once and may even have
74 cycles, a hash has to be built up with an entry for each file.
75 This might be expensive both in space and time for a large
76 directory tree. See I<follow_fast> and I<follow_skip> below.
77 If either I<follow> or I<follow_fast> is in effect:
83 It is guaranteed that an I<lstat> has been called before the user's
84 I<wanted()> function is called. This enables fast file checks involving S< _>.
88 There is a variable C<$File::Find::fullname> which holds the absolute
89 pathname of the file with all symbolic links resolved
95 This is similar to I<follow> except that it may report some files more
96 than once. It does detect cycles, however. Since only symbolic links
97 have to be hashed, this is much cheaper both in space and time. If
98 processing a file more than once (by the user's I<wanted()> function)
99 is worse than just taking time, the option I<follow> should be used.
103 C<follow_skip==1>, which is the default, causes all files which are
104 neither directories nor symbolic links to be ignored if they are about
105 to be processed a second time. If a directory or a symbolic link
106 are about to be processed a second time, File::Find dies.
107 C<follow_skip==0> causes File::Find to die if any file is about to be
108 processed a second time.
109 C<follow_skip==2> causes File::Find to ignore any duplicate files and
110 directories but to proceed normally otherwise.
112 =item C<dangling_symlinks>
114 If true and a code reference, will be called with the symbolic link
115 name and the directory it lives in as arguments. Otherwise, if true
116 and warnings are on, warning "symbolic_link_name is a dangling
117 symbolic link\n" will be issued. If false, the dangling symbolic link
118 will be silently ignored.
122 Does not C<chdir()> to each directory as it recurses. The wanted()
123 function will need to be aware of this, of course. In this case,
124 C<$_> will be the same as C<$File::Find::name>.
128 If find is used in taint-mode (-T command line switch or if EUID != UID
129 or if EGID != GID) then internally directory names have to be untainted
130 before they can be chdir'ed to. Therefore they are checked against a regular
131 expression I<untaint_pattern>. Note that all names passed to the user's
132 I<wanted()> function are still tainted. If this option is used while
133 not in taint-mode, C<untaint> is a no-op.
135 =item C<untaint_pattern>
137 See above. This should be set using the C<qr> quoting operator.
138 The default is set to C<qr|^([-+@\w./]+)$|>.
139 Note that the parentheses are vital.
141 =item C<untaint_skip>
143 If set, a directory which fails the I<untaint_pattern> is skipped,
144 including all its sub-directories. The default is to 'die' in such a case.
148 The wanted() function does whatever verifications you want.
149 C<$File::Find::dir> contains the current directory name, and C<$_> the
150 current filename within that directory. C<$File::Find::name> contains
151 the complete pathname to the file. You are chdir()'d to
152 C<$File::Find::dir> when the function is called, unless C<no_chdir>
153 was specified. Note that when changing to directories is in effect
154 the root directory (F</>) is a somewhat special case inasmuch as the
155 concatenation of C<$File::Find::dir>, C<'/'> and C<$_> is not literally
156 equal to C<$File::Find::name>. The table below summarizes all variants:
158 $File::Find::name $File::Find::dir $_
160 no_chdir=>0 /etc / etc
168 When <follow> or <follow_fast> are in effect, there is
169 also a C<$File::Find::fullname>. The function may set
170 C<$File::Find::prune> to prune the tree unless C<bydepth> was
171 specified. Unless C<follow> or C<follow_fast> is specified, for
172 compatibility reasons (find.pl, find2perl) there are in addition the
173 following globals available: C<$File::Find::topdir>,
174 C<$File::Find::topdev>, C<$File::Find::topino>,
175 C<$File::Find::topmode> and C<$File::Find::topnlink>.
177 This library is useful for the C<find2perl> tool, which when fed,
179 find2perl / -name .nfs\* -mtime +7 \
180 -exec rm -f {} \; -o -fstype nfs -prune
182 produces something like:
186 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
190 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
192 ($File::Find::prune = 1);
195 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
196 filehandle that caches the information from the preceding
197 stat(), lstat(), or filetest.
199 Here's another interesting wanted function. It will find all symbolic
200 links that don't resolve:
203 -l && !-e && print "bogus link: $File::Find::name\n";
206 See also the script C<pfind> on CPAN for a nice application of this
211 If you run your program with the C<-w> switch, or if you use the
212 C<warnings> pragma, File::Find will report warnings for several weird
213 situations. You can disable these warnings by putting the statement
215 no warnings 'File::Find';
217 in the appropriate scope. See L<perllexwarn> for more info about lexical
224 =item $dont_use_nlink
226 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
227 force File::Find to always stat directories. This was used for file systems
228 that do not have an C<nlink> count matching the number of sub-directories.
229 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
230 system) and a couple of others.
232 You shouldn't need to set this variable, since File::Find should now detect
233 such file systems on-the-fly and switch itself to using stat. This works even
234 for parts of your file system, like a mounted CD-ROM.
236 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
240 Be aware that the option to follow symbolic links can be dangerous.
241 Depending on the structure of the directory tree (including symbolic
242 links to directories) you might traverse a given (physical) directory
243 more than once (only if C<follow_fast> is in effect).
244 Furthermore, deleting or changing files in a symbolically linked directory
245 might cause very unpleasant surprises, since you delete or change files
246 in an unknown directory.
256 Mac OS (Classic) users should note a few differences:
262 The path separator is ':', not '/', and the current directory is denoted
263 as ':', not '.'. You should be careful about specifying relative pathnames.
264 While a full path always begins with a volume name, a relative pathname
265 should always begin with a ':'. If specifying a volume name only, a
266 trailing ':' is required.
270 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
271 contains the name of a directory, that name may or may not end with a
272 ':'. Likewise, C<$File::Find::name>, which contains the complete
273 pathname to that directory, and C<$File::Find::fullname>, which holds
274 the absolute pathname of that directory with all symbolic links resolved,
275 may or may not end with a ':'.
279 The default C<untaint_pattern> (see above) on Mac OS is set to
280 C<qr|^(.+)$|>. Note that the parentheses are vital.
284 The invisible system file "Icon\015" is ignored. While this file may
285 appear in every directory, there are some more invisible system files
286 on every volume, which are all located at the volume root level (i.e.
287 "MacintoshHD:"). These system files are B<not> excluded automatically.
288 Your filter may use the following code to recognize invisible files or
289 directories (requires Mac::Files):
293 # invisible() -- returns 1 if file/directory is invisible,
294 # 0 if it's visible or undef if an error occurred
298 my ($fileCat, $fileInfo);
299 my $invisible_flag = 1 << 14;
301 if ( $fileCat = FSpGetCatInfo($file) ) {
302 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
303 return (($fileInfo->fdFlags & $invisible_flag) && 1);
309 Generally, invisible files are system files, unless an odd application
310 decides to use invisible files for its own purposes. To distinguish
311 such files from system files, you have to look at the B<type> and B<creator>
312 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
313 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
314 (see MacPerl.pm for details).
316 Files that appear on the desktop actually reside in an (hidden) directory
317 named "Desktop Folder" on the particular disk volume. Note that, although
318 all desktop files appear to be on the same "virtual" desktop, each disk
319 volume actually maintains its own "Desktop Folder" directory.
327 File::Find used to produce incorrect results if called recursively.
328 During the development of perl 5.8 this bug was fixed.
329 The first fixed version of File::Find was 1.01.
333 our @ISA = qw(Exporter);
334 our @EXPORT = qw(find finddepth);
341 require File::Basename;
344 # Should ideally be my() not our() but local() currently
345 # refuses to operate on lexicals
348 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
349 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
350 $pre_process, $post_process, $dangling_symlinks);
355 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
357 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
361 my $abs_name= $cdir . $fn;
363 if (substr($fn,0,3) eq '../') {
364 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
370 # return the absolute name of a directory or file
371 sub contract_name_Mac {
375 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
377 my $colon_count = length ($1);
378 if ($colon_count == 1) {
379 $abs_name = $cdir . $2;
383 # need to move up the tree, but
384 # only if it's not a volume name
385 for (my $i=1; $i<$colon_count; $i++) {
386 unless ($cdir =~ /^[^:]+:$/) { # volume name
387 $cdir =~ s/[^:]+:$//;
393 $abs_name = $cdir . $2;
400 # $fn may be a valid path to a directory or file or (dangling)
401 # symlink, without a leading ':'
402 if ( (-e $fn) || (-l $fn) ) {
403 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
404 return $fn; # $fn is already an absolute path
407 $abs_name = $cdir . $fn;
411 else { # argh!, $fn is not a valid directory/file
417 sub PathCombine($$) {
418 my ($Base,$Name) = @_;
422 # $Name is the resolved symlink (always a full path on MacOS),
423 # i.e. there's no need to call contract_name_Mac()
426 # (simple) check for recursion
427 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
432 if (substr($Name,0,1) eq '/') {
436 $AbsName= contract_name($Base,$Name);
439 # (simple) check for recursion
440 my $newlen= length($AbsName);
441 if ($newlen <= length($Base)) {
442 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
443 && $AbsName eq substr($Base,0,$newlen))
452 sub Follow_SymLink($) {
455 my ($NewName,$DEV, $INO);
456 ($DEV, $INO)= lstat $AbsName;
459 if ($SLnkSeen{$DEV, $INO}++) {
460 if ($follow_skip < 2) {
461 die "$AbsName is encountered a second time";
467 $NewName= PathCombine($AbsName, readlink($AbsName));
468 unless(defined $NewName) {
469 if ($follow_skip < 2) {
470 die "$AbsName is a recursive symbolic link";
479 ($DEV, $INO) = lstat($AbsName);
480 return undef unless defined $DEV; # dangling symbolic link
483 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
484 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
485 die "$AbsName encountered a second time";
495 our($dir, $name, $fullname, $prune);
496 sub _find_dir_symlnk($$$);
499 # check whether or not a scalar variable is tainted
500 # (code straight from the Camel, 3rd ed., page 561)
503 my $nada = substr($arg, 0, 0); # zero-length
505 eval { eval "# $nada" };
506 return length($@) != 0;
511 die "invalid top directory" unless defined $_[0];
513 # This function must local()ize everything because callbacks may
514 # call find() or finddepth()
517 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
518 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
519 $pre_process, $post_process, $dangling_symlinks);
520 local($dir, $name, $fullname, $prune);
522 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
523 my $cwd_untainted = $cwd;
525 $wanted_callback = $wanted->{wanted};
526 $bydepth = $wanted->{bydepth};
527 $pre_process = $wanted->{preprocess};
528 $post_process = $wanted->{postprocess};
529 $no_chdir = $wanted->{no_chdir};
530 $full_check = $wanted->{follow};
531 $follow = $full_check || $wanted->{follow_fast};
532 $follow_skip = $wanted->{follow_skip};
533 $untaint = $wanted->{untaint};
534 $untaint_pat = $wanted->{untaint_pattern};
535 $untaint_skip = $wanted->{untaint_skip};
536 $dangling_symlinks = $wanted->{dangling_symlinks};
538 # for compatibility reasons (find.pl, find2perl)
539 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
541 # a symbolic link to a directory doesn't increase the link count
542 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
544 my ($abs_dir, $Is_Dir);
547 foreach my $TOP (@_) {
551 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
552 $top_item = ":$top_item"
553 if ( (-d _) && ( $top_item !~ /:/ ) );
556 $top_item =~ s|/\z|| unless $top_item eq '/';
557 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
565 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
567 if ($top_item eq $File::Find::current_dir) {
571 $abs_dir = contract_name_Mac($cwd, $top_item);
572 unless (defined $abs_dir) {
573 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
580 if (substr($top_item,0,1) eq '/') {
581 $abs_dir = $top_item;
583 elsif ($top_item eq $File::Find::current_dir) {
586 else { # care about any ../
587 $abs_dir = contract_name("$cwd/",$top_item);
590 $abs_dir= Follow_SymLink($abs_dir);
591 unless (defined $abs_dir) {
592 if ($dangling_symlinks) {
593 if (ref $dangling_symlinks eq 'CODE') {
594 $dangling_symlinks->($top_item, $cwd);
596 warnings::warnif "$top_item is a dangling symbolic link\n";
603 _find_dir_symlnk($wanted, $abs_dir, $top_item);
609 unless (defined $topnlink) {
610 warnings::warnif "Can't stat $top_item: $!\n";
614 $top_item =~ s/\.dir\z// if $Is_VMS;
615 _find_dir($wanted, $top_item, $topnlink);
624 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
626 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
629 ($dir,$_) = ('./', $top_item);
634 if (( $untaint ) && (is_tainted($dir) )) {
635 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
636 unless (defined $abs_dir) {
637 if ($untaint_skip == 0) {
638 die "directory $dir is still tainted";
646 unless ($no_chdir || chdir $abs_dir) {
647 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
651 $name = $abs_dir . $_; # $File::Find::name
653 { &$wanted_callback }; # protect against wild "next"
657 unless ( $no_chdir ) {
658 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
659 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
660 unless (defined $cwd_untainted) {
661 die "insecure cwd in find(depth)";
665 unless (chdir $cwd_untainted) {
666 die "Can't cd to $cwd: $!\n";
674 # $p_dir : "parent directory"
675 # $nlink : what came back from the stat
677 # chdir (if not no_chdir) to dir
680 my ($wanted, $p_dir, $nlink) = @_;
681 my ($CdLvl,$Level) = (0,0);
684 my ($subcount,$sub_nlink);
686 my $dir_name= $p_dir;
688 my $dir_rel = $File::Find::current_dir;
693 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
696 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
699 local ($dir, $name, $prune, *DIR);
701 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
703 if (( $untaint ) && (is_tainted($p_dir) )) {
704 ( $udir ) = $p_dir =~ m|$untaint_pat|;
705 unless (defined $udir) {
706 if ($untaint_skip == 0) {
707 die "directory $p_dir is still tainted";
714 unless (chdir $udir) {
715 warnings::warnif "Can't cd to $udir: $!\n";
720 # push the starting directory
721 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
724 $p_dir = $dir_pref; # ensure trailing ':'
727 while (defined $SE) {
729 $dir= $p_dir; # $File::Find::dir
730 $name= $dir_name; # $File::Find::name
731 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
732 # prune may happen here
734 { &$wanted_callback }; # protect against wild "next"
738 # change to that directory
739 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
741 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
742 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
743 unless (defined $udir) {
744 if ($untaint_skip == 0) {
746 die "directory ($p_dir) $dir_rel is still tainted";
749 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
751 } else { # $untaint_skip == 1
756 unless (chdir $udir) {
758 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
761 warnings::warnif "Can't cd to (" .
762 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
770 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
773 $dir= $dir_name; # $File::Find::dir
775 # Get the list of files in the current directory.
776 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
777 warnings::warnif "Can't opendir($dir_name): $!\n";
780 @filenames = readdir DIR;
782 @filenames = &$pre_process(@filenames) if $pre_process;
783 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
785 # default: use whatever was specifid
786 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
787 $no_nlink = $avoid_nlink;
788 # if dir has wrong nlink count, force switch to slower stat method
789 $no_nlink = 1 if ($nlink < 2);
791 if ($nlink == 2 && !$no_nlink) {
792 # This dir has no subdirectories.
793 for my $FN (@filenames) {
794 next if $FN =~ $File::Find::skip_pattern;
796 $name = $dir_pref . $FN; # $File::Find::name
797 $_ = ($no_chdir ? $name : $FN); # $_
798 { &$wanted_callback }; # protect against wild "next"
803 # This dir has subdirectories.
804 $subcount = $nlink - 2;
806 for my $FN (@filenames) {
807 next if $FN =~ $File::Find::skip_pattern;
808 if ($subcount > 0 || $no_nlink) {
809 # Seen all the subdirs?
810 # check for directoriness.
811 # stat is faster for a file in the current directory
812 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
816 $FN =~ s/\.dir\z// if $Is_VMS;
817 push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
820 $name = $dir_pref . $FN; # $File::Find::name
821 $_= ($no_chdir ? $name : $FN); # $_
822 { &$wanted_callback }; # protect against wild "next"
826 $name = $dir_pref . $FN; # $File::Find::name
827 $_= ($no_chdir ? $name : $FN); # $_
828 { &$wanted_callback }; # protect against wild "next"
834 while ( defined ($SE = pop @Stack) ) {
835 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
836 if ($CdLvl > $Level && !$no_chdir) {
839 $tmp = (':' x ($CdLvl-$Level)) . ':';
842 $tmp = join('/',('..') x ($CdLvl-$Level));
844 die "Can't cd to $dir_name" . $tmp
850 # $pdir always has a trailing ':', except for the starting dir,
851 # where $dir_rel eq ':'
852 $dir_name = "$p_dir$dir_rel";
853 $dir_pref = "$dir_name:";
856 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
857 $dir_pref = "$dir_name/";
860 if ( $nlink == -2 ) {
861 $name = $dir = $p_dir; # $File::Find::name / dir
862 $_ = $File::Find::current_dir;
863 &$post_process; # End-of-directory processing
865 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
868 if ($dir_rel eq ':') { # must be the top dir, where we started
869 $name =~ s|:$||; # $File::Find::name
870 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
872 $dir = $p_dir; # $File::Find::dir
873 $_ = ($no_chdir ? $name : $dir_rel); # $_
876 if ( substr($name,-2) eq '/.' ) {
877 substr($name, length($name) == 2 ? -1 : -2) = '';
880 $_ = ($no_chdir ? $dir_name : $dir_rel );
881 if ( substr($_,-2) eq '/.' ) {
882 substr($_, length($_) == 2 ? -1 : -2) = '';
885 { &$wanted_callback }; # protect against wild "next"
888 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
898 # $dir_loc : absolute location of a dir
899 # $p_dir : "parent directory"
901 # chdir (if not no_chdir) to dir
903 sub _find_dir_symlnk($$$) {
904 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
908 my $updir_loc = $dir_loc; # untainted parent directory
910 my $dir_name = $p_dir;
913 my $dir_rel = $File::Find::current_dir;
914 my $byd_flag; # flag for pending stack entry if $bydepth
919 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
920 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
922 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
923 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
926 local ($dir, $name, $fullname, $prune, *DIR);
930 if (( $untaint ) && (is_tainted($dir_loc) )) {
931 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
932 # once untainted, $updir_loc is pushed on the stack (as parent directory);
933 # hence, we don't need to untaint the parent directory every time we chdir
935 unless (defined $updir_loc) {
936 if ($untaint_skip == 0) {
937 die "directory $dir_loc is still tainted";
944 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
946 warnings::warnif "Can't cd to $updir_loc: $!\n";
951 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
954 $p_dir = $dir_pref; # ensure trailing ':'
957 while (defined $SE) {
960 # change (back) to parent directory (always untainted)
962 unless (chdir $updir_loc) {
963 warnings::warnif "Can't cd to $updir_loc: $!\n";
967 $dir= $p_dir; # $File::Find::dir
968 $name= $dir_name; # $File::Find::name
969 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
970 $fullname= $dir_loc; # $File::Find::fullname
971 # prune may happen here
973 lstat($_); # make sure file tests with '_' work
974 { &$wanted_callback }; # protect against wild "next"
978 # change to that directory
979 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
980 $updir_loc = $dir_loc;
981 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
982 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
983 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
984 unless (defined $updir_loc) {
985 if ($untaint_skip == 0) {
986 die "directory $dir_loc is still tainted";
993 unless (chdir $updir_loc) {
994 warnings::warnif "Can't cd to $updir_loc: $!\n";
1000 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1003 $dir = $dir_name; # $File::Find::dir
1005 # Get the list of files in the current directory.
1006 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1007 warnings::warnif "Can't opendir($dir_loc): $!\n";
1010 @filenames = readdir DIR;
1013 for my $FN (@filenames) {
1014 next if $FN =~ $File::Find::skip_pattern;
1016 # follow symbolic links / do an lstat
1017 $new_loc = Follow_SymLink($loc_pref.$FN);
1019 # ignore if invalid symlink
1020 next unless defined $new_loc;
1023 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1026 $fullname = $new_loc; # $File::Find::fullname
1027 $name = $dir_pref . $FN; # $File::Find::name
1028 $_ = ($no_chdir ? $name : $FN); # $_
1029 { &$wanted_callback }; # protect against wild "next"
1035 while (defined($SE = pop @Stack)) {
1036 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1038 # $p_dir always has a trailing ':', except for the starting dir,
1039 # where $dir_rel eq ':'
1040 $dir_name = "$p_dir$dir_rel";
1041 $dir_pref = "$dir_name:";
1042 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1045 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1046 $dir_pref = "$dir_name/";
1047 $loc_pref = "$dir_loc/";
1049 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1050 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1051 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1052 warnings::warnif "Can't cd to $updir_loc: $!\n";
1056 $fullname = $dir_loc; # $File::Find::fullname
1057 $name = $dir_name; # $File::Find::name
1059 if ($dir_rel eq ':') { # must be the top dir, where we started
1060 $name =~ s|:$||; # $File::Find::name
1061 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1063 $dir = $p_dir; # $File::Find::dir
1064 $_ = ($no_chdir ? $name : $dir_rel); # $_
1067 if ( substr($name,-2) eq '/.' ) {
1068 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1070 $dir = $p_dir; # $File::Find::dir
1071 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1072 if ( substr($_,-2) eq '/.' ) {
1073 substr($_, length($_) == 2 ? -1 : -2) = '';
1077 lstat($_); # make sure file tests with '_' work
1078 { &$wanted_callback }; # protect against wild "next"
1081 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1091 if ( ref($wanted) eq 'HASH' ) {
1092 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1093 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1095 if ( $wanted->{untaint} ) {
1096 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1097 unless defined $wanted->{untaint_pattern};
1098 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1103 return { wanted => $wanted };
1109 _find_opt(wrap_wanted($wanted), @_);
1113 my $wanted = wrap_wanted(shift);
1114 $wanted->{bydepth} = 1;
1115 _find_opt($wanted, @_);
1119 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1120 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1122 # These are hard-coded for now, but may move to hint files.
1125 $File::Find::dont_use_nlink = 1;
1127 elsif ($^O eq 'MacOS') {
1129 $File::Find::dont_use_nlink = 1;
1130 $File::Find::skip_pattern = qr/^Icon\015\z/;
1131 $File::Find::untaint_pattern = qr|^(.+)$|;
1134 # this _should_ work properly on all platforms
1135 # where File::Find can be expected to work
1136 $File::Find::current_dir = File::Spec->curdir || '.';
1138 $File::Find::dont_use_nlink = 1
1139 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1140 $^O eq 'cygwin' || $^O eq 'epoc';
1142 # Set dont_use_nlink in your hint file if your system's stat doesn't
1143 # report the number of links in a directory as an indication
1144 # of the number of files.
1145 # See, e.g. hints/machten.sh for MachTen 2.2.
1146 unless ($File::Find::dont_use_nlink) {
1148 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1151 # We need a function that checks if a scalar is tainted. Either use the
1152 # Scalar::Util module's tainted() function or our (slower) pure Perl
1153 # fallback is_tainted_pp()
1156 eval { require Scalar::Util };
1157 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;