This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
File::Find::_find_dir nit for VMS, plus version bump.
[perl5.git] / lib / File / Find.pm
CommitLineData
a0d0e21e 1package File::Find;
3b825e41 2use 5.006;
b75c8c73 3use strict;
b395063c 4use warnings;
cd68ec93 5use warnings::register;
d8101854 6our $VERSION = '1.12';
a0d0e21e 7require Exporter;
6280b799 8require Cwd;
a0d0e21e 9
7bd31527
JH
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
f06db76b
AD
16=head1 NAME
17
abfdd623 18File::Find - Traverse a directory tree.
f06db76b
AD
19
20=head1 SYNOPSIS
21
22 use File::Find;
6d355c6e 23 find(\&wanted, @directories_to_search);
f06db76b 24 sub wanted { ... }
237437d0 25
f06db76b 26 use File::Find;
abfdd623 27 finddepth(\&wanted, @directories_to_search);
f06db76b 28 sub wanted { ... }
3cb6de81 29
81793b90
GS
30 use File::Find;
31 find({ wanted => \&process, follow => 1 }, '.');
f06db76b
AD
32
33=head1 DESCRIPTION
34
abfdd623
MS
35These are functions for searching through directory trees doing work
36on each file found similar to the Unix I<find> command. File::Find
37exports two functions, C<find> and C<finddepth>. They work similarly
38but have subtle differences.
39
40=over 4
41
42=item B<find>
43
44 find(\&wanted, @directories);
45 find(\%options, @directories);
46
6eb87ff8
MJD
47C<find()> does a depth-first search over the given C<@directories> in
48the order they are given. For each file or directory found, it calls
49the C<&wanted> subroutine. (See below for details on how to use the
50C<&wanted> function). Additionally, for each directory found, it will
51C<chdir()> into that directory and continue the search, invoking the
52C<&wanted> function on each file or subdirectory in the directory.
abfdd623
MS
53
54=item B<finddepth>
55
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
58
b807ffce 59C<finddepth()> works just like C<find()> except that it invokes the
6eb87ff8
MJD
60C<&wanted> function for a directory I<after> invoking it for the
61directory's contents. It does a postorder traversal instead of a
62preorder traversal, working from the bottom of the directory tree up
63where C<find()> works from the top of the tree down.
abfdd623
MS
64
65=back
66
67=head2 %options
68
95e23d19
AL
69The first argument to C<find()> is either a code reference to your
70C<&wanted> function, or a hash reference describing the operations
71to be performed for each file. The
abfdd623 72code reference is described in L<The wanted function> below.
20408e3c 73
81793b90
GS
74Here are the possible keys for the hash:
75
76=over 3
77
78=item C<wanted>
79
abfdd623
MS
80The value should be a code reference. This code reference is
81described in L<The wanted function> below.
81793b90
GS
82
83=item C<bydepth>
84
85Reports the name of a directory only AFTER all its entries
95e23d19
AL
86have been reported. Entry point C<finddepth()> is a shortcut for
87specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
81793b90 88
719c805e
JS
89=item C<preprocess>
90
3555aed3
SP
91The value should be a code reference. This code reference is used to
92preprocess the current directory. The name of the currently processed
95e23d19
AL
93directory is in C<$File::Find::dir>. Your preprocessing function is
94called after C<readdir()>, but before the loop that calls the C<wanted()>
3555aed3
SP
95function. It is called with a list of strings (actually file/directory
96names) and is expected to return a list of strings. The code can be
97used to sort the file/directory names alphabetically, numerically,
98or to filter out directory entries based on their name alone. When
7e47e6ff 99I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
719c805e
JS
100
101=item C<postprocess>
102
3555aed3
SP
103The value should be a code reference. It is invoked just before leaving
104the currently processed directory. It is called in void context with no
105arguments. The name of the current directory is in C<$File::Find::dir>. This
106hook is handy for summarizing a directory, such as calculating its disk
107usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
7e47e6ff 108no-op.
719c805e 109
81793b90
GS
110=item C<follow>
111
112Causes symbolic links to be followed. Since directory trees with symbolic
113links (followed) may contain files more than once and may even have
114cycles, a hash has to be built up with an entry for each file.
115This might be expensive both in space and time for a large
116directory tree. See I<follow_fast> and I<follow_skip> below.
117If either I<follow> or I<follow_fast> is in effect:
118
119=over 6
120
a45bd81d 121=item *
81793b90 122
54bd407c
RGS
123It is guaranteed that an I<lstat> has been called before the user's
124C<wanted()> function is called. This enables fast file checks involving S<_>.
125Note that this guarantee no longer holds if I<follow> or I<follow_fast>
126are not set.
81793b90 127
a45bd81d 128=item *
81793b90
GS
129
130There is a variable C<$File::Find::fullname> which holds the absolute
615a2b9b
SP
131pathname of the file with all symbolic links resolved. If the link is
132a dangling symbolic link, then fullname will be set to C<undef>.
81793b90
GS
133
134=back
135
204b4d7f
SP
136This is a no-op on Win32.
137
81793b90
GS
138=item C<follow_fast>
139
f10e1564
RM
140This is similar to I<follow> except that it may report some files more
141than once. It does detect cycles, however. Since only symbolic links
142have to be hashed, this is much cheaper both in space and time. If
95e23d19 143processing a file more than once (by the user's C<wanted()> function)
81793b90
GS
144is worse than just taking time, the option I<follow> should be used.
145
204b4d7f
SP
146This is also a no-op on Win32.
147
81793b90
GS
148=item C<follow_skip>
149
150C<follow_skip==1>, which is the default, causes all files which are
151neither directories nor symbolic links to be ignored if they are about
3555aed3 152to be processed a second time. If a directory or a symbolic link
81793b90 153are about to be processed a second time, File::Find dies.
95e23d19 154
81793b90
GS
155C<follow_skip==0> causes File::Find to die if any file is about to be
156processed a second time.
95e23d19 157
81793b90 158C<follow_skip==2> causes File::Find to ignore any duplicate files and
7e47e6ff 159directories but to proceed normally otherwise.
20408e3c 160
80e52b73
JH
161=item C<dangling_symlinks>
162
163If true and a code reference, will be called with the symbolic link
164name and the directory it lives in as arguments. Otherwise, if true
165and warnings are on, warning "symbolic_link_name is a dangling
166symbolic link\n" will be issued. If false, the dangling symbolic link
167will be silently ignored.
f06db76b 168
81793b90
GS
169=item C<no_chdir>
170
95e23d19 171Does not C<chdir()> to each directory as it recurses. The C<wanted()>
81793b90
GS
172function will need to be aware of this, of course. In this case,
173C<$_> will be the same as C<$File::Find::name>.
174
175=item C<untaint>
176
177If find is used in taint-mode (-T command line switch or if EUID != UID
178or if EGID != GID) then internally directory names have to be untainted
7e47e6ff 179before they can be chdir'ed to. Therefore they are checked against a regular
3555aed3
SP
180expression I<untaint_pattern>. Note that all names passed to the user's
181I<wanted()> function are still tainted. If this option is used while
7e47e6ff 182not in taint-mode, C<untaint> is a no-op.
81793b90
GS
183
184=item C<untaint_pattern>
185
186See above. This should be set using the C<qr> quoting operator.
3555aed3 187The default is set to C<qr|^([-+@\w./]+)$|>.
1cffc1dd 188Note that the parentheses are vital.
81793b90
GS
189
190=item C<untaint_skip>
191
3555aed3 192If set, a directory which fails the I<untaint_pattern> is skipped,
7e47e6ff 193including all its sub-directories. The default is to 'die' in such a case.
81793b90
GS
194
195=back
196
abfdd623
MS
197=head2 The wanted function
198
95e23d19
AL
199The C<wanted()> function does whatever verifications you want on
200each file and directory. Note that despite its name, the C<wanted()>
201function is a generic callback function, and does B<not> tell
202File::Find if a file is "wanted" or not. In fact, its return value
203is ignored.
204
205The wanted function takes no arguments but rather does its work
abfdd623
MS
206through a collection of variables.
207
208=over 4
209
f837ebe2 210=item C<$File::Find::dir> is the current directory name,
abfdd623
MS
211
212=item C<$_> is the current filename within that directory
213
f837ebe2 214=item C<$File::Find::name> is the complete pathname to the file.
abfdd623
MS
215
216=back
217
4c767a4e
SP
218The above variables have all been localized and may be changed without
219effecting data outside of the wanted function.
220
95e23d19 221For example, when examining the file F</some/path/foo.ext> you will have:
abfdd623
MS
222
223 $File::Find::dir = /some/path/
224 $_ = foo.ext
225 $File::Find::name = /some/path/foo.ext
226
3555aed3 227You are chdir()'d to C<$File::Find::dir> when the function is called,
abfdd623
MS
228unless C<no_chdir> was specified. Note that when changing to
229directories is in effect the root directory (F</>) is a somewhat
230special case inasmuch as the concatenation of C<$File::Find::dir>,
231C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
232table below summarizes all variants:
5cf0a2f2
WL
233
234 $File::Find::name $File::Find::dir $_
235 default / / .
236 no_chdir=>0 /etc / etc
237 /etc/x /etc x
abfdd623 238
5cf0a2f2
WL
239 no_chdir=>1 / / /
240 /etc / /etc
241 /etc/x /etc /etc/x
242
243
244When <follow> or <follow_fast> are in effect, there is
f10e1564
RM
245also a C<$File::Find::fullname>. The function may set
246C<$File::Find::prune> to prune the tree unless C<bydepth> was
247specified. Unless C<follow> or C<follow_fast> is specified, for
248compatibility reasons (find.pl, find2perl) there are in addition the
249following globals available: C<$File::Find::topdir>,
250C<$File::Find::topdev>, C<$File::Find::topino>,
e7b91b67 251C<$File::Find::topmode> and C<$File::Find::topnlink>.
47a735e8 252
20408e3c 253This library is useful for the C<find2perl> tool, which when fed,
f06db76b
AD
254
255 find2perl / -name .nfs\* -mtime +7 \
81793b90 256 -exec rm -f {} \; -o -fstype nfs -prune
f06db76b
AD
257
258produces something like:
259
260 sub wanted {
c7b9dd21 261 /^\.nfs.*\z/s &&
81793b90 262 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
f06db76b
AD
263 int(-M _) > 7 &&
264 unlink($_)
265 ||
81793b90 266 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
f06db76b 267 $dev < 0 &&
6280b799 268 ($File::Find::prune = 1);
f06db76b
AD
269 }
270
43dece2a
JH
271Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
272filehandle that caches the information from the preceding
95e23d19 273C<stat()>, C<lstat()>, or filetest.
43dece2a 274
1cffc1dd
JH
275Here's another interesting wanted function. It will find all symbolic
276links that don't resolve:
f06db76b
AD
277
278 sub wanted {
81793b90 279 -l && !-e && print "bogus link: $File::Find::name\n";
237437d0 280 }
f06db76b 281
81793b90
GS
282See also the script C<pfind> on CPAN for a nice application of this
283module.
284
cd68ec93
RGS
285=head1 WARNINGS
286
287If you run your program with the C<-w> switch, or if you use the
288C<warnings> pragma, File::Find will report warnings for several weird
289situations. You can disable these warnings by putting the statement
290
291 no warnings 'File::Find';
292
293in the appropriate scope. See L<perllexwarn> for more info about lexical
294warnings.
295
81793b90
GS
296=head1 CAVEAT
297
5fa2bf2b
DD
298=over 2
299
300=item $dont_use_nlink
301
302You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
6cf3b067
T
303force File::Find to always stat directories. This was used for file systems
304that do not have an C<nlink> count matching the number of sub-directories.
305Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
306system) and a couple of others.
5fa2bf2b 307
6cf3b067
T
308You shouldn't need to set this variable, since File::Find should now detect
309such file systems on-the-fly and switch itself to using stat. This works even
310for parts of your file system, like a mounted CD-ROM.
5fa2bf2b 311
6cf3b067 312If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
5fa2bf2b
DD
313
314=item symlinks
315
f10e1564 316Be aware that the option to follow symbolic links can be dangerous.
81793b90
GS
317Depending on the structure of the directory tree (including symbolic
318links to directories) you might traverse a given (physical) directory
3555aed3 319more than once (only if C<follow_fast> is in effect).
81793b90
GS
320Furthermore, deleting or changing files in a symbolically linked directory
321might cause very unpleasant surprises, since you delete or change files
322in an unknown directory.
0530a6c4 323
5fa2bf2b
DD
324=back
325
7e47e6ff
JH
326=head1 NOTES
327
328=over 4
329
330=item *
331
332Mac OS (Classic) users should note a few differences:
333
334=over 4
335
3555aed3 336=item *
7e47e6ff 337
3555aed3
SP
338The path separator is ':', not '/', and the current directory is denoted
339as ':', not '.'. You should be careful about specifying relative pathnames.
340While a full path always begins with a volume name, a relative pathname
341should always begin with a ':'. If specifying a volume name only, a
7e47e6ff
JH
342trailing ':' is required.
343
3555aed3 344=item *
7e47e6ff 345
3555aed3
SP
346C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
347contains the name of a directory, that name may or may not end with a
348':'. Likewise, C<$File::Find::name>, which contains the complete
349pathname to that directory, and C<$File::Find::fullname>, which holds
7e47e6ff
JH
350the absolute pathname of that directory with all symbolic links resolved,
351may or may not end with a ':'.
352
3555aed3 353=item *
7e47e6ff 354
3555aed3 355The default C<untaint_pattern> (see above) on Mac OS is set to
7e47e6ff
JH
356C<qr|^(.+)$|>. Note that the parentheses are vital.
357
3555aed3 358=item *
7e47e6ff 359
3555aed3
SP
360The invisible system file "Icon\015" is ignored. While this file may
361appear in every directory, there are some more invisible system files
362on every volume, which are all located at the volume root level (i.e.
363"MacintoshHD:"). These system files are B<not> excluded automatically.
364Your filter may use the following code to recognize invisible files or
7e47e6ff
JH
365directories (requires Mac::Files):
366
367 use Mac::Files;
368
3555aed3 369 # invisible() -- returns 1 if file/directory is invisible,
1cffc1dd 370 # 0 if it's visible or undef if an error occurred
7e47e6ff 371
3555aed3 372 sub invisible($) {
7e47e6ff 373 my $file = shift;
3555aed3
SP
374 my ($fileCat, $fileInfo);
375 my $invisible_flag = 1 << 14;
7e47e6ff
JH
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
3555aed3
SP
385Generally, invisible files are system files, unless an odd application
386decides to use invisible files for its own purposes. To distinguish
387such files from system files, you have to look at the B<type> and B<creator>
388file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
389C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
7e47e6ff
JH
390(see MacPerl.pm for details).
391
392Files that appear on the desktop actually reside in an (hidden) directory
393named "Desktop Folder" on the particular disk volume. Note that, although
3555aed3 394all desktop files appear to be on the same "virtual" desktop, each disk
7e47e6ff
JH
395volume actually maintains its own "Desktop Folder" directory.
396
397=back
398
399=back
0530a6c4 400
6eb87ff8
MJD
401=head1 BUGS AND CAVEATS
402
403Despite the name of the C<finddepth()> function, both C<find()> and
404C<finddepth()> perform a depth-first search of the directory
405hierarchy.
406
a85af077
A
407=head1 HISTORY
408
409File::Find used to produce incorrect results if called recursively.
410During the development of perl 5.8 this bug was fixed.
411The first fixed version of File::Find was 1.01.
412
f06db76b
AD
413=cut
414
b75c8c73
MS
415our @ISA = qw(Exporter);
416our @EXPORT = qw(find finddepth);
6280b799 417
a0d0e21e 418
81793b90
GS
419use strict;
420my $Is_VMS;
7e47e6ff 421my $Is_MacOS;
81793b90
GS
422
423require File::Basename;
7e47e6ff 424require File::Spec;
81793b90 425
9f826d6a
BM
426# Should ideally be my() not our() but local() currently
427# refuses to operate on lexicals
428
429our %SLnkSeen;
430our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
719c805e 431 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
80e52b73 432 $pre_process, $post_process, $dangling_symlinks);
81793b90
GS
433
434sub contract_name {
435 my ($cdir,$fn) = @_;
436
7e47e6ff 437 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
81793b90
GS
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 '../') {
fecbda2b 446 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
81793b90
GS
447 }
448
449 return $abs_name;
450}
451
7e47e6ff
JH
452# return the absolute name of a directory or file
453sub contract_name_Mac {
3555aed3 454 my ($cdir,$fn) = @_;
7e47e6ff
JH
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 }
3555aed3
SP
464 else {
465 # need to move up the tree, but
7e47e6ff
JH
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 }
3555aed3 493 else { # argh!, $fn is not a valid directory/file
7e47e6ff
JH
494 return undef;
495 }
496 }
497}
81793b90
GS
498
499sub PathCombine($$) {
500 my ($Base,$Name) = @_;
501 my $AbsName;
502
7e47e6ff
JH
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()
3555aed3 506 $AbsName = $Name;
7e47e6ff
JH
507
508 # (simple) check for recursion
509 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
510 return undef;
511 }
81793b90
GS
512 }
513 else {
7e47e6ff
JH
514 if (substr($Name,0,1) eq '/') {
515 $AbsName= $Name;
516 }
517 else {
518 $AbsName= contract_name($Base,$Name);
519 }
81793b90 520
7e47e6ff
JH
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 }
81793b90
GS
529 }
530 }
531 return $AbsName;
532}
533
534sub 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";
a0d0e21e
LW
544 }
545 else {
81793b90 546 return undef;
a0d0e21e
LW
547 }
548 }
81793b90
GS
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;
a0d0e21e 556 }
81793b90
GS
557 }
558 else {
559 $AbsName= $NewName;
560 }
561 ($DEV, $INO) = lstat($AbsName);
562 return undef unless defined $DEV; # dangling symbolic link
563 }
564
cd68ec93 565 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
7e47e6ff 566 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
81793b90
GS
567 die "$AbsName encountered a second time";
568 }
569 else {
570 return undef;
571 }
572 }
573
574 return $AbsName;
575}
576
17f410f9 577our($dir, $name, $fullname, $prune);
81793b90
GS
578sub _find_dir_symlnk($$$);
579sub _find_dir($$$);
580
7e47e6ff
JH
581# check whether or not a scalar variable is tainted
582# (code straight from the Camel, 3rd ed., page 561)
583sub 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;
3555aed3 589}
7e47e6ff 590
81793b90
GS
591sub _find_opt {
592 my $wanted = shift;
593 die "invalid top directory" unless defined $_[0];
594
9f826d6a
BM
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,
80e52b73 601 $pre_process, $post_process, $dangling_symlinks);
4c621faf 602 local($dir, $name, $fullname, $prune);
bc125c03 603 local *_ = \my $a;
9f826d6a 604
a0c9c202 605 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
a1ccf0c4
JM
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 }
80e52b73
JH
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};
204b4d7f 627 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
1bb17459
RGS
628 $follow = $^O eq 'MSWin32' ? 0 :
629 $full_check || $wanted->{follow_fast};
80e52b73
JH
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};
81793b90 635
1cffc1dd 636 # for compatibility reasons (find.pl, find2perl)
9f826d6a 637 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
81793b90
GS
638
639 # a symbolic link to a directory doesn't increase the link count
640 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
3555aed3 641
e7b91b67 642 my ($abs_dir, $Is_Dir);
81793b90
GS
643
644 Proc_Top_Item:
4c621faf 645 foreach my $TOP (@_) {
7e47e6ff
JH
646 my $top_item = $TOP;
647
3555aed3
SP
648 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
649
7e47e6ff 650 if ($Is_MacOS) {
7e47e6ff 651 $top_item = ":$top_item"
3fa6e24b 652 if ( (-d _) && ( $top_item !~ /:/ ) );
3555aed3
SP
653 } elsif ($^O eq 'MSWin32') {
654 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
7e47e6ff
JH
655 }
656 else {
657 $top_item =~ s|/\z|| unless $top_item eq '/';
7e47e6ff
JH
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) {
cd68ec93 673 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
7e47e6ff
JH
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 ../
a1ccf0c4 687 $top_item =~ s/\.dir\z//i if $Is_VMS;
7e47e6ff
JH
688 $abs_dir = contract_name("$cwd/",$top_item);
689 }
690 }
691 $abs_dir= Follow_SymLink($abs_dir);
692 unless (defined $abs_dir) {
80e52b73
JH
693 if ($dangling_symlinks) {
694 if (ref $dangling_symlinks eq 'CODE') {
695 $dangling_symlinks->($top_item, $cwd);
696 } else {
cd68ec93 697 warnings::warnif "$top_item is a dangling symbolic link\n";
80e52b73
JH
698 }
699 }
81793b90 700 next Proc_Top_Item;
7e47e6ff
JH
701 }
702
703 if (-d _) {
a1ccf0c4 704 $top_item =~ s/\.dir\z//i if $Is_VMS;
81793b90
GS
705 _find_dir_symlnk($wanted, $abs_dir, $top_item);
706 $Is_Dir= 1;
7e47e6ff
JH
707 }
708 }
81793b90 709 else { # no follow
7e47e6ff
JH
710 $topdir = $top_item;
711 unless (defined $topnlink) {
cd68ec93 712 warnings::warnif "Can't stat $top_item: $!\n";
7e47e6ff
JH
713 next Proc_Top_Item;
714 }
715 if (-d _) {
544ff7a7 716 $top_item =~ s/\.dir\z//i if $Is_VMS;
e7b91b67 717 _find_dir($wanted, $top_item, $topnlink);
81793b90 718 $Is_Dir= 1;
7e47e6ff 719 }
237437d0 720 else {
81793b90 721 $abs_dir= $top_item;
7e47e6ff
JH
722 }
723 }
81793b90 724
7e47e6ff 725 unless ($Is_Dir) {
81793b90 726 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
7e47e6ff
JH
727 if ($Is_MacOS) {
728 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
729 }
730 else {
731 ($dir,$_) = ('./', $top_item);
732 }
81793b90
GS
733 }
734
7e47e6ff
JH
735 $abs_dir = $dir;
736 if (( $untaint ) && (is_tainted($dir) )) {
737 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
81793b90
GS
738 unless (defined $abs_dir) {
739 if ($untaint_skip == 0) {
7e47e6ff 740 die "directory $dir is still tainted";
81793b90
GS
741 }
742 else {
743 next Proc_Top_Item;
744 }
745 }
7e47e6ff 746 }
81793b90 747
7e47e6ff 748 unless ($no_chdir || chdir $abs_dir) {
cd68ec93 749 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
7e47e6ff
JH
750 next Proc_Top_Item;
751 }
719911cc 752
7e47e6ff 753 $name = $abs_dir . $_; # $File::Find::name
3bb6d3e5 754 $_ = $name if $no_chdir;
719911cc 755
abfdd623 756 { $wanted_callback->() }; # protect against wild "next"
81793b90 757
7e47e6ff 758 }
81793b90 759
7e47e6ff
JH
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 }
81793b90
GS
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
782sub _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;
7e47e6ff 790 my $dir_pref;
39e79f6b 791 my $dir_rel = $File::Find::current_dir;
7e47e6ff 792 my $tainted = 0;
5fa2bf2b 793 my $no_nlink;
7e47e6ff
JH
794
795 if ($Is_MacOS) {
796 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
3555aed3
SP
797 } elsif ($^O eq 'MSWin32') {
798 $dir_pref = ($p_dir =~ m|\w:/$| ? $p_dir : "$p_dir/" );
1e9c9d75 799 } elsif ($^O eq 'VMS') {
a1ccf0c4
JM
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
1e9c9d75 808 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
7e47e6ff
JH
809 }
810 else {
811 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
7e47e6ff 812 }
81793b90
GS
813
814 local ($dir, $name, $prune, *DIR);
7e47e6ff
JH
815
816 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
81793b90 817 my $udir = $p_dir;
7e47e6ff
JH
818 if (( $untaint ) && (is_tainted($p_dir) )) {
819 ( $udir ) = $p_dir =~ m|$untaint_pat|;
81793b90
GS
820 unless (defined $udir) {
821 if ($untaint_skip == 0) {
822 die "directory $p_dir is still tainted";
823 }
824 else {
825 return;
826 }
237437d0 827 }
a0d0e21e 828 }
8d8eebbf 829 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
cd68ec93 830 warnings::warnif "Can't cd to $udir: $!\n";
81793b90
GS
831 return;
832 }
833 }
7e47e6ff
JH
834
835 # push the starting directory
57e73c4b 836 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
81793b90 837
7e47e6ff
JH
838 if ($Is_MacOS) {
839 $p_dir = $dir_pref; # ensure trailing ':'
840 }
841
81793b90
GS
842 while (defined $SE) {
843 unless ($bydepth) {
3555aed3
SP
844 $dir= $p_dir; # $File::Find::dir
845 $name= $dir_name; # $File::Find::name
7e47e6ff 846 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
81793b90 847 # prune may happen here
7e47e6ff 848 $prune= 0;
abfdd623 849 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 850 next if $prune;
81793b90 851 }
7e47e6ff 852
81793b90 853 # change to that directory
7e47e6ff 854 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
81793b90 855 my $udir= $dir_rel;
7e47e6ff
JH
856 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
857 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
81793b90
GS
858 unless (defined $udir) {
859 if ($untaint_skip == 0) {
7e47e6ff
JH
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
3555aed3 867 next;
81793b90
GS
868 }
869 }
870 }
8d8eebbf 871 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
7e47e6ff 872 if ($Is_MacOS) {
cd68ec93 873 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
7e47e6ff
JH
874 }
875 else {
cd68ec93
RGS
876 warnings::warnif "Can't cd to (" .
877 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
7e47e6ff 878 }
81793b90
GS
879 next;
880 }
881 $CdLvl++;
882 }
883
7e47e6ff
JH
884 if ($Is_MacOS) {
885 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
886 }
887
3555aed3 888 $dir= $dir_name; # $File::Find::dir
81793b90
GS
889
890 # Get the list of files in the current directory.
7e47e6ff 891 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
cd68ec93 892 warnings::warnif "Can't opendir($dir_name): $!\n";
81793b90
GS
893 next;
894 }
895 @filenames = readdir DIR;
896 closedir(DIR);
abfdd623 897 @filenames = $pre_process->(@filenames) if $pre_process;
719c805e 898 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
81793b90 899
5fa2bf2b
DD
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) {
81793b90
GS
907 # This dir has no subdirectories.
908 for my $FN (@filenames) {
a1ccf0c4
JM
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 }
7e47e6ff 917 next if $FN =~ $File::Find::skip_pattern;
81793b90 918
7e47e6ff
JH
919 $name = $dir_pref . $FN; # $File::Find::name
920 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 921 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
922 }
923
924 }
925 else {
926 # This dir has subdirectories.
927 $subcount = $nlink - 2;
928
7bd31527
JH
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
81793b90 934 for my $FN (@filenames) {
7e47e6ff 935 next if $FN =~ $File::Find::skip_pattern;
5fa2bf2b 936 if ($subcount > 0 || $no_nlink) {
81793b90
GS
937 # Seen all the subdirs?
938 # check for directoriness.
939 # stat is faster for a file in the current directory
07867069 940 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
81793b90
GS
941
942 if (-d _) {
943 --$subcount;
544ff7a7 944 $FN =~ s/\.dir\z//i if $Is_VMS;
7bd31527
JH
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];
81793b90
GS
949 }
950 else {
7e47e6ff
JH
951 $name = $dir_pref . $FN; # $File::Find::name
952 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 953 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
954 }
955 }
07867069 956 else {
7e47e6ff
JH
957 $name = $dir_pref . $FN; # $File::Find::name
958 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 959 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
960 }
961 }
962 }
17b275ff
RA
963 }
964 continue {
57e73c4b 965 while ( defined ($SE = pop @Stack) ) {
81793b90
GS
966 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
967 if ($CdLvl > $Level && !$no_chdir) {
7e47e6ff
JH
968 my $tmp;
969 if ($Is_MacOS) {
970 $tmp = (':' x ($CdLvl-$Level)) . ':';
971 }
d8101854
CB
972 elsif ($Is_VMS) {
973 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
974 }
7e47e6ff
JH
975 else {
976 $tmp = join('/',('..') x ($CdLvl-$Level));
977 }
d8101854 978 die "Can't cd to $tmp from $dir_name"
7e47e6ff 979 unless chdir ($tmp);
81793b90
GS
980 $CdLvl = $Level;
981 }
7e47e6ff
JH
982
983 if ($Is_MacOS) {
984 # $pdir always has a trailing ':', except for the starting dir,
985 # where $dir_rel eq ':'
986 $dir_name = "$p_dir$dir_rel";
987 $dir_pref = "$dir_name:";
988 }
3555aed3
SP
989 elsif ($^O eq 'MSWin32') {
990 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
991 $dir_pref = "$dir_name/";
992 }
1e9c9d75
CB
993 elsif ($^O eq 'VMS') {
994 if ($p_dir =~ m/[\]>]+$/) {
995 $dir_name = $p_dir;
996 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
997 $dir_pref = $dir_name;
998 }
999 else {
1000 $dir_name = "$p_dir/$dir_rel";
1001 $dir_pref = "$dir_name/";
1002 }
1003 }
7e47e6ff
JH
1004 else {
1005 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1006 $dir_pref = "$dir_name/";
1007 }
1008
719c805e 1009 if ( $nlink == -2 ) {
7e47e6ff 1010 $name = $dir = $p_dir; # $File::Find::name / dir
39e79f6b 1011 $_ = $File::Find::current_dir;
abfdd623 1012 $post_process->(); # End-of-directory processing
7e47e6ff
JH
1013 }
1014 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
1015 $name = $dir_name;
1016 if ($Is_MacOS) {
1017 if ($dir_rel eq ':') { # must be the top dir, where we started
1018 $name =~ s|:$||; # $File::Find::name
1019 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1020 }
1021 $dir = $p_dir; # $File::Find::dir
1022 $_ = ($no_chdir ? $name : $dir_rel); # $_
1023 }
1024 else {
1025 if ( substr($name,-2) eq '/.' ) {
5cf0a2f2 1026 substr($name, length($name) == 2 ? -1 : -2) = '';
7e47e6ff
JH
1027 }
1028 $dir = $p_dir;
1029 $_ = ($no_chdir ? $dir_name : $dir_rel );
1030 if ( substr($_,-2) eq '/.' ) {
5cf0a2f2 1031 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff
JH
1032 }
1033 }
abfdd623 1034 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
1035 }
1036 else {
1037 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
1038 last;
1039 }
81793b90 1040 }
a0d0e21e
LW
1041 }
1042}
1043
81793b90
GS
1044
1045# API:
1046# $wanted
1047# $dir_loc : absolute location of a dir
1048# $p_dir : "parent directory"
1049# preconditions:
1050# chdir (if not no_chdir) to dir
1051
1052sub _find_dir_symlnk($$$) {
7e47e6ff 1053 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
81793b90
GS
1054 my @Stack;
1055 my @filenames;
1056 my $new_loc;
7e47e6ff 1057 my $updir_loc = $dir_loc; # untainted parent directory
81793b90
GS
1058 my $SE = [];
1059 my $dir_name = $p_dir;
7e47e6ff
JH
1060 my $dir_pref;
1061 my $loc_pref;
39e79f6b 1062 my $dir_rel = $File::Find::current_dir;
7e47e6ff
JH
1063 my $byd_flag; # flag for pending stack entry if $bydepth
1064 my $tainted = 0;
1065 my $ok = 1;
1066
1067 if ($Is_MacOS) {
1068 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1069 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
7e47e6ff
JH
1070 } else {
1071 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1072 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
7e47e6ff 1073 }
81793b90
GS
1074
1075 local ($dir, $name, $fullname, $prune, *DIR);
7e47e6ff
JH
1076
1077 unless ($no_chdir) {
1078 # untaint the topdir
1079 if (( $untaint ) && (is_tainted($dir_loc) )) {
1080 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1081 # once untainted, $updir_loc is pushed on the stack (as parent directory);
3555aed3
SP
1082 # hence, we don't need to untaint the parent directory every time we chdir
1083 # to it later
7e47e6ff 1084 unless (defined $updir_loc) {
81793b90
GS
1085 if ($untaint_skip == 0) {
1086 die "directory $dir_loc is still tainted";
1087 }
1088 else {
1089 return;
1090 }
1091 }
1092 }
7e47e6ff
JH
1093 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1094 unless ($ok) {
cd68ec93 1095 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1096 return;
1097 }
1098 }
1099
7e47e6ff
JH
1100 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1101
1102 if ($Is_MacOS) {
1103 $p_dir = $dir_pref; # ensure trailing ':'
1104 }
57e73c4b 1105
81793b90
GS
1106 while (defined $SE) {
1107
1108 unless ($bydepth) {
7e47e6ff 1109 # change (back) to parent directory (always untainted)
704ea872 1110 unless ($no_chdir) {
7e47e6ff 1111 unless (chdir $updir_loc) {
cd68ec93 1112 warnings::warnif "Can't cd to $updir_loc: $!\n";
704ea872
GS
1113 next;
1114 }
1115 }
7e47e6ff
JH
1116 $dir= $p_dir; # $File::Find::dir
1117 $name= $dir_name; # $File::Find::name
1118 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1119 $fullname= $dir_loc; # $File::Find::fullname
81793b90 1120 # prune may happen here
7e47e6ff 1121 $prune= 0;
704ea872 1122 lstat($_); # make sure file tests with '_' work
abfdd623 1123 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 1124 next if $prune;
81793b90
GS
1125 }
1126
1127 # change to that directory
7e47e6ff
JH
1128 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1129 $updir_loc = $dir_loc;
1130 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
3555aed3 1131 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
7e47e6ff
JH
1132 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1133 unless (defined $updir_loc) {
81793b90
GS
1134 if ($untaint_skip == 0) {
1135 die "directory $dir_loc is still tainted";
a0d0e21e 1136 }
237437d0 1137 else {
81793b90 1138 next;
237437d0 1139 }
a0d0e21e
LW
1140 }
1141 }
7e47e6ff 1142 unless (chdir $updir_loc) {
cd68ec93 1143 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1144 next;
1145 }
1146 }
1147
7e47e6ff
JH
1148 if ($Is_MacOS) {
1149 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1150 }
1151
1152 $dir = $dir_name; # $File::Find::dir
81793b90
GS
1153
1154 # Get the list of files in the current directory.
7e47e6ff 1155 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
cd68ec93 1156 warnings::warnif "Can't opendir($dir_loc): $!\n";
81793b90
GS
1157 next;
1158 }
1159 @filenames = readdir DIR;
1160 closedir(DIR);
1161
1162 for my $FN (@filenames) {
a1ccf0c4
JM
1163 if ($Is_VMS) {
1164 # Big hammer here - Compensate for VMS trailing . and .dir
1165 # No win situation until this is changed, but this
1166 # will handle the majority of the cases with breaking the fewest.
1167
1168 $FN =~ s/\.dir\z//i;
1169 $FN =~ s#\.$## if ($FN ne '.');
1170 }
7e47e6ff 1171 next if $FN =~ $File::Find::skip_pattern;
81793b90
GS
1172
1173 # follow symbolic links / do an lstat
07867069 1174 $new_loc = Follow_SymLink($loc_pref.$FN);
81793b90
GS
1175
1176 # ignore if invalid symlink
3555aed3 1177 unless (defined $new_loc) {
fab43c1b 1178 if (!defined -l _ && $dangling_symlinks) {
615a2b9b
SP
1179 if (ref $dangling_symlinks eq 'CODE') {
1180 $dangling_symlinks->($FN, $dir_pref);
1181 } else {
1182 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1183 }
1184 }
1185
1186 $fullname = undef;
1187 $name = $dir_pref . $FN;
1188 $_ = ($no_chdir ? $name : $FN);
1189 { $wanted_callback->() };
1190 next;
1191 }
7e47e6ff 1192
81793b90 1193 if (-d _) {
a1ccf0c4
JM
1194 if ($Is_VMS) {
1195 $FN =~ s/\.dir\z//i;
1196 $FN =~ s#\.$## if ($FN ne '.');
1197 $new_loc =~ s/\.dir\z//i;
1198 $new_loc =~ s#\.$## if ($new_loc ne '.');
1199 }
7e47e6ff 1200 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
81793b90
GS
1201 }
1202 else {
3555aed3 1203 $fullname = $new_loc; # $File::Find::fullname
7e47e6ff
JH
1204 $name = $dir_pref . $FN; # $File::Find::name
1205 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 1206 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
1207 }
1208 }
1209
81793b90
GS
1210 }
1211 continue {
57e73c4b 1212 while (defined($SE = pop @Stack)) {
7e47e6ff
JH
1213 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1214 if ($Is_MacOS) {
1215 # $p_dir always has a trailing ':', except for the starting dir,
1216 # where $dir_rel eq ':'
1217 $dir_name = "$p_dir$dir_rel";
1218 $dir_pref = "$dir_name:";
1219 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1220 }
1221 else {
1222 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1223 $dir_pref = "$dir_name/";
1224 $loc_pref = "$dir_loc/";
1225 }
1226 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1227 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
3555aed3 1228 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
cd68ec93 1229 warnings::warnif "Can't cd to $updir_loc: $!\n";
7e47e6ff
JH
1230 next;
1231 }
1232 }
1233 $fullname = $dir_loc; # $File::Find::fullname
1234 $name = $dir_name; # $File::Find::name
1235 if ($Is_MacOS) {
1236 if ($dir_rel eq ':') { # must be the top dir, where we started
1237 $name =~ s|:$||; # $File::Find::name
1238 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1239 }
1240 $dir = $p_dir; # $File::Find::dir
1241 $_ = ($no_chdir ? $name : $dir_rel); # $_
1242 }
1243 else {
1244 if ( substr($name,-2) eq '/.' ) {
f801979b 1245 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
7e47e6ff
JH
1246 }
1247 $dir = $p_dir; # $File::Find::dir
1248 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1249 if ( substr($_,-2) eq '/.' ) {
f801979b 1250 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff
JH
1251 }
1252 }
1253
1254 lstat($_); # make sure file tests with '_' work
abfdd623 1255 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
1256 }
1257 else {
1258 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1259 last;
1260 }
a0d0e21e
LW
1261 }
1262 }
1263}
1264
81793b90 1265
20408e3c 1266sub wrap_wanted {
81793b90
GS
1267 my $wanted = shift;
1268 if ( ref($wanted) eq 'HASH' ) {
1269 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1270 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1271 }
1272 if ( $wanted->{untaint} ) {
3555aed3 1273 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
81793b90
GS
1274 unless defined $wanted->{untaint_pattern};
1275 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1276 }
1277 return $wanted;
1278 }
1279 else {
1280 return { wanted => $wanted };
1281 }
a0d0e21e
LW
1282}
1283
20408e3c 1284sub find {
81793b90
GS
1285 my $wanted = shift;
1286 _find_opt(wrap_wanted($wanted), @_);
a0d0e21e
LW
1287}
1288
55d729e4 1289sub finddepth {
81793b90
GS
1290 my $wanted = wrap_wanted(shift);
1291 $wanted->{bydepth} = 1;
1292 _find_opt($wanted, @_);
20408e3c 1293}
6280b799 1294
7e47e6ff
JH
1295# default
1296$File::Find::skip_pattern = qr/^\.{1,2}\z/;
1297$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1298
6280b799 1299# These are hard-coded for now, but may move to hint files.
10eba763 1300if ($^O eq 'VMS') {
81793b90 1301 $Is_VMS = 1;
7e47e6ff
JH
1302 $File::Find::dont_use_nlink = 1;
1303}
1304elsif ($^O eq 'MacOS') {
1305 $Is_MacOS = 1;
1306 $File::Find::dont_use_nlink = 1;
1307 $File::Find::skip_pattern = qr/^Icon\015\z/;
1308 $File::Find::untaint_pattern = qr|^(.+)$|;
748a9306
LW
1309}
1310
7e47e6ff
JH
1311# this _should_ work properly on all platforms
1312# where File::Find can be expected to work
1313$File::Find::current_dir = File::Spec->curdir || '.';
1314
81793b90 1315$File::Find::dont_use_nlink = 1
497711e7 1316 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
0c52c6a9 1317 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1119cb72 1318 $^O eq 'nto';
6280b799 1319
20408e3c
GS
1320# Set dont_use_nlink in your hint file if your system's stat doesn't
1321# report the number of links in a directory as an indication
1322# of the number of files.
1323# See, e.g. hints/machten.sh for MachTen 2.2.
81793b90
GS
1324unless ($File::Find::dont_use_nlink) {
1325 require Config;
1326 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
20408e3c
GS
1327}
1328
3555aed3
SP
1329# We need a function that checks if a scalar is tainted. Either use the
1330# Scalar::Util module's tainted() function or our (slower) pure Perl
7e47e6ff
JH
1331# fallback is_tainted_pp()
1332{
1333 local $@;
1334 eval { require Scalar::Util };
1335 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1336}
1337
a0d0e21e 13381;