This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #40369] File::Find mishandles non-dangling symlinks
[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
6eb87ff8
MJD
59C<finddepth()> works just like C<find()> except that is invokes the
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/" );
7e47e6ff
JH
783 }
784 else {
785 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
7e47e6ff 786 }
81793b90
GS
787
788 local ($dir, $name, $prune, *DIR);
7e47e6ff
JH
789
790 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
81793b90 791 my $udir = $p_dir;
7e47e6ff
JH
792 if (( $untaint ) && (is_tainted($p_dir) )) {
793 ( $udir ) = $p_dir =~ m|$untaint_pat|;
81793b90
GS
794 unless (defined $udir) {
795 if ($untaint_skip == 0) {
796 die "directory $p_dir is still tainted";
797 }
798 else {
799 return;
800 }
237437d0 801 }
a0d0e21e 802 }
8d8eebbf 803 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
cd68ec93 804 warnings::warnif "Can't cd to $udir: $!\n";
81793b90
GS
805 return;
806 }
807 }
7e47e6ff
JH
808
809 # push the starting directory
57e73c4b 810 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
81793b90 811
7e47e6ff
JH
812 if ($Is_MacOS) {
813 $p_dir = $dir_pref; # ensure trailing ':'
814 }
815
81793b90
GS
816 while (defined $SE) {
817 unless ($bydepth) {
3555aed3
SP
818 $dir= $p_dir; # $File::Find::dir
819 $name= $dir_name; # $File::Find::name
7e47e6ff 820 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
81793b90 821 # prune may happen here
7e47e6ff 822 $prune= 0;
abfdd623 823 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 824 next if $prune;
81793b90 825 }
7e47e6ff 826
81793b90 827 # change to that directory
7e47e6ff 828 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
81793b90 829 my $udir= $dir_rel;
7e47e6ff
JH
830 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
831 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
81793b90
GS
832 unless (defined $udir) {
833 if ($untaint_skip == 0) {
7e47e6ff
JH
834 if ($Is_MacOS) {
835 die "directory ($p_dir) $dir_rel is still tainted";
836 }
837 else {
838 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
839 }
840 } else { # $untaint_skip == 1
3555aed3 841 next;
81793b90
GS
842 }
843 }
844 }
8d8eebbf 845 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
7e47e6ff 846 if ($Is_MacOS) {
cd68ec93 847 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
7e47e6ff
JH
848 }
849 else {
cd68ec93
RGS
850 warnings::warnif "Can't cd to (" .
851 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
7e47e6ff 852 }
81793b90
GS
853 next;
854 }
855 $CdLvl++;
856 }
857
7e47e6ff
JH
858 if ($Is_MacOS) {
859 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
860 }
861
3555aed3 862 $dir= $dir_name; # $File::Find::dir
81793b90
GS
863
864 # Get the list of files in the current directory.
7e47e6ff 865 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
cd68ec93 866 warnings::warnif "Can't opendir($dir_name): $!\n";
81793b90
GS
867 next;
868 }
869 @filenames = readdir DIR;
870 closedir(DIR);
abfdd623 871 @filenames = $pre_process->(@filenames) if $pre_process;
719c805e 872 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
81793b90 873
5fa2bf2b
DD
874 # default: use whatever was specifid
875 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
876 $no_nlink = $avoid_nlink;
877 # if dir has wrong nlink count, force switch to slower stat method
878 $no_nlink = 1 if ($nlink < 2);
879
880 if ($nlink == 2 && !$no_nlink) {
81793b90
GS
881 # This dir has no subdirectories.
882 for my $FN (@filenames) {
7e47e6ff 883 next if $FN =~ $File::Find::skip_pattern;
81793b90 884
7e47e6ff
JH
885 $name = $dir_pref . $FN; # $File::Find::name
886 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 887 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
888 }
889
890 }
891 else {
892 # This dir has subdirectories.
893 $subcount = $nlink - 2;
894
7bd31527
JH
895 # HACK: insert directories at this position. so as to preserve
896 # the user pre-processed ordering of files.
897 # EG: directory traversal is in user sorted order, not at random.
898 my $stack_top = @Stack;
899
81793b90 900 for my $FN (@filenames) {
7e47e6ff 901 next if $FN =~ $File::Find::skip_pattern;
5fa2bf2b 902 if ($subcount > 0 || $no_nlink) {
81793b90
GS
903 # Seen all the subdirs?
904 # check for directoriness.
905 # stat is faster for a file in the current directory
07867069 906 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
81793b90
GS
907
908 if (-d _) {
909 --$subcount;
544ff7a7 910 $FN =~ s/\.dir\z//i if $Is_VMS;
7bd31527
JH
911 # HACK: replace push to preserve dir traversal order
912 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
913 splice @Stack, $stack_top, 0,
914 [$CdLvl,$dir_name,$FN,$sub_nlink];
81793b90
GS
915 }
916 else {
7e47e6ff
JH
917 $name = $dir_pref . $FN; # $File::Find::name
918 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 919 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
920 }
921 }
07867069 922 else {
7e47e6ff
JH
923 $name = $dir_pref . $FN; # $File::Find::name
924 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 925 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
926 }
927 }
928 }
17b275ff
RA
929 }
930 continue {
57e73c4b 931 while ( defined ($SE = pop @Stack) ) {
81793b90
GS
932 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
933 if ($CdLvl > $Level && !$no_chdir) {
7e47e6ff
JH
934 my $tmp;
935 if ($Is_MacOS) {
936 $tmp = (':' x ($CdLvl-$Level)) . ':';
937 }
938 else {
939 $tmp = join('/',('..') x ($CdLvl-$Level));
940 }
941 die "Can't cd to $dir_name" . $tmp
942 unless chdir ($tmp);
81793b90
GS
943 $CdLvl = $Level;
944 }
7e47e6ff
JH
945
946 if ($Is_MacOS) {
947 # $pdir always has a trailing ':', except for the starting dir,
948 # where $dir_rel eq ':'
949 $dir_name = "$p_dir$dir_rel";
950 $dir_pref = "$dir_name:";
951 }
3555aed3
SP
952 elsif ($^O eq 'MSWin32') {
953 $dir_name = ($p_dir =~ m|\w:/$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
954 $dir_pref = "$dir_name/";
955 }
7e47e6ff
JH
956 else {
957 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
958 $dir_pref = "$dir_name/";
959 }
960
719c805e 961 if ( $nlink == -2 ) {
7e47e6ff 962 $name = $dir = $p_dir; # $File::Find::name / dir
39e79f6b 963 $_ = $File::Find::current_dir;
abfdd623 964 $post_process->(); # End-of-directory processing
7e47e6ff
JH
965 }
966 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
967 $name = $dir_name;
968 if ($Is_MacOS) {
969 if ($dir_rel eq ':') { # must be the top dir, where we started
970 $name =~ s|:$||; # $File::Find::name
971 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
972 }
973 $dir = $p_dir; # $File::Find::dir
974 $_ = ($no_chdir ? $name : $dir_rel); # $_
975 }
976 else {
977 if ( substr($name,-2) eq '/.' ) {
5cf0a2f2 978 substr($name, length($name) == 2 ? -1 : -2) = '';
7e47e6ff
JH
979 }
980 $dir = $p_dir;
981 $_ = ($no_chdir ? $dir_name : $dir_rel );
982 if ( substr($_,-2) eq '/.' ) {
5cf0a2f2 983 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff
JH
984 }
985 }
abfdd623 986 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
987 }
988 else {
989 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
990 last;
991 }
81793b90 992 }
a0d0e21e
LW
993 }
994}
995
81793b90
GS
996
997# API:
998# $wanted
999# $dir_loc : absolute location of a dir
1000# $p_dir : "parent directory"
1001# preconditions:
1002# chdir (if not no_chdir) to dir
1003
1004sub _find_dir_symlnk($$$) {
7e47e6ff 1005 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
81793b90
GS
1006 my @Stack;
1007 my @filenames;
1008 my $new_loc;
7e47e6ff 1009 my $updir_loc = $dir_loc; # untainted parent directory
81793b90
GS
1010 my $SE = [];
1011 my $dir_name = $p_dir;
7e47e6ff
JH
1012 my $dir_pref;
1013 my $loc_pref;
39e79f6b 1014 my $dir_rel = $File::Find::current_dir;
7e47e6ff
JH
1015 my $byd_flag; # flag for pending stack entry if $bydepth
1016 my $tainted = 0;
1017 my $ok = 1;
1018
1019 if ($Is_MacOS) {
1020 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1021 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
7e47e6ff
JH
1022 } else {
1023 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1024 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
7e47e6ff 1025 }
81793b90
GS
1026
1027 local ($dir, $name, $fullname, $prune, *DIR);
7e47e6ff
JH
1028
1029 unless ($no_chdir) {
1030 # untaint the topdir
1031 if (( $untaint ) && (is_tainted($dir_loc) )) {
1032 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1033 # once untainted, $updir_loc is pushed on the stack (as parent directory);
3555aed3
SP
1034 # hence, we don't need to untaint the parent directory every time we chdir
1035 # to it later
7e47e6ff 1036 unless (defined $updir_loc) {
81793b90
GS
1037 if ($untaint_skip == 0) {
1038 die "directory $dir_loc is still tainted";
1039 }
1040 else {
1041 return;
1042 }
1043 }
1044 }
7e47e6ff
JH
1045 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1046 unless ($ok) {
cd68ec93 1047 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1048 return;
1049 }
1050 }
1051
7e47e6ff
JH
1052 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1053
1054 if ($Is_MacOS) {
1055 $p_dir = $dir_pref; # ensure trailing ':'
1056 }
57e73c4b 1057
81793b90
GS
1058 while (defined $SE) {
1059
1060 unless ($bydepth) {
7e47e6ff 1061 # change (back) to parent directory (always untainted)
704ea872 1062 unless ($no_chdir) {
7e47e6ff 1063 unless (chdir $updir_loc) {
cd68ec93 1064 warnings::warnif "Can't cd to $updir_loc: $!\n";
704ea872
GS
1065 next;
1066 }
1067 }
7e47e6ff
JH
1068 $dir= $p_dir; # $File::Find::dir
1069 $name= $dir_name; # $File::Find::name
1070 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1071 $fullname= $dir_loc; # $File::Find::fullname
81793b90 1072 # prune may happen here
7e47e6ff 1073 $prune= 0;
704ea872 1074 lstat($_); # make sure file tests with '_' work
abfdd623 1075 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 1076 next if $prune;
81793b90
GS
1077 }
1078
1079 # change to that directory
7e47e6ff
JH
1080 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1081 $updir_loc = $dir_loc;
1082 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
3555aed3 1083 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
7e47e6ff
JH
1084 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1085 unless (defined $updir_loc) {
81793b90
GS
1086 if ($untaint_skip == 0) {
1087 die "directory $dir_loc is still tainted";
a0d0e21e 1088 }
237437d0 1089 else {
81793b90 1090 next;
237437d0 1091 }
a0d0e21e
LW
1092 }
1093 }
7e47e6ff 1094 unless (chdir $updir_loc) {
cd68ec93 1095 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1096 next;
1097 }
1098 }
1099
7e47e6ff
JH
1100 if ($Is_MacOS) {
1101 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1102 }
1103
1104 $dir = $dir_name; # $File::Find::dir
81793b90
GS
1105
1106 # Get the list of files in the current directory.
7e47e6ff 1107 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
cd68ec93 1108 warnings::warnif "Can't opendir($dir_loc): $!\n";
81793b90
GS
1109 next;
1110 }
1111 @filenames = readdir DIR;
1112 closedir(DIR);
1113
1114 for my $FN (@filenames) {
7e47e6ff 1115 next if $FN =~ $File::Find::skip_pattern;
81793b90
GS
1116
1117 # follow symbolic links / do an lstat
07867069 1118 $new_loc = Follow_SymLink($loc_pref.$FN);
81793b90
GS
1119
1120 # ignore if invalid symlink
3555aed3 1121 unless (defined $new_loc) {
fab43c1b 1122 if (!defined -l _ && $dangling_symlinks) {
615a2b9b
SP
1123 if (ref $dangling_symlinks eq 'CODE') {
1124 $dangling_symlinks->($FN, $dir_pref);
1125 } else {
1126 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1127 }
1128 }
1129
1130 $fullname = undef;
1131 $name = $dir_pref . $FN;
1132 $_ = ($no_chdir ? $name : $FN);
1133 { $wanted_callback->() };
1134 next;
1135 }
7e47e6ff 1136
81793b90 1137 if (-d _) {
7e47e6ff 1138 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
81793b90
GS
1139 }
1140 else {
3555aed3 1141 $fullname = $new_loc; # $File::Find::fullname
7e47e6ff
JH
1142 $name = $dir_pref . $FN; # $File::Find::name
1143 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 1144 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
1145 }
1146 }
1147
81793b90
GS
1148 }
1149 continue {
57e73c4b 1150 while (defined($SE = pop @Stack)) {
7e47e6ff
JH
1151 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1152 if ($Is_MacOS) {
1153 # $p_dir always has a trailing ':', except for the starting dir,
1154 # where $dir_rel eq ':'
1155 $dir_name = "$p_dir$dir_rel";
1156 $dir_pref = "$dir_name:";
1157 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1158 }
1159 else {
1160 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1161 $dir_pref = "$dir_name/";
1162 $loc_pref = "$dir_loc/";
1163 }
1164 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1165 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
3555aed3 1166 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
cd68ec93 1167 warnings::warnif "Can't cd to $updir_loc: $!\n";
7e47e6ff
JH
1168 next;
1169 }
1170 }
1171 $fullname = $dir_loc; # $File::Find::fullname
1172 $name = $dir_name; # $File::Find::name
1173 if ($Is_MacOS) {
1174 if ($dir_rel eq ':') { # must be the top dir, where we started
1175 $name =~ s|:$||; # $File::Find::name
1176 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1177 }
1178 $dir = $p_dir; # $File::Find::dir
1179 $_ = ($no_chdir ? $name : $dir_rel); # $_
1180 }
1181 else {
1182 if ( substr($name,-2) eq '/.' ) {
f801979b 1183 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
7e47e6ff
JH
1184 }
1185 $dir = $p_dir; # $File::Find::dir
1186 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1187 if ( substr($_,-2) eq '/.' ) {
f801979b 1188 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff
JH
1189 }
1190 }
1191
1192 lstat($_); # make sure file tests with '_' work
abfdd623 1193 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
1194 }
1195 else {
1196 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1197 last;
1198 }
a0d0e21e
LW
1199 }
1200 }
1201}
1202
81793b90 1203
20408e3c 1204sub wrap_wanted {
81793b90
GS
1205 my $wanted = shift;
1206 if ( ref($wanted) eq 'HASH' ) {
1207 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1208 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1209 }
1210 if ( $wanted->{untaint} ) {
3555aed3 1211 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
81793b90
GS
1212 unless defined $wanted->{untaint_pattern};
1213 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1214 }
1215 return $wanted;
1216 }
1217 else {
1218 return { wanted => $wanted };
1219 }
a0d0e21e
LW
1220}
1221
20408e3c 1222sub find {
81793b90
GS
1223 my $wanted = shift;
1224 _find_opt(wrap_wanted($wanted), @_);
a0d0e21e
LW
1225}
1226
55d729e4 1227sub finddepth {
81793b90
GS
1228 my $wanted = wrap_wanted(shift);
1229 $wanted->{bydepth} = 1;
1230 _find_opt($wanted, @_);
20408e3c 1231}
6280b799 1232
7e47e6ff
JH
1233# default
1234$File::Find::skip_pattern = qr/^\.{1,2}\z/;
1235$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1236
6280b799 1237# These are hard-coded for now, but may move to hint files.
10eba763 1238if ($^O eq 'VMS') {
81793b90 1239 $Is_VMS = 1;
7e47e6ff
JH
1240 $File::Find::dont_use_nlink = 1;
1241}
1242elsif ($^O eq 'MacOS') {
1243 $Is_MacOS = 1;
1244 $File::Find::dont_use_nlink = 1;
1245 $File::Find::skip_pattern = qr/^Icon\015\z/;
1246 $File::Find::untaint_pattern = qr|^(.+)$|;
748a9306
LW
1247}
1248
7e47e6ff
JH
1249# this _should_ work properly on all platforms
1250# where File::Find can be expected to work
1251$File::Find::current_dir = File::Spec->curdir || '.';
1252
81793b90 1253$File::Find::dont_use_nlink = 1
497711e7 1254 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
0c52c6a9 1255 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1119cb72 1256 $^O eq 'nto';
6280b799 1257
20408e3c
GS
1258# Set dont_use_nlink in your hint file if your system's stat doesn't
1259# report the number of links in a directory as an indication
1260# of the number of files.
1261# See, e.g. hints/machten.sh for MachTen 2.2.
81793b90
GS
1262unless ($File::Find::dont_use_nlink) {
1263 require Config;
1264 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
20408e3c
GS
1265}
1266
3555aed3
SP
1267# We need a function that checks if a scalar is tainted. Either use the
1268# Scalar::Util module's tainted() function or our (slower) pure Perl
7e47e6ff
JH
1269# fallback is_tainted_pp()
1270{
1271 local $@;
1272 eval { require Scalar::Util };
1273 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1274}
1275
a0d0e21e 12761;