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