This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
06fe587ae9c1c2e1cdab51d1c56baf69b165f7e6
[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     if ($Is_VMS) {
607         # VMS returns this by default in VMS format which just doesn't
608         # work for the rest of this module.
609         $cwd = VMS::Filespec::unixpath($cwd);
610
611         # Apparently this is not expected to have a trailing space.
612         # To attempt to make VMS/UNIX conversions mostly reversable,
613         # a trailing slash is needed.  The run-time functions ignore the
614         # resulting double slash, but it causes the perl tests to fail.
615         $cwd =~ s#/\z##;
616
617         # This comes up in upper case now, but should be lower.
618         # In the future this could be exact case, no need to change.
619     }
620     my $cwd_untainted  = $cwd;
621     my $check_t_cwd    = 1;
622     $wanted_callback   = $wanted->{wanted};
623     $bydepth           = $wanted->{bydepth};
624     $pre_process       = $wanted->{preprocess};
625     $post_process      = $wanted->{postprocess};
626     $no_chdir          = $wanted->{no_chdir};
627     $full_check        = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
628     $follow            = $^O eq 'MSWin32' ? 0 :
629                              $full_check || $wanted->{follow_fast};
630     $follow_skip       = $wanted->{follow_skip};
631     $untaint           = $wanted->{untaint};
632     $untaint_pat       = $wanted->{untaint_pattern};
633     $untaint_skip      = $wanted->{untaint_skip};
634     $dangling_symlinks = $wanted->{dangling_symlinks};
635
636     # for compatibility reasons (find.pl, find2perl)
637     local our ($topdir, $topdev, $topino, $topmode, $topnlink);
638
639     # a symbolic link to a directory doesn't increase the link count
640     $avoid_nlink      = $follow || $File::Find::dont_use_nlink;
641
642     my ($abs_dir, $Is_Dir);
643
644     Proc_Top_Item:
645     foreach my $TOP (@_) {
646         my $top_item = $TOP;
647
648         ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
649
650         if ($Is_MacOS) {
651             $top_item = ":$top_item"
652                 if ( (-d _) && ( $top_item !~ /:/ ) );
653         } elsif ($^O eq 'MSWin32') {
654             $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
655         }
656         else {
657             $top_item =~ s|/\z|| unless $top_item eq '/';
658         }
659
660         $Is_Dir= 0;
661
662         if ($follow) {
663
664             if ($Is_MacOS) {
665                 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
666
667                 if ($top_item eq $File::Find::current_dir) {
668                     $abs_dir = $cwd;
669                 }
670                 else {
671                     $abs_dir = contract_name_Mac($cwd, $top_item);
672                     unless (defined $abs_dir) {
673                         warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
674                         next Proc_Top_Item;
675                     }
676                 }
677
678             }
679             else {
680                 if (substr($top_item,0,1) eq '/') {
681                     $abs_dir = $top_item;
682                 }
683                 elsif ($top_item eq $File::Find::current_dir) {
684                     $abs_dir = $cwd;
685                 }
686                 else {  # care about any  ../
687                     $top_item =~ s/\.dir\z//i if $Is_VMS;
688                     $abs_dir = contract_name("$cwd/",$top_item);
689                 }
690             }
691             $abs_dir= Follow_SymLink($abs_dir);
692             unless (defined $abs_dir) {
693                 if ($dangling_symlinks) {
694                     if (ref $dangling_symlinks eq 'CODE') {
695                         $dangling_symlinks->($top_item, $cwd);
696                     } else {
697                         warnings::warnif "$top_item is a dangling symbolic link\n";
698                     }
699                 }
700                 next Proc_Top_Item;
701             }
702
703             if (-d _) {
704                 $top_item =~ s/\.dir\z//i if $Is_VMS;
705                 _find_dir_symlnk($wanted, $abs_dir, $top_item);
706                 $Is_Dir= 1;
707             }
708         }
709         else { # no follow
710             $topdir = $top_item;
711             unless (defined $topnlink) {
712                 warnings::warnif "Can't stat $top_item: $!\n";
713                 next Proc_Top_Item;
714             }
715             if (-d _) {
716                 $top_item =~ s/\.dir\z//i if $Is_VMS;
717                 _find_dir($wanted, $top_item, $topnlink);
718                 $Is_Dir= 1;
719             }
720             else {
721                 $abs_dir= $top_item;
722             }
723         }
724
725         unless ($Is_Dir) {
726             unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
727                 if ($Is_MacOS) {
728                     ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
729                 }
730                 else {
731                     ($dir,$_) = ('./', $top_item);
732                 }
733             }
734
735             $abs_dir = $dir;
736             if (( $untaint ) && (is_tainted($dir) )) {
737                 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
738                 unless (defined $abs_dir) {
739                     if ($untaint_skip == 0) {
740                         die "directory $dir is still tainted";
741                     }
742                     else {
743                         next Proc_Top_Item;
744                     }
745                 }
746             }
747
748             unless ($no_chdir || chdir $abs_dir) {
749                 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
750                 next Proc_Top_Item;
751             }
752
753             $name = $abs_dir . $_; # $File::Find::name
754             $_ = $name if $no_chdir;
755
756             { $wanted_callback->() }; # protect against wild "next"
757
758         }
759
760         unless ( $no_chdir ) {
761             if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
762                 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
763                 unless (defined $cwd_untainted) {
764                     die "insecure cwd in find(depth)";
765                 }
766                 $check_t_cwd = 0;
767             }
768             unless (chdir $cwd_untainted) {
769                 die "Can't cd to $cwd: $!\n";
770             }
771         }
772     }
773 }
774
775 # API:
776 #  $wanted
777 #  $p_dir :  "parent directory"
778 #  $nlink :  what came back from the stat
779 # preconditions:
780 #  chdir (if not no_chdir) to dir
781
782 sub _find_dir($$$) {
783     my ($wanted, $p_dir, $nlink) = @_;
784     my ($CdLvl,$Level) = (0,0);
785     my @Stack;
786     my @filenames;
787     my ($subcount,$sub_nlink);
788     my $SE= [];
789     my $dir_name= $p_dir;
790     my $dir_pref;
791     my $dir_rel = $File::Find::current_dir;
792     my $tainted = 0;
793     my $no_nlink;
794
795     if ($Is_MacOS) {
796         $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
797     } elsif ($^O eq 'MSWin32') {
798         $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
799     } elsif ($^O eq 'VMS') {
800
801         #       VMS is returning trailing .dir on directories
802         #       and trailing . on files and symbolic links
803         #       in UNIX syntax.
804         #
805
806         $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
807
808         $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
809     }
810     else {
811         $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
812     }
813
814     local ($dir, $name, $prune, *DIR);
815
816     unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
817         my $udir = $p_dir;
818         if (( $untaint ) && (is_tainted($p_dir) )) {
819             ( $udir ) = $p_dir =~ m|$untaint_pat|;
820             unless (defined $udir) {
821                 if ($untaint_skip == 0) {
822                     die "directory $p_dir is still tainted";
823                 }
824                 else {
825                     return;
826                 }
827             }
828         }
829         unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
830             warnings::warnif "Can't cd to $udir: $!\n";
831             return;
832         }
833     }
834
835     # push the starting directory
836     push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
837
838     if ($Is_MacOS) {
839         $p_dir = $dir_pref;  # ensure trailing ':'
840     }
841
842     while (defined $SE) {
843         unless ($bydepth) {
844             $dir= $p_dir; # $File::Find::dir
845             $name= $dir_name; # $File::Find::name
846             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
847             # prune may happen here
848             $prune= 0;
849             { $wanted_callback->() };   # protect against wild "next"
850             next if $prune;
851         }
852
853         # change to that directory
854         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
855             my $udir= $dir_rel;
856             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
857                 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
858                 unless (defined $udir) {
859                     if ($untaint_skip == 0) {
860                         if ($Is_MacOS) {
861                             die "directory ($p_dir) $dir_rel is still tainted";
862                         }
863                         else {
864                             die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
865                         }
866                     } else { # $untaint_skip == 1
867                         next;
868                     }
869                 }
870             }
871             unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
872                 if ($Is_MacOS) {
873                     warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
874                 }
875                 else {
876                     warnings::warnif "Can't cd to (" .
877                         ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
878                 }
879                 next;
880             }
881             $CdLvl++;
882         }
883
884         if ($Is_MacOS) {
885             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
886         }
887
888         $dir= $dir_name; # $File::Find::dir
889
890         # Get the list of files in the current directory.
891         unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
892             warnings::warnif "Can't opendir($dir_name): $!\n";
893             next;
894         }
895         @filenames = readdir DIR;
896         closedir(DIR);
897         @filenames = $pre_process->(@filenames) if $pre_process;
898         push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;
899
900         # default: use whatever was specifid
901         # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
902         $no_nlink = $avoid_nlink;
903         # if dir has wrong nlink count, force switch to slower stat method
904         $no_nlink = 1 if ($nlink < 2);
905
906         if ($nlink == 2 && !$no_nlink) {
907             # This dir has no subdirectories.
908             for my $FN (@filenames) {
909                 if ($Is_VMS) {
910                 # Big hammer here - Compensate for VMS trailing . and .dir
911                 # No win situation until this is changed, but this
912                 # will handle the majority of the cases with breaking the fewest
913
914                     $FN =~ s/\.dir\z//i;
915                     $FN =~ s#\.$## if ($FN ne '.');
916                 }
917                 next if $FN =~ $File::Find::skip_pattern;
918                 
919                 $name = $dir_pref . $FN; # $File::Find::name
920                 $_ = ($no_chdir ? $name : $FN); # $_
921                 { $wanted_callback->() }; # protect against wild "next"
922             }
923
924         }
925         else {
926             # This dir has subdirectories.
927             $subcount = $nlink - 2;
928
929             # HACK: insert directories at this position. so as to preserve
930             # the user pre-processed ordering of files.
931             # EG: directory traversal is in user sorted order, not at random.
932             my $stack_top = @Stack;
933
934             for my $FN (@filenames) {
935                 next if $FN =~ $File::Find::skip_pattern;
936                 if ($subcount > 0 || $no_nlink) {
937                     # Seen all the subdirs?
938                     # check for directoriness.
939                     # stat is faster for a file in the current directory
940                     $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
941
942                     if (-d _) {
943                         --$subcount;
944                         $FN =~ s/\.dir\z//i if $Is_VMS;
945                         # HACK: replace push to preserve dir traversal order
946                         #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
947                         splice @Stack, $stack_top, 0,
948                                  [$CdLvl,$dir_name,$FN,$sub_nlink];
949                     }
950                     else {
951                         $name = $dir_pref . $FN; # $File::Find::name
952                         $_= ($no_chdir ? $name : $FN); # $_
953                         { $wanted_callback->() }; # protect against wild "next"
954                     }
955                 }
956                 else {
957                     $name = $dir_pref . $FN; # $File::Find::name
958                     $_= ($no_chdir ? $name : $FN); # $_
959                     { $wanted_callback->() }; # protect against wild "next"
960                 }
961             }
962         }
963     }
964     continue {
965         while ( defined ($SE = pop @Stack) ) {
966             ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
967             if ($CdLvl > $Level && !$no_chdir) {
968                 my $tmp;
969                 if ($Is_MacOS) {
970                     $tmp = (':' x ($CdLvl-$Level)) . ':';
971                 }
972                 else {
973                     $tmp = join('/',('..') x ($CdLvl-$Level));
974                 }
975                 die "Can't cd to $dir_name" . $tmp
976                     unless chdir ($tmp);
977                 $CdLvl = $Level;
978             }
979
980             if ($Is_MacOS) {
981                 # $pdir always has a trailing ':', except for the starting dir,
982                 # where $dir_rel eq ':'
983                 $dir_name = "$p_dir$dir_rel";
984                 $dir_pref = "$dir_name:";
985             }
986             elsif ($^O eq 'MSWin32') {
987                 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
988                 $dir_pref = "$dir_name/";
989             }
990             elsif ($^O eq 'VMS') {
991                 if ($p_dir =~ m/[\]>]+$/) {
992                     $dir_name = $p_dir;
993                     $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
994                     $dir_pref = $dir_name;
995                 }
996                 else {
997                     $dir_name = "$p_dir/$dir_rel";
998                     $dir_pref = "$dir_name/";
999                 }
1000             }
1001             else {
1002                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1003                 $dir_pref = "$dir_name/";
1004             }
1005
1006             if ( $nlink == -2 ) {
1007                 $name = $dir = $p_dir; # $File::Find::name / dir
1008                 $_ = $File::Find::current_dir;
1009                 $post_process->();              # End-of-directory processing
1010             }
1011             elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
1012                 $name = $dir_name;
1013                 if ($Is_MacOS) {
1014                     if ($dir_rel eq ':') { # must be the top dir, where we started
1015                         $name =~ s|:$||; # $File::Find::name
1016                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1017                     }
1018                     $dir = $p_dir; # $File::Find::dir
1019                     $_ = ($no_chdir ? $name : $dir_rel); # $_
1020                 }
1021                 else {
1022                     if ( substr($name,-2) eq '/.' ) {
1023                         substr($name, length($name) == 2 ? -1 : -2) = '';
1024                     }
1025                     $dir = $p_dir;
1026                     $_ = ($no_chdir ? $dir_name : $dir_rel );
1027                     if ( substr($_,-2) eq '/.' ) {
1028                         substr($_, length($_) == 2 ? -1 : -2) = '';
1029                     }
1030                 }
1031                 { $wanted_callback->() }; # protect against wild "next"
1032              }
1033              else {
1034                 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
1035                 last;
1036             }
1037         }
1038     }
1039 }
1040
1041
1042 # API:
1043 #  $wanted
1044 #  $dir_loc : absolute location of a dir
1045 #  $p_dir   : "parent directory"
1046 # preconditions:
1047 #  chdir (if not no_chdir) to dir
1048
1049 sub _find_dir_symlnk($$$) {
1050     my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1051     my @Stack;
1052     my @filenames;
1053     my $new_loc;
1054     my $updir_loc = $dir_loc; # untainted parent directory
1055     my $SE = [];
1056     my $dir_name = $p_dir;
1057     my $dir_pref;
1058     my $loc_pref;
1059     my $dir_rel = $File::Find::current_dir;
1060     my $byd_flag; # flag for pending stack entry if $bydepth
1061     my $tainted = 0;
1062     my $ok = 1;
1063
1064     if ($Is_MacOS) {
1065         $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1066         $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1067     } else {
1068         $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
1069         $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1070     }
1071
1072     local ($dir, $name, $fullname, $prune, *DIR);
1073
1074     unless ($no_chdir) {
1075         # untaint the topdir
1076         if (( $untaint ) && (is_tainted($dir_loc) )) {
1077             ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1078              # once untainted, $updir_loc is pushed on the stack (as parent directory);
1079             # hence, we don't need to untaint the parent directory every time we chdir
1080             # to it later
1081             unless (defined $updir_loc) {
1082                 if ($untaint_skip == 0) {
1083                     die "directory $dir_loc is still tainted";
1084                 }
1085                 else {
1086                     return;
1087                 }
1088             }
1089         }
1090         $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1091         unless ($ok) {
1092             warnings::warnif "Can't cd to $updir_loc: $!\n";
1093             return;
1094         }
1095     }
1096
1097     push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;
1098
1099     if ($Is_MacOS) {
1100         $p_dir = $dir_pref; # ensure trailing ':'
1101     }
1102
1103     while (defined $SE) {
1104
1105         unless ($bydepth) {
1106             # change (back) to parent directory (always untainted)
1107             unless ($no_chdir) {
1108                 unless (chdir $updir_loc) {
1109                     warnings::warnif "Can't cd to $updir_loc: $!\n";
1110                     next;
1111                 }
1112             }
1113             $dir= $p_dir; # $File::Find::dir
1114             $name= $dir_name; # $File::Find::name
1115             $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1116             $fullname= $dir_loc; # $File::Find::fullname
1117             # prune may happen here
1118             $prune= 0;
1119             lstat($_); # make sure  file tests with '_' work
1120             { $wanted_callback->() }; # protect against wild "next"
1121             next if $prune;
1122         }
1123
1124         # change to that directory
1125         unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1126             $updir_loc = $dir_loc;
1127             if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1128                 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1129                 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1130                 unless (defined $updir_loc) {
1131                     if ($untaint_skip == 0) {
1132                         die "directory $dir_loc is still tainted";
1133                     }
1134                     else {
1135                         next;
1136                     }
1137                 }
1138             }
1139             unless (chdir $updir_loc) {
1140                 warnings::warnif "Can't cd to $updir_loc: $!\n";
1141                 next;
1142             }
1143         }
1144
1145         if ($Is_MacOS) {
1146             $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1147         }
1148
1149         $dir = $dir_name; # $File::Find::dir
1150
1151         # Get the list of files in the current directory.
1152         unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
1153             warnings::warnif "Can't opendir($dir_loc): $!\n";
1154             next;
1155         }
1156         @filenames = readdir DIR;
1157         closedir(DIR);
1158
1159         for my $FN (@filenames) {
1160             if ($Is_VMS) {
1161             # Big hammer here - Compensate for VMS trailing . and .dir
1162             # No win situation until this is changed, but this
1163             # will handle the majority of the cases with breaking the fewest.
1164
1165                 $FN =~ s/\.dir\z//i;
1166                 $FN =~ s#\.$## if ($FN ne '.');
1167             }
1168             next if $FN =~ $File::Find::skip_pattern;
1169
1170             # follow symbolic links / do an lstat
1171             $new_loc = Follow_SymLink($loc_pref.$FN);
1172
1173             # ignore if invalid symlink
1174             unless (defined $new_loc) {
1175                 if (!defined -l _ && $dangling_symlinks) {
1176                     if (ref $dangling_symlinks eq 'CODE') {
1177                         $dangling_symlinks->($FN, $dir_pref);
1178                     } else {
1179                         warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1180                     }
1181                 }
1182
1183                 $fullname = undef;
1184                 $name = $dir_pref . $FN;
1185                 $_ = ($no_chdir ? $name : $FN);
1186                 { $wanted_callback->() };
1187                 next;
1188             }
1189
1190             if (-d _) {
1191                 if ($Is_VMS) {
1192                     $FN =~ s/\.dir\z//i;
1193                     $FN =~ s#\.$## if ($FN ne '.');
1194                     $new_loc =~ s/\.dir\z//i;
1195                     $new_loc =~ s#\.$## if ($new_loc ne '.');
1196                 }
1197                 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1198             }
1199             else {
1200                 $fullname = $new_loc; # $File::Find::fullname
1201                 $name = $dir_pref . $FN; # $File::Find::name
1202                 $_ = ($no_chdir ? $name : $FN); # $_
1203                 { $wanted_callback->() }; # protect against wild "next"
1204             }
1205         }
1206
1207     }
1208     continue {
1209         while (defined($SE = pop @Stack)) {
1210             ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1211             if ($Is_MacOS) {
1212                 # $p_dir always has a trailing ':', except for the starting dir,
1213                 # where $dir_rel eq ':'
1214                 $dir_name = "$p_dir$dir_rel";
1215                 $dir_pref = "$dir_name:";
1216                 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1217             }
1218             else {
1219                 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1220                 $dir_pref = "$dir_name/";
1221                 $loc_pref = "$dir_loc/";
1222             }
1223             if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
1224                 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1225                     unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1226                         warnings::warnif "Can't cd to $updir_loc: $!\n";
1227                         next;
1228                     }
1229                 }
1230                 $fullname = $dir_loc; # $File::Find::fullname
1231                 $name = $dir_name; # $File::Find::name
1232                 if ($Is_MacOS) {
1233                     if ($dir_rel eq ':') { # must be the top dir, where we started
1234                         $name =~ s|:$||; # $File::Find::name
1235                         $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1236                     }
1237                     $dir = $p_dir; # $File::Find::dir
1238                      $_ = ($no_chdir ? $name : $dir_rel); # $_
1239                 }
1240                 else {
1241                     if ( substr($name,-2) eq '/.' ) {
1242                         substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1243                     }
1244                     $dir = $p_dir; # $File::Find::dir
1245                     $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1246                     if ( substr($_,-2) eq '/.' ) {
1247                         substr($_, length($_) == 2 ? -1 : -2) = '';
1248                     }
1249                 }
1250
1251                 lstat($_); # make sure file tests with '_' work
1252                 { $wanted_callback->() }; # protect against wild "next"
1253             }
1254             else {
1255                 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
1256                 last;
1257             }
1258         }
1259     }
1260 }
1261
1262
1263 sub wrap_wanted {
1264     my $wanted = shift;
1265     if ( ref($wanted) eq 'HASH' ) {
1266         if ( $wanted->{follow} || $wanted->{follow_fast}) {
1267             $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1268         }
1269         if ( $wanted->{untaint} ) {
1270             $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1271                 unless defined $wanted->{untaint_pattern};
1272             $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1273         }
1274         return $wanted;
1275     }
1276     else {
1277         return { wanted => $wanted };
1278     }
1279 }
1280
1281 sub find {
1282     my $wanted = shift;
1283     _find_opt(wrap_wanted($wanted), @_);
1284 }
1285
1286 sub finddepth {
1287     my $wanted = wrap_wanted(shift);
1288     $wanted->{bydepth} = 1;
1289     _find_opt($wanted, @_);
1290 }
1291
1292 # default
1293 $File::Find::skip_pattern    = qr/^\.{1,2}\z/;
1294 $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1295
1296 # These are hard-coded for now, but may move to hint files.
1297 if ($^O eq 'VMS') {
1298     $Is_VMS = 1;
1299     $File::Find::dont_use_nlink  = 1;
1300 }
1301 elsif ($^O eq 'MacOS') {
1302     $Is_MacOS = 1;
1303     $File::Find::dont_use_nlink  = 1;
1304     $File::Find::skip_pattern    = qr/^Icon\015\z/;
1305     $File::Find::untaint_pattern = qr|^(.+)$|;
1306 }
1307
1308 # this _should_ work properly on all platforms
1309 # where File::Find can be expected to work
1310 $File::Find::current_dir = File::Spec->curdir || '.';
1311
1312 $File::Find::dont_use_nlink = 1
1313     if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1314        $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1315            $^O eq 'nto';
1316
1317 # Set dont_use_nlink in your hint file if your system's stat doesn't
1318 # report the number of links in a directory as an indication
1319 # of the number of files.
1320 # See, e.g. hints/machten.sh for MachTen 2.2.
1321 unless ($File::Find::dont_use_nlink) {
1322     require Config;
1323     $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1324 }
1325
1326 # We need a function that checks if a scalar is tainted. Either use the
1327 # Scalar::Util module's tainted() function or our (slower) pure Perl
1328 # fallback is_tainted_pp()
1329 {
1330     local $@;
1331     eval { require Scalar::Util };
1332     *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1333 }
1334
1335 1;