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