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