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