5 use warnings::register;
12 File::Find - Traverse a directory tree.
17 find(\&wanted, @directories_to_search);
21 finddepth(\&wanted, @directories_to_search);
25 find({ wanted => \&process, follow => 1 }, '.');
29 These are functions for searching through directory trees doing work
30 on each file found similar to the Unix I<find> command. File::Find
31 exports two functions, C<find> and C<finddepth>. They work similarly
32 but have subtle differences.
38 find(\&wanted, @directories);
39 find(\%options, @directories);
41 find() does a breadth-first search over the given @directories in the
42 order they are given. In essence, it works from the top down.
44 For each file or directory found the &wanted subroutine is called (see
45 below for details). Additionally, for each directory found it will go
46 into that directory and continue the search.
50 finddepth(\&wanted, @directories);
51 finddepth(\%options, @directories);
53 finddepth() works just like find() except it does a depth-first search.
54 It works from the bottom of the directory tree up.
60 The first argument to find() is either a hash reference describing the
61 operations to be performed for each file, or a code reference. The
62 code reference is described in L<The wanted function> below.
64 Here are the possible keys for the hash:
70 The value should be a code reference. This code reference is
71 described in L<The wanted function> below.
75 Reports the name of a directory only AFTER all its entries
76 have been reported. Entry point finddepth() is a shortcut for
77 specifying C<{ bydepth =E<gt> 1 }> in the first argument of find().
81 The value should be a code reference. This code reference is used to
82 preprocess the current directory. The name of currently processed
83 directory is in $File::Find::dir. Your preprocessing function is
84 called after readdir() but before the loop that calls the wanted()
85 function. It is called with a list of strings (actually file/directory
86 names) and is expected to return a list of strings. The code can be
87 used to sort the file/directory names alphabetically, numerically,
88 or to filter out directory entries based on their name alone. When
89 I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
93 The value should be a code reference. It is invoked just before leaving
94 the currently processed directory. It is called in void context with no
95 arguments. The name of the current directory is in $File::Find::dir. This
96 hook is handy for summarizing a directory, such as calculating its disk
97 usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
102 Causes symbolic links to be followed. Since directory trees with symbolic
103 links (followed) may contain files more than once and may even have
104 cycles, a hash has to be built up with an entry for each file.
105 This might be expensive both in space and time for a large
106 directory tree. See I<follow_fast> and I<follow_skip> below.
107 If either I<follow> or I<follow_fast> is in effect:
113 It is guaranteed that an I<lstat> has been called before the user's
114 I<wanted()> function is called. This enables fast file checks involving S< _>.
118 There is a variable C<$File::Find::fullname> which holds the absolute
119 pathname of the file with all symbolic links resolved
125 This is similar to I<follow> except that it may report some files more
126 than once. It does detect cycles, however. Since only symbolic links
127 have to be hashed, this is much cheaper both in space and time. If
128 processing a file more than once (by the user's I<wanted()> function)
129 is worse than just taking time, the option I<follow> should be used.
133 C<follow_skip==1>, which is the default, causes all files which are
134 neither directories nor symbolic links to be ignored if they are about
135 to be processed a second time. If a directory or a symbolic link
136 are about to be processed a second time, File::Find dies.
137 C<follow_skip==0> causes File::Find to die if any file is about to be
138 processed a second time.
139 C<follow_skip==2> causes File::Find to ignore any duplicate files and
140 directories but to proceed normally otherwise.
142 =item C<dangling_symlinks>
144 If true and a code reference, will be called with the symbolic link
145 name and the directory it lives in as arguments. Otherwise, if true
146 and warnings are on, warning "symbolic_link_name is a dangling
147 symbolic link\n" will be issued. If false, the dangling symbolic link
148 will be silently ignored.
152 Does not C<chdir()> to each directory as it recurses. The wanted()
153 function will need to be aware of this, of course. In this case,
154 C<$_> will be the same as C<$File::Find::name>.
158 If find is used in taint-mode (-T command line switch or if EUID != UID
159 or if EGID != GID) then internally directory names have to be untainted
160 before they can be chdir'ed to. Therefore they are checked against a regular
161 expression I<untaint_pattern>. Note that all names passed to the user's
162 I<wanted()> function are still tainted. If this option is used while
163 not in taint-mode, C<untaint> is a no-op.
165 =item C<untaint_pattern>
167 See above. This should be set using the C<qr> quoting operator.
168 The default is set to C<qr|^([-+@\w./]+)$|>.
169 Note that the parentheses are vital.
171 =item C<untaint_skip>
173 If set, a directory which fails the I<untaint_pattern> is skipped,
174 including all its sub-directories. The default is to 'die' in such a case.
178 =head2 The wanted function
180 The wanted() function does whatever verifications you want on each
181 file and directory. It takes no arguments but rather does its work
182 through a collection of variables.
186 =item C<$File::Find::dir> is the current directory name,
188 =item C<$_> is the current filename within that directory
190 =item C<$File::Find::name> is the complete pathname to the file.
194 Don't modify these variables.
196 For example, when examining the file /some/path/foo.ext you will have:
198 $File::Find::dir = /some/path/
200 $File::Find::name = /some/path/foo.ext
202 You are chdir()'d toC<$File::Find::dir> when the function is called,
203 unless C<no_chdir> was specified. Note that when changing to
204 directories is in effect the root directory (F</>) is a somewhat
205 special case inasmuch as the concatenation of C<$File::Find::dir>,
206 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
207 table below summarizes all variants:
209 $File::Find::name $File::Find::dir $_
211 no_chdir=>0 /etc / etc
219 When <follow> or <follow_fast> are in effect, there is
220 also a C<$File::Find::fullname>. The function may set
221 C<$File::Find::prune> to prune the tree unless C<bydepth> was
222 specified. Unless C<follow> or C<follow_fast> is specified, for
223 compatibility reasons (find.pl, find2perl) there are in addition the
224 following globals available: C<$File::Find::topdir>,
225 C<$File::Find::topdev>, C<$File::Find::topino>,
226 C<$File::Find::topmode> and C<$File::Find::topnlink>.
228 This library is useful for the C<find2perl> tool, which when fed,
230 find2perl / -name .nfs\* -mtime +7 \
231 -exec rm -f {} \; -o -fstype nfs -prune
233 produces something like:
237 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
241 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
243 ($File::Find::prune = 1);
246 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
247 filehandle that caches the information from the preceding
248 stat(), lstat(), or filetest.
250 Here's another interesting wanted function. It will find all symbolic
251 links that don't resolve:
254 -l && !-e && print "bogus link: $File::Find::name\n";
257 See also the script C<pfind> on CPAN for a nice application of this
262 If you run your program with the C<-w> switch, or if you use the
263 C<warnings> pragma, File::Find will report warnings for several weird
264 situations. You can disable these warnings by putting the statement
266 no warnings 'File::Find';
268 in the appropriate scope. See L<perllexwarn> for more info about lexical
275 =item $dont_use_nlink
277 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
278 force File::Find to always stat directories. This was used for file systems
279 that do not have an C<nlink> count matching the number of sub-directories.
280 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
281 system) and a couple of others.
283 You shouldn't need to set this variable, since File::Find should now detect
284 such file systems on-the-fly and switch itself to using stat. This works even
285 for parts of your file system, like a mounted CD-ROM.
287 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
291 Be aware that the option to follow symbolic links can be dangerous.
292 Depending on the structure of the directory tree (including symbolic
293 links to directories) you might traverse a given (physical) directory
294 more than once (only if C<follow_fast> is in effect).
295 Furthermore, deleting or changing files in a symbolically linked directory
296 might cause very unpleasant surprises, since you delete or change files
297 in an unknown directory.
307 Mac OS (Classic) users should note a few differences:
313 The path separator is ':', not '/', and the current directory is denoted
314 as ':', not '.'. You should be careful about specifying relative pathnames.
315 While a full path always begins with a volume name, a relative pathname
316 should always begin with a ':'. If specifying a volume name only, a
317 trailing ':' is required.
321 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
322 contains the name of a directory, that name may or may not end with a
323 ':'. Likewise, C<$File::Find::name>, which contains the complete
324 pathname to that directory, and C<$File::Find::fullname>, which holds
325 the absolute pathname of that directory with all symbolic links resolved,
326 may or may not end with a ':'.
330 The default C<untaint_pattern> (see above) on Mac OS is set to
331 C<qr|^(.+)$|>. Note that the parentheses are vital.
335 The invisible system file "Icon\015" is ignored. While this file may
336 appear in every directory, there are some more invisible system files
337 on every volume, which are all located at the volume root level (i.e.
338 "MacintoshHD:"). These system files are B<not> excluded automatically.
339 Your filter may use the following code to recognize invisible files or
340 directories (requires Mac::Files):
344 # invisible() -- returns 1 if file/directory is invisible,
345 # 0 if it's visible or undef if an error occurred
349 my ($fileCat, $fileInfo);
350 my $invisible_flag = 1 << 14;
352 if ( $fileCat = FSpGetCatInfo($file) ) {
353 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
354 return (($fileInfo->fdFlags & $invisible_flag) && 1);
360 Generally, invisible files are system files, unless an odd application
361 decides to use invisible files for its own purposes. To distinguish
362 such files from system files, you have to look at the B<type> and B<creator>
363 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
364 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
365 (see MacPerl.pm for details).
367 Files that appear on the desktop actually reside in an (hidden) directory
368 named "Desktop Folder" on the particular disk volume. Note that, although
369 all desktop files appear to be on the same "virtual" desktop, each disk
370 volume actually maintains its own "Desktop Folder" directory.
378 File::Find used to produce incorrect results if called recursively.
379 During the development of perl 5.8 this bug was fixed.
380 The first fixed version of File::Find was 1.01.
384 our @ISA = qw(Exporter);
385 our @EXPORT = qw(find finddepth);
392 require File::Basename;
395 # Should ideally be my() not our() but local() currently
396 # refuses to operate on lexicals
399 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
400 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
401 $pre_process, $post_process, $dangling_symlinks);
406 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
408 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
412 my $abs_name= $cdir . $fn;
414 if (substr($fn,0,3) eq '../') {
415 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
421 # return the absolute name of a directory or file
422 sub contract_name_Mac {
426 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
428 my $colon_count = length ($1);
429 if ($colon_count == 1) {
430 $abs_name = $cdir . $2;
434 # need to move up the tree, but
435 # only if it's not a volume name
436 for (my $i=1; $i<$colon_count; $i++) {
437 unless ($cdir =~ /^[^:]+:$/) { # volume name
438 $cdir =~ s/[^:]+:$//;
444 $abs_name = $cdir . $2;
451 # $fn may be a valid path to a directory or file or (dangling)
452 # symlink, without a leading ':'
453 if ( (-e $fn) || (-l $fn) ) {
454 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
455 return $fn; # $fn is already an absolute path
458 $abs_name = $cdir . $fn;
462 else { # argh!, $fn is not a valid directory/file
468 sub PathCombine($$) {
469 my ($Base,$Name) = @_;
473 # $Name is the resolved symlink (always a full path on MacOS),
474 # i.e. there's no need to call contract_name_Mac()
477 # (simple) check for recursion
478 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
483 if (substr($Name,0,1) eq '/') {
487 $AbsName= contract_name($Base,$Name);
490 # (simple) check for recursion
491 my $newlen= length($AbsName);
492 if ($newlen <= length($Base)) {
493 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
494 && $AbsName eq substr($Base,0,$newlen))
503 sub Follow_SymLink($) {
506 my ($NewName,$DEV, $INO);
507 ($DEV, $INO)= lstat $AbsName;
510 if ($SLnkSeen{$DEV, $INO}++) {
511 if ($follow_skip < 2) {
512 die "$AbsName is encountered a second time";
518 $NewName= PathCombine($AbsName, readlink($AbsName));
519 unless(defined $NewName) {
520 if ($follow_skip < 2) {
521 die "$AbsName is a recursive symbolic link";
530 ($DEV, $INO) = lstat($AbsName);
531 return undef unless defined $DEV; # dangling symbolic link
534 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
535 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
536 die "$AbsName encountered a second time";
546 our($dir, $name, $fullname, $prune);
547 sub _find_dir_symlnk($$$);
550 # check whether or not a scalar variable is tainted
551 # (code straight from the Camel, 3rd ed., page 561)
554 my $nada = substr($arg, 0, 0); # zero-length
556 eval { eval "# $nada" };
557 return length($@) != 0;
562 die "invalid top directory" unless defined $_[0];
564 # This function must local()ize everything because callbacks may
565 # call find() or finddepth()
568 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
569 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
570 $pre_process, $post_process, $dangling_symlinks);
571 local($dir, $name, $fullname, $prune, $_);
573 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
574 my $cwd_untainted = $cwd;
576 $wanted_callback = $wanted->{wanted};
577 $bydepth = $wanted->{bydepth};
578 $pre_process = $wanted->{preprocess};
579 $post_process = $wanted->{postprocess};
580 $no_chdir = $wanted->{no_chdir};
581 $full_check = $wanted->{follow};
582 $follow = $full_check || $wanted->{follow_fast};
583 $follow_skip = $wanted->{follow_skip};
584 $untaint = $wanted->{untaint};
585 $untaint_pat = $wanted->{untaint_pattern};
586 $untaint_skip = $wanted->{untaint_skip};
587 $dangling_symlinks = $wanted->{dangling_symlinks};
589 # for compatibility reasons (find.pl, find2perl)
590 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
592 # a symbolic link to a directory doesn't increase the link count
593 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
595 my ($abs_dir, $Is_Dir);
598 foreach my $TOP (@_) {
602 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
603 $top_item = ":$top_item"
604 if ( (-d _) && ( $top_item !~ /:/ ) );
607 $top_item =~ s|/\z|| unless $top_item eq '/';
608 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
616 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
618 if ($top_item eq $File::Find::current_dir) {
622 $abs_dir = contract_name_Mac($cwd, $top_item);
623 unless (defined $abs_dir) {
624 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
631 if (substr($top_item,0,1) eq '/') {
632 $abs_dir = $top_item;
634 elsif ($top_item eq $File::Find::current_dir) {
637 else { # care about any ../
638 $abs_dir = contract_name("$cwd/",$top_item);
641 $abs_dir= Follow_SymLink($abs_dir);
642 unless (defined $abs_dir) {
643 if ($dangling_symlinks) {
644 if (ref $dangling_symlinks eq 'CODE') {
645 $dangling_symlinks->($top_item, $cwd);
647 warnings::warnif "$top_item is a dangling symbolic link\n";
654 _find_dir_symlnk($wanted, $abs_dir, $top_item);
660 unless (defined $topnlink) {
661 warnings::warnif "Can't stat $top_item: $!\n";
665 $top_item =~ s/\.dir\z// if $Is_VMS;
666 _find_dir($wanted, $top_item, $topnlink);
675 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
677 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
680 ($dir,$_) = ('./', $top_item);
685 if (( $untaint ) && (is_tainted($dir) )) {
686 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
687 unless (defined $abs_dir) {
688 if ($untaint_skip == 0) {
689 die "directory $dir is still tainted";
697 unless ($no_chdir || chdir $abs_dir) {
698 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
702 $name = $abs_dir . $_; # $File::Find::name
703 $_ = $name if $no_chdir;
705 { $wanted_callback->() }; # protect against wild "next"
709 unless ( $no_chdir ) {
710 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
711 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
712 unless (defined $cwd_untainted) {
713 die "insecure cwd in find(depth)";
717 unless (chdir $cwd_untainted) {
718 die "Can't cd to $cwd: $!\n";
726 # $p_dir : "parent directory"
727 # $nlink : what came back from the stat
729 # chdir (if not no_chdir) to dir
732 my ($wanted, $p_dir, $nlink) = @_;
733 my ($CdLvl,$Level) = (0,0);
736 my ($subcount,$sub_nlink);
738 my $dir_name= $p_dir;
740 my $dir_rel = $File::Find::current_dir;
745 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
748 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
751 local ($dir, $name, $prune, *DIR);
753 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
755 if (( $untaint ) && (is_tainted($p_dir) )) {
756 ( $udir ) = $p_dir =~ m|$untaint_pat|;
757 unless (defined $udir) {
758 if ($untaint_skip == 0) {
759 die "directory $p_dir is still tainted";
766 unless (chdir $udir) {
767 warnings::warnif "Can't cd to $udir: $!\n";
772 # push the starting directory
773 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
776 $p_dir = $dir_pref; # ensure trailing ':'
779 while (defined $SE) {
781 $dir= $p_dir; # $File::Find::dir
782 $name= $dir_name; # $File::Find::name
783 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
784 # prune may happen here
786 { $wanted_callback->() }; # protect against wild "next"
790 # change to that directory
791 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
793 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
794 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
795 unless (defined $udir) {
796 if ($untaint_skip == 0) {
798 die "directory ($p_dir) $dir_rel is still tainted";
801 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
803 } else { # $untaint_skip == 1
808 unless (chdir $udir) {
810 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
813 warnings::warnif "Can't cd to (" .
814 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
822 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
825 $dir= $dir_name; # $File::Find::dir
827 # Get the list of files in the current directory.
828 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
829 warnings::warnif "Can't opendir($dir_name): $!\n";
832 @filenames = readdir DIR;
834 @filenames = $pre_process->(@filenames) if $pre_process;
835 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
837 # default: use whatever was specifid
838 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
839 $no_nlink = $avoid_nlink;
840 # if dir has wrong nlink count, force switch to slower stat method
841 $no_nlink = 1 if ($nlink < 2);
843 if ($nlink == 2 && !$no_nlink) {
844 # This dir has no subdirectories.
845 for my $FN (@filenames) {
846 next if $FN =~ $File::Find::skip_pattern;
848 $name = $dir_pref . $FN; # $File::Find::name
849 $_ = ($no_chdir ? $name : $FN); # $_
850 { $wanted_callback->() }; # protect against wild "next"
855 # This dir has subdirectories.
856 $subcount = $nlink - 2;
858 for my $FN (@filenames) {
859 next if $FN =~ $File::Find::skip_pattern;
860 if ($subcount > 0 || $no_nlink) {
861 # Seen all the subdirs?
862 # check for directoriness.
863 # stat is faster for a file in the current directory
864 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
868 $FN =~ s/\.dir\z// if $Is_VMS;
869 push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
872 $name = $dir_pref . $FN; # $File::Find::name
873 $_= ($no_chdir ? $name : $FN); # $_
874 { $wanted_callback->() }; # protect against wild "next"
878 $name = $dir_pref . $FN; # $File::Find::name
879 $_= ($no_chdir ? $name : $FN); # $_
880 { $wanted_callback->() }; # protect against wild "next"
886 while ( defined ($SE = pop @Stack) ) {
887 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
888 if ($CdLvl > $Level && !$no_chdir) {
891 $tmp = (':' x ($CdLvl-$Level)) . ':';
894 $tmp = join('/',('..') x ($CdLvl-$Level));
896 die "Can't cd to $dir_name" . $tmp
902 # $pdir always has a trailing ':', except for the starting dir,
903 # where $dir_rel eq ':'
904 $dir_name = "$p_dir$dir_rel";
905 $dir_pref = "$dir_name:";
908 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
909 $dir_pref = "$dir_name/";
912 if ( $nlink == -2 ) {
913 $name = $dir = $p_dir; # $File::Find::name / dir
914 $_ = $File::Find::current_dir;
915 $post_process->(); # End-of-directory processing
917 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
920 if ($dir_rel eq ':') { # must be the top dir, where we started
921 $name =~ s|:$||; # $File::Find::name
922 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
924 $dir = $p_dir; # $File::Find::dir
925 $_ = ($no_chdir ? $name : $dir_rel); # $_
928 if ( substr($name,-2) eq '/.' ) {
929 substr($name, length($name) == 2 ? -1 : -2) = '';
932 $_ = ($no_chdir ? $dir_name : $dir_rel );
933 if ( substr($_,-2) eq '/.' ) {
934 substr($_, length($_) == 2 ? -1 : -2) = '';
937 { $wanted_callback->() }; # protect against wild "next"
940 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
950 # $dir_loc : absolute location of a dir
951 # $p_dir : "parent directory"
953 # chdir (if not no_chdir) to dir
955 sub _find_dir_symlnk($$$) {
956 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
960 my $updir_loc = $dir_loc; # untainted parent directory
962 my $dir_name = $p_dir;
965 my $dir_rel = $File::Find::current_dir;
966 my $byd_flag; # flag for pending stack entry if $bydepth
971 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
972 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
974 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
975 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
978 local ($dir, $name, $fullname, $prune, *DIR);
982 if (( $untaint ) && (is_tainted($dir_loc) )) {
983 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
984 # once untainted, $updir_loc is pushed on the stack (as parent directory);
985 # hence, we don't need to untaint the parent directory every time we chdir
987 unless (defined $updir_loc) {
988 if ($untaint_skip == 0) {
989 die "directory $dir_loc is still tainted";
996 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
998 warnings::warnif "Can't cd to $updir_loc: $!\n";
1003 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1006 $p_dir = $dir_pref; # ensure trailing ':'
1009 while (defined $SE) {
1012 # change (back) to parent directory (always untainted)
1013 unless ($no_chdir) {
1014 unless (chdir $updir_loc) {
1015 warnings::warnif "Can't cd to $updir_loc: $!\n";
1019 $dir= $p_dir; # $File::Find::dir
1020 $name= $dir_name; # $File::Find::name
1021 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1022 $fullname= $dir_loc; # $File::Find::fullname
1023 # prune may happen here
1025 lstat($_); # make sure file tests with '_' work
1026 { $wanted_callback->() }; # protect against wild "next"
1030 # change to that directory
1031 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1032 $updir_loc = $dir_loc;
1033 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1034 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1035 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1036 unless (defined $updir_loc) {
1037 if ($untaint_skip == 0) {
1038 die "directory $dir_loc is still tainted";
1045 unless (chdir $updir_loc) {
1046 warnings::warnif "Can't cd to $updir_loc: $!\n";
1052 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1055 $dir = $dir_name; # $File::Find::dir
1057 # Get the list of files in the current directory.
1058 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1059 warnings::warnif "Can't opendir($dir_loc): $!\n";
1062 @filenames = readdir DIR;
1065 for my $FN (@filenames) {
1066 next if $FN =~ $File::Find::skip_pattern;
1068 # follow symbolic links / do an lstat
1069 $new_loc = Follow_SymLink($loc_pref.$FN);
1071 # ignore if invalid symlink
1072 next unless defined $new_loc;
1075 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1078 $fullname = $new_loc; # $File::Find::fullname
1079 $name = $dir_pref . $FN; # $File::Find::name
1080 $_ = ($no_chdir ? $name : $FN); # $_
1081 { $wanted_callback->() }; # protect against wild "next"
1087 while (defined($SE = pop @Stack)) {
1088 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1090 # $p_dir always has a trailing ':', except for the starting dir,
1091 # where $dir_rel eq ':'
1092 $dir_name = "$p_dir$dir_rel";
1093 $dir_pref = "$dir_name:";
1094 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1097 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1098 $dir_pref = "$dir_name/";
1099 $loc_pref = "$dir_loc/";
1101 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1102 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1103 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1104 warnings::warnif "Can't cd to $updir_loc: $!\n";
1108 $fullname = $dir_loc; # $File::Find::fullname
1109 $name = $dir_name; # $File::Find::name
1111 if ($dir_rel eq ':') { # must be the top dir, where we started
1112 $name =~ s|:$||; # $File::Find::name
1113 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1115 $dir = $p_dir; # $File::Find::dir
1116 $_ = ($no_chdir ? $name : $dir_rel); # $_
1119 if ( substr($name,-2) eq '/.' ) {
1120 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1122 $dir = $p_dir; # $File::Find::dir
1123 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1124 if ( substr($_,-2) eq '/.' ) {
1125 substr($_, length($_) == 2 ? -1 : -2) = '';
1129 lstat($_); # make sure file tests with '_' work
1130 { $wanted_callback->() }; # protect against wild "next"
1133 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1143 if ( ref($wanted) eq 'HASH' ) {
1144 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1145 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1147 if ( $wanted->{untaint} ) {
1148 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1149 unless defined $wanted->{untaint_pattern};
1150 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1155 return { wanted => $wanted };
1161 _find_opt(wrap_wanted($wanted), @_);
1165 my $wanted = wrap_wanted(shift);
1166 $wanted->{bydepth} = 1;
1167 _find_opt($wanted, @_);
1171 $File::Find::skip_pattern = qr/^\.{1,2}\z/;
1172 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1174 # These are hard-coded for now, but may move to hint files.
1177 $File::Find::dont_use_nlink = 1;
1179 elsif ($^O eq 'MacOS') {
1181 $File::Find::dont_use_nlink = 1;
1182 $File::Find::skip_pattern = qr/^Icon\015\z/;
1183 $File::Find::untaint_pattern = qr|^(.+)$|;
1186 # this _should_ work properly on all platforms
1187 # where File::Find can be expected to work
1188 $File::Find::current_dir = File::Spec->curdir || '.';
1190 $File::Find::dont_use_nlink = 1
1191 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1192 $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1195 # Set dont_use_nlink in your hint file if your system's stat doesn't
1196 # report the number of links in a directory as an indication
1197 # of the number of files.
1198 # See, e.g. hints/machten.sh for MachTen 2.2.
1199 unless ($File::Find::dont_use_nlink) {
1201 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1204 # We need a function that checks if a scalar is tainted. Either use the
1205 # Scalar::Util module's tainted() function or our (slower) pure Perl
1206 # fallback is_tainted_pp()
1209 eval { require Scalar::Util };
1210 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;