This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
gcc -Wall nits picked out by a non-UNIX system
[perl5.git] / lib / File / Find.pm
CommitLineData
a0d0e21e 1package File::Find;
b75c8c73 2use strict;
b395063c
BS
3use warnings;
4use 5.6.0;
b75c8c73 5our $VERSION = '1.00';
a0d0e21e 6require Exporter;
6280b799 7require Cwd;
a0d0e21e 8
f06db76b
AD
9=head1 NAME
10
11find - traverse a file tree
12
13finddepth - traverse a directory structure depth-first
14
15=head1 SYNOPSIS
16
17 use File::Find;
81793b90 18 find(\&wanted, '/foo', '/bar');
f06db76b 19 sub wanted { ... }
237437d0 20
f06db76b 21 use File::Find;
81793b90 22 finddepth(\&wanted, '/foo', '/bar');
f06db76b 23 sub wanted { ... }
3cb6de81 24
81793b90
GS
25 use File::Find;
26 find({ wanted => \&process, follow => 1 }, '.');
f06db76b
AD
27
28=head1 DESCRIPTION
29
20408e3c 30The first argument to find() is either a hash reference describing the
81793b90 31operations to be performed for each file, or a code reference.
20408e3c 32
81793b90
GS
33Here are the possible keys for the hash:
34
35=over 3
36
37=item C<wanted>
38
39The value should be a code reference. This code reference is called
40I<the wanted() function> below.
41
42=item C<bydepth>
43
44Reports the name of a directory only AFTER all its entries
45have been reported. Entry point finddepth() is a shortcut for
46specifying C<{ bydepth => 1 }> in the first argument of find().
47
719c805e
JS
48=item C<preprocess>
49
50The value should be a code reference. This code reference is used to
51preprocess a directory; it is called after readdir() but before the loop that
52calls the wanted() function. It is called with a list of strings and is
53expected to return a list of strings. The code can be used to sort the
54strings alphabetically, numerically, or to filter out directory entries based
55on their name alone.
56
57=item C<postprocess>
58
59The value should be a code reference. It is invoked just before leaving the
60current directory. It is called in void context with no arguments. The name
61of the current directory is in $File::Find::dir. This hook is handy for
62summarizing a directory, such as calculating its disk usage.
63
81793b90
GS
64=item C<follow>
65
66Causes symbolic links to be followed. Since directory trees with symbolic
67links (followed) may contain files more than once and may even have
68cycles, a hash has to be built up with an entry for each file.
69This might be expensive both in space and time for a large
70directory tree. See I<follow_fast> and I<follow_skip> below.
71If either I<follow> or I<follow_fast> is in effect:
72
73=over 6
74
a45bd81d 75=item *
81793b90 76
f10e1564 77It is guaranteed that an I<lstat> has been called before the user's
81793b90
GS
78I<wanted()> function is called. This enables fast file checks involving S< _>.
79
a45bd81d 80=item *
81793b90
GS
81
82There is a variable C<$File::Find::fullname> which holds the absolute
83pathname of the file with all symbolic links resolved
84
85=back
86
87=item C<follow_fast>
88
f10e1564
RM
89This is similar to I<follow> except that it may report some files more
90than once. It does detect cycles, however. Since only symbolic links
91have to be hashed, this is much cheaper both in space and time. If
92processing a file more than once (by the user's I<wanted()> function)
81793b90
GS
93is worse than just taking time, the option I<follow> should be used.
94
95=item C<follow_skip>
96
97C<follow_skip==1>, which is the default, causes all files which are
98neither directories nor symbolic links to be ignored if they are about
99to be processed a second time. If a directory or a symbolic link
100are about to be processed a second time, File::Find dies.
101C<follow_skip==0> causes File::Find to die if any file is about to be
102processed a second time.
103C<follow_skip==2> causes File::Find to ignore any duplicate files and
104dirctories but to proceed normally otherwise.
20408e3c 105
f06db76b 106
81793b90
GS
107=item C<no_chdir>
108
109Does not C<chdir()> to each directory as it recurses. The wanted()
110function will need to be aware of this, of course. In this case,
111C<$_> will be the same as C<$File::Find::name>.
112
113=item C<untaint>
114
115If find is used in taint-mode (-T command line switch or if EUID != UID
116or if EGID != GID) then internally directory names have to be untainted
117before they can be cd'ed to. Therefore they are checked against a regular
f10e1564 118expression I<untaint_pattern>. Note that all names passed to the
81793b90
GS
119user's I<wanted()> function are still tainted.
120
121=item C<untaint_pattern>
122
123See above. This should be set using the C<qr> quoting operator.
124The default is set to C<qr|^([-+@\w./]+)$|>.
ac06ab1d 125Note that the parantheses are vital.
81793b90
GS
126
127=item C<untaint_skip>
128
129If set, directories (subtrees) which fail the I<untaint_pattern>
130are skipped. The default is to 'die' in such a case.
131
132=back
133
134The wanted() function does whatever verifications you want.
135C<$File::Find::dir> contains the current directory name, and C<$_> the
136current filename within that directory. C<$File::Find::name> contains
f10e1564
RM
137the complete pathname to the file. You are chdir()'d to
138C<$File::Find::dir> when the function is called, unless C<no_chdir>
139was specified. When <follow> or <follow_fast> are in effect, there is
140also a C<$File::Find::fullname>. The function may set
141C<$File::Find::prune> to prune the tree unless C<bydepth> was
142specified. Unless C<follow> or C<follow_fast> is specified, for
143compatibility reasons (find.pl, find2perl) there are in addition the
144following globals available: C<$File::Find::topdir>,
145C<$File::Find::topdev>, C<$File::Find::topino>,
e7b91b67 146C<$File::Find::topmode> and C<$File::Find::topnlink>.
47a735e8 147
20408e3c 148This library is useful for the C<find2perl> tool, which when fed,
f06db76b
AD
149
150 find2perl / -name .nfs\* -mtime +7 \
81793b90 151 -exec rm -f {} \; -o -fstype nfs -prune
f06db76b
AD
152
153produces something like:
154
155 sub wanted {
c7b9dd21 156 /^\.nfs.*\z/s &&
81793b90 157 (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
f06db76b
AD
158 int(-M _) > 7 &&
159 unlink($_)
160 ||
81793b90 161 ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
f06db76b 162 $dev < 0 &&
6280b799 163 ($File::Find::prune = 1);
f06db76b
AD
164 }
165
81793b90 166Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
6280b799 167since AFS cheats.
f06db76b 168
f06db76b
AD
169
170Here's another interesting wanted function. It will find all symlinks
171that don't resolve:
172
173 sub wanted {
81793b90 174 -l && !-e && print "bogus link: $File::Find::name\n";
237437d0 175 }
f06db76b 176
81793b90
GS
177See also the script C<pfind> on CPAN for a nice application of this
178module.
179
180=head1 CAVEAT
181
f10e1564 182Be aware that the option to follow symbolic links can be dangerous.
81793b90
GS
183Depending on the structure of the directory tree (including symbolic
184links to directories) you might traverse a given (physical) directory
185more than once (only if C<follow_fast> is in effect).
186Furthermore, deleting or changing files in a symbolically linked directory
187might cause very unpleasant surprises, since you delete or change files
188in an unknown directory.
0530a6c4 189
0530a6c4 190
f06db76b
AD
191=cut
192
b75c8c73
MS
193our @ISA = qw(Exporter);
194our @EXPORT = qw(find finddepth);
6280b799 195
a0d0e21e 196
81793b90
GS
197use strict;
198my $Is_VMS;
199
200require File::Basename;
201
202my %SLnkSeen;
203my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
719c805e
JS
204 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
205 $pre_process, $post_process);
81793b90
GS
206
207sub contract_name {
208 my ($cdir,$fn) = @_;
209
210 return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.';
211
212 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
213
214 $fn =~ s|^\./||;
215
216 my $abs_name= $cdir . $fn;
217
218 if (substr($fn,0,3) eq '../') {
fecbda2b 219 1 while $abs_name =~ s!/[^/]*/\.\./!/!;
81793b90
GS
220 }
221
222 return $abs_name;
223}
224
225
226sub PathCombine($$) {
227 my ($Base,$Name) = @_;
228 my $AbsName;
229
230 if (substr($Name,0,1) eq '/') {
231 $AbsName= $Name;
232 }
233 else {
234 $AbsName= contract_name($Base,$Name);
235 }
236
237 # (simple) check for recursion
238 my $newlen= length($AbsName);
239 if ($newlen <= length($Base)) {
240 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
241 && $AbsName eq substr($Base,0,$newlen))
242 {
243 return undef;
244 }
245 }
246 return $AbsName;
247}
248
249sub Follow_SymLink($) {
250 my ($AbsName) = @_;
251
252 my ($NewName,$DEV, $INO);
253 ($DEV, $INO)= lstat $AbsName;
254
255 while (-l _) {
256 if ($SLnkSeen{$DEV, $INO}++) {
257 if ($follow_skip < 2) {
258 die "$AbsName is encountered a second time";
a0d0e21e
LW
259 }
260 else {
81793b90 261 return undef;
a0d0e21e
LW
262 }
263 }
81793b90
GS
264 $NewName= PathCombine($AbsName, readlink($AbsName));
265 unless(defined $NewName) {
266 if ($follow_skip < 2) {
267 die "$AbsName is a recursive symbolic link";
268 }
269 else {
270 return undef;
a0d0e21e 271 }
81793b90
GS
272 }
273 else {
274 $AbsName= $NewName;
275 }
276 ($DEV, $INO) = lstat($AbsName);
277 return undef unless defined $DEV; # dangling symbolic link
278 }
279
280 if ($full_check && $SLnkSeen{$DEV, $INO}++) {
281 if ($follow_skip < 1) {
282 die "$AbsName encountered a second time";
283 }
284 else {
285 return undef;
286 }
287 }
288
289 return $AbsName;
290}
291
17f410f9 292our($dir, $name, $fullname, $prune);
81793b90
GS
293sub _find_dir_symlnk($$$);
294sub _find_dir($$$);
295
296sub _find_opt {
297 my $wanted = shift;
298 die "invalid top directory" unless defined $_[0];
299
300 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
301 my $cwd_untainted = $cwd;
302 $wanted_callback = $wanted->{wanted};
303 $bydepth = $wanted->{bydepth};
719c805e
JS
304 $pre_process = $wanted->{preprocess};
305 $post_process = $wanted->{postprocess};
81793b90
GS
306 $no_chdir = $wanted->{no_chdir};
307 $full_check = $wanted->{follow};
308 $follow = $full_check || $wanted->{follow_fast};
309 $follow_skip = $wanted->{follow_skip};
310 $untaint = $wanted->{untaint};
311 $untaint_pat = $wanted->{untaint_pattern};
312 $untaint_skip = $wanted->{untaint_skip};
313
e7b91b67
GS
314 # for compatability reasons (find.pl, find2perl)
315 our ($topdir, $topdev, $topino, $topmode, $topnlink);
81793b90
GS
316
317 # a symbolic link to a directory doesn't increase the link count
318 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
319
320 if ( $untaint ) {
321 $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|;
322 die "insecure cwd in find(depth)" unless defined($cwd_untainted);
323 }
324
e7b91b67 325 my ($abs_dir, $Is_Dir);
81793b90
GS
326
327 Proc_Top_Item:
328 foreach my $TOP (@_) {
329 my $top_item = $TOP;
c7b9dd21 330 $top_item =~ s|/\z|| unless $top_item eq '/';
81793b90
GS
331 $Is_Dir= 0;
332
333 if ($follow) {
0c1c71f2 334 ($topdev,$topino,$topmode,$topnlink) = stat $top_item;
81793b90
GS
335 if (substr($top_item,0,1) eq '/') {
336 $abs_dir = $top_item;
337 }
338 elsif ($top_item eq '.') {
339 $abs_dir = $cwd;
237437d0 340 }
81793b90
GS
341 else { # care about any ../
342 $abs_dir = contract_name("$cwd/",$top_item);
343 }
344 $abs_dir= Follow_SymLink($abs_dir);
345 unless (defined $abs_dir) {
346 warn "$top_item is a dangling symbolic link\n";
347 next Proc_Top_Item;
348 }
349 if (-d _) {
350 _find_dir_symlnk($wanted, $abs_dir, $top_item);
351 $Is_Dir= 1;
352 }
353 }
354 else { # no follow
0c1c71f2 355 ($topdev,$topino,$topmode,$topnlink) = lstat $top_item;
e7b91b67 356 $topdir = $top_item;
e7b91b67 357 unless (defined $topnlink) {
81793b90
GS
358 warn "Can't stat $top_item: $!\n";
359 next Proc_Top_Item;
360 }
361 if (-d _) {
c7b9dd21 362 $top_item =~ s/\.dir\z// if $Is_VMS;
e7b91b67 363 _find_dir($wanted, $top_item, $topnlink);
81793b90
GS
364 $Is_Dir= 1;
365 }
237437d0 366 else {
81793b90
GS
367 $abs_dir= $top_item;
368 }
369 }
370
371 unless ($Is_Dir) {
372 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
719911cc 373 ($dir,$_) = ('./', $top_item);
81793b90
GS
374 }
375
376 $abs_dir = $dir;
377 if ($untaint) {
378 my $abs_dir_save = $abs_dir;
379 $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|;
380 unless (defined $abs_dir) {
381 if ($untaint_skip == 0) {
382 die "directory $abs_dir_save is still tainted";
383 }
384 else {
385 next Proc_Top_Item;
386 }
387 }
388 }
389
390 unless ($no_chdir or chdir $abs_dir) {
391 warn "Couldn't chdir $abs_dir: $!\n";
392 next Proc_Top_Item;
393 }
719911cc
GS
394
395 $name = $abs_dir . $_;
396
73396e07 397 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
398
399 }
400
401 $no_chdir or chdir $cwd_untainted;
402 }
403}
404
405# API:
406# $wanted
407# $p_dir : "parent directory"
408# $nlink : what came back from the stat
409# preconditions:
410# chdir (if not no_chdir) to dir
411
412sub _find_dir($$$) {
413 my ($wanted, $p_dir, $nlink) = @_;
414 my ($CdLvl,$Level) = (0,0);
415 my @Stack;
416 my @filenames;
417 my ($subcount,$sub_nlink);
418 my $SE= [];
419 my $dir_name= $p_dir;
07867069 420 my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
81793b90
GS
421 my $dir_rel= '.'; # directory name relative to current directory
422
423 local ($dir, $name, $prune, *DIR);
424
425 unless ($no_chdir or $p_dir eq '.') {
426 my $udir = $p_dir;
427 if ($untaint) {
428 $udir = $1 if $p_dir =~ m|$untaint_pat|;
429 unless (defined $udir) {
430 if ($untaint_skip == 0) {
431 die "directory $p_dir is still tainted";
432 }
433 else {
434 return;
435 }
237437d0 436 }
a0d0e21e 437 }
81793b90
GS
438 unless (chdir $udir) {
439 warn "Can't cd to $udir: $!\n";
440 return;
441 }
442 }
57e73c4b
GS
443
444 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
81793b90
GS
445
446 while (defined $SE) {
447 unless ($bydepth) {
448 $dir= $p_dir;
449 $name= $dir_name;
450 $_= ($no_chdir ? $dir_name : $dir_rel );
451 # prune may happen here
452 $prune= 0;
73396e07 453 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
454 next if $prune;
455 }
456
457 # change to that directory
458 unless ($no_chdir or $dir_rel eq '.') {
459 my $udir= $dir_rel;
460 if ($untaint) {
461 $udir = $1 if $dir_rel =~ m|$untaint_pat|;
462 unless (defined $udir) {
463 if ($untaint_skip == 0) {
07867069
HJ
464 die "directory ("
465 . ($p_dir ne '/' ? $p_dir : '')
466 . "/) $dir_rel is still tainted";
81793b90
GS
467 }
468 }
469 }
470 unless (chdir $udir) {
07867069
HJ
471 warn "Can't cd to ("
472 . ($p_dir ne '/' ? $p_dir : '')
473 . "/) $udir : $!\n";
81793b90
GS
474 next;
475 }
476 $CdLvl++;
477 }
478
479 $dir= $dir_name;
480
481 # Get the list of files in the current directory.
482 unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
483 warn "Can't opendir($dir_name): $!\n";
484 next;
485 }
486 @filenames = readdir DIR;
487 closedir(DIR);
719c805e
JS
488 @filenames = &$pre_process(@filenames) if $pre_process;
489 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
81793b90
GS
490
491 if ($nlink == 2 && !$avoid_nlink) {
492 # This dir has no subdirectories.
493 for my $FN (@filenames) {
c7b9dd21 494 next if $FN =~ /^\.{1,2}\z/;
81793b90 495
07867069 496 $name = $dir_pref . $FN;
81793b90 497 $_ = ($no_chdir ? $name : $FN);
73396e07 498 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
499 }
500
501 }
502 else {
503 # This dir has subdirectories.
504 $subcount = $nlink - 2;
505
506 for my $FN (@filenames) {
c7b9dd21 507 next if $FN =~ /^\.{1,2}\z/;
81793b90
GS
508 if ($subcount > 0 || $avoid_nlink) {
509 # Seen all the subdirs?
510 # check for directoriness.
511 # stat is faster for a file in the current directory
07867069 512 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
81793b90
GS
513
514 if (-d _) {
515 --$subcount;
c7b9dd21 516 $FN =~ s/\.dir\z// if $Is_VMS;
81793b90
GS
517 push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
518 }
519 else {
07867069 520 $name = $dir_pref . $FN;
81793b90 521 $_= ($no_chdir ? $name : $FN);
73396e07 522 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
523 }
524 }
07867069
HJ
525 else {
526 $name = $dir_pref . $FN;
81793b90 527 $_= ($no_chdir ? $name : $FN);
73396e07 528 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
529 }
530 }
531 }
17b275ff
RA
532 }
533 continue {
57e73c4b 534 while ( defined ($SE = pop @Stack) ) {
81793b90
GS
535 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
536 if ($CdLvl > $Level && !$no_chdir) {
f0963acb
GS
537 my $tmp = join('/',('..') x ($CdLvl-$Level));
538 die "Can't cd to $dir_name" . $tmp
539 unless chdir ($tmp);
81793b90
GS
540 $CdLvl = $Level;
541 }
07867069
HJ
542 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
543 $dir_pref = "$dir_name/";
719c805e
JS
544 if ( $nlink == -2 ) {
545 $name = $dir = $p_dir;
546 $_ = ".";
547 &$post_process; # End-of-directory processing
548 } elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
57e73c4b 549 $name = $dir_name;
57907763
GS
550 if ( substr($name,-2) eq '/.' ) {
551 $name =~ s|/\.$||;
552 }
57e73c4b
GS
553 $dir = $p_dir;
554 $_ = ($no_chdir ? $dir_name : $dir_rel );
57907763
GS
555 if ( substr($_,-2) eq '/.' ) {
556 s|/\.$||;
557 }
73396e07 558 { &$wanted_callback }; # protect against wild "next"
57e73c4b
GS
559 } else {
560 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
561 last;
562 }
81793b90 563 }
a0d0e21e
LW
564 }
565}
566
81793b90
GS
567
568# API:
569# $wanted
570# $dir_loc : absolute location of a dir
571# $p_dir : "parent directory"
572# preconditions:
573# chdir (if not no_chdir) to dir
574
575sub _find_dir_symlnk($$$) {
576 my ($wanted, $dir_loc, $p_dir) = @_;
577 my @Stack;
578 my @filenames;
579 my $new_loc;
57e73c4b 580 my $pdir_loc = $dir_loc;
81793b90
GS
581 my $SE = [];
582 my $dir_name = $p_dir;
07867069
HJ
583 my $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
584 my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
81793b90 585 my $dir_rel = '.'; # directory name relative to current directory
57e73c4b 586 my $byd_flag; # flag for pending stack entry if $bydepth
81793b90
GS
587
588 local ($dir, $name, $fullname, $prune, *DIR);
589
590 unless ($no_chdir or $p_dir eq '.') {
591 my $udir = $dir_loc;
592 if ($untaint) {
593 $udir = $1 if $dir_loc =~ m|$untaint_pat|;
594 unless (defined $udir) {
595 if ($untaint_skip == 0) {
596 die "directory $dir_loc is still tainted";
597 }
598 else {
599 return;
600 }
601 }
602 }
603 unless (chdir $udir) {
604 warn "Can't cd to $udir: $!\n";
605 return;
606 }
607 }
608
57e73c4b
GS
609 push @Stack,[$dir_loc,$pdir_loc,$p_dir,$dir_rel,-1] if $bydepth;
610
81793b90
GS
611 while (defined $SE) {
612
613 unless ($bydepth) {
704ea872
GS
614 # change to parent directory
615 unless ($no_chdir) {
616 my $udir = $pdir_loc;
617 if ($untaint) {
618 $udir = $1 if $pdir_loc =~ m|$untaint_pat|;
619 }
620 unless (chdir $udir) {
621 warn "Can't cd to $udir: $!\n";
622 next;
623 }
624 }
81793b90
GS
625 $dir= $p_dir;
626 $name= $dir_name;
627 $_= ($no_chdir ? $dir_name : $dir_rel );
628 $fullname= $dir_loc;
629 # prune may happen here
630 $prune= 0;
704ea872 631 lstat($_); # make sure file tests with '_' work
73396e07 632 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
633 next if $prune;
634 }
635
636 # change to that directory
637 unless ($no_chdir or $dir_rel eq '.') {
638 my $udir = $dir_loc;
639 if ($untaint) {
640 $udir = $1 if $dir_loc =~ m|$untaint_pat|;
641 unless (defined $udir ) {
642 if ($untaint_skip == 0) {
643 die "directory $dir_loc is still tainted";
a0d0e21e 644 }
237437d0 645 else {
81793b90 646 next;
237437d0 647 }
a0d0e21e
LW
648 }
649 }
81793b90
GS
650 unless (chdir $udir) {
651 warn "Can't cd to $udir: $!\n";
652 next;
653 }
654 }
655
656 $dir = $dir_name;
657
658 # Get the list of files in the current directory.
659 unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
660 warn "Can't opendir($dir_loc): $!\n";
661 next;
662 }
663 @filenames = readdir DIR;
664 closedir(DIR);
665
666 for my $FN (@filenames) {
c7b9dd21 667 next if $FN =~ /^\.{1,2}\z/;
81793b90
GS
668
669 # follow symbolic links / do an lstat
07867069 670 $new_loc = Follow_SymLink($loc_pref.$FN);
81793b90
GS
671
672 # ignore if invalid symlink
673 next unless defined $new_loc;
674
675 if (-d _) {
57e73c4b 676 push @Stack,[$new_loc,$dir_loc,$dir_name,$FN,1];
81793b90
GS
677 }
678 else {
679 $fullname = $new_loc;
07867069 680 $name = $dir_pref . $FN;
81793b90 681 $_ = ($no_chdir ? $name : $FN);
73396e07 682 { &$wanted_callback }; # protect against wild "next"
81793b90
GS
683 }
684 }
685
81793b90
GS
686 }
687 continue {
57e73c4b
GS
688 while (defined($SE = pop @Stack)) {
689 ($dir_loc, $pdir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
07867069
HJ
690 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
691 $dir_pref = "$dir_name/";
692 $loc_pref = "$dir_loc/";
57e73c4b
GS
693 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
694 unless ($no_chdir or $dir_rel eq '.') {
695 my $udir = $pdir_loc;
696 if ($untaint) {
697 $udir = $1 if $dir_loc =~ m|$untaint_pat|;
698 }
699 unless (chdir $udir) {
700 warn "Can't cd to $udir: $!\n";
701 next;
702 }
703 }
704 $fullname = $dir_loc;
705 $name = $dir_name;
57907763
GS
706 if ( substr($name,-2) eq '/.' ) {
707 $name =~ s|/\.$||;
708 }
57e73c4b
GS
709 $dir = $p_dir;
710 $_ = ($no_chdir ? $dir_name : $dir_rel);
57907763
GS
711 if ( substr($_,-2) eq '/.' ) {
712 s|/\.$||;
713 }
714
704ea872 715 lstat($_); # make sure file tests with '_' work
73396e07 716 { &$wanted_callback }; # protect against wild "next"
57e73c4b
GS
717 } else {
718 push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1] if $bydepth;
719 last;
720 }
a0d0e21e
LW
721 }
722 }
723}
724
81793b90 725
20408e3c 726sub wrap_wanted {
81793b90
GS
727 my $wanted = shift;
728 if ( ref($wanted) eq 'HASH' ) {
729 if ( $wanted->{follow} || $wanted->{follow_fast}) {
730 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
731 }
732 if ( $wanted->{untaint} ) {
733 $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|
734 unless defined $wanted->{untaint_pattern};
735 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
736 }
737 return $wanted;
738 }
739 else {
740 return { wanted => $wanted };
741 }
a0d0e21e
LW
742}
743
20408e3c 744sub find {
81793b90
GS
745 my $wanted = shift;
746 _find_opt(wrap_wanted($wanted), @_);
747 %SLnkSeen= (); # free memory
a0d0e21e
LW
748}
749
55d729e4 750sub finddepth {
81793b90
GS
751 my $wanted = wrap_wanted(shift);
752 $wanted->{bydepth} = 1;
753 _find_opt($wanted, @_);
754 %SLnkSeen= (); # free memory
20408e3c 755}
6280b799
PP
756
757# These are hard-coded for now, but may move to hint files.
10eba763 758if ($^O eq 'VMS') {
81793b90
GS
759 $Is_VMS = 1;
760 $File::Find::dont_use_nlink = 1;
748a9306
LW
761}
762
81793b90 763$File::Find::dont_use_nlink = 1
497711e7 764 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
fa6a1c44 765 $^O eq 'cygwin' || $^O eq 'epoc';
6280b799 766
20408e3c
GS
767# Set dont_use_nlink in your hint file if your system's stat doesn't
768# report the number of links in a directory as an indication
769# of the number of files.
770# See, e.g. hints/machten.sh for MachTen 2.2.
81793b90
GS
771unless ($File::Find::dont_use_nlink) {
772 require Config;
773 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
20408e3c
GS
774}
775
a0d0e21e 7761;