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
135 This is similar to I<follow> except that it may report some files more
136 than once. It does detect cycles, however. Since only symbolic links
137 have to be hashed, this is much cheaper both in space and time. If
138 processing a file more than once (by the user's C<wanted()> function)
139 is worse than just taking time, the option I<follow> should be used.
143 C<follow_skip==1>, which is the default, causes all files which are
144 neither directories nor symbolic links to be ignored if they are about
145 to be processed a second time. If a directory or a symbolic link
146 are about to be processed a second time, File::Find dies.
148 C<follow_skip==0> causes File::Find to die if any file is about to be
149 processed a second time.
151 C<follow_skip==2> causes File::Find to ignore any duplicate files and
152 directories but to proceed normally otherwise.
154 =item C<dangling_symlinks>
156 If true and a code reference, will be called with the symbolic link
157 name and the directory it lives in as arguments. Otherwise, if true
158 and warnings are on, warning "symbolic_link_name is a dangling
159 symbolic link\n" will be issued. If false, the dangling symbolic link
160 will be silently ignored.
164 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
165 function will need to be aware of this, of course. In this case,
166 C<$_> will be the same as C<$File::Find::name>.
170 If find is used in taint-mode (-T command line switch or if EUID != UID
171 or if EGID != GID) then internally directory names have to be untainted
172 before they can be chdir'ed to. Therefore they are checked against a regular
173 expression I<untaint_pattern>. Note that all names passed to the user's
174 I<wanted()> function are still tainted. If this option is used while
175 not in taint-mode, C<untaint> is a no-op.
177 =item C<untaint_pattern>
179 See above. This should be set using the C<qr> quoting operator.
180 The default is set to C<qr|^([-+@\w./]+)$|>.
181 Note that the parentheses are vital.
183 =item C<untaint_skip>
185 If set, a directory which fails the I<untaint_pattern> is skipped,
186 including all its sub-directories. The default is to 'die' in such a case.
190 =head2 The wanted function
192 The C<wanted()> function does whatever verifications you want on
193 each file and directory. Note that despite its name, the C<wanted()>
194 function is a generic callback function, and does B<not> tell
195 File::Find if a file is "wanted" or not. In fact, its return value
198 The wanted function takes no arguments but rather does its work
199 through a collection of variables.
203 =item C<$File::Find::dir> is the current directory name,
205 =item C<$_> is the current filename within that directory
207 =item C<$File::Find::name> is the complete pathname to the file.
211 Don't modify these variables.
213 For example, when examining the file F</some/path/foo.ext> you will have:
215 $File::Find::dir = /some/path/
217 $File::Find::name = /some/path/foo.ext
219 You are chdir()'d toC<$File::Find::dir> when the function is called,
220 unless C<no_chdir> was specified. Note that when changing to
221 directories is in effect the root directory (F</>) is a somewhat
222 special case inasmuch as the concatenation of C<$File::Find::dir>,
223 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
224 table below summarizes all variants:
226 $File::Find::name $File::Find::dir $_
228 no_chdir=>0 /etc / etc
236 When <follow> or <follow_fast> are in effect, there is
237 also a C<$File::Find::fullname>. The function may set
238 C<$File::Find::prune> to prune the tree unless C<bydepth> was
239 specified. Unless C<follow> or C<follow_fast> is specified, for
240 compatibility reasons (find.pl, find2perl) there are in addition the
241 following globals available: C<$File::Find::topdir>,
242 C<$File::Find::topdev>, C<$File::Find::topino>,
243 C<$File::Find::topmode> and C<$File::Find::topnlink>.
245 This library is useful for the C<find2perl> tool, which when fed,
247 find2perl / -name .nfs\* -mtime +7 \
248 -exec rm -f {} \; -o -fstype nfs -prune
250 produces something like:
254 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
258 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
260 ($File::Find::prune = 1);
263 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
264 filehandle that caches the information from the preceding
265 C<stat()>, C<lstat()>, or filetest.
267 Here's another interesting wanted function. It will find all symbolic
268 links that don't resolve:
271 -l && !-e && print "bogus link: $File::Find::name\n";
274 See also the script C<pfind> on CPAN for a nice application of this
279 If you run your program with the C<-w> switch, or if you use the
280 C<warnings> pragma, File::Find will report warnings for several weird
281 situations. You can disable these warnings by putting the statement
283 no warnings 'File::Find';
285 in the appropriate scope. See L<perllexwarn> for more info about lexical
292 =item $dont_use_nlink
294 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
295 force File::Find to always stat directories. This was used for file systems
296 that do not have an C<nlink> count matching the number of sub-directories.
297 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
298 system) and a couple of others.
300 You shouldn't need to set this variable, since File::Find should now detect
301 such file systems on-the-fly and switch itself to using stat. This works even
302 for parts of your file system, like a mounted CD-ROM.
304 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
308 Be aware that the option to follow symbolic links can be dangerous.
309 Depending on the structure of the directory tree (including symbolic
310 links to directories) you might traverse a given (physical) directory
311 more than once (only if C<follow_fast> is in effect).
312 Furthermore, deleting or changing files in a symbolically linked directory
313 might cause very unpleasant surprises, since you delete or change files
314 in an unknown directory.
324 Mac OS (Classic) users should note a few differences:
330 The path separator is ':', not '/', and the current directory is denoted
331 as ':', not '.'. You should be careful about specifying relative pathnames.
332 While a full path always begins with a volume name, a relative pathname
333 should always begin with a ':'. If specifying a volume name only, a
334 trailing ':' is required.
338 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
339 contains the name of a directory, that name may or may not end with a
340 ':'. Likewise, C<$File::Find::name>, which contains the complete
341 pathname to that directory, and C<$File::Find::fullname>, which holds
342 the absolute pathname of that directory with all symbolic links resolved,
343 may or may not end with a ':'.
347 The default C<untaint_pattern> (see above) on Mac OS is set to
348 C<qr|^(.+)$|>. Note that the parentheses are vital.
352 The invisible system file "Icon\015" is ignored. While this file may
353 appear in every directory, there are some more invisible system files
354 on every volume, which are all located at the volume root level (i.e.
355 "MacintoshHD:"). These system files are B<not> excluded automatically.
356 Your filter may use the following code to recognize invisible files or
357 directories (requires Mac::Files):
361 # invisible() -- returns 1 if file/directory is invisible,
362 # 0 if it's visible or undef if an error occurred
366 my ($fileCat, $fileInfo);
367 my $invisible_flag = 1 << 14;
369 if ( $fileCat = FSpGetCatInfo($file) ) {
370 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
371 return (($fileInfo->fdFlags & $invisible_flag) && 1);
377 Generally, invisible files are system files, unless an odd application
378 decides to use invisible files for its own purposes. To distinguish
379 such files from system files, you have to look at the B<type> and B<creator>
380 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
381 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
382 (see MacPerl.pm for details).
384 Files that appear on the desktop actually reside in an (hidden) directory
385 named "Desktop Folder" on the particular disk volume. Note that, although
386 all desktop files appear to be on the same "virtual" desktop, each disk
387 volume actually maintains its own "Desktop Folder" directory.
393 =head1 BUGS AND CAVEATS
395 Despite the name of the C<finddepth()> function, both C<find()> and
396 C<finddepth()> perform a depth-first search of the directory
401 File::Find used to produce incorrect results if called recursively.
402 During the development of perl 5.8 this bug was fixed.
403 The first fixed version of File::Find was 1.01.
407 our @ISA = qw(Exporter);
408 our @EXPORT = qw(find finddepth);
415 require File::Basename;
418 # Should ideally be my() not our() but local() currently
419 # refuses to operate on lexicals
422 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
423 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
424 $pre_process, $post_process, $dangling_symlinks);
429 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
431 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
435 my $abs_name= $cdir . $fn;
437 if (substr($fn,0,3) eq '../') {
438 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
444 # return the absolute name of a directory or file
445 sub contract_name_Mac {
449 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
451 my $colon_count = length ($1);
452 if ($colon_count == 1) {
453 $abs_name = $cdir . $2;
457 # need to move up the tree, but
458 # only if it's not a volume name
459 for (my $i=1; $i<$colon_count; $i++) {
460 unless ($cdir =~ /^[^:]+:$/) { # volume name
461 $cdir =~ s/[^:]+:$//;
467 $abs_name = $cdir . $2;
474 # $fn may be a valid path to a directory or file or (dangling)
475 # symlink, without a leading ':'
476 if ( (-e $fn) || (-l $fn) ) {
477 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
478 return $fn; # $fn is already an absolute path
481 $abs_name = $cdir . $fn;
485 else { # argh!, $fn is not a valid directory/file
491 sub PathCombine($$) {
492 my ($Base,$Name) = @_;
496 # $Name is the resolved symlink (always a full path on MacOS),
497 # i.e. there's no need to call contract_name_Mac()
500 # (simple) check for recursion
501 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
506 if (substr($Name,0,1) eq '/') {
510 $AbsName= contract_name($Base,$Name);
513 # (simple) check for recursion
514 my $newlen= length($AbsName);
515 if ($newlen <= length($Base)) {
516 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
517 && $AbsName eq substr($Base,0,$newlen))
526 sub Follow_SymLink($) {
529 my ($NewName,$DEV, $INO);
530 ($DEV, $INO)= lstat $AbsName;
533 if ($SLnkSeen{$DEV, $INO}++) {
534 if ($follow_skip < 2) {
535 die "$AbsName is encountered a second time";
541 $NewName= PathCombine($AbsName, readlink($AbsName));
542 unless(defined $NewName) {
543 if ($follow_skip < 2) {
544 die "$AbsName is a recursive symbolic link";
553 ($DEV, $INO) = lstat($AbsName);
554 return undef unless defined $DEV; # dangling symbolic link
557 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
558 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
559 die "$AbsName encountered a second time";
569 our($dir, $name, $fullname, $prune);
570 sub _find_dir_symlnk($$$);
573 # check whether or not a scalar variable is tainted
574 # (code straight from the Camel, 3rd ed., page 561)
577 my $nada = substr($arg, 0, 0); # zero-length
579 eval { eval "# $nada" };
580 return length($@) != 0;
585 die "invalid top directory" unless defined $_[0];
587 # This function must local()ize everything because callbacks may
588 # call find() or finddepth()
591 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
592 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
593 $pre_process, $post_process, $dangling_symlinks);
594 local($dir, $name, $fullname, $prune, $_);
596 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
597 my $cwd_untainted = $cwd;
599 $wanted_callback = $wanted->{wanted};
600 $bydepth = $wanted->{bydepth};
601 $pre_process = $wanted->{preprocess};
602 $post_process = $wanted->{postprocess};
603 $no_chdir = $wanted->{no_chdir};
604 $full_check = $wanted->{follow};
605 $follow = $full_check || $wanted->{follow_fast};
606 $follow_skip = $wanted->{follow_skip};
607 $untaint = $wanted->{untaint};
608 $untaint_pat = $wanted->{untaint_pattern};
609 $untaint_skip = $wanted->{untaint_skip};
610 $dangling_symlinks = $wanted->{dangling_symlinks};
612 # for compatibility reasons (find.pl, find2perl)
613 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
615 # a symbolic link to a directory doesn't increase the link count
616 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
618 my ($abs_dir, $Is_Dir);
621 foreach my $TOP (@_) {
625 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
626 $top_item = ":$top_item"
627 if ( (-d _) && ( $top_item !~ /:/ ) );
630 $top_item =~ s|/\z|| unless $top_item eq '/';
631 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
639 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
641 if ($top_item eq $File::Find::current_dir) {
645 $abs_dir = contract_name_Mac($cwd, $top_item);
646 unless (defined $abs_dir) {
647 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
654 if (substr($top_item,0,1) eq '/') {
655 $abs_dir = $top_item;
657 elsif ($top_item eq $File::Find::current_dir) {
660 else { # care about any ../
661 $abs_dir = contract_name("$cwd/",$top_item);
664 $abs_dir= Follow_SymLink($abs_dir);
665 unless (defined $abs_dir) {
666 if ($dangling_symlinks) {
667 if (ref $dangling_symlinks eq 'CODE') {
668 $dangling_symlinks->($top_item, $cwd);
670 warnings::warnif "$top_item is a dangling symbolic link\n";
677 _find_dir_symlnk($wanted, $abs_dir, $top_item);
683 unless (defined $topnlink) {
684 warnings::warnif "Can't stat $top_item: $!\n";
688 $top_item =~ s/\.dir\z//i if $Is_VMS;
689 _find_dir($wanted, $top_item, $topnlink);
698 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
700 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
703 ($dir,$_) = ('./', $top_item);
708 if (( $untaint ) && (is_tainted($dir) )) {
709 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
710 unless (defined $abs_dir) {
711 if ($untaint_skip == 0) {
712 die "directory $dir is still tainted";
720 unless ($no_chdir || chdir $abs_dir) {
721 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
725 $name = $abs_dir . $_; # $File::Find::name
726 $_ = $name if $no_chdir;
728 { $wanted_callback->() }; # protect against wild "next"
732 unless ( $no_chdir ) {
733 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
734 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
735 unless (defined $cwd_untainted) {
736 die "insecure cwd in find(depth)";
740 unless (chdir $cwd_untainted) {
741 die "Can't cd to $cwd: $!\n";
749 # $p_dir : "parent directory"
750 # $nlink : what came back from the stat
752 # chdir (if not no_chdir) to dir
755 my ($wanted, $p_dir, $nlink) = @_;
756 my ($CdLvl,$Level) = (0,0);
759 my ($subcount,$sub_nlink);
761 my $dir_name= $p_dir;
763 my $dir_rel = $File::Find::current_dir;
768 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
771 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
774 local ($dir, $name, $prune, *DIR);
776 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
778 if (( $untaint ) && (is_tainted($p_dir) )) {
779 ( $udir ) = $p_dir =~ m|$untaint_pat|;
780 unless (defined $udir) {
781 if ($untaint_skip == 0) {
782 die "directory $p_dir is still tainted";
789 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
790 warnings::warnif "Can't cd to $udir: $!\n";
795 # push the starting directory
796 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
799 $p_dir = $dir_pref; # ensure trailing ':'
802 while (defined $SE) {
804 $dir= $p_dir; # $File::Find::dir
805 $name= $dir_name; # $File::Find::name
806 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
807 # prune may happen here
809 { $wanted_callback->() }; # protect against wild "next"
813 # change to that directory
814 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
816 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
817 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
818 unless (defined $udir) {
819 if ($untaint_skip == 0) {
821 die "directory ($p_dir) $dir_rel is still tainted";
824 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
826 } else { # $untaint_skip == 1
831 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
833 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
836 warnings::warnif "Can't cd to (" .
837 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
845 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
848 $dir= $dir_name; # $File::Find::dir
850 # Get the list of files in the current directory.
851 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
852 warnings::warnif "Can't opendir($dir_name): $!\n";
855 @filenames = readdir DIR;
857 @filenames = $pre_process->(@filenames) if $pre_process;
858 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
860 # default: use whatever was specifid
861 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
862 $no_nlink = $avoid_nlink;
863 # if dir has wrong nlink count, force switch to slower stat method
864 $no_nlink = 1 if ($nlink < 2);
866 if ($nlink == 2 && !$no_nlink) {
867 # This dir has no subdirectories.
868 for my $FN (@filenames) {
869 next if $FN =~ $File::Find::skip_pattern;
871 $name = $dir_pref . $FN; # $File::Find::name
872 $_ = ($no_chdir ? $name : $FN); # $_
873 { $wanted_callback->() }; # protect against wild "next"
878 # This dir has subdirectories.
879 $subcount = $nlink - 2;
881 # HACK: insert directories at this position. so as to preserve
882 # the user pre-processed ordering of files.
883 # EG: directory traversal is in user sorted order, not at random.
884 my $stack_top = @Stack;
886 for my $FN (@filenames) {
887 next if $FN =~ $File::Find::skip_pattern;
888 if ($subcount > 0 || $no_nlink) {
889 # Seen all the subdirs?
890 # check for directoriness.
891 # stat is faster for a file in the current directory
892 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
896 $FN =~ s/\.dir\z//i if $Is_VMS;
897 # HACK: replace push to preserve dir traversal order
898 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
899 splice @Stack, $stack_top, 0,
900 [$CdLvl,$dir_name,$FN,$sub_nlink];
903 $name = $dir_pref . $FN; # $File::Find::name
904 $_= ($no_chdir ? $name : $FN); # $_
905 { $wanted_callback->() }; # protect against wild "next"
909 $name = $dir_pref . $FN; # $File::Find::name
910 $_= ($no_chdir ? $name : $FN); # $_
911 { $wanted_callback->() }; # protect against wild "next"
917 while ( defined ($SE = pop @Stack) ) {
918 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
919 if ($CdLvl > $Level && !$no_chdir) {
922 $tmp = (':' x ($CdLvl-$Level)) . ':';
925 $tmp = join('/',('..') x ($CdLvl-$Level));
927 die "Can't cd to $dir_name" . $tmp
933 # $pdir always has a trailing ':', except for the starting dir,
934 # where $dir_rel eq ':'
935 $dir_name = "$p_dir$dir_rel";
936 $dir_pref = "$dir_name:";
939 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
940 $dir_pref = "$dir_name/";
943 if ( $nlink == -2 ) {
944 $name = $dir = $p_dir; # $File::Find::name / dir
945 $_ = $File::Find::current_dir;
946 $post_process->(); # End-of-directory processing
948 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
951 if ($dir_rel eq ':') { # must be the top dir, where we started
952 $name =~ s|:$||; # $File::Find::name
953 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
955 $dir = $p_dir; # $File::Find::dir
956 $_ = ($no_chdir ? $name : $dir_rel); # $_
959 if ( substr($name,-2) eq '/.' ) {
960 substr($name, length($name) == 2 ? -1 : -2) = '';
963 $_ = ($no_chdir ? $dir_name : $dir_rel );
964 if ( substr($_,-2) eq '/.' ) {
965 substr($_, length($_) == 2 ? -1 : -2) = '';
968 { $wanted_callback->() }; # protect against wild "next"
971 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
981 # $dir_loc : absolute location of a dir
982 # $p_dir : "parent directory"
984 # chdir (if not no_chdir) to dir
986 sub _find_dir_symlnk($$$) {
987 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
991 my $updir_loc = $dir_loc; # untainted parent directory
993 my $dir_name = $p_dir;
996 my $dir_rel = $File::Find::current_dir;
997 my $byd_flag; # flag for pending stack entry if $bydepth
1002 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1003 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1005 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1006 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1009 local ($dir, $name, $fullname, $prune, *DIR);
1011 unless ($no_chdir) {
1012 # untaint the topdir
1013 if (( $untaint ) && (is_tainted($dir_loc) )) {
1014 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1015 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1016 # hence, we don't need to untaint the parent directory every time we chdir
1018 unless (defined $updir_loc) {
1019 if ($untaint_skip == 0) {
1020 die "directory $dir_loc is still tainted";
1027 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1029 warnings::warnif "Can't cd to $updir_loc: $!\n";
1034 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1037 $p_dir = $dir_pref; # ensure trailing ':'
1040 while (defined $SE) {
1043 # change (back) to parent directory (always untainted)
1044 unless ($no_chdir) {
1045 unless (chdir $updir_loc) {
1046 warnings::warnif "Can't cd to $updir_loc: $!\n";
1050 $dir= $p_dir; # $File::Find::dir
1051 $name= $dir_name; # $File::Find::name
1052 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1053 $fullname= $dir_loc; # $File::Find::fullname
1054 # prune may happen here
1056 lstat($_); # make sure file tests with '_' work
1057 { $wanted_callback->() }; # protect against wild "next"
1061 # change to that directory
1062 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1063 $updir_loc = $dir_loc;
1064 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1065 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1066 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1067 unless (defined $updir_loc) {
1068 if ($untaint_skip == 0) {
1069 die "directory $dir_loc is still tainted";
1076 unless (chdir $updir_loc) {
1077 warnings::warnif "Can't cd to $updir_loc: $!\n";
1083 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1086 $dir = $dir_name; # $File::Find::dir
1088 # Get the list of files in the current directory.
1089 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1090 warnings::warnif "Can't opendir($dir_loc): $!\n";
1093 @filenames = readdir DIR;
1096 for my $FN (@filenames) {
1097 next if $FN =~ $File::Find::skip_pattern;
1099 # follow symbolic links / do an lstat
1100 $new_loc = Follow_SymLink($loc_pref.$FN);
1102 # ignore if invalid symlink
1103 next unless defined $new_loc;
1106 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1109 $fullname = $new_loc; # $File::Find::fullname
1110 $name = $dir_pref . $FN; # $File::Find::name
1111 $_ = ($no_chdir ? $name : $FN); # $_
1112 { $wanted_callback->() }; # protect against wild "next"
1118 while (defined($SE = pop @Stack)) {
1119 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1121 # $p_dir always has a trailing ':', except for the starting dir,
1122 # where $dir_rel eq ':'
1123 $dir_name = "$p_dir$dir_rel";
1124 $dir_pref = "$dir_name:";
1125 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1128 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1129 $dir_pref = "$dir_name/";
1130 $loc_pref = "$dir_loc/";
1132 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1133 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1134 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1135 warnings::warnif "Can't cd to $updir_loc: $!\n";
1139 $fullname = $dir_loc; # $File::Find::fullname
1140 $name = $dir_name; # $File::Find::name
1142 if ($dir_rel eq ':') { # must be the top dir, where we started
1143 $name =~ s|:$||; # $File::Find::name
1144 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1146 $dir = $p_dir; # $File::Find::dir
1147 $_ = ($no_chdir ? $name : $dir_rel); # $_
1150 if ( substr($name,-2) eq '/.' ) {
1151 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1153 $dir = $p_dir; # $File::Find::dir
1154 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1155 if ( substr($_,-2) eq '/.' ) {
1156 substr($_, length($_) == 2 ? -1 : -2) = '';
1160 lstat($_); # make sure file tests with '_' work
1161 { $wanted_callback->() }; # protect against wild "next"
1164 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1174 if ( ref($wanted) eq 'HASH' ) {
1175 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1176 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1178 if ( $wanted->{untaint} ) {
1179 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1180 unless defined $wanted->{untaint_pattern};
1181 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1186 return { wanted => $wanted };
1192 _find_opt(wrap_wanted($wanted), @_);
1196 my $wanted = wrap_wanted(shift);
1197 $wanted->{bydepth} = 1;
1198 _find_opt($wanted, @_);
1202 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1203 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1205 # These are hard-coded for now, but may move to hint files.
1208 $File::Find::dont_use_nlink = 1;
1210 elsif ($^O eq 'MacOS') {
1212 $File::Find::dont_use_nlink = 1;
1213 $File::Find::skip_pattern = qr/^Icon\015\z/;
1214 $File::Find::untaint_pattern = qr|^(.+)$|;
1217 # this _should_ work properly on all platforms
1218 # where File::Find can be expected to work
1219 $File::Find::current_dir = File::Spec->curdir || '.';
1221 $File::Find::dont_use_nlink = 1
1222 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1223 $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1226 # Set dont_use_nlink in your hint file if your system's stat doesn't
1227 # report the number of links in a directory as an indication
1228 # of the number of files.
1229 # See, e.g. hints/machten.sh for MachTen 2.2.
1230 unless ($File::Find::dont_use_nlink) {
1232 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1235 # We need a function that checks if a scalar is tainted. Either use the
1236 # Scalar::Util module's tainted() function or our (slower) pure Perl
1237 # fallback is_tainted_pp()
1240 eval { require Scalar::Util };
1241 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;