This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
77a4bab535ca80683e28bfbc36bd7761bdcb7c66
[perl5.git] / lib / File / Find.pm
1 package File::Find;
2 use 5.006;
3 use strict;
4 use warnings;
5 use warnings::register;
6 our $VERSION = '1.11';
7 require Exporter;
8 require Cwd;
9
10 #
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).
14 #
15
16 =head1 NAME
17
18 File::Find - Traverse a directory tree.
19
20 =head1 SYNOPSIS
21
22     use File::Find;
23     find(\&wanted, @directories_to_search);
24     sub wanted { ... }
25
26     use File::Find;
27     finddepth(\&wanted, @directories_to_search);
28     sub wanted { ... }
29
30     use File::Find;
31     find({ wanted => \&process, follow => 1 }, '.');
32
33 =head1 DESCRIPTION
34
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.
39
40 =over 4
41
42 =item B<find>
43
44   find(\&wanted,  @directories);
45   find(\%options, @directories);
46
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.
53
54 =item B<finddepth>
55
56   finddepth(\&wanted,  @directories);
57   finddepth(\%options, @directories);
58
59 C<finddepth()> works just like C<find()> except that it 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.
64
65 =back
66
67 =head2 %options
68
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.
73
74 Here are the possible keys for the hash:
75
76 =over 3
77
78 =item C<wanted>
79
80 The value should be a code reference.  This code reference is
81 described in L<The wanted function> below.
82
83 =item C<bydepth>
84
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()>.
88
89 =item C<preprocess>
90
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.
100
101 =item C<postprocess>
102
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
108 no-op.
109
110 =item C<follow>
111
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:
118
119 =over 6
120
121 =item *
122
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<_>.
125 Note that this guarantee no longer holds if I<follow> or I<follow_fast>
126 are not set.
127
128 =item *
129
130 There is a variable C<$File::Find::fullname> which holds the absolute
131 pathname of the file with all symbolic links resolved.  If the link is
132 a dangling symbolic link, then fullname will be set to C<undef>.
133
134 =back
135
136 This is a no-op on Win32.
137
138 =item C<follow_fast>
139
140 This is similar to I<follow> except that it may report some files more
141 than once.  It does detect cycles, however.  Since only symbolic links
142 have to be hashed, this is much cheaper both in space and time.  If
143 processing a file more than once (by the user's C<wanted()> function)
144 is worse than just taking time, the option I<follow> should be used.
145
146 This is also a no-op on Win32.
147
148 =item C<follow_skip>
149
150 C<follow_skip==1>, which is the default, causes all files which are
151 neither directories nor symbolic links to be ignored if they are about
152 to be processed a second time. If a directory or a symbolic link
153 are about to be processed a second time, File::Find dies.
154
155 C<follow_skip==0> causes File::Find to die if any file is about to be
156 processed a second time.
157
158 C<follow_skip==2> causes File::Find to ignore any duplicate files and
159 directories but to proceed normally otherwise.
160
161 =item C<dangling_symlinks>
162
163 If true and a code reference, will be called with the symbolic link
164 name and the directory it lives in as arguments.  Otherwise, if true
165 and warnings are on, warning "symbolic_link_name is a dangling
166 symbolic link\n" will be issued.  If false, the dangling symbolic link
167 will be silently ignored.
168
169 =item C<no_chdir>
170
171 Does not C<chdir()> to each directory as it recurses. The C<wanted()>
172 function will need to be aware of this, of course. In this case,
173 C<$_> will be the same as C<$File::Find::name>.
174
175 =item C<untaint>
176
177 If find is used in taint-mode (-T command line switch or if EUID != UID
178 or if EGID != GID) then internally directory names have to be untainted
179 before they can be chdir'ed to. Therefore they are checked against a regular
180 expression I<untaint_pattern>.  Note that all names passed to the user's
181 I<wanted()> function are still tainted. If this option is used while
182 not in taint-mode, C<untaint> is a no-op.
183
184 =item C<untaint_pattern>
185
186 See above. This should be set using the C<qr> quoting operator.
187 The default is set to  C<qr|^([-+@\w./]+)$|>.
188 Note that the parentheses are vital.
189
190 =item C<untaint_skip>
191
192 If set, a directory which fails the I<untaint_pattern> is skipped,
193 including all its sub-directories. The default is to 'die' in such a case.
194
195 =back
196
197 =head2 The wanted function
198
199 The C<wanted()> function does whatever verifications you want on
200 each file and directory.  Note that despite its name, the C<wanted()>
201 function is a generic callback function, and does B<not> tell
202 File::Find if a file is "wanted" or not.  In fact, its return value
203 is ignored.
204
205 The wanted function takes no arguments but rather does its work
206 through a collection of variables.
207
208 =over 4
209
210 =item C<$File::Find::dir> is the current directory name,
211
212 =item C<$_> is the current filename within that directory
213
214 =item C<$File::Find::name> is the complete pathname to the file.
215
216 =back
217
218 The above variables have all been localized and may be changed without
219 effecting data outside of the wanted function.
220
221 For example, when examining the file F</some/path/foo.ext> you will have:
222
223     $File::Find::dir  = /some/path/
224     $_                = foo.ext
225     $File::Find::name = /some/path/foo.ext
226
227 You are chdir()'d to C<$File::Find::dir> when the function is called,
228 unless C<no_chdir> was specified. Note that when changing to
229 directories is in effect the root directory (F</>) is a somewhat
230 special case inasmuch as the concatenation of C<$File::Find::dir>,
231 C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
232 table below summarizes all variants:
233
234               $File::Find::name  $File::Find::dir  $_
235  default      /                  /                 .
236  no_chdir=>0  /etc               /                 etc
237               /etc/x             /etc              x
238
239  no_chdir=>1  /                  /                 /
240               /etc               /                 /etc
241               /etc/x             /etc              /etc/x
242
243
244 When <follow> or <follow_fast> are in effect, there is
245 also a C<$File::Find::fullname>.  The function may set
246 C<$File::Find::prune> to prune the tree unless C<bydepth> was
247 specified.  Unless C<follow> or C<follow_fast> is specified, for
248 compatibility reasons (find.pl, find2perl) there are in addition the
249 following globals available: C<$File::Find::topdir>,
250 C<$File::Find::topdev>, C<$File::Find::topino>,
251 C<$File::Find::topmode> and C<$File::Find::topnlink>.
252
253 This library is useful for the C<find2perl> tool, which when fed,
254
255     find2perl / -name .nfs\* -mtime +7 \
256         -exec rm -f {} \; -o -fstype nfs -prune
257
258 produces something like:
259
260     sub wanted {
261         /^\.nfs.*\z/s &&
262         (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
263         int(-M _) > 7 &&
264         unlink($_)
265         ||
266         ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
267         $dev < 0 &&
268         ($File::Find::prune = 1);
269     }
270
271 Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
272 filehandle that caches the information from the preceding
273 C<stat()>, C<lstat()>, or filetest.
274
275 Here's another interesting wanted function.  It will find all symbolic
276 links that don't resolve:
277
278     sub wanted {
279          -l && !-e && print "bogus link: $File::Find::name\n";
280     }
281
282 See also the script C<pfind> on CPAN for a nice application of this
283 module.
284
285 =head1 WARNINGS
286
287 If you run your program with the C<-w> switch, or if you use the
288 C<warnings> pragma, File::Find will report warnings for several weird
289 situations. You can disable these warnings by putting the statement
290
291     no warnings 'File::Find';
292
293 in the appropriate scope. See L<perllexwarn> for more info about lexical
294 warnings.
295
296 =head1 CAVEAT
297
298 =over 2
299
300 =item $dont_use_nlink
301
302 You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
303 force File::Find to always stat directories. This was used for file systems
304 that do not have an C<nlink> count matching the number of sub-directories.
305 Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
306 system) and a couple of others.
307
308 You shouldn't need to set this variable, since File::Find should now detect
309 such file systems on-the-fly and switch itself to using stat. This works even
310 for parts of your file system, like a mounted CD-ROM.
311
312 If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
313
314 =item symlinks
315
316 Be aware that the option to follow symbolic links can be dangerous.
317 Depending on the structure of the directory tree (including symbolic
318 links to directories) you might traverse a given (physical) directory
319 more than once (only if C<follow_fast> is in effect).
320 Furthermore, deleting or changing files in a symbolically linked directory
321 might cause very unpleasant surprises, since you delete or change files
322 in an unknown directory.
323
324 =back
325
326 =head1 NOTES
327
328 =over 4
329
330 =item *
331
332 Mac OS (Classic) users should note a few differences:
333
334 =over 4
335
336 =item *
337
338 The path separator is ':', not '/', and the current directory is denoted
339 as ':', not '.'. You should be careful about specifying relative pathnames.
340 While a full path always begins with a volume name, a relative pathname
341 should always begin with a ':'.  If specifying a volume name only, a
342 trailing ':' is required.
343
344 =item *
345
346 C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
347 contains the name of a directory, that name may or may not end with a
348 ':'. Likewise, C<$File::Find::name>, which contains the complete
349 pathname to that directory, and C<$File::Find::fullname>, which holds
350 the absolute pathname of that directory with all symbolic links resolved,
351 may or may not end with a ':'.
352
353 =item *
354
355 The default C<untaint_pattern> (see above) on Mac OS is set to
356 C<qr|^(.+)$|>. Note that the parentheses are vital.
357
358 =item *
359
360 The invisible system file "Icon\015" is ignored. While this file may
361 appear in every directory, there are some more invisible system files
362 on every volume, which are all located at the volume root level (i.e.
363 "MacintoshHD:"). These system files are B<not> excluded automatically.
364 Your filter may use the following code to recognize invisible files or
365 directories (requires Mac::Files):
366
367  use Mac::Files;
368
369  # invisible() --  returns 1 if file/directory is invisible,
370  # 0 if it's visible or undef if an error occurred
371
372  sub invisible($) {
373    my $file = shift;
374    my ($fileCat, $fileInfo);
375    my $invisible_flag =  1 << 14;
376
377    if ( $fileCat = FSpGetCatInfo($file) ) {
378      if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
379        return (($fileInfo->fdFlags & $invisible_flag) && 1);
380      }
381    }
382    return undef;
383  }
384
385 Generally, invisible files are system files, unless an odd application
386 decides to use invisible files for its own purposes. To distinguish
387 such files from system files, you have to look at the B<type> and B<creator>
388 file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
389 C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
390 (see MacPerl.pm for details).
391
392 Files that appear on the desktop actually reside in an (hidden) directory
393 named "Desktop Folder" on the particular disk volume. Note that, although
394 all desktop files appear to be on the same "virtual" desktop, each disk
395 volume actually maintains its own "Desktop Folder" directory.
396
397 =back
398
399 =back
400
401 =head1 BUGS AND CAVEATS
402
403 Despite the name of the C<finddepth()> function, both C<find()> and
404 C<finddepth()> perform a depth-first search of the directory
405 hierarchy.
406
407 =head1 HISTORY
408
409 File::Find used to produce incorrect results if called recursively.
410 During the development of perl 5.8 this bug was fixed.
411 The first fixed version of File::Find was 1.01.
412
413 =cut
414
415 our @ISA = qw(Exporter);
416 our @EXPORT = qw(find finddepth);
417
418
419 use strict;
420 my $Is_VMS;
421 my $Is_MacOS;
422
423 require File::Basename;
424 require File::Spec;
425
426 # Should ideally be my() not our() but local() currently
427 # refuses to operate on lexicals
428
429 our %SLnkSeen;
430 our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
431     $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
432     $pre_process, $post_process, $dangling_symlinks);
433
434 sub contract_name {
435     my ($cdir,$fn) = @_;
436
437     return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
438
439     $cdir = substr($cdir,0,rindex($cdir,'/')+1);
440
441     $fn =~ s|^\./||;
442
443     my $abs_name= $cdir . $fn;
444
445     if (substr($fn,0,3) eq '../') {
446        1 while $abs_name =~ s!/[^/]*/\.\./!/!;
447     }
448
449     return $abs_name;
450 }
451
452 # return the absolute name of a directory or file
453 sub contract_name_Mac {
454     my ($cdir,$fn) = @_;
455     my $abs_name;
456
457     if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
458
459         my $colon_count = length ($1);
460         if ($colon_count == 1) {
461             $abs_name = $cdir . $2;
462             return $abs_name;
463         }
464         else {
465             # need to move up the tree, but
466             # only if it's not a volume name
467             for (my $i=1; $i<$colon_count; $i++) {
468                 unless ($cdir =~ /^[^:]+:$/) { # volume name
469                     $cdir =~ s/[^:]+:$//;
470                 }
471                 else {
472                     return undef;
473                 }
474             }
475             $abs_name = $cdir . $2;
476             return $abs_name;
477         }
478
479     }
480     else {
481
482         # $fn may be a valid path to a directory or file or (dangling)
483         # symlink, without a leading ':'
484         if ( (-e $fn) || (-l $fn) ) {
485             if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
486                 return $fn; # $fn is already an absolute path
487             }
488             else {
489                 $abs_name = $cdir . $fn;
490                 return $abs_name;
491             }
492         }
493         else { # argh!, $fn is not a valid directory/file
494              return undef;
495         }
496     }
497 }
498
499 sub PathCombine($$) {
500     my ($Base,$Name) = @_;
501     my $AbsName;
502
503     if ($Is_MacOS) {
504         # $Name is the resolved symlink (always a full path on MacOS),
505         # i.e. there's no need to call contract_name_Mac()
506         $AbsName = $Name;
507
508         # (simple) check for recursion
509         if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
510             return undef;
511         }
512     }
513     else {
514         if (substr($Name,0,1) eq '/') {
515             $AbsName= $Name;
516         }
517         else {
518             $AbsName= contract_name($Base,$Name);
519         }
520
521         # (simple) check for recursion
522         my $newlen= length($AbsName);
523         if ($newlen <= length($Base)) {
524             if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
525                 && $AbsName eq substr($Base,0,$newlen))
526             {
527                 return undef;
528             }
529         }
530     }
531     return $AbsName;
532 }
533
534 sub Follow_SymLink($) {
535     my ($AbsName) = @_;
536
537     my ($NewName,$DEV, $INO);
538     ($DEV, $INO)= lstat $AbsName;
539
540     while (-l _) {
541         if ($SLnkSeen{$DEV, $INO}++) {
542             if ($follow_skip < 2) {
543                 die "$AbsName is encountered a second time";
544             }
545             else {
546                 return undef;
547             }
548         }
549         $NewName= PathCombine($AbsName, readlink($AbsName));
550         unless(defined $NewName) {
551             if ($follow_skip < 2) {
552                 die "$AbsName is a recursive symbolic link";
553             }
554             else {
555                 return undef;
556             }
557         }
558         else {
559             $AbsName= $NewName;
560         }
561         ($DEV, $INO) = lstat($AbsName);
562         return undef unless defined $DEV;  #  dangling symbolic link
563     }
564
565     if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
566         if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
567             die "$AbsName encountered a second time";
568         }
569         else {
570             return undef;
571         }
572     }
573
574     return $AbsName;
575 }
576
577 our($dir, $name, $fullname, $prune);
578 sub _find_dir_symlnk($$$);
579 sub _find_dir($$$);
580
581 # check whether or not a scalar variable is tainted
582 # (code straight from the Camel, 3rd ed., page 561)
583 sub is_tainted_pp {
584     my $arg = shift;
585     my $nada = substr($arg, 0, 0); # zero-length
586     local $@;
587     eval { eval "# $nada" };
588     return length($@) != 0;
589 }
590
591 sub _find_opt {
592     my $wanted = shift;
593     die "invalid top directory" unless defined $_[0];
594
595     # This function must local()ize everything because callbacks may
596     # call find() or finddepth()
597
598     local %SLnkSeen;
599     local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
600         $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
601         $pre_process, $post_process, $dangling_symlinks);
602     local($dir, $name, $fullname, $prune);
603     local *_ = \my $a;
604
605     my $cwd            = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
606     my $cwd_untainted  = $cwd;
607     my $check_t_cwd    = 1;
608     $wanted_callback   = $wanted->{wanted};
609     $bydepth           = $wanted->{bydepth};
610     $pre_process       = $wanted->{preprocess};
611     $post_process      = $wanted->{postprocess};
612     $no_chdir          = $wanted->{no_chdir};
613     $full_check        = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
614     $follow            = $^O eq 'MSWin32' ? 0 :
615                              $full_check || $wanted->{follow_fast};
616     $follow_skip       = $wanted->{follow_skip};
617     $untaint           = $wanted->{untaint};
618     $untaint_pat       = $wanted->{untaint_pattern};
619     $untaint_skip      = $wanted->{untaint_skip};
620     $dangling_symlinks = $wanted->{dangling_symlinks};
621
622     # for compatibility reasons (find.pl, find2perl)
623     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
624
625     # a symbolic link to a directory doesn't increase the link count
626     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
627
628     my ($abs_dir, $Is_Dir);
629
630     Proc_Top_Item:
631     foreach my $TOP (@_) {
632         my $top_item = $TOP;
633
634         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
635
636         if ($Is_MacOS) {
637             $top_item = ":$top_item"
638                 if ( (-d _) && ( $top_item !~ /:/ ) );
639         } elsif ($^O eq 'MSWin32') {
640             $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
641         }
642         else {
643             $top_item =~ s|/\z|| unless $top_item eq '/';
644         }
645
646         $Is_Dir= 0;
647
648         if ($follow) {
649
650             if ($Is_MacOS) {
651                 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
652
653                 if ($top_item eq $File::Find::current_dir) {
654                     $abs_dir = $cwd;
655                 }
656                 else {
657                     $abs_dir = contract_name_Mac($cwd, $top_item);
658                     unless (defined $abs_dir) {
659                         warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
660                         next Proc_Top_Item;
661                     }
662                 }
663
664             }
665             else {
666                 if (substr($top_item,0,1) eq '/') {
667                     $abs_dir = $top_item;
668                 }
669                 elsif ($top_item eq $File::Find::current_dir) {
670                     $abs_dir = $cwd;
671                 }
672                 else {  # care about any  ../
673                     $abs_dir = contract_name("$cwd/",$top_item);
674                 }
675             }
676             $abs_dir= Follow_SymLink($abs_dir);
677             unless (defined $abs_dir) {
678                 if ($dangling_symlinks) {
679                     if (ref $dangling_symlinks eq 'CODE') {
680                         $dangling_symlinks->($top_item, $cwd);
681                     } else {
682                         warnings::warnif "$top_item is a dangling symbolic link\n";
683                     }
684                 }
685                 next Proc_Top_Item;
686             }
687
688             if (-d _) {
689                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
690                 $Is_Dir= 1;
691             }
692         }
693         else { # no follow
694             $topdir = $top_item;
695             unless (defined $topnlink) {
696                 warnings::warnif "Can't stat $top_item: $!\n";
697                 next Proc_Top_Item;
698             }
699             if (-d _) {
700                 $top_item =~ s/\.dir\z//i if $Is_VMS;
701                 _find_dir($wanted, $top_item, $topnlink);
702                 $Is_Dir= 1;
703             }
704             else {
705                 $abs_dir= $top_item;
706             }
707         }
708
709         unless ($Is_Dir) {
710             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
711                 if ($Is_MacOS) {
712                     ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
713                 }
714                 else {
715                     ($dir,$_) = ('./', $top_item);
716                 }
717             }
718
719             $abs_dir = $dir;
720             if (( $untaint ) && (is_tainted($dir) )) {
721                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
722                 unless (defined $abs_dir) {
723                     if ($untaint_skip == 0) {
724                         die "directory $dir is still tainted";
725                     }
726                     else {
727                         next Proc_Top_Item;
728                     }
729                 }
730             }
731
732             unless ($no_chdir || chdir $abs_dir) {
733                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
734                 next Proc_Top_Item;
735             }
736
737             $name = $abs_dir . $_; # $File::Find::name
738             $_ = $name if $no_chdir;
739
740             { $wanted_callback->() }; # protect against wild "next"
741
742         }
743
744         unless ( $no_chdir ) {
745             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
746                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
747                 unless (defined $cwd_untainted) {
748                     die "insecure cwd in find(depth)";
749                 }
750                 $check_t_cwd = 0;
751             }
752             unless (chdir $cwd_untainted) {
753                 die "Can't cd to $cwd: $!\n";
754             }
755         }
756     }
757 }
758
759 # API:
760 #  $wanted
761 #  $p_dir :  "parent directory"
762 #  $nlink :  what came back from the stat
763 # preconditions:
764 #  chdir (if not no_chdir) to dir
765
766 sub _find_dir($$$) {
767     my ($wanted, $p_dir, $nlink) = @_;
768     my ($CdLvl,$Level) = (0,0);
769     my @Stack;
770     my @filenames;
771     my ($subcount,$sub_nlink);
772     my $SE= [];
773     my $dir_name= $p_dir;
774     my $dir_pref;
775     my $dir_rel = $File::Find::current_dir;
776     my $tainted = 0;
777     my $no_nlink;
778
779     if ($Is_MacOS) {
780         $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
781     } elsif ($^O eq 'MSWin32') {
782         $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
783     }
784     else {
785         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
786     }
787
788     local ($dir, $name, $prune, *DIR);
789
790     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
791         my $udir = $p_dir;
792         if (( $untaint ) && (is_tainted($p_dir) )) {
793             ( $udir ) = $p_dir =~ m|$untaint_pat|;
794             unless (defined $udir) {
795                 if ($untaint_skip == 0) {
796                     die "directory $p_dir is still tainted";
797                 }
798                 else {
799                     return;
800                 }
801             }
802         }
803         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
804             warnings::warnif "Can't cd to $udir: $!\n";
805             return;
806         }
807     }
808
809     # push the starting directory
810     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
811
812     if ($Is_MacOS) {
813         $p_dir = $dir_pref;  # ensure trailing ':'
814     }
815
816     while (defined $SE) {
817         unless ($bydepth) {
818             $dir= $p_dir; # $File::Find::dir
819             $name= $dir_name; # $File::Find::name
820             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
821             # prune may happen here
822             $prune= 0;
823             { $wanted_callback->() };   # protect against wild "next"
824             next if $prune;
825         }
826
827         # change to that directory
828         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
829             my $udir= $dir_rel;
830             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
831                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
832                 unless (defined $udir) {
833                     if ($untaint_skip == 0) {
834                         if ($Is_MacOS) {
835                             die "directory ($p_dir) $dir_rel is still tainted";
836                         }
837                         else {
838                             die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
839                         }
840                     } else { # $untaint_skip == 1
841                         next;
842                     }
843                 }
844             }
845             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
846                 if ($Is_MacOS) {
847                     warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
848                 }
849                 else {
850                     warnings::warnif "Can't cd to (" .
851                         ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
852                 }
853                 next;
854             }
855             $CdLvl++;
856         }
857
858         if ($Is_MacOS) {
859             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
860         }
861
862         $dir= $dir_name; # $File::Find::dir
863
864         # Get the list of files in the current directory.
865         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
866             warnings::warnif "Can't opendir($dir_name): $!\n";
867             next;
868         }
869         @filenames = readdir DIR;
870         closedir(DIR);
871         @filenames = $pre_process->(@filenames) if $pre_process;
872         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
873
874         # default: use whatever was specifid
875         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
876         $no_nlink = $avoid_nlink;
877         # if dir has wrong nlink count, force switch to slower stat method
878         $no_nlink = 1 if ($nlink < 2);
879
880         if ($nlink == 2 && !$no_nlink) {
881             # This dir has no subdirectories.
882             for my $FN (@filenames) {
883                 next if $FN =~ $File::Find::skip_pattern;
884                 
885                 $name = $dir_pref . $FN; # $File::Find::name
886                 $_ = ($no_chdir ? $name : $FN); # $_
887                 { $wanted_callback->() }; # protect against wild "next"
888             }
889
890         }
891         else {
892             # This dir has subdirectories.
893             $subcount = $nlink - 2;
894
895             # HACK: insert directories at this position. so as to preserve
896             # the user pre-processed ordering of files.
897             # EG: directory traversal is in user sorted order, not at random.
898             my $stack_top = @Stack;
899
900             for my $FN (@filenames) {
901                 next if $FN =~ $File::Find::skip_pattern;
902                 if ($subcount > 0 || $no_nlink) {
903                     # Seen all the subdirs?
904                     # check for directoriness.
905                     # stat is faster for a file in the current directory
906                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
907
908                     if (-d _) {
909                         --$subcount;
910                         $FN =~ s/\.dir\z//i if $Is_VMS;
911                         # HACK: replace push to preserve dir traversal order
912                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
913                         splice @Stack, $stack_top, 0,
914                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
915                     }
916                     else {
917                         $name = $dir_pref . $FN; # $File::Find::name
918                         $_= ($no_chdir ? $name : $FN); # $_
919                         { $wanted_callback->() }; # protect against wild "next"
920                     }
921                 }
922                 else {
923                     $name = $dir_pref . $FN; # $File::Find::name
924                     $_= ($no_chdir ? $name : $FN); # $_
925                     { $wanted_callback->() }; # protect against wild "next"
926                 }
927             }
928         }
929     }
930     continue {
931         while ( defined ($SE = pop @Stack) ) {
932             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
933             if ($CdLvl > $Level && !$no_chdir) {
934                 my $tmp;
935                 if ($Is_MacOS) {
936                     $tmp = (':' x ($CdLvl-$Level)) . ':';
937                 }
938                 else {
939                     $tmp = join('/',('..') x ($CdLvl-$Level));
940                 }
941                 die "Can't cd to $dir_name" . $tmp
942                     unless chdir ($tmp);
943                 $CdLvl = $Level;
944             }
945
946             if ($Is_MacOS) {
947                 # $pdir always has a trailing ':', except for the starting dir,
948                 # where $dir_rel eq ':'
949                 $dir_name = "$p_dir$dir_rel";
950                 $dir_pref = "$dir_name:";
951             }
952             elsif ($^O eq 'MSWin32') {
953                 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
954                 $dir_pref = "$dir_name/";
955             }
956             else {
957                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
958                 $dir_pref = "$dir_name/";
959             }
960
961             if ( $nlink == -2 ) {
962                 $name = $dir = $p_dir; # $File::Find::name / dir
963                 $_ = $File::Find::current_dir;
964                 $post_process->();              # End-of-directory processing
965             }
966             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
967                 $name = $dir_name;
968                 if ($Is_MacOS) {
969                     if ($dir_rel eq ':') { # must be the top dir, where we started
970                         $name =~ s|:$||; # $File::Find::name
971                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
972                     }
973                     $dir = $p_dir; # $File::Find::dir
974                     $_ = ($no_chdir ? $name : $dir_rel); # $_
975                 }
976                 else {
977                     if ( substr($name,-2) eq '/.' ) {
978                         substr($name, length($name) == 2 ? -1 : -2) = '';
979                     }
980                     $dir = $p_dir;
981                     $_ = ($no_chdir ? $dir_name : $dir_rel );
982                     if ( substr($_,-2) eq '/.' ) {
983                         substr($_, length($_) == 2 ? -1 : -2) = '';
984                     }
985                 }
986                 { $wanted_callback->() }; # protect against wild "next"
987              }
988              else {
989                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
990                 last;
991             }
992         }
993     }
994 }
995
996
997 # API:
998 #  $wanted
999 #  $dir_loc : absolute location of a dir
1000 #  $p_dir   : "parent directory"
1001 # preconditions:
1002 #  chdir (if not no_chdir) to dir
1003
1004 sub _find_dir_symlnk($$$) {
1005     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1006     my @Stack;
1007     my @filenames;
1008     my $new_loc;
1009     my $updir_loc = $dir_loc; # untainted parent directory
1010     my $SE = [];
1011     my $dir_name = $p_dir;
1012     my $dir_pref;
1013     my $loc_pref;
1014     my $dir_rel = $File::Find::current_dir;
1015     my $byd_flag; # flag for pending stack entry if $bydepth
1016     my $tainted = 0;
1017     my $ok = 1;
1018
1019     if ($Is_MacOS) {
1020         $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1021         $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1022     } else {
1023         $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
1024         $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1025     }
1026
1027     local ($dir, $name, $fullname, $prune, *DIR);
1028
1029     unless ($no_chdir) {
1030         # untaint the topdir
1031         if (( $untaint ) && (is_tainted($dir_loc) )) {
1032             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1033              # once untainted, $updir_loc is pushed on the stack (as parent directory);
1034             # hence, we don't need to untaint the parent directory every time we chdir
1035             # to it later
1036             unless (defined $updir_loc) {
1037                 if ($untaint_skip == 0) {
1038                     die "directory $dir_loc is still tainted";
1039                 }
1040                 else {
1041                     return;
1042                 }
1043             }
1044         }
1045         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1046         unless ($ok) {
1047             warnings::warnif "Can't cd to $updir_loc: $!\n";
1048             return;
1049         }
1050     }
1051
1052     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
1053
1054     if ($Is_MacOS) {
1055         $p_dir = $dir_pref; # ensure trailing ':'
1056     }
1057
1058     while (defined $SE) {
1059
1060         unless ($bydepth) {
1061             # change (back) to parent directory (always untainted)
1062             unless ($no_chdir) {
1063                 unless (chdir $updir_loc) {
1064                     warnings::warnif "Can't cd to $updir_loc: $!\n";
1065                     next;
1066                 }
1067             }
1068             $dir= $p_dir; # $File::Find::dir
1069             $name= $dir_name; # $File::Find::name
1070             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1071             $fullname= $dir_loc; # $File::Find::fullname
1072             # prune may happen here
1073             $prune= 0;
1074             lstat($_); # make sure  file tests with '_' work
1075             { $wanted_callback->() }; # protect against wild "next"
1076             next if $prune;
1077         }
1078
1079         # change to that directory
1080         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1081             $updir_loc = $dir_loc;
1082             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1083                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1084                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1085                 unless (defined $updir_loc) {
1086                     if ($untaint_skip == 0) {
1087                         die "directory $dir_loc is still tainted";
1088                     }
1089                     else {
1090                         next;
1091                     }
1092                 }
1093             }
1094             unless (chdir $updir_loc) {
1095                 warnings::warnif "Can't cd to $updir_loc: $!\n";
1096                 next;
1097             }
1098         }
1099
1100         if ($Is_MacOS) {
1101             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1102         }
1103
1104         $dir = $dir_name; # $File::Find::dir
1105
1106         # Get the list of files in the current directory.
1107         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1108             warnings::warnif "Can't opendir($dir_loc): $!\n";
1109             next;
1110         }
1111         @filenames = readdir DIR;
1112         closedir(DIR);
1113
1114         for my $FN (@filenames) {
1115             next if $FN =~ $File::Find::skip_pattern;
1116
1117             # follow symbolic links / do an lstat
1118             $new_loc = Follow_SymLink($loc_pref.$FN);
1119
1120             # ignore if invalid symlink
1121             unless (defined $new_loc) {
1122                 if (!defined -l _ && $dangling_symlinks) {
1123                     if (ref $dangling_symlinks eq 'CODE') {
1124                         $dangling_symlinks->($FN, $dir_pref);
1125                     } else {
1126                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1127                     }
1128                 }
1129
1130                 $fullname = undef;
1131                 $name = $dir_pref . $FN;
1132                 $_ = ($no_chdir ? $name : $FN);
1133                 { $wanted_callback->() };
1134                 next;
1135             }
1136
1137             if (-d _) {
1138                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1139             }
1140             else {
1141                 $fullname = $new_loc; # $File::Find::fullname
1142                 $name = $dir_pref . $FN; # $File::Find::name
1143                 $_ = ($no_chdir ? $name : $FN); # $_
1144                 { $wanted_callback->() }; # protect against wild "next"
1145             }
1146         }
1147
1148     }
1149     continue {
1150         while (defined($SE = pop @Stack)) {
1151             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1152             if ($Is_MacOS) {
1153                 # $p_dir always has a trailing ':', except for the starting dir,
1154                 # where $dir_rel eq ':'
1155                 $dir_name = "$p_dir$dir_rel";
1156                 $dir_pref = "$dir_name:";
1157                 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1158             }
1159             else {
1160                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1161                 $dir_pref = "$dir_name/";
1162                 $loc_pref = "$dir_loc/";
1163             }
1164             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1165                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1166                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1167                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1168                         next;
1169                     }
1170                 }
1171                 $fullname = $dir_loc; # $File::Find::fullname
1172                 $name = $dir_name; # $File::Find::name
1173                 if ($Is_MacOS) {
1174                     if ($dir_rel eq ':') { # must be the top dir, where we started
1175                         $name =~ s|:$||; # $File::Find::name
1176                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1177                     }
1178                     $dir = $p_dir; # $File::Find::dir
1179                      $_ = ($no_chdir ? $name : $dir_rel); # $_
1180                 }
1181                 else {
1182                     if ( substr($name,-2) eq '/.' ) {
1183                         substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1184                     }
1185                     $dir = $p_dir; # $File::Find::dir
1186                     $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1187                     if ( substr($_,-2) eq '/.' ) {
1188                         substr($_, length($_) == 2 ? -1 : -2) = '';
1189                     }
1190                 }
1191
1192                 lstat($_); # make sure file tests with '_' work
1193                 { $wanted_callback->() }; # protect against wild "next"
1194             }
1195             else {
1196                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1197                 last;
1198             }
1199         }
1200     }
1201 }
1202
1203
1204 sub wrap_wanted {
1205     my $wanted = shift;
1206     if ( ref($wanted) eq 'HASH' ) {
1207         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1208             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1209         }
1210         if ( $wanted->{untaint} ) {
1211             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1212                 unless defined $wanted->{untaint_pattern};
1213             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1214         }
1215         return $wanted;
1216     }
1217     else {
1218         return { wanted => $wanted };
1219     }
1220 }
1221
1222 sub find {
1223     my $wanted = shift;
1224     _find_opt(wrap_wanted($wanted), @_);
1225 }
1226
1227 sub finddepth {
1228     my $wanted = wrap_wanted(shift);
1229     $wanted->{bydepth} = 1;
1230     _find_opt($wanted, @_);
1231 }
1232
1233 # default
1234 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1235 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1236
1237 # These are hard-coded for now, but may move to hint files.
1238 if ($^O eq 'VMS') {
1239     $Is_VMS = 1;
1240     $File::Find::dont_use_nlink  = 1;
1241 }
1242 elsif ($^O eq 'MacOS') {
1243     $Is_MacOS = 1;
1244     $File::Find::dont_use_nlink  = 1;
1245     $File::Find::skip_pattern    = qr/^Icon\015\z/;
1246     $File::Find::untaint_pattern = qr|^(.+)$|;
1247 }
1248
1249 # this _should_ work properly on all platforms
1250 # where File::Find can be expected to work
1251 $File::Find::current_dir = File::Spec->curdir || '.';
1252
1253 $File::Find::dont_use_nlink = 1
1254     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1255        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1256            $^O eq 'nto';
1257
1258 # Set dont_use_nlink in your hint file if your system's stat doesn't
1259 # report the number of links in a directory as an indication
1260 # of the number of files.
1261 # See, e.g. hints/machten.sh for MachTen 2.2.
1262 unless ($File::Find::dont_use_nlink) {
1263     require Config;
1264     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1265 }
1266
1267 # We need a function that checks if a scalar is tainted. Either use the
1268 # Scalar::Util module's tainted() function or our (slower) pure Perl
1269 # fallback is_tainted_pp()
1270 {
1271     local $@;
1272     eval { require Scalar::Util };
1273     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1274 }
1275
1276 1;