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. When C<follow> or C<follow_fast> are in effect, there is
154 also a C<$File::Find::fullname>. The function may set
155 C<$File::Find::prune> to prune the tree unless C<bydepth> was
156 specified. Unless C<follow> or C<follow_fast> is specified, for
157 compatibility reasons (find.pl, find2perl) there are in addition the
158 following globals available: C<$File::Find::topdir>,
159 C<$File::Find::topdev>, C<$File::Find::topino>,
160 C<$File::Find::topmode> and C<$File::Find::topnlink>.
162 This library is useful for the C<find2perl> tool, which when fed,
164 find2perl / -name .nfs\* -mtime +7 \
165 -exec rm -f {} \; -o -fstype nfs -prune
167 produces something like:
171 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
175 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
177 ($File::Find::prune = 1);
180 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
181 filehandle that caches the information from the preceding
182 stat(), lstat(), or filetest.
184 Here's another interesting wanted function. It will find all symbolic
185 links that don't resolve:
188 -l && !-e && print "bogus link: $File::Find::name\n";
191 See also the script C<pfind> on CPAN for a nice application of this
196 If you run your program with the C<-w> switch, or if you use the
197 C<warnings> pragma, File::Find will report warnings for several weird
198 situations. You can disable these warnings by putting the statement
200 no warnings 'File::Find';
202 in the appropriate scope. See L<perllexwarn> for more info about lexical
209 =item $dont_use_nlink
211 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
212 force File::Find to always stat directories. This was used for file systems
213 that do not have an C<nlink> count matching the number of sub-directories.
214 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
215 system) and a couple of others.
217 You shouldn't need to set this variable, since File::Find should now detect
218 such file systems on-the-fly and switch itself to using stat. This works even
219 for parts of your file system, like a mounted CD-ROM.
221 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
225 Be aware that the option to follow symbolic links can be dangerous.
226 Depending on the structure of the directory tree (including symbolic
227 links to directories) you might traverse a given (physical) directory
228 more than once (only if C<follow_fast> is in effect).
229 Furthermore, deleting or changing files in a symbolically linked directory
230 might cause very unpleasant surprises, since you delete or change files
231 in an unknown directory.
241 Mac OS (Classic) users should note a few differences:
247 The path separator is ':', not '/', and the current directory is denoted
248 as ':', not '.'. You should be careful about specifying relative pathnames.
249 While a full path always begins with a volume name, a relative pathname
250 should always begin with a ':'. If specifying a volume name only, a
251 trailing ':' is required.
255 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
256 contains the name of a directory, that name may or may not end with a
257 ':'. Likewise, C<$File::Find::name>, which contains the complete
258 pathname to that directory, and C<$File::Find::fullname>, which holds
259 the absolute pathname of that directory with all symbolic links resolved,
260 may or may not end with a ':'.
264 The default C<untaint_pattern> (see above) on Mac OS is set to
265 C<qr|^(.+)$|>. Note that the parentheses are vital.
269 The invisible system file "Icon\015" is ignored. While this file may
270 appear in every directory, there are some more invisible system files
271 on every volume, which are all located at the volume root level (i.e.
272 "MacintoshHD:"). These system files are B<not> excluded automatically.
273 Your filter may use the following code to recognize invisible files or
274 directories (requires Mac::Files):
278 # invisible() -- returns 1 if file/directory is invisible,
279 # 0 if it's visible or undef if an error occurred
283 my ($fileCat, $fileInfo);
284 my $invisible_flag = 1 << 14;
286 if ( $fileCat = FSpGetCatInfo($file) ) {
287 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
288 return (($fileInfo->fdFlags & $invisible_flag) && 1);
294 Generally, invisible files are system files, unless an odd application
295 decides to use invisible files for its own purposes. To distinguish
296 such files from system files, you have to look at the B<type> and B<creator>
297 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
298 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
299 (see MacPerl.pm for details).
301 Files that appear on the desktop actually reside in an (hidden) directory
302 named "Desktop Folder" on the particular disk volume. Note that, although
303 all desktop files appear to be on the same "virtual" desktop, each disk
304 volume actually maintains its own "Desktop Folder" directory.
312 File::Find used to produce incorrect results if called recursively.
313 During the development of perl 5.8 this bug was fixed.
314 The first fixed version of File::Find was 1.01.
318 our @ISA = qw(Exporter);
319 our @EXPORT = qw(find finddepth);
326 require File::Basename;
329 # Should ideally be my() not our() but local() currently
330 # refuses to operate on lexicals
333 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
334 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
335 $pre_process, $post_process, $dangling_symlinks);
340 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
342 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
346 my $abs_name= $cdir . $fn;
348 if (substr($fn,0,3) eq '../') {
349 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
355 # return the absolute name of a directory or file
356 sub contract_name_Mac {
360 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
362 my $colon_count = length ($1);
363 if ($colon_count == 1) {
364 $abs_name = $cdir . $2;
368 # need to move up the tree, but
369 # only if it's not a volume name
370 for (my $i=1; $i<$colon_count; $i++) {
371 unless ($cdir =~ /^[^:]+:$/) { # volume name
372 $cdir =~ s/[^:]+:$//;
378 $abs_name = $cdir . $2;
385 # $fn may be a valid path to a directory or file or (dangling)
386 # symlink, without a leading ':'
387 if ( (-e $fn) || (-l $fn) ) {
388 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
389 return $fn; # $fn is already an absolute path
392 $abs_name = $cdir . $fn;
396 else { # argh!, $fn is not a valid directory/file
402 sub PathCombine($$) {
403 my ($Base,$Name) = @_;
407 # $Name is the resolved symlink (always a full path on MacOS),
408 # i.e. there's no need to call contract_name_Mac()
411 # (simple) check for recursion
412 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
417 if (substr($Name,0,1) eq '/') {
421 $AbsName= contract_name($Base,$Name);
424 # (simple) check for recursion
425 my $newlen= length($AbsName);
426 if ($newlen <= length($Base)) {
427 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
428 && $AbsName eq substr($Base,0,$newlen))
437 sub Follow_SymLink($) {
440 my ($NewName,$DEV, $INO);
441 ($DEV, $INO)= lstat $AbsName;
444 if ($SLnkSeen{$DEV, $INO}++) {
445 if ($follow_skip < 2) {
446 die "$AbsName is encountered a second time";
452 $NewName= PathCombine($AbsName, readlink($AbsName));
453 unless(defined $NewName) {
454 if ($follow_skip < 2) {
455 die "$AbsName is a recursive symbolic link";
464 ($DEV, $INO) = lstat($AbsName);
465 return undef unless defined $DEV; # dangling symbolic link
468 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
469 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
470 die "$AbsName encountered a second time";
480 our($dir, $name, $fullname, $prune);
481 sub _find_dir_symlnk($$$);
484 # check whether or not a scalar variable is tainted
485 # (code straight from the Camel, 3rd ed., page 561)
488 my $nada = substr($arg, 0, 0); # zero-length
490 eval { eval "# $nada" };
491 return length($@) != 0;
496 die "invalid top directory" unless defined $_[0];
498 # This function must local()ize everything because callbacks may
499 # call find() or finddepth()
502 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
503 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
504 $pre_process, $post_process, $dangling_symlinks);
505 local($dir, $name, $fullname, $prune);
507 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
508 my $cwd_untainted = $cwd;
510 $wanted_callback = $wanted->{wanted};
511 $bydepth = $wanted->{bydepth};
512 $pre_process = $wanted->{preprocess};
513 $post_process = $wanted->{postprocess};
514 $no_chdir = $wanted->{no_chdir};
515 $full_check = $wanted->{follow};
516 $follow = $full_check || $wanted->{follow_fast};
517 $follow_skip = $wanted->{follow_skip};
518 $untaint = $wanted->{untaint};
519 $untaint_pat = $wanted->{untaint_pattern};
520 $untaint_skip = $wanted->{untaint_skip};
521 $dangling_symlinks = $wanted->{dangling_symlinks};
523 # for compatibility reasons (find.pl, find2perl)
524 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
526 # a symbolic link to a directory doesn't increase the link count
527 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
529 my ($abs_dir, $Is_Dir);
532 foreach my $TOP (@_) {
536 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
537 $top_item = ":$top_item"
538 if ( (-d _) && ( $top_item !~ /:/ ) );
541 $top_item =~ s|/\z|| unless $top_item eq '/';
542 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
550 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
552 if ($top_item eq $File::Find::current_dir) {
553 # avoid empty name after return to '/'
554 $name = '/' unless length( $name );
558 $abs_dir = contract_name_Mac($cwd, $top_item);
559 unless (defined $abs_dir) {
560 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
567 if (substr($top_item,0,1) eq '/') {
568 $abs_dir = $top_item;
570 elsif ($top_item eq $File::Find::current_dir) {
573 else { # care about any ../
574 $abs_dir = contract_name("$cwd/",$top_item);
577 $abs_dir= Follow_SymLink($abs_dir);
578 unless (defined $abs_dir) {
579 if ($dangling_symlinks) {
580 if (ref $dangling_symlinks eq 'CODE') {
581 $dangling_symlinks->($top_item, $cwd);
583 warnings::warnif "$top_item is a dangling symbolic link\n";
590 _find_dir_symlnk($wanted, $abs_dir, $top_item);
596 unless (defined $topnlink) {
597 warnings::warnif "Can't stat $top_item: $!\n";
601 $top_item =~ s/\.dir\z// if $Is_VMS;
602 _find_dir($wanted, $top_item, $topnlink);
611 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
613 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
616 ($dir,$_) = ('./', $top_item);
621 if (( $untaint ) && (is_tainted($dir) )) {
622 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
623 unless (defined $abs_dir) {
624 if ($untaint_skip == 0) {
625 die "directory $dir is still tainted";
633 unless ($no_chdir || chdir $abs_dir) {
634 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
638 $name = $abs_dir . $_; # $File::Find::name
640 { &$wanted_callback }; # protect against wild "next"
644 unless ( $no_chdir ) {
645 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
646 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
647 unless (defined $cwd_untainted) {
648 die "insecure cwd in find(depth)";
652 unless (chdir $cwd_untainted) {
653 die "Can't cd to $cwd: $!\n";
661 # $p_dir : "parent directory"
662 # $nlink : what came back from the stat
664 # chdir (if not no_chdir) to dir
667 my ($wanted, $p_dir, $nlink) = @_;
668 my ($CdLvl,$Level) = (0,0);
671 my ($subcount,$sub_nlink);
673 my $dir_name= $p_dir;
675 my $dir_rel = $File::Find::current_dir;
680 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
683 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
686 local ($dir, $name, $prune, *DIR);
688 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
690 if (( $untaint ) && (is_tainted($p_dir) )) {
691 ( $udir ) = $p_dir =~ m|$untaint_pat|;
692 unless (defined $udir) {
693 if ($untaint_skip == 0) {
694 die "directory $p_dir is still tainted";
701 unless (chdir $udir) {
702 warnings::warnif "Can't cd to $udir: $!\n";
707 # push the starting directory
708 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
711 $p_dir = $dir_pref; # ensure trailing ':'
714 while (defined $SE) {
716 $dir= $p_dir; # $File::Find::dir
717 $name= $dir_name; # $File::Find::name
718 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
719 # prune may happen here
721 # guarantee lstat for directory
723 { &$wanted_callback }; # protect against wild "next"
727 # change to that directory
728 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
730 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
731 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
732 unless (defined $udir) {
733 if ($untaint_skip == 0) {
735 die "directory ($p_dir) $dir_rel is still tainted";
738 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
740 } else { # $untaint_skip == 1
745 unless (chdir $udir) {
747 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
750 warnings::warnif "Can't cd to (" .
751 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
759 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
762 $dir= $dir_name; # $File::Find::dir
764 # Get the list of files in the current directory.
765 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
766 warnings::warnif "Can't opendir($dir_name): $!\n";
769 @filenames = readdir DIR;
771 @filenames = &$pre_process(@filenames) if $pre_process;
772 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
774 # default: use whatever was specifid
775 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
776 $no_nlink = $avoid_nlink;
777 # if dir has wrong nlink count, force switch to slower stat method
778 $no_nlink = 1 if ($nlink < 2);
780 if ($nlink == 2 && !$no_nlink) {
781 # This dir has no subdirectories.
782 for my $FN (@filenames) {
783 next if $FN =~ $File::Find::skip_pattern;
785 $name = $dir_pref . $FN; # $File::Find::name
786 $_ = ($no_chdir ? $name : $FN); # $_
787 { &$wanted_callback }; # protect against wild "next"
792 # This dir has subdirectories.
793 $subcount = $nlink - 2;
795 for my $FN (@filenames) {
796 next if $FN =~ $File::Find::skip_pattern;
797 if ($subcount > 0 || $no_nlink) {
798 # Seen all the subdirs?
799 # check for directoriness.
800 # stat is faster for a file in the current directory
801 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
805 $FN =~ s/\.dir\z// if $Is_VMS;
806 push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
809 $name = $dir_pref . $FN; # $File::Find::name
810 $_= ($no_chdir ? $name : $FN); # $_
811 { &$wanted_callback }; # protect against wild "next"
815 $name = $dir_pref . $FN; # $File::Find::name
816 $_= ($no_chdir ? $name : $FN); # $_
817 { &$wanted_callback }; # protect against wild "next"
823 while ( defined ($SE = pop @Stack) ) {
824 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
825 if ($CdLvl > $Level && !$no_chdir) {
828 $tmp = (':' x ($CdLvl-$Level)) . ':';
831 $tmp = join('/',('..') x ($CdLvl-$Level));
833 die "Can't cd to $dir_name" . $tmp
839 # $pdir always has a trailing ':', except for the starting dir,
840 # where $dir_rel eq ':'
841 $dir_name = "$p_dir$dir_rel";
842 $dir_pref = "$dir_name:";
845 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
846 $dir_pref = "$dir_name/";
849 if ( $nlink == -2 ) {
850 $name = $dir = $p_dir; # $File::Find::name / dir
851 $_ = $File::Find::current_dir;
852 &$post_process; # End-of-directory processing
854 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
857 if ($dir_rel eq ':') { # must be the top dir, where we started
858 $name =~ s|:$||; # $File::Find::name
859 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
861 $dir = $p_dir; # $File::Find::dir
862 $_ = ($no_chdir ? $name : $dir_rel); # $_
865 if ( substr($name,-2) eq '/.' ) {
869 $_ = ($no_chdir ? $dir_name : $dir_rel );
870 if ( substr($_,-2) eq '/.' ) {
874 # guarantee lstat at return to directory
876 { &$wanted_callback }; # protect against wild "next"
879 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
889 # $dir_loc : absolute location of a dir
890 # $p_dir : "parent directory"
892 # chdir (if not no_chdir) to dir
894 sub _find_dir_symlnk($$$) {
895 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
899 my $updir_loc = $dir_loc; # untainted parent directory
901 my $dir_name = $p_dir;
904 my $dir_rel = $File::Find::current_dir;
905 my $byd_flag; # flag for pending stack entry if $bydepth
910 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
911 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
913 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
914 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
917 local ($dir, $name, $fullname, $prune, *DIR);
921 if (( $untaint ) && (is_tainted($dir_loc) )) {
922 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
923 # once untainted, $updir_loc is pushed on the stack (as parent directory);
924 # hence, we don't need to untaint the parent directory every time we chdir
926 unless (defined $updir_loc) {
927 if ($untaint_skip == 0) {
928 die "directory $dir_loc is still tainted";
935 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
937 warnings::warnif "Can't cd to $updir_loc: $!\n";
942 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
945 $p_dir = $dir_pref; # ensure trailing ':'
948 while (defined $SE) {
951 # change (back) to parent directory (always untainted)
953 unless (chdir $updir_loc) {
954 warnings::warnif "Can't cd to $updir_loc: $!\n";
958 $dir= $p_dir; # $File::Find::dir
959 $name= $dir_name; # $File::Find::name
960 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
961 $fullname= $dir_loc; # $File::Find::fullname
962 # prune may happen here
964 lstat($_); # make sure file tests with '_' work
965 { &$wanted_callback }; # protect against wild "next"
969 # change to that directory
970 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
971 $updir_loc = $dir_loc;
972 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
973 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
974 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
975 unless (defined $updir_loc) {
976 if ($untaint_skip == 0) {
977 die "directory $dir_loc is still tainted";
984 unless (chdir $updir_loc) {
985 warnings::warnif "Can't cd to $updir_loc: $!\n";
991 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
994 $dir = $dir_name; # $File::Find::dir
996 # Get the list of files in the current directory.
997 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
998 warnings::warnif "Can't opendir($dir_loc): $!\n";
1001 @filenames = readdir DIR;
1004 for my $FN (@filenames) {
1005 next if $FN =~ $File::Find::skip_pattern;
1007 # follow symbolic links / do an lstat
1008 $new_loc = Follow_SymLink($loc_pref.$FN);
1010 # ignore if invalid symlink
1011 next unless defined $new_loc;
1014 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1017 $fullname = $new_loc; # $File::Find::fullname
1018 $name = $dir_pref . $FN; # $File::Find::name
1019 $_ = ($no_chdir ? $name : $FN); # $_
1020 { &$wanted_callback }; # protect against wild "next"
1026 while (defined($SE = pop @Stack)) {
1027 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1029 # $p_dir always has a trailing ':', except for the starting dir,
1030 # where $dir_rel eq ':'
1031 $dir_name = "$p_dir$dir_rel";
1032 $dir_pref = "$dir_name:";
1033 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1036 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1037 $dir_pref = "$dir_name/";
1038 $loc_pref = "$dir_loc/";
1040 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1041 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1042 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1043 warnings::warnif "Can't cd to $updir_loc: $!\n";
1047 $fullname = $dir_loc; # $File::Find::fullname
1048 $name = $dir_name; # $File::Find::name
1050 if ($dir_rel eq ':') { # must be the top dir, where we started
1051 $name =~ s|:$||; # $File::Find::name
1052 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1054 $dir = $p_dir; # $File::Find::dir
1055 $_ = ($no_chdir ? $name : $dir_rel); # $_
1058 if ( substr($name,-2) eq '/.' ) {
1059 $name =~ s|/\.$||; # $File::Find::name
1061 $dir = $p_dir; # $File::Find::dir
1062 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1063 if ( substr($_,-2) eq '/.' ) {
1068 lstat($_); # make sure file tests with '_' work
1069 { &$wanted_callback }; # protect against wild "next"
1072 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1082 if ( ref($wanted) eq 'HASH' ) {
1083 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1084 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1086 if ( $wanted->{untaint} ) {
1087 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1088 unless defined $wanted->{untaint_pattern};
1089 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1094 return { wanted => $wanted };
1100 _find_opt(wrap_wanted($wanted), @_);
1104 my $wanted = wrap_wanted(shift);
1105 $wanted->{bydepth} = 1;
1106 _find_opt($wanted, @_);
1110 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1111 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1113 # These are hard-coded for now, but may move to hint files.
1116 $File::Find::dont_use_nlink = 1;
1118 elsif ($^O eq 'MacOS') {
1120 $File::Find::dont_use_nlink = 1;
1121 $File::Find::skip_pattern = qr/^Icon\015\z/;
1122 $File::Find::untaint_pattern = qr|^(.+)$|;
1125 # this _should_ work properly on all platforms
1126 # where File::Find can be expected to work
1127 $File::Find::current_dir = File::Spec->curdir || '.';
1129 $File::Find::dont_use_nlink = 1
1130 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1131 $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'NetWare';
1133 # Set dont_use_nlink in your hint file if your system's stat doesn't
1134 # report the number of links in a directory as an indication
1135 # of the number of files.
1136 # See, e.g. hints/machten.sh for MachTen 2.2.
1137 unless ($File::Find::dont_use_nlink) {
1139 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1142 # We need a function that checks if a scalar is tainted. Either use the
1143 # Scalar::Util module's tainted() function or our (slower) pure Perl
1144 # fallback is_tainted_pp()
1147 eval { require Scalar::Util };
1148 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;