This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #71710] fixes for File::Find
[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;
a0b245d5 6our $VERSION = '1.18';
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;
a0b245d5 426my $Is_Win32;
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
862f843b
NC
508 if (substr($Name,0,1) eq '/') {
509 $AbsName= $Name;
81793b90
GS
510 }
511 else {
862f843b
NC
512 $AbsName= contract_name($Base,$Name);
513 }
81793b90 514
862f843b
NC
515 # (simple) check for recursion
516 my $newlen= length($AbsName);
517 if ($newlen <= length($Base)) {
518 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
519 && $AbsName eq substr($Base,0,$newlen))
520 {
521 return undef;
81793b90
GS
522 }
523 }
524 return $AbsName;
525}
526
527sub Follow_SymLink($) {
528 my ($AbsName) = @_;
529
530 my ($NewName,$DEV, $INO);
531 ($DEV, $INO)= lstat $AbsName;
532
533 while (-l _) {
534 if ($SLnkSeen{$DEV, $INO}++) {
535 if ($follow_skip < 2) {
536 die "$AbsName is encountered a second time";
a0d0e21e
LW
537 }
538 else {
81793b90 539 return undef;
a0d0e21e
LW
540 }
541 }
81793b90
GS
542 $NewName= PathCombine($AbsName, readlink($AbsName));
543 unless(defined $NewName) {
544 if ($follow_skip < 2) {
545 die "$AbsName is a recursive symbolic link";
546 }
547 else {
548 return undef;
a0d0e21e 549 }
81793b90
GS
550 }
551 else {
552 $AbsName= $NewName;
553 }
554 ($DEV, $INO) = lstat($AbsName);
555 return undef unless defined $DEV; # dangling symbolic link
556 }
557
cd68ec93 558 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
7e47e6ff 559 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
81793b90
GS
560 die "$AbsName encountered a second time";
561 }
562 else {
563 return undef;
564 }
565 }
566
567 return $AbsName;
568}
569
17f410f9 570our($dir, $name, $fullname, $prune);
81793b90
GS
571sub _find_dir_symlnk($$$);
572sub _find_dir($$$);
573
7e47e6ff
JH
574# check whether or not a scalar variable is tainted
575# (code straight from the Camel, 3rd ed., page 561)
576sub is_tainted_pp {
577 my $arg = shift;
578 my $nada = substr($arg, 0, 0); # zero-length
579 local $@;
580 eval { eval "# $nada" };
581 return length($@) != 0;
3555aed3 582}
7e47e6ff 583
81793b90
GS
584sub _find_opt {
585 my $wanted = shift;
586 die "invalid top directory" unless defined $_[0];
587
9f826d6a
BM
588 # This function must local()ize everything because callbacks may
589 # call find() or finddepth()
590
591 local %SLnkSeen;
592 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
593 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
80e52b73 594 $pre_process, $post_process, $dangling_symlinks);
4c621faf 595 local($dir, $name, $fullname, $prune);
bc125c03 596 local *_ = \my $a;
9f826d6a 597
a0c9c202 598 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
a1ccf0c4
JM
599 if ($Is_VMS) {
600 # VMS returns this by default in VMS format which just doesn't
601 # work for the rest of this module.
602 $cwd = VMS::Filespec::unixpath($cwd);
603
604 # Apparently this is not expected to have a trailing space.
605 # To attempt to make VMS/UNIX conversions mostly reversable,
606 # a trailing slash is needed. The run-time functions ignore the
607 # resulting double slash, but it causes the perl tests to fail.
608 $cwd =~ s#/\z##;
609
610 # This comes up in upper case now, but should be lower.
611 # In the future this could be exact case, no need to change.
612 }
80e52b73
JH
613 my $cwd_untainted = $cwd;
614 my $check_t_cwd = 1;
615 $wanted_callback = $wanted->{wanted};
616 $bydepth = $wanted->{bydepth};
617 $pre_process = $wanted->{preprocess};
618 $post_process = $wanted->{postprocess};
619 $no_chdir = $wanted->{no_chdir};
a0b245d5
AD
620 $full_check = $Is_Win32 ? 0 : $wanted->{follow};
621 $follow = $Is_Win32 ? 0 :
1bb17459 622 $full_check || $wanted->{follow_fast};
80e52b73
JH
623 $follow_skip = $wanted->{follow_skip};
624 $untaint = $wanted->{untaint};
625 $untaint_pat = $wanted->{untaint_pattern};
626 $untaint_skip = $wanted->{untaint_skip};
627 $dangling_symlinks = $wanted->{dangling_symlinks};
81793b90 628
1cffc1dd 629 # for compatibility reasons (find.pl, find2perl)
9f826d6a 630 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
81793b90
GS
631
632 # a symbolic link to a directory doesn't increase the link count
633 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
3555aed3 634
e7b91b67 635 my ($abs_dir, $Is_Dir);
81793b90
GS
636
637 Proc_Top_Item:
4c621faf 638 foreach my $TOP (@_) {
7e47e6ff
JH
639 my $top_item = $TOP;
640
3555aed3
SP
641 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
642
a0b245d5
AD
643 if ($Is_Win32) {
644 $top_item =~ s|[/\\]\z||
645 unless $top_item =~ m{^(?:\w:)?[/\\]$};
7e47e6ff
JH
646 }
647 else {
648 $top_item =~ s|/\z|| unless $top_item eq '/';
7e47e6ff
JH
649 }
650
651 $Is_Dir= 0;
652
653 if ($follow) {
654
862f843b
NC
655 if (substr($top_item,0,1) eq '/') {
656 $abs_dir = $top_item;
7e47e6ff 657 }
862f843b
NC
658 elsif ($top_item eq $File::Find::current_dir) {
659 $abs_dir = $cwd;
660 }
661 else { # care about any ../
662 $top_item =~ s/\.dir\z//i if $Is_VMS;
663 $abs_dir = contract_name("$cwd/",$top_item);
7e47e6ff
JH
664 }
665 $abs_dir= Follow_SymLink($abs_dir);
666 unless (defined $abs_dir) {
80e52b73
JH
667 if ($dangling_symlinks) {
668 if (ref $dangling_symlinks eq 'CODE') {
669 $dangling_symlinks->($top_item, $cwd);
670 } else {
cd68ec93 671 warnings::warnif "$top_item is a dangling symbolic link\n";
80e52b73
JH
672 }
673 }
81793b90 674 next Proc_Top_Item;
7e47e6ff
JH
675 }
676
677 if (-d _) {
a1ccf0c4 678 $top_item =~ s/\.dir\z//i if $Is_VMS;
81793b90
GS
679 _find_dir_symlnk($wanted, $abs_dir, $top_item);
680 $Is_Dir= 1;
7e47e6ff
JH
681 }
682 }
81793b90 683 else { # no follow
7e47e6ff
JH
684 $topdir = $top_item;
685 unless (defined $topnlink) {
cd68ec93 686 warnings::warnif "Can't stat $top_item: $!\n";
7e47e6ff
JH
687 next Proc_Top_Item;
688 }
689 if (-d _) {
544ff7a7 690 $top_item =~ s/\.dir\z//i if $Is_VMS;
e7b91b67 691 _find_dir($wanted, $top_item, $topnlink);
81793b90 692 $Is_Dir= 1;
7e47e6ff 693 }
237437d0 694 else {
81793b90 695 $abs_dir= $top_item;
7e47e6ff
JH
696 }
697 }
81793b90 698
7e47e6ff 699 unless ($Is_Dir) {
81793b90 700 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
862f843b 701 ($dir,$_) = ('./', $top_item);
81793b90
GS
702 }
703
7e47e6ff
JH
704 $abs_dir = $dir;
705 if (( $untaint ) && (is_tainted($dir) )) {
706 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
81793b90
GS
707 unless (defined $abs_dir) {
708 if ($untaint_skip == 0) {
7e47e6ff 709 die "directory $dir is still tainted";
81793b90
GS
710 }
711 else {
712 next Proc_Top_Item;
713 }
714 }
7e47e6ff 715 }
81793b90 716
7e47e6ff 717 unless ($no_chdir || chdir $abs_dir) {
cd68ec93 718 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
7e47e6ff
JH
719 next Proc_Top_Item;
720 }
719911cc 721
7e47e6ff 722 $name = $abs_dir . $_; # $File::Find::name
3bb6d3e5 723 $_ = $name if $no_chdir;
719911cc 724
abfdd623 725 { $wanted_callback->() }; # protect against wild "next"
81793b90 726
7e47e6ff 727 }
81793b90 728
7e47e6ff
JH
729 unless ( $no_chdir ) {
730 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
731 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
732 unless (defined $cwd_untainted) {
733 die "insecure cwd in find(depth)";
734 }
735 $check_t_cwd = 0;
736 }
737 unless (chdir $cwd_untainted) {
738 die "Can't cd to $cwd: $!\n";
739 }
740 }
81793b90
GS
741 }
742}
743
744# API:
745# $wanted
746# $p_dir : "parent directory"
747# $nlink : what came back from the stat
748# preconditions:
749# chdir (if not no_chdir) to dir
750
751sub _find_dir($$$) {
752 my ($wanted, $p_dir, $nlink) = @_;
753 my ($CdLvl,$Level) = (0,0);
754 my @Stack;
755 my @filenames;
756 my ($subcount,$sub_nlink);
757 my $SE= [];
758 my $dir_name= $p_dir;
7e47e6ff 759 my $dir_pref;
39e79f6b 760 my $dir_rel = $File::Find::current_dir;
7e47e6ff 761 my $tainted = 0;
5fa2bf2b 762 my $no_nlink;
7e47e6ff 763
a0b245d5
AD
764 if ($Is_Win32) {
765 $dir_pref
766 = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
767 } elsif ($Is_VMS) {
a1ccf0c4
JM
768
769 # VMS is returning trailing .dir on directories
770 # and trailing . on files and symbolic links
771 # in UNIX syntax.
772 #
773
774 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
775
1e9c9d75 776 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
7e47e6ff
JH
777 }
778 else {
779 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
7e47e6ff 780 }
81793b90
GS
781
782 local ($dir, $name, $prune, *DIR);
7e47e6ff
JH
783
784 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
81793b90 785 my $udir = $p_dir;
7e47e6ff
JH
786 if (( $untaint ) && (is_tainted($p_dir) )) {
787 ( $udir ) = $p_dir =~ m|$untaint_pat|;
81793b90
GS
788 unless (defined $udir) {
789 if ($untaint_skip == 0) {
790 die "directory $p_dir is still tainted";
791 }
792 else {
793 return;
794 }
237437d0 795 }
a0d0e21e 796 }
8d8eebbf 797 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
cd68ec93 798 warnings::warnif "Can't cd to $udir: $!\n";
81793b90
GS
799 return;
800 }
801 }
7e47e6ff
JH
802
803 # push the starting directory
57e73c4b 804 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
81793b90
GS
805
806 while (defined $SE) {
807 unless ($bydepth) {
3555aed3
SP
808 $dir= $p_dir; # $File::Find::dir
809 $name= $dir_name; # $File::Find::name
7e47e6ff 810 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
81793b90 811 # prune may happen here
7e47e6ff 812 $prune= 0;
abfdd623 813 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 814 next if $prune;
81793b90 815 }
7e47e6ff 816
81793b90 817 # change to that directory
7e47e6ff 818 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
81793b90 819 my $udir= $dir_rel;
7e47e6ff
JH
820 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
821 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
81793b90
GS
822 unless (defined $udir) {
823 if ($untaint_skip == 0) {
862f843b 824 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
7e47e6ff 825 } else { # $untaint_skip == 1
3555aed3 826 next;
81793b90
GS
827 }
828 }
829 }
8d8eebbf 830 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
862f843b
NC
831 warnings::warnif "Can't cd to (" .
832 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
81793b90
GS
833 next;
834 }
835 $CdLvl++;
836 }
837
3555aed3 838 $dir= $dir_name; # $File::Find::dir
81793b90
GS
839
840 # Get the list of files in the current directory.
7e47e6ff 841 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
cd68ec93 842 warnings::warnif "Can't opendir($dir_name): $!\n";
81793b90
GS
843 next;
844 }
845 @filenames = readdir DIR;
846 closedir(DIR);
abfdd623 847 @filenames = $pre_process->(@filenames) if $pre_process;
719c805e 848 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
81793b90 849
5fa2bf2b
DD
850 # default: use whatever was specifid
851 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
852 $no_nlink = $avoid_nlink;
853 # if dir has wrong nlink count, force switch to slower stat method
854 $no_nlink = 1 if ($nlink < 2);
855
856 if ($nlink == 2 && !$no_nlink) {
81793b90
GS
857 # This dir has no subdirectories.
858 for my $FN (@filenames) {
a1ccf0c4
JM
859 if ($Is_VMS) {
860 # Big hammer here - Compensate for VMS trailing . and .dir
861 # No win situation until this is changed, but this
862 # will handle the majority of the cases with breaking the fewest
863
864 $FN =~ s/\.dir\z//i;
865 $FN =~ s#\.$## if ($FN ne '.');
866 }
7e47e6ff 867 next if $FN =~ $File::Find::skip_pattern;
81793b90 868
7e47e6ff
JH
869 $name = $dir_pref . $FN; # $File::Find::name
870 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 871 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
872 }
873
874 }
875 else {
876 # This dir has subdirectories.
877 $subcount = $nlink - 2;
878
7bd31527
JH
879 # HACK: insert directories at this position. so as to preserve
880 # the user pre-processed ordering of files.
881 # EG: directory traversal is in user sorted order, not at random.
882 my $stack_top = @Stack;
883
81793b90 884 for my $FN (@filenames) {
7e47e6ff 885 next if $FN =~ $File::Find::skip_pattern;
5fa2bf2b 886 if ($subcount > 0 || $no_nlink) {
81793b90
GS
887 # Seen all the subdirs?
888 # check for directoriness.
889 # stat is faster for a file in the current directory
07867069 890 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
81793b90
GS
891
892 if (-d _) {
893 --$subcount;
544ff7a7 894 $FN =~ s/\.dir\z//i if $Is_VMS;
7bd31527
JH
895 # HACK: replace push to preserve dir traversal order
896 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
897 splice @Stack, $stack_top, 0,
898 [$CdLvl,$dir_name,$FN,$sub_nlink];
81793b90
GS
899 }
900 else {
7e47e6ff
JH
901 $name = $dir_pref . $FN; # $File::Find::name
902 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 903 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
904 }
905 }
07867069 906 else {
7e47e6ff
JH
907 $name = $dir_pref . $FN; # $File::Find::name
908 $_= ($no_chdir ? $name : $FN); # $_
abfdd623 909 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
910 }
911 }
912 }
17b275ff
RA
913 }
914 continue {
57e73c4b 915 while ( defined ($SE = pop @Stack) ) {
81793b90
GS
916 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
917 if ($CdLvl > $Level && !$no_chdir) {
7e47e6ff 918 my $tmp;
862f843b 919 if ($Is_VMS) {
d8101854
CB
920 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
921 }
7e47e6ff
JH
922 else {
923 $tmp = join('/',('..') x ($CdLvl-$Level));
924 }
d8101854 925 die "Can't cd to $tmp from $dir_name"
7e47e6ff 926 unless chdir ($tmp);
81793b90
GS
927 $CdLvl = $Level;
928 }
7e47e6ff 929
862f843b 930 if ($^O eq 'MSWin32') {
68c65ec0 931 $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
3555aed3
SP
932 $dir_pref = "$dir_name/";
933 }
1e9c9d75
CB
934 elsif ($^O eq 'VMS') {
935 if ($p_dir =~ m/[\]>]+$/) {
936 $dir_name = $p_dir;
937 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
938 $dir_pref = $dir_name;
939 }
940 else {
941 $dir_name = "$p_dir/$dir_rel";
942 $dir_pref = "$dir_name/";
943 }
944 }
7e47e6ff
JH
945 else {
946 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
947 $dir_pref = "$dir_name/";
948 }
949
719c805e 950 if ( $nlink == -2 ) {
7e47e6ff 951 $name = $dir = $p_dir; # $File::Find::name / dir
39e79f6b 952 $_ = $File::Find::current_dir;
abfdd623 953 $post_process->(); # End-of-directory processing
7e47e6ff
JH
954 }
955 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
956 $name = $dir_name;
862f843b
NC
957 if ( substr($name,-2) eq '/.' ) {
958 substr($name, length($name) == 2 ? -1 : -2) = '';
7e47e6ff 959 }
862f843b
NC
960 $dir = $p_dir;
961 $_ = ($no_chdir ? $dir_name : $dir_rel );
962 if ( substr($_,-2) eq '/.' ) {
963 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff 964 }
abfdd623 965 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
966 }
967 else {
968 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
969 last;
970 }
81793b90 971 }
a0d0e21e
LW
972 }
973}
974
81793b90
GS
975
976# API:
977# $wanted
978# $dir_loc : absolute location of a dir
979# $p_dir : "parent directory"
980# preconditions:
981# chdir (if not no_chdir) to dir
982
983sub _find_dir_symlnk($$$) {
7e47e6ff 984 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
81793b90
GS
985 my @Stack;
986 my @filenames;
987 my $new_loc;
7e47e6ff 988 my $updir_loc = $dir_loc; # untainted parent directory
81793b90
GS
989 my $SE = [];
990 my $dir_name = $p_dir;
7e47e6ff
JH
991 my $dir_pref;
992 my $loc_pref;
39e79f6b 993 my $dir_rel = $File::Find::current_dir;
7e47e6ff
JH
994 my $byd_flag; # flag for pending stack entry if $bydepth
995 my $tainted = 0;
996 my $ok = 1;
997
862f843b
NC
998 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
999 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
81793b90
GS
1000
1001 local ($dir, $name, $fullname, $prune, *DIR);
7e47e6ff
JH
1002
1003 unless ($no_chdir) {
1004 # untaint the topdir
1005 if (( $untaint ) && (is_tainted($dir_loc) )) {
1006 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1007 # once untainted, $updir_loc is pushed on the stack (as parent directory);
3555aed3
SP
1008 # hence, we don't need to untaint the parent directory every time we chdir
1009 # to it later
7e47e6ff 1010 unless (defined $updir_loc) {
81793b90
GS
1011 if ($untaint_skip == 0) {
1012 die "directory $dir_loc is still tainted";
1013 }
1014 else {
1015 return;
1016 }
1017 }
1018 }
7e47e6ff
JH
1019 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1020 unless ($ok) {
cd68ec93 1021 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1022 return;
1023 }
1024 }
1025
7e47e6ff
JH
1026 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1027
81793b90
GS
1028 while (defined $SE) {
1029
1030 unless ($bydepth) {
7e47e6ff 1031 # change (back) to parent directory (always untainted)
704ea872 1032 unless ($no_chdir) {
7e47e6ff 1033 unless (chdir $updir_loc) {
cd68ec93 1034 warnings::warnif "Can't cd to $updir_loc: $!\n";
704ea872
GS
1035 next;
1036 }
1037 }
7e47e6ff
JH
1038 $dir= $p_dir; # $File::Find::dir
1039 $name= $dir_name; # $File::Find::name
1040 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1041 $fullname= $dir_loc; # $File::Find::fullname
81793b90 1042 # prune may happen here
7e47e6ff 1043 $prune= 0;
704ea872 1044 lstat($_); # make sure file tests with '_' work
abfdd623 1045 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff 1046 next if $prune;
81793b90
GS
1047 }
1048
1049 # change to that directory
7e47e6ff
JH
1050 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1051 $updir_loc = $dir_loc;
1052 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
3555aed3 1053 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
7e47e6ff
JH
1054 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1055 unless (defined $updir_loc) {
81793b90
GS
1056 if ($untaint_skip == 0) {
1057 die "directory $dir_loc is still tainted";
a0d0e21e 1058 }
237437d0 1059 else {
81793b90 1060 next;
237437d0 1061 }
a0d0e21e
LW
1062 }
1063 }
7e47e6ff 1064 unless (chdir $updir_loc) {
cd68ec93 1065 warnings::warnif "Can't cd to $updir_loc: $!\n";
81793b90
GS
1066 next;
1067 }
1068 }
1069
7e47e6ff 1070 $dir = $dir_name; # $File::Find::dir
81793b90
GS
1071
1072 # Get the list of files in the current directory.
7e47e6ff 1073 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
cd68ec93 1074 warnings::warnif "Can't opendir($dir_loc): $!\n";
81793b90
GS
1075 next;
1076 }
1077 @filenames = readdir DIR;
1078 closedir(DIR);
1079
1080 for my $FN (@filenames) {
a1ccf0c4
JM
1081 if ($Is_VMS) {
1082 # Big hammer here - Compensate for VMS trailing . and .dir
1083 # No win situation until this is changed, but this
1084 # will handle the majority of the cases with breaking the fewest.
1085
1086 $FN =~ s/\.dir\z//i;
1087 $FN =~ s#\.$## if ($FN ne '.');
1088 }
7e47e6ff 1089 next if $FN =~ $File::Find::skip_pattern;
81793b90
GS
1090
1091 # follow symbolic links / do an lstat
07867069 1092 $new_loc = Follow_SymLink($loc_pref.$FN);
81793b90
GS
1093
1094 # ignore if invalid symlink
3555aed3 1095 unless (defined $new_loc) {
fab43c1b 1096 if (!defined -l _ && $dangling_symlinks) {
615a2b9b
SP
1097 if (ref $dangling_symlinks eq 'CODE') {
1098 $dangling_symlinks->($FN, $dir_pref);
1099 } else {
1100 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1101 }
1102 }
1103
1104 $fullname = undef;
1105 $name = $dir_pref . $FN;
1106 $_ = ($no_chdir ? $name : $FN);
1107 { $wanted_callback->() };
1108 next;
1109 }
7e47e6ff 1110
81793b90 1111 if (-d _) {
a1ccf0c4
JM
1112 if ($Is_VMS) {
1113 $FN =~ s/\.dir\z//i;
1114 $FN =~ s#\.$## if ($FN ne '.');
1115 $new_loc =~ s/\.dir\z//i;
1116 $new_loc =~ s#\.$## if ($new_loc ne '.');
1117 }
7e47e6ff 1118 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
81793b90
GS
1119 }
1120 else {
3555aed3 1121 $fullname = $new_loc; # $File::Find::fullname
7e47e6ff
JH
1122 $name = $dir_pref . $FN; # $File::Find::name
1123 $_ = ($no_chdir ? $name : $FN); # $_
abfdd623 1124 { $wanted_callback->() }; # protect against wild "next"
81793b90
GS
1125 }
1126 }
1127
81793b90
GS
1128 }
1129 continue {
57e73c4b 1130 while (defined($SE = pop @Stack)) {
7e47e6ff 1131 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
862f843b
NC
1132 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1133 $dir_pref = "$dir_name/";
1134 $loc_pref = "$dir_loc/";
7e47e6ff
JH
1135 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1136 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
3555aed3 1137 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
cd68ec93 1138 warnings::warnif "Can't cd to $updir_loc: $!\n";
7e47e6ff
JH
1139 next;
1140 }
1141 }
1142 $fullname = $dir_loc; # $File::Find::fullname
1143 $name = $dir_name; # $File::Find::name
862f843b
NC
1144 if ( substr($name,-2) eq '/.' ) {
1145 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
7e47e6ff 1146 }
862f843b
NC
1147 $dir = $p_dir; # $File::Find::dir
1148 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1149 if ( substr($_,-2) eq '/.' ) {
1150 substr($_, length($_) == 2 ? -1 : -2) = '';
7e47e6ff
JH
1151 }
1152
1153 lstat($_); # make sure file tests with '_' work
abfdd623 1154 { $wanted_callback->() }; # protect against wild "next"
7e47e6ff
JH
1155 }
1156 else {
1157 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1158 last;
1159 }
a0d0e21e
LW
1160 }
1161 }
1162}
1163
81793b90 1164
20408e3c 1165sub wrap_wanted {
81793b90
GS
1166 my $wanted = shift;
1167 if ( ref($wanted) eq 'HASH' ) {
4c90698d
RB
1168 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1169 die 'no &wanted subroutine given';
1170 }
81793b90
GS
1171 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1172 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1173 }
1174 if ( $wanted->{untaint} ) {
3555aed3 1175 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
81793b90
GS
1176 unless defined $wanted->{untaint_pattern};
1177 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1178 }
1179 return $wanted;
1180 }
4c90698d 1181 elsif( ref( $wanted ) eq 'CODE' ) {
81793b90
GS
1182 return { wanted => $wanted };
1183 }
4c90698d
RB
1184 else {
1185 die 'no &wanted subroutine given';
1186 }
a0d0e21e
LW
1187}
1188
20408e3c 1189sub find {
81793b90
GS
1190 my $wanted = shift;
1191 _find_opt(wrap_wanted($wanted), @_);
a0d0e21e
LW
1192}
1193
55d729e4 1194sub finddepth {
81793b90
GS
1195 my $wanted = wrap_wanted(shift);
1196 $wanted->{bydepth} = 1;
1197 _find_opt($wanted, @_);
20408e3c 1198}
6280b799 1199
7e47e6ff
JH
1200# default
1201$File::Find::skip_pattern = qr/^\.{1,2}\z/;
1202$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
1203
6280b799 1204# These are hard-coded for now, but may move to hint files.
10eba763 1205if ($^O eq 'VMS') {
81793b90 1206 $Is_VMS = 1;
7e47e6ff
JH
1207 $File::Find::dont_use_nlink = 1;
1208}
748a9306 1209
7e47e6ff
JH
1210# this _should_ work properly on all platforms
1211# where File::Find can be expected to work
1212$File::Find::current_dir = File::Spec->curdir || '.';
1213
81793b90 1214$File::Find::dont_use_nlink = 1
497711e7 1215 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
0c52c6a9 1216 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1119cb72 1217 $^O eq 'nto';
6280b799 1218
20408e3c
GS
1219# Set dont_use_nlink in your hint file if your system's stat doesn't
1220# report the number of links in a directory as an indication
1221# of the number of files.
1222# See, e.g. hints/machten.sh for MachTen 2.2.
81793b90
GS
1223unless ($File::Find::dont_use_nlink) {
1224 require Config;
1225 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
20408e3c
GS
1226}
1227
3555aed3
SP
1228# We need a function that checks if a scalar is tainted. Either use the
1229# Scalar::Util module's tainted() function or our (slower) pure Perl
7e47e6ff
JH
1230# fallback is_tainted_pp()
1231{
1232 local $@;
1233 eval { require Scalar::Util };
1234 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1235}
1236
a0d0e21e 12371;