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