5 use warnings::register;
11 # Modified to ensure sub-directory traversal order is not inverded by stack
12 # push and pops. That is remains in the same order as in the directory file,
13 # or user pre-processing (EG:sorted).
18 File::Find - Traverse a directory tree.
23 find(\&wanted, @directories_to_search);
27 finddepth(\&wanted, @directories_to_search);
31 find({ wanted => \&process, follow => 1 }, '.');
35 These are functions for searching through directory trees doing work
36 on each file found similar to the Unix I<find> command. File::Find
37 exports two functions, C<find> and C<finddepth>. They work similarly
38 but have subtle differences.
44 find(\&wanted, @directories);
45 find(\%options, @directories);
47 C<find()> does a depth-first search over the given C<@directories> in
48 the order they are given. For each file or directory found, it calls
49 the C<&wanted> subroutine. (See below for details on how to use the
50 C<&wanted> function). Additionally, for each directory found, it will
51 C<chdir()> into that directory and continue the search, invoking the
52 C<&wanted> function on each file or subdirectory in the directory.
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
59 C<finddepth()> works just like C<find()> except that is invokes the
60 C<&wanted> function for a directory I<after> invoking it for the
61 directory's contents. It does a postorder traversal instead of a
62 preorder traversal, working from the bottom of the directory tree up
63 where C<find()> works from the top of the tree down.
69 The first argument to C<find()> is either a code reference to your
70 C<&wanted> function, or a hash reference describing the operations
71 to be performed for each file. The
72 code reference is described in L<The wanted function> below.
74 Here are the possible keys for the hash:
80 The value should be a code reference. This code reference is
81 described in L<The wanted function> below.
85 Reports the name of a directory only AFTER all its entries
86 have been reported. Entry point C<finddepth()> is a shortcut for
87 specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
91 The value should be a code reference. This code reference is used to
92 preprocess the current directory. The name of the currently processed
93 directory is in C<$File::Find::dir>. Your preprocessing function is
94 called after C<readdir()>, but before the loop that calls the C<wanted()>
95 function. It is called with a list of strings (actually file/directory
96 names) and is expected to return a list of strings. The code can be
97 used to sort the file/directory names alphabetically, numerically,
98 or to filter out directory entries based on their name alone. When
99 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
103 The value should be a code reference. It is invoked just before leaving
104 the currently processed directory. It is called in void context with no
105 arguments. The name of the current directory is in C<$File::Find::dir>. This
106 hook is handy for summarizing a directory, such as calculating its disk
107 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
112 Causes symbolic links to be followed. Since directory trees with symbolic
113 links (followed) may contain files more than once and may even have
114 cycles, a hash has to be built up with an entry for each file.
115 This might be expensive both in space and time for a large
116 directory tree. See I<follow_fast> and I<follow_skip> below.
117 If either I<follow> or I<follow_fast> is in effect:
123 It is guaranteed that an I<lstat> has been called before the user's
124 C<wanted()> function is called. This enables fast file checks involving S< _>.
128 There is a variable C<$File::Find::fullname> which holds the absolute
129 pathname of the file with all symbolic links resolved. If the link is
130 a dangling symbolic link, then fullname will be set to C<undef>.
136 This is similar to I<follow> except that it may report some files more
137 than once. It does detect cycles, however. Since only symbolic links
138 have to be hashed, this is much cheaper both in space and time. If
139 processing a file more than once (by the user's C<wanted()> function)
140 is worse than just taking time, the option I<follow> should be used.
144 C<follow_skip==1>, which is the default, causes all files which are
145 neither directories nor symbolic links to be ignored if they are about
146 to be processed a second time. If a directory or a symbolic link
147 are about to be processed a second time, File::Find dies.
149 C<follow_skip==0> causes File::Find to die if any file is about to be
150 processed a second time.
152 C<follow_skip==2> causes File::Find to ignore any duplicate files and
153 directories but to proceed normally otherwise.
155 =item C<dangling_symlinks>
157 If true and a code reference, will be called with the symbolic link
158 name and the directory it lives in as arguments. Otherwise, if true
159 and warnings are on, warning "symbolic_link_name is a dangling
160 symbolic link\n" will be issued. If false, the dangling symbolic link
161 will be silently ignored.
165 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
166 function will need to be aware of this, of course. In this case,
167 C<$_> will be the same as C<$File::Find::name>.
171 If find is used in taint-mode (-T command line switch or if EUID != UID
172 or if EGID != GID) then internally directory names have to be untainted
173 before they can be chdir'ed to. Therefore they are checked against a regular
174 expression I<untaint_pattern>. Note that all names passed to the user's
175 I<wanted()> function are still tainted. If this option is used while
176 not in taint-mode, C<untaint> is a no-op.
178 =item C<untaint_pattern>
180 See above. This should be set using the C<qr> quoting operator.
181 The default is set to C<qr|^([-+@\w./]+)$|>.
182 Note that the parentheses are vital.
184 =item C<untaint_skip>
186 If set, a directory which fails the I<untaint_pattern> is skipped,
187 including all its sub-directories. The default is to 'die' in such a case.
191 =head2 The wanted function
193 The C<wanted()> function does whatever verifications you want on
194 each file and directory. Note that despite its name, the C<wanted()>
195 function is a generic callback function, and does B<not> tell
196 File::Find if a file is "wanted" or not. In fact, its return value
199 The wanted function takes no arguments but rather does its work
200 through a collection of variables.
204 =item C<$File::Find::dir> is the current directory name,
206 =item C<$_> is the current filename within that directory
208 =item C<$File::Find::name> is the complete pathname to the file.
212 Don't modify these variables.
214 For example, when examining the file F</some/path/foo.ext> you will have:
216 $File::Find::dir = /some/path/
218 $File::Find::name = /some/path/foo.ext
220 You are chdir()'d to C<$File::Find::dir> when the function is called,
221 unless C<no_chdir> was specified. Note that when changing to
222 directories is in effect the root directory (F</>) is a somewhat
223 special case inasmuch as the concatenation of C<$File::Find::dir>,
224 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
225 table below summarizes all variants:
227 $File::Find::name $File::Find::dir $_
229 no_chdir=>0 /etc / etc
237 When <follow> or <follow_fast> are in effect, there is
238 also a C<$File::Find::fullname>. The function may set
239 C<$File::Find::prune> to prune the tree unless C<bydepth> was
240 specified. Unless C<follow> or C<follow_fast> is specified, for
241 compatibility reasons (find.pl, find2perl) there are in addition the
242 following globals available: C<$File::Find::topdir>,
243 C<$File::Find::topdev>, C<$File::Find::topino>,
244 C<$File::Find::topmode> and C<$File::Find::topnlink>.
246 This library is useful for the C<find2perl> tool, which when fed,
248 find2perl / -name .nfs\* -mtime +7 \
249 -exec rm -f {} \; -o -fstype nfs -prune
251 produces something like:
255 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
259 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
261 ($File::Find::prune = 1);
264 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
265 filehandle that caches the information from the preceding
266 C<stat()>, C<lstat()>, or filetest.
268 Here's another interesting wanted function. It will find all symbolic
269 links that don't resolve:
272 -l && !-e && print "bogus link: $File::Find::name\n";
275 See also the script C<pfind> on CPAN for a nice application of this
280 If you run your program with the C<-w> switch, or if you use the
281 C<warnings> pragma, File::Find will report warnings for several weird
282 situations. You can disable these warnings by putting the statement
284 no warnings 'File::Find';
286 in the appropriate scope. See L<perllexwarn> for more info about lexical
293 =item $dont_use_nlink
295 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
296 force File::Find to always stat directories. This was used for file systems
297 that do not have an C<nlink> count matching the number of sub-directories.
298 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
299 system) and a couple of others.
301 You shouldn't need to set this variable, since File::Find should now detect
302 such file systems on-the-fly and switch itself to using stat. This works even
303 for parts of your file system, like a mounted CD-ROM.
305 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
309 Be aware that the option to follow symbolic links can be dangerous.
310 Depending on the structure of the directory tree (including symbolic
311 links to directories) you might traverse a given (physical) directory
312 more than once (only if C<follow_fast> is in effect).
313 Furthermore, deleting or changing files in a symbolically linked directory
314 might cause very unpleasant surprises, since you delete or change files
315 in an unknown directory.
325 Mac OS (Classic) users should note a few differences:
331 The path separator is ':', not '/', and the current directory is denoted
332 as ':', not '.'. You should be careful about specifying relative pathnames.
333 While a full path always begins with a volume name, a relative pathname
334 should always begin with a ':'. If specifying a volume name only, a
335 trailing ':' is required.
339 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
340 contains the name of a directory, that name may or may not end with a
341 ':'. Likewise, C<$File::Find::name>, which contains the complete
342 pathname to that directory, and C<$File::Find::fullname>, which holds
343 the absolute pathname of that directory with all symbolic links resolved,
344 may or may not end with a ':'.
348 The default C<untaint_pattern> (see above) on Mac OS is set to
349 C<qr|^(.+)$|>. Note that the parentheses are vital.
353 The invisible system file "Icon\015" is ignored. While this file may
354 appear in every directory, there are some more invisible system files
355 on every volume, which are all located at the volume root level (i.e.
356 "MacintoshHD:"). These system files are B<not> excluded automatically.
357 Your filter may use the following code to recognize invisible files or
358 directories (requires Mac::Files):
362 # invisible() -- returns 1 if file/directory is invisible,
363 # 0 if it's visible or undef if an error occurred
367 my ($fileCat, $fileInfo);
368 my $invisible_flag = 1 << 14;
370 if ( $fileCat = FSpGetCatInfo($file) ) {
371 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
372 return (($fileInfo->fdFlags & $invisible_flag) && 1);
378 Generally, invisible files are system files, unless an odd application
379 decides to use invisible files for its own purposes. To distinguish
380 such files from system files, you have to look at the B<type> and B<creator>
381 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
382 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
383 (see MacPerl.pm for details).
385 Files that appear on the desktop actually reside in an (hidden) directory
386 named "Desktop Folder" on the particular disk volume. Note that, although
387 all desktop files appear to be on the same "virtual" desktop, each disk
388 volume actually maintains its own "Desktop Folder" directory.
394 =head1 BUGS AND CAVEATS
396 Despite the name of the C<finddepth()> function, both C<find()> and
397 C<finddepth()> perform a depth-first search of the directory
402 File::Find used to produce incorrect results if called recursively.
403 During the development of perl 5.8 this bug was fixed.
404 The first fixed version of File::Find was 1.01.
408 our @ISA = qw(Exporter);
409 our @EXPORT = qw(find finddepth);
416 require File::Basename;
419 # Should ideally be my() not our() but local() currently
420 # refuses to operate on lexicals
423 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
424 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
425 $pre_process, $post_process, $dangling_symlinks);
430 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
432 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
436 my $abs_name= $cdir . $fn;
438 if (substr($fn,0,3) eq '../') {
439 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
445 # return the absolute name of a directory or file
446 sub contract_name_Mac {
450 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
452 my $colon_count = length ($1);
453 if ($colon_count == 1) {
454 $abs_name = $cdir . $2;
458 # need to move up the tree, but
459 # only if it's not a volume name
460 for (my $i=1; $i<$colon_count; $i++) {
461 unless ($cdir =~ /^[^:]+:$/) { # volume name
462 $cdir =~ s/[^:]+:$//;
468 $abs_name = $cdir . $2;
475 # $fn may be a valid path to a directory or file or (dangling)
476 # symlink, without a leading ':'
477 if ( (-e $fn) || (-l $fn) ) {
478 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
479 return $fn; # $fn is already an absolute path
482 $abs_name = $cdir . $fn;
486 else { # argh!, $fn is not a valid directory/file
492 sub PathCombine($$) {
493 my ($Base,$Name) = @_;
497 # $Name is the resolved symlink (always a full path on MacOS),
498 # i.e. there's no need to call contract_name_Mac()
501 # (simple) check for recursion
502 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
507 if (substr($Name,0,1) eq '/') {
511 $AbsName= contract_name($Base,$Name);
514 # (simple) check for recursion
515 my $newlen= length($AbsName);
516 if ($newlen <= length($Base)) {
517 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
518 && $AbsName eq substr($Base,0,$newlen))
527 sub Follow_SymLink($) {
530 my ($NewName,$DEV, $INO);
531 ($DEV, $INO)= lstat $AbsName;
534 if ($SLnkSeen{$DEV, $INO}++) {
535 if ($follow_skip < 2) {
536 die "$AbsName is encountered a second time";
542 $NewName= PathCombine($AbsName, readlink($AbsName));
543 unless(defined $NewName) {
544 if ($follow_skip < 2) {
545 die "$AbsName is a recursive symbolic link";
554 ($DEV, $INO) = lstat($AbsName);
555 return undef unless defined $DEV; # dangling symbolic link
558 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
559 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
560 die "$AbsName encountered a second time";
570 our($dir, $name, $fullname, $prune);
571 sub _find_dir_symlnk($$$);
574 # check whether or not a scalar variable is tainted
575 # (code straight from the Camel, 3rd ed., page 561)
578 my $nada = substr($arg, 0, 0); # zero-length
580 eval { eval "# $nada" };
581 return length($@) != 0;
586 die "invalid top directory" unless defined $_[0];
588 # This function must local()ize everything because callbacks may
589 # call find() or finddepth()
592 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
593 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
594 $pre_process, $post_process, $dangling_symlinks);
595 local($dir, $name, $fullname, $prune);
598 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
599 my $cwd_untainted = $cwd;
601 $wanted_callback = $wanted->{wanted};
602 $bydepth = $wanted->{bydepth};
603 $pre_process = $wanted->{preprocess};
604 $post_process = $wanted->{postprocess};
605 $no_chdir = $wanted->{no_chdir};
606 $full_check = $wanted->{follow};
607 $follow = $full_check || $wanted->{follow_fast};
608 $follow_skip = $wanted->{follow_skip};
609 $untaint = $wanted->{untaint};
610 $untaint_pat = $wanted->{untaint_pattern};
611 $untaint_skip = $wanted->{untaint_skip};
612 $dangling_symlinks = $wanted->{dangling_symlinks};
614 # for compatibility reasons (find.pl, find2perl)
615 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
617 # a symbolic link to a directory doesn't increase the link count
618 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
620 my ($abs_dir, $Is_Dir);
623 foreach my $TOP (@_) {
626 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
629 $top_item = ":$top_item"
630 if ( (-d _) && ( $top_item !~ /:/ ) );
631 } elsif ($^O eq 'MSWin32') {
632 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
635 $top_item =~ s|/\z|| unless $top_item eq '/';
643 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
645 if ($top_item eq $File::Find::current_dir) {
649 $abs_dir = contract_name_Mac($cwd, $top_item);
650 unless (defined $abs_dir) {
651 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
658 if (substr($top_item,0,1) eq '/') {
659 $abs_dir = $top_item;
661 elsif ($top_item eq $File::Find::current_dir) {
664 else { # care about any ../
665 $abs_dir = contract_name("$cwd/",$top_item);
668 $abs_dir= Follow_SymLink($abs_dir);
669 unless (defined $abs_dir) {
670 if ($dangling_symlinks) {
671 if (ref $dangling_symlinks eq 'CODE') {
672 $dangling_symlinks->($top_item, $cwd);
674 warnings::warnif "$top_item is a dangling symbolic link\n";
681 _find_dir_symlnk($wanted, $abs_dir, $top_item);
687 unless (defined $topnlink) {
688 warnings::warnif "Can't stat $top_item: $!\n";
692 $top_item =~ s/\.dir\z//i if $Is_VMS;
693 _find_dir($wanted, $top_item, $topnlink);
702 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
704 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
707 ($dir,$_) = ('./', $top_item);
712 if (( $untaint ) && (is_tainted($dir) )) {
713 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
714 unless (defined $abs_dir) {
715 if ($untaint_skip == 0) {
716 die "directory $dir is still tainted";
724 unless ($no_chdir || chdir $abs_dir) {
725 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
729 $name = $abs_dir . $_; # $File::Find::name
730 $_ = $name if $no_chdir;
732 { $wanted_callback->() }; # protect against wild "next"
736 unless ( $no_chdir ) {
737 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
738 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
739 unless (defined $cwd_untainted) {
740 die "insecure cwd in find(depth)";
744 unless (chdir $cwd_untainted) {
745 die "Can't cd to $cwd: $!\n";
753 # $p_dir : "parent directory"
754 # $nlink : what came back from the stat
756 # chdir (if not no_chdir) to dir
759 my ($wanted, $p_dir, $nlink) = @_;
760 my ($CdLvl,$Level) = (0,0);
763 my ($subcount,$sub_nlink);
765 my $dir_name= $p_dir;
767 my $dir_rel = $File::Find::current_dir;
772 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
773 } elsif ($^O eq 'MSWin32') {
774 $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
777 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
780 local ($dir, $name, $prune, *DIR);
782 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
784 if (( $untaint ) && (is_tainted($p_dir) )) {
785 ( $udir ) = $p_dir =~ m|$untaint_pat|;
786 unless (defined $udir) {
787 if ($untaint_skip == 0) {
788 die "directory $p_dir is still tainted";
795 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
796 warnings::warnif "Can't cd to $udir: $!\n";
801 # push the starting directory
802 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
805 $p_dir = $dir_pref; # ensure trailing ':'
808 while (defined $SE) {
810 $dir= $p_dir; # $File::Find::dir
811 $name= $dir_name; # $File::Find::name
812 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
813 # prune may happen here
815 { $wanted_callback->() }; # protect against wild "next"
819 # change to that directory
820 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
822 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
823 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
824 unless (defined $udir) {
825 if ($untaint_skip == 0) {
827 die "directory ($p_dir) $dir_rel is still tainted";
830 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
832 } else { # $untaint_skip == 1
837 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
839 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
842 warnings::warnif "Can't cd to (" .
843 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
851 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
854 $dir= $dir_name; # $File::Find::dir
856 # Get the list of files in the current directory.
857 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
858 warnings::warnif "Can't opendir($dir_name): $!\n";
861 @filenames = readdir DIR;
863 @filenames = $pre_process->(@filenames) if $pre_process;
864 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
866 # default: use whatever was specifid
867 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
868 $no_nlink = $avoid_nlink;
869 # if dir has wrong nlink count, force switch to slower stat method
870 $no_nlink = 1 if ($nlink < 2);
872 if ($nlink == 2 && !$no_nlink) {
873 # This dir has no subdirectories.
874 for my $FN (@filenames) {
875 next if $FN =~ $File::Find::skip_pattern;
877 $name = $dir_pref . $FN; # $File::Find::name
878 $_ = ($no_chdir ? $name : $FN); # $_
879 { $wanted_callback->() }; # protect against wild "next"
884 # This dir has subdirectories.
885 $subcount = $nlink - 2;
887 # HACK: insert directories at this position. so as to preserve
888 # the user pre-processed ordering of files.
889 # EG: directory traversal is in user sorted order, not at random.
890 my $stack_top = @Stack;
892 for my $FN (@filenames) {
893 next if $FN =~ $File::Find::skip_pattern;
894 if ($subcount > 0 || $no_nlink) {
895 # Seen all the subdirs?
896 # check for directoriness.
897 # stat is faster for a file in the current directory
898 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
902 $FN =~ s/\.dir\z//i if $Is_VMS;
903 # HACK: replace push to preserve dir traversal order
904 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
905 splice @Stack, $stack_top, 0,
906 [$CdLvl,$dir_name,$FN,$sub_nlink];
909 $name = $dir_pref . $FN; # $File::Find::name
910 $_= ($no_chdir ? $name : $FN); # $_
911 { $wanted_callback->() }; # protect against wild "next"
915 $name = $dir_pref . $FN; # $File::Find::name
916 $_= ($no_chdir ? $name : $FN); # $_
917 { $wanted_callback->() }; # protect against wild "next"
923 while ( defined ($SE = pop @Stack) ) {
924 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
925 if ($CdLvl > $Level && !$no_chdir) {
928 $tmp = (':' x ($CdLvl-$Level)) . ':';
931 $tmp = join('/',('..') x ($CdLvl-$Level));
933 die "Can't cd to $dir_name" . $tmp
939 # $pdir always has a trailing ':', except for the starting dir,
940 # where $dir_rel eq ':'
941 $dir_name = "$p_dir$dir_rel";
942 $dir_pref = "$dir_name:";
944 elsif ($^O eq 'MSWin32') {
945 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
946 $dir_pref = "$dir_name/";
949 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
950 $dir_pref = "$dir_name/";
953 if ( $nlink == -2 ) {
954 $name = $dir = $p_dir; # $File::Find::name / dir
955 $_ = $File::Find::current_dir;
956 $post_process->(); # End-of-directory processing
958 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
961 if ($dir_rel eq ':') { # must be the top dir, where we started
962 $name =~ s|:$||; # $File::Find::name
963 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
965 $dir = $p_dir; # $File::Find::dir
966 $_ = ($no_chdir ? $name : $dir_rel); # $_
969 if ( substr($name,-2) eq '/.' ) {
970 substr($name, length($name) == 2 ? -1 : -2) = '';
973 $_ = ($no_chdir ? $dir_name : $dir_rel );
974 if ( substr($_,-2) eq '/.' ) {
975 substr($_, length($_) == 2 ? -1 : -2) = '';
978 { $wanted_callback->() }; # protect against wild "next"
981 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
991 # $dir_loc : absolute location of a dir
992 # $p_dir : "parent directory"
994 # chdir (if not no_chdir) to dir
996 sub _find_dir_symlnk($$$) {
997 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1001 my $updir_loc = $dir_loc; # untainted parent directory
1003 my $dir_name = $p_dir;
1006 my $dir_rel = $File::Find::current_dir;
1007 my $byd_flag; # flag for pending stack entry if $bydepth
1012 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1013 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1015 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1016 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1019 local ($dir, $name, $fullname, $prune, *DIR);
1021 unless ($no_chdir) {
1022 # untaint the topdir
1023 if (( $untaint ) && (is_tainted($dir_loc) )) {
1024 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1025 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1026 # hence, we don't need to untaint the parent directory every time we chdir
1028 unless (defined $updir_loc) {
1029 if ($untaint_skip == 0) {
1030 die "directory $dir_loc is still tainted";
1037 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1039 warnings::warnif "Can't cd to $updir_loc: $!\n";
1044 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1047 $p_dir = $dir_pref; # ensure trailing ':'
1050 while (defined $SE) {
1053 # change (back) to parent directory (always untainted)
1054 unless ($no_chdir) {
1055 unless (chdir $updir_loc) {
1056 warnings::warnif "Can't cd to $updir_loc: $!\n";
1060 $dir= $p_dir; # $File::Find::dir
1061 $name= $dir_name; # $File::Find::name
1062 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1063 $fullname= $dir_loc; # $File::Find::fullname
1064 # prune may happen here
1066 lstat($_); # make sure file tests with '_' work
1067 { $wanted_callback->() }; # protect against wild "next"
1071 # change to that directory
1072 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1073 $updir_loc = $dir_loc;
1074 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1075 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1076 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1077 unless (defined $updir_loc) {
1078 if ($untaint_skip == 0) {
1079 die "directory $dir_loc is still tainted";
1086 unless (chdir $updir_loc) {
1087 warnings::warnif "Can't cd to $updir_loc: $!\n";
1093 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1096 $dir = $dir_name; # $File::Find::dir
1098 # Get the list of files in the current directory.
1099 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1100 warnings::warnif "Can't opendir($dir_loc): $!\n";
1103 @filenames = readdir DIR;
1106 for my $FN (@filenames) {
1107 next if $FN =~ $File::Find::skip_pattern;
1109 # follow symbolic links / do an lstat
1110 $new_loc = Follow_SymLink($loc_pref.$FN);
1112 # ignore if invalid symlink
1113 unless (defined $new_loc) {
1114 if ($dangling_symlinks) {
1115 if (ref $dangling_symlinks eq 'CODE') {
1116 $dangling_symlinks->($FN, $dir_pref);
1118 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1123 $name = $dir_pref . $FN;
1124 $_ = ($no_chdir ? $name : $FN);
1125 { $wanted_callback->() };
1130 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1133 $fullname = $new_loc; # $File::Find::fullname
1134 $name = $dir_pref . $FN; # $File::Find::name
1135 $_ = ($no_chdir ? $name : $FN); # $_
1136 { $wanted_callback->() }; # protect against wild "next"
1142 while (defined($SE = pop @Stack)) {
1143 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1145 # $p_dir always has a trailing ':', except for the starting dir,
1146 # where $dir_rel eq ':'
1147 $dir_name = "$p_dir$dir_rel";
1148 $dir_pref = "$dir_name:";
1149 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1152 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1153 $dir_pref = "$dir_name/";
1154 $loc_pref = "$dir_loc/";
1156 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1157 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1158 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1159 warnings::warnif "Can't cd to $updir_loc: $!\n";
1163 $fullname = $dir_loc; # $File::Find::fullname
1164 $name = $dir_name; # $File::Find::name
1166 if ($dir_rel eq ':') { # must be the top dir, where we started
1167 $name =~ s|:$||; # $File::Find::name
1168 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1170 $dir = $p_dir; # $File::Find::dir
1171 $_ = ($no_chdir ? $name : $dir_rel); # $_
1174 if ( substr($name,-2) eq '/.' ) {
1175 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1177 $dir = $p_dir; # $File::Find::dir
1178 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1179 if ( substr($_,-2) eq '/.' ) {
1180 substr($_, length($_) == 2 ? -1 : -2) = '';
1184 lstat($_); # make sure file tests with '_' work
1185 { $wanted_callback->() }; # protect against wild "next"
1188 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1198 if ( ref($wanted) eq 'HASH' ) {
1199 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1200 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1202 if ( $wanted->{untaint} ) {
1203 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1204 unless defined $wanted->{untaint_pattern};
1205 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1210 return { wanted => $wanted };
1216 _find_opt(wrap_wanted($wanted), @_);
1220 my $wanted = wrap_wanted(shift);
1221 $wanted->{bydepth} = 1;
1222 _find_opt($wanted, @_);
1226 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1227 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1229 # These are hard-coded for now, but may move to hint files.
1232 $File::Find::dont_use_nlink = 1;
1234 elsif ($^O eq 'MacOS') {
1236 $File::Find::dont_use_nlink = 1;
1237 $File::Find::skip_pattern = qr/^Icon\015\z/;
1238 $File::Find::untaint_pattern = qr|^(.+)$|;
1241 # this _should_ work properly on all platforms
1242 # where File::Find can be expected to work
1243 $File::Find::current_dir = File::Spec->curdir || '.';
1245 $File::Find::dont_use_nlink = 1
1246 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1247 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1250 # Set dont_use_nlink in your hint file if your system's stat doesn't
1251 # report the number of links in a directory as an indication
1252 # of the number of files.
1253 # See, e.g. hints/machten.sh for MachTen 2.2.
1254 unless ($File::Find::dont_use_nlink) {
1256 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1259 # We need a function that checks if a scalar is tainted. Either use the
1260 # Scalar::Util module's tainted() function or our (slower) pure Perl
1261 # fallback is_tainted_pp()
1264 eval { require Scalar::Util };
1265 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;