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 => 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) {
568 # avoid empty name after return to '/'
569 $name = '/' unless length( $name );
573 $abs_dir = contract_name_Mac($cwd, $top_item);
574 unless (defined $abs_dir) {
575 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
582 if (substr($top_item,0,1) eq '/') {
583 $abs_dir = $top_item;
585 elsif ($top_item eq $File::Find::current_dir) {
588 else { # care about any ../
589 $abs_dir = contract_name("$cwd/",$top_item);
592 $abs_dir= Follow_SymLink($abs_dir);
593 unless (defined $abs_dir) {
594 if ($dangling_symlinks) {
595 if (ref $dangling_symlinks eq 'CODE') {
596 $dangling_symlinks->($top_item, $cwd);
598 warnings::warnif "$top_item is a dangling symbolic link\n";
605 _find_dir_symlnk($wanted, $abs_dir, $top_item);
611 unless (defined $topnlink) {
612 warnings::warnif "Can't stat $top_item: $!\n";
616 $top_item =~ s/\.dir\z// if $Is_VMS;
617 _find_dir($wanted, $top_item, $topnlink);
626 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
628 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
631 ($dir,$_) = ('./', $top_item);
636 if (( $untaint ) && (is_tainted($dir) )) {
637 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
638 unless (defined $abs_dir) {
639 if ($untaint_skip == 0) {
640 die "directory $dir is still tainted";
648 unless ($no_chdir || chdir $abs_dir) {
649 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
653 $name = $abs_dir . $_; # $File::Find::name
655 { &$wanted_callback }; # protect against wild "next"
659 unless ( $no_chdir ) {
660 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
661 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
662 unless (defined $cwd_untainted) {
663 die "insecure cwd in find(depth)";
667 unless (chdir $cwd_untainted) {
668 die "Can't cd to $cwd: $!\n";
676 # $p_dir : "parent directory"
677 # $nlink : what came back from the stat
679 # chdir (if not no_chdir) to dir
682 my ($wanted, $p_dir, $nlink) = @_;
683 my ($CdLvl,$Level) = (0,0);
686 my ($subcount,$sub_nlink);
688 my $dir_name= $p_dir;
690 my $dir_rel = $File::Find::current_dir;
695 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
698 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
701 local ($dir, $name, $prune, *DIR);
703 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
705 if (( $untaint ) && (is_tainted($p_dir) )) {
706 ( $udir ) = $p_dir =~ m|$untaint_pat|;
707 unless (defined $udir) {
708 if ($untaint_skip == 0) {
709 die "directory $p_dir is still tainted";
716 unless (chdir $udir) {
717 warnings::warnif "Can't cd to $udir: $!\n";
722 # push the starting directory
723 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
726 $p_dir = $dir_pref; # ensure trailing ':'
729 while (defined $SE) {
731 $dir= $p_dir; # $File::Find::dir
732 $name= $dir_name; # $File::Find::name
733 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
734 # prune may happen here
736 # guarantee lstat for directory
738 { &$wanted_callback }; # protect against wild "next"
742 # change to that directory
743 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
745 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
746 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
747 unless (defined $udir) {
748 if ($untaint_skip == 0) {
750 die "directory ($p_dir) $dir_rel is still tainted";
753 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
755 } else { # $untaint_skip == 1
760 unless (chdir $udir) {
762 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
765 warnings::warnif "Can't cd to (" .
766 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
774 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
777 $dir= $dir_name; # $File::Find::dir
779 # Get the list of files in the current directory.
780 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
781 warnings::warnif "Can't opendir($dir_name): $!\n";
784 @filenames = readdir DIR;
786 @filenames = &$pre_process(@filenames) if $pre_process;
787 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
789 # default: use whatever was specifid
790 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
791 $no_nlink = $avoid_nlink;
792 # if dir has wrong nlink count, force switch to slower stat method
793 $no_nlink = 1 if ($nlink < 2);
795 if ($nlink == 2 && !$no_nlink) {
796 # This dir has no subdirectories.
797 for my $FN (@filenames) {
798 next if $FN =~ $File::Find::skip_pattern;
800 $name = $dir_pref . $FN; # $File::Find::name
801 $_ = ($no_chdir ? $name : $FN); # $_
802 { &$wanted_callback }; # protect against wild "next"
807 # This dir has subdirectories.
808 $subcount = $nlink - 2;
810 for my $FN (@filenames) {
811 next if $FN =~ $File::Find::skip_pattern;
812 if ($subcount > 0 || $no_nlink) {
813 # Seen all the subdirs?
814 # check for directoriness.
815 # stat is faster for a file in the current directory
816 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
820 $FN =~ s/\.dir\z// if $Is_VMS;
821 push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
824 $name = $dir_pref . $FN; # $File::Find::name
825 $_= ($no_chdir ? $name : $FN); # $_
826 { &$wanted_callback }; # protect against wild "next"
830 $name = $dir_pref . $FN; # $File::Find::name
831 $_= ($no_chdir ? $name : $FN); # $_
832 { &$wanted_callback }; # protect against wild "next"
838 while ( defined ($SE = pop @Stack) ) {
839 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
840 if ($CdLvl > $Level && !$no_chdir) {
843 $tmp = (':' x ($CdLvl-$Level)) . ':';
846 $tmp = join('/',('..') x ($CdLvl-$Level));
848 die "Can't cd to $dir_name" . $tmp
854 # $pdir always has a trailing ':', except for the starting dir,
855 # where $dir_rel eq ':'
856 $dir_name = "$p_dir$dir_rel";
857 $dir_pref = "$dir_name:";
860 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
861 $dir_pref = "$dir_name/";
864 if ( $nlink == -2 ) {
865 $name = $dir = $p_dir; # $File::Find::name / dir
866 $_ = $File::Find::current_dir;
867 &$post_process; # End-of-directory processing
869 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
872 if ($dir_rel eq ':') { # must be the top dir, where we started
873 $name =~ s|:$||; # $File::Find::name
874 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
876 $dir = $p_dir; # $File::Find::dir
877 $_ = ($no_chdir ? $name : $dir_rel); # $_
880 if ( substr($name,-2) eq '/.' ) {
881 substr($name, length($name) == 2 ? -1 : -2) = '';
884 $_ = ($no_chdir ? $dir_name : $dir_rel );
885 if ( substr($_,-2) eq '/.' ) {
886 substr($_, length($_) == 2 ? -1 : -2) = '';
889 # guarantee lstat at return to directory
891 { &$wanted_callback }; # protect against wild "next"
894 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
904 # $dir_loc : absolute location of a dir
905 # $p_dir : "parent directory"
907 # chdir (if not no_chdir) to dir
909 sub _find_dir_symlnk($$$) {
910 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
914 my $updir_loc = $dir_loc; # untainted parent directory
916 my $dir_name = $p_dir;
919 my $dir_rel = $File::Find::current_dir;
920 my $byd_flag; # flag for pending stack entry if $bydepth
925 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
926 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
928 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
929 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
932 local ($dir, $name, $fullname, $prune, *DIR);
936 if (( $untaint ) && (is_tainted($dir_loc) )) {
937 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
938 # once untainted, $updir_loc is pushed on the stack (as parent directory);
939 # hence, we don't need to untaint the parent directory every time we chdir
941 unless (defined $updir_loc) {
942 if ($untaint_skip == 0) {
943 die "directory $dir_loc is still tainted";
950 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
952 warnings::warnif "Can't cd to $updir_loc: $!\n";
957 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
960 $p_dir = $dir_pref; # ensure trailing ':'
963 while (defined $SE) {
966 # change (back) to parent directory (always untainted)
968 unless (chdir $updir_loc) {
969 warnings::warnif "Can't cd to $updir_loc: $!\n";
973 $dir= $p_dir; # $File::Find::dir
974 $name= $dir_name; # $File::Find::name
975 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
976 $fullname= $dir_loc; # $File::Find::fullname
977 # prune may happen here
979 lstat($_); # make sure file tests with '_' work
980 { &$wanted_callback }; # protect against wild "next"
984 # change to that directory
985 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
986 $updir_loc = $dir_loc;
987 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
988 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
989 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
990 unless (defined $updir_loc) {
991 if ($untaint_skip == 0) {
992 die "directory $dir_loc is still tainted";
999 unless (chdir $updir_loc) {
1000 warnings::warnif "Can't cd to $updir_loc: $!\n";
1006 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1009 $dir = $dir_name; # $File::Find::dir
1011 # Get the list of files in the current directory.
1012 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1013 warnings::warnif "Can't opendir($dir_loc): $!\n";
1016 @filenames = readdir DIR;
1019 for my $FN (@filenames) {
1020 next if $FN =~ $File::Find::skip_pattern;
1022 # follow symbolic links / do an lstat
1023 $new_loc = Follow_SymLink($loc_pref.$FN);
1025 # ignore if invalid symlink
1026 next unless defined $new_loc;
1029 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1032 $fullname = $new_loc; # $File::Find::fullname
1033 $name = $dir_pref . $FN; # $File::Find::name
1034 $_ = ($no_chdir ? $name : $FN); # $_
1035 { &$wanted_callback }; # protect against wild "next"
1041 while (defined($SE = pop @Stack)) {
1042 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1044 # $p_dir always has a trailing ':', except for the starting dir,
1045 # where $dir_rel eq ':'
1046 $dir_name = "$p_dir$dir_rel";
1047 $dir_pref = "$dir_name:";
1048 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1051 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1052 $dir_pref = "$dir_name/";
1053 $loc_pref = "$dir_loc/";
1055 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1056 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1057 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1058 warnings::warnif "Can't cd to $updir_loc: $!\n";
1062 $fullname = $dir_loc; # $File::Find::fullname
1063 $name = $dir_name; # $File::Find::name
1065 if ($dir_rel eq ':') { # must be the top dir, where we started
1066 $name =~ s|:$||; # $File::Find::name
1067 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1069 $dir = $p_dir; # $File::Find::dir
1070 $_ = ($no_chdir ? $name : $dir_rel); # $_
1073 if ( substr($name,-2) eq '/.' ) {
1074 $name =~ s|/\.$||; # $File::Find::name
1076 $dir = $p_dir; # $File::Find::dir
1077 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1078 if ( substr($_,-2) eq '/.' ) {
1083 lstat($_); # make sure file tests with '_' work
1084 { &$wanted_callback }; # protect against wild "next"
1087 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1097 if ( ref($wanted) eq 'HASH' ) {
1098 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1099 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1101 if ( $wanted->{untaint} ) {
1102 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1103 unless defined $wanted->{untaint_pattern};
1104 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1109 return { wanted => $wanted };
1115 _find_opt(wrap_wanted($wanted), @_);
1119 my $wanted = wrap_wanted(shift);
1120 $wanted->{bydepth} = 1;
1121 _find_opt($wanted, @_);
1125 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1126 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1128 # These are hard-coded for now, but may move to hint files.
1131 $File::Find::dont_use_nlink = 1;
1133 elsif ($^O eq 'MacOS') {
1135 $File::Find::dont_use_nlink = 1;
1136 $File::Find::skip_pattern = qr/^Icon\015\z/;
1137 $File::Find::untaint_pattern = qr|^(.+)$|;
1140 # this _should_ work properly on all platforms
1141 # where File::Find can be expected to work
1142 $File::Find::current_dir = File::Spec->curdir || '.';
1144 $File::Find::dont_use_nlink = 1
1145 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1146 $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'NetWare';
1148 # Set dont_use_nlink in your hint file if your system's stat doesn't
1149 # report the number of links in a directory as an indication
1150 # of the number of files.
1151 # See, e.g. hints/machten.sh for MachTen 2.2.
1152 unless ($File::Find::dont_use_nlink) {
1154 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1157 # We need a function that checks if a scalar is tainted. Either use the
1158 # Scalar::Util module's tainted() function or our (slower) pure Perl
1159 # fallback is_tainted_pp()
1162 eval { require Scalar::Util };
1163 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;