Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

Find.pm@ 3184

Visit:

Last change on this file since 3184 was 3181, checked in by bird, 19 years ago
perl 5.8.8
File size: 35.8 KB

Line
1	package File::Find;
2	use 5.006;
3	use strict;
4	use warnings;
5	use warnings::register;
6	our $VERSION = '1.10';
7	require Exporter;
8	require Cwd;
9
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
16	=head1 NAME
17
18	File::Find - Traverse a directory tree.
19
20	=head1 SYNOPSIS
21
22	use File::Find;
23	find(\&wanted, @directories_to_search);
24	sub wanted { ... }
25
26	use File::Find;
27	finddepth(\&wanted, @directories_to_search);
28	sub wanted { ... }
29
30	use File::Find;
31	find({ wanted => \&process, follow => 1 }, '.');
32
33	=head1 DESCRIPTION
34
35	These are functions for searching through directory trees doing work
36	on each file found similar to the Unix I<find> command. File::Find
37	exports two functions, C<find> and C<finddepth>. They work similarly
38	but have subtle differences.
39
40	=over 4
41
42	=item B<find>
43
44	find(\&wanted, @directories);
45	find(\%options, @directories);
46
47	C<find()> does a depth-first search over the given C<@directories> in
48	the order they are given. For each file or directory found, it calls
49	the C<&wanted> subroutine. (See below for details on how to use the
50	C<&wanted> function). Additionally, for each directory found, it will
51	C<chdir()> into that directory and continue the search, invoking the
52	C<&wanted> function on each file or subdirectory in the directory.
53
54	=item B<finddepth>
55
56	finddepth(\&wanted, @directories);
57	finddepth(\%options, @directories);
58
59	C<finddepth()> works just like C<find()> except that is invokes the
60	C<&wanted> function for a directory I<after> invoking it for the
61	directory's contents. It does a postorder traversal instead of a
62	preorder traversal, working from the bottom of the directory tree up
63	where C<find()> works from the top of the tree down.
64
65	=back
66
67	=head2 %options
68
69	The first argument to C<find()> is either a code reference to your
70	C<&wanted> function, or a hash reference describing the operations
71	to be performed for each file. The
72	code reference is described in L<The wanted function> below.
73
74	Here are the possible keys for the hash:
75
76	=over 3
77
78	=item C<wanted>
79
80	The value should be a code reference. This code reference is
81	described in L<The wanted function> below.
82
83	=item C<bydepth>
84
85	Reports the name of a directory only AFTER all its entries
86	have been reported. Entry point C<finddepth()> is a shortcut for
87	specifying C<<{ bydepth => 1 }>> in the first argument of C<find()>.
88
89	=item C<preprocess>
90
91	The value should be a code reference. This code reference is used to
92	preprocess the current directory. The name of the currently processed
93	directory is in C<$File::Find::dir>. Your preprocessing function is
94	called after C<readdir()>, but before the loop that calls the C<wanted()>
95	function. It is called with a list of strings (actually file/directory
96	names) and is expected to return a list of strings. The code can be
97	used to sort the file/directory names alphabetically, numerically,
98	or to filter out directory entries based on their name alone. When
99	I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
100
101	=item C<postprocess>
102
103	The value should be a code reference. It is invoked just before leaving
104	the currently processed directory. It is called in void context with no
105	arguments. The name of the current directory is in C<$File::Find::dir>. This
106	hook is handy for summarizing a directory, such as calculating its disk
107	usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
108	no-op.
109
110	=item C<follow>
111
112	Causes symbolic links to be followed. Since directory trees with symbolic
113	links (followed) may contain files more than once and may even have
114	cycles, a hash has to be built up with an entry for each file.
115	This might be expensive both in space and time for a large
116	directory tree. See I<follow_fast> and I<follow_skip> below.
117	If either I<follow> or I<follow_fast> is in effect:
118
119	=over 6
120
121	=item *
122
123	It is guaranteed that an I<lstat> has been called before the user's
124	C<wanted()> function is called. This enables fast file checks involving S<_>.
125	Note that this guarantee no longer holds if I<follow> or I<follow_fast>
126	are not set.
127
128	=item *
129
130	There is a variable C<$File::Find::fullname> which holds the absolute
131	pathname of the file with all symbolic links resolved. If the link is
132	a dangling symbolic link, then fullname will be set to C<undef>.
133
134	=back
135
136	This is a no-op on Win32.
137
138	=item C<follow_fast>
139
140	This is similar to I<follow> except that it may report some files more
141	than once. It does detect cycles, however. Since only symbolic links
142	have to be hashed, this is much cheaper both in space and time. If
143	processing a file more than once (by the user's C<wanted()> function)
144	is worse than just taking time, the option I<follow> should be used.
145
146	This is also a no-op on Win32.
147
148	=item C<follow_skip>
149
150	C<follow_skip==1>, which is the default, causes all files which are
151	neither directories nor symbolic links to be ignored if they are about
152	to be processed a second time. If a directory or a symbolic link
153	are about to be processed a second time, File::Find dies.
154
155	C<follow_skip==0> causes File::Find to die if any file is about to be
156	processed a second time.
157
158	C<follow_skip==2> causes File::Find to ignore any duplicate files and
159	directories but to proceed normally otherwise.
160
161	=item C<dangling_symlinks>
162
163	If true and a code reference, will be called with the symbolic link
164	name and the directory it lives in as arguments. Otherwise, if true
165	and warnings are on, warning "symbolic_link_name is a dangling
166	symbolic link\n" will be issued. If false, the dangling symbolic link
167	will be silently ignored.
168
169	=item C<no_chdir>
170
171	Does not C<chdir()> to each directory as it recurses. The C<wanted()>
172	function will need to be aware of this, of course. In this case,
173	C<$_> will be the same as C<$File::Find::name>.
174
175	=item C<untaint>
176
177	If find is used in taint-mode (-T command line switch or if EUID != UID
178	or if EGID != GID) then internally directory names have to be untainted
179	before they can be chdir'ed to. Therefore they are checked against a regular
180	expression I<untaint_pattern>. Note that all names passed to the user's
181	I<wanted()> function are still tainted. If this option is used while
182	not in taint-mode, C<untaint> is a no-op.
183
184	=item C<untaint_pattern>
185
186	See above. This should be set using the C<qr> quoting operator.
187	The default is set to C<qr\|^([-+@\w./]+)$\|>.
188	Note that the parentheses are vital.
189
190	=item C<untaint_skip>
191
192	If set, a directory which fails the I<untaint_pattern> is skipped,
193	including all its sub-directories. The default is to 'die' in such a case.
194
195	=back
196
197	=head2 The wanted function
198
199	The C<wanted()> function does whatever verifications you want on
200	each file and directory. Note that despite its name, the C<wanted()>
201	function is a generic callback function, and does B<not> tell
202	File::Find if a file is "wanted" or not. In fact, its return value
203	is ignored.
204
205	The wanted function takes no arguments but rather does its work
206	through a collection of variables.
207
208	=over 4
209
210	=item C<$File::Find::dir> is the current directory name,
211
212	=item C<$_> is the current filename within that directory
213
214	=item C<$File::Find::name> is the complete pathname to the file.
215
216	=back
217
218	Don't modify these variables.
219
220	For example, when examining the file F</some/path/foo.ext> you will have:
221
222	$File::Find::dir = /some/path/
223	$_ = foo.ext
224	$File::Find::name = /some/path/foo.ext
225
226	You are chdir()'d to C<$File::Find::dir> when the function is called,
227	unless C<no_chdir> was specified. Note that when changing to
228	directories is in effect the root directory (F</>) is a somewhat
229	special case inasmuch as the concatenation of C<$File::Find::dir>,
230	C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
231	table below summarizes all variants:
232
233	$File::Find::name $File::Find::dir $_
234	default / / .
235	no_chdir=>0 /etc / etc
236	/etc/x /etc x
237
238	no_chdir=>1 / / /
239	/etc / /etc
240	/etc/x /etc /etc/x
241
242
243	When <follow> or <follow_fast> are in effect, there is
244	also a C<$File::Find::fullname>. The function may set
245	C<$File::Find::prune> to prune the tree unless C<bydepth> was
246	specified. Unless C<follow> or C<follow_fast> is specified, for
247	compatibility reasons (find.pl, find2perl) there are in addition the
248	following globals available: C<$File::Find::topdir>,
249	C<$File::Find::topdev>, C<$File::Find::topino>,
250	C<$File::Find::topmode> and C<$File::Find::topnlink>.
251
252	This library is useful for the C<find2perl> tool, which when fed,
253
254	find2perl / -name .nfs\* -mtime +7 \
255	-exec rm -f {} \; -o -fstype nfs -prune
256
257	produces something like:
258
259	sub wanted {
260	/^\.nfs.*\z/s &&
261	(($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
262	int(-M _) > 7 &&
263	unlink($_)
264	\|\|
265	($nlink \|\| (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
266	$dev < 0 &&
267	($File::Find::prune = 1);
268	}
269
270	Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
271	filehandle that caches the information from the preceding
272	C<stat()>, C<lstat()>, or filetest.
273
274	Here's another interesting wanted function. It will find all symbolic
275	links that don't resolve:
276
277	sub wanted {
278	-l && !-e && print "bogus link: $File::Find::name\n";
279	}
280
281	See also the script C<pfind> on CPAN for a nice application of this
282	module.
283
284	=head1 WARNINGS
285
286	If you run your program with the C<-w> switch, or if you use the
287	C<warnings> pragma, File::Find will report warnings for several weird
288	situations. You can disable these warnings by putting the statement
289
290	no warnings 'File::Find';
291
292	in the appropriate scope. See L<perllexwarn> for more info about lexical
293	warnings.
294
295	=head1 CAVEAT
296
297	=over 2
298
299	=item $dont_use_nlink
300
301	You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
302	force File::Find to always stat directories. This was used for file systems
303	that do not have an C<nlink> count matching the number of sub-directories.
304	Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
305	system) and a couple of others.
306
307	You shouldn't need to set this variable, since File::Find should now detect
308	such file systems on-the-fly and switch itself to using stat. This works even
309	for parts of your file system, like a mounted CD-ROM.
310
311	If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
312
313	=item symlinks
314
315	Be aware that the option to follow symbolic links can be dangerous.
316	Depending on the structure of the directory tree (including symbolic
317	links to directories) you might traverse a given (physical) directory
318	more than once (only if C<follow_fast> is in effect).
319	Furthermore, deleting or changing files in a symbolically linked directory
320	might cause very unpleasant surprises, since you delete or change files
321	in an unknown directory.
322
323	=back
324
325	=head1 NOTES
326
327	=over 4
328
329	=item *
330
331	Mac OS (Classic) users should note a few differences:
332
333	=over 4
334
335	=item *
336
337	The path separator is ':', not '/', and the current directory is denoted
338	as ':', not '.'. You should be careful about specifying relative pathnames.
339	While a full path always begins with a volume name, a relative pathname
340	should always begin with a ':'. If specifying a volume name only, a
341	trailing ':' is required.
342
343	=item *
344
345	C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
346	contains the name of a directory, that name may or may not end with a
347	':'. Likewise, C<$File::Find::name>, which contains the complete
348	pathname to that directory, and C<$File::Find::fullname>, which holds
349	the absolute pathname of that directory with all symbolic links resolved,
350	may or may not end with a ':'.
351
352	=item *
353
354	The default C<untaint_pattern> (see above) on Mac OS is set to
355	C<qr\|^(.+)$\|>. Note that the parentheses are vital.
356
357	=item *
358
359	The invisible system file "Icon\015" is ignored. While this file may
360	appear in every directory, there are some more invisible system files
361	on every volume, which are all located at the volume root level (i.e.
362	"MacintoshHD:"). These system files are B<not> excluded automatically.
363	Your filter may use the following code to recognize invisible files or
364	directories (requires Mac::Files):
365
366	use Mac::Files;
367
368	# invisible() -- returns 1 if file/directory is invisible,
369	# 0 if it's visible or undef if an error occurred
370
371	sub invisible($) {
372	my $file = shift;
373	my ($fileCat, $fileInfo);
374	my $invisible_flag = 1 << 14;
375
376	if ( $fileCat = FSpGetCatInfo($file) ) {
377	if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
378	return (($fileInfo->fdFlags & $invisible_flag) && 1);
379	}
380	}
381	return undef;
382	}
383
384	Generally, invisible files are system files, unless an odd application
385	decides to use invisible files for its own purposes. To distinguish
386	such files from system files, you have to look at the B<type> and B<creator>
387	file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
388	C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
389	(see MacPerl.pm for details).
390
391	Files that appear on the desktop actually reside in an (hidden) directory
392	named "Desktop Folder" on the particular disk volume. Note that, although
393	all desktop files appear to be on the same "virtual" desktop, each disk
394	volume actually maintains its own "Desktop Folder" directory.
395
396	=back
397
398	=back
399
400	=head1 BUGS AND CAVEATS
401
402	Despite the name of the C<finddepth()> function, both C<find()> and
403	C<finddepth()> perform a depth-first search of the directory
404	hierarchy.
405
406	=head1 HISTORY
407
408	File::Find used to produce incorrect results if called recursively.
409	During the development of perl 5.8 this bug was fixed.
410	The first fixed version of File::Find was 1.01.
411
412	=cut
413
414	our @ISA = qw(Exporter);
415	our @EXPORT = qw(find finddepth);
416
417
418	use strict;
419	my $Is_VMS;
420	my $Is_MacOS;
421
422	require File::Basename;
423	require File::Spec;
424
425	# Should ideally be my() not our() but local() currently
426	# refuses to operate on lexicals
427
428	our %SLnkSeen;
429	our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
430	$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
431	$pre_process, $post_process, $dangling_symlinks);
432
433	sub contract_name {
434	my ($cdir,$fn) = @_;
435
436	return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
437
438	$cdir = substr($cdir,0,rindex($cdir,'/')+1);
439
440	$fn =~ s\|^\./\|\|;
441
442	my $abs_name= $cdir . $fn;
443
444	if (substr($fn,0,3) eq '../') {
445	1 while $abs_name =~ s!/[^/]*/\.\./!/!;
446	}
447
448	return $abs_name;
449	}
450
451	# return the absolute name of a directory or file
452	sub contract_name_Mac {
453	my ($cdir,$fn) = @_;
454	my $abs_name;
455
456	if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
457
458	my $colon_count = length ($1);
459	if ($colon_count == 1) {
460	$abs_name = $cdir . $2;
461	return $abs_name;
462	}
463	else {
464	# need to move up the tree, but
465	# only if it's not a volume name
466	for (my $i=1; $i<$colon_count; $i++) {
467	unless ($cdir =~ /^[^:]+:$/) { # volume name
468	$cdir =~ s/[^:]+:$//;
469	}
470	else {
471	return undef;
472	}
473	}
474	$abs_name = $cdir . $2;
475	return $abs_name;
476	}
477
478	}
479	else {
480
481	# $fn may be a valid path to a directory or file or (dangling)
482	# symlink, without a leading ':'
483	if ( (-e $fn) \|\| (-l $fn) ) {
484	if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
485	return $fn; # $fn is already an absolute path
486	}
487	else {
488	$abs_name = $cdir . $fn;
489	return $abs_name;
490	}
491	}
492	else { # argh!, $fn is not a valid directory/file
493	return undef;
494	}
495	}
496	}
497
498	sub PathCombine($$) {
499	my ($Base,$Name) = @_;
500	my $AbsName;
501
502	if ($Is_MacOS) {
503	# $Name is the resolved symlink (always a full path on MacOS),
504	# i.e. there's no need to call contract_name_Mac()
505	$AbsName = $Name;
506
507	# (simple) check for recursion
508	if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
509	return undef;
510	}
511	}
512	else {
513	if (substr($Name,0,1) eq '/') {
514	$AbsName= $Name;
515	}
516	else {
517	$AbsName= contract_name($Base,$Name);
518	}
519
520	# (simple) check for recursion
521	my $newlen= length($AbsName);
522	if ($newlen <= length($Base)) {
523	if (($newlen == length($Base) \|\| substr($Base,$newlen,1) eq '/')
524	&& $AbsName eq substr($Base,0,$newlen))
525	{
526	return undef;
527	}
528	}
529	}
530	return $AbsName;
531	}
532
533	sub Follow_SymLink($) {
534	my ($AbsName) = @_;
535
536	my ($NewName,$DEV, $INO);
537	($DEV, $INO)= lstat $AbsName;
538
539	while (-l _) {
540	if ($SLnkSeen{$DEV, $INO}++) {
541	if ($follow_skip < 2) {
542	die "$AbsName is encountered a second time";
543	}
544	else {
545	return undef;
546	}
547	}
548	$NewName= PathCombine($AbsName, readlink($AbsName));
549	unless(defined $NewName) {
550	if ($follow_skip < 2) {
551	die "$AbsName is a recursive symbolic link";
552	}
553	else {
554	return undef;
555	}
556	}
557	else {
558	$AbsName= $NewName;
559	}
560	($DEV, $INO) = lstat($AbsName);
561	return undef unless defined $DEV; # dangling symbolic link
562	}
563
564	if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
565	if ( ($follow_skip < 1) \|\| ((-d _) && ($follow_skip < 2)) ) {
566	die "$AbsName encountered a second time";
567	}
568	else {
569	return undef;
570	}
571	}
572
573	return $AbsName;
574	}
575
576	our($dir, $name, $fullname, $prune);
577	sub _find_dir_symlnk($$$);
578	sub _find_dir($$$);
579
580	# check whether or not a scalar variable is tainted
581	# (code straight from the Camel, 3rd ed., page 561)
582	sub is_tainted_pp {
583	my $arg = shift;
584	my $nada = substr($arg, 0, 0); # zero-length
585	local $@;
586	eval { eval "# $nada" };
587	return length($@) != 0;
588	}
589
590	sub _find_opt {
591	my $wanted = shift;
592	die "invalid top directory" unless defined $_[0];
593
594	# This function must local()ize everything because callbacks may
595	# call find() or finddepth()
596
597	local %SLnkSeen;
598	local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
599	$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
600	$pre_process, $post_process, $dangling_symlinks);
601	local($dir, $name, $fullname, $prune);
602	local *_ = \my $a;
603
604	my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
605	my $cwd_untainted = $cwd;
606	my $check_t_cwd = 1;
607	$wanted_callback = $wanted->{wanted};
608	$bydepth = $wanted->{bydepth};
609	$pre_process = $wanted->{preprocess};
610	$post_process = $wanted->{postprocess};
611	$no_chdir = $wanted->{no_chdir};
612	$full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
613	$follow = $^O eq 'MSWin32' ? 0 :
614	$full_check \|\| $wanted->{follow_fast};
615	$follow_skip = $wanted->{follow_skip};
616	$untaint = $wanted->{untaint};
617	$untaint_pat = $wanted->{untaint_pattern};
618	$untaint_skip = $wanted->{untaint_skip};
619	$dangling_symlinks = $wanted->{dangling_symlinks};
620
621	# for compatibility reasons (find.pl, find2perl)
622	local our ($topdir, $topdev, $topino, $topmode, $topnlink);
623
624	# a symbolic link to a directory doesn't increase the link count
625	$avoid_nlink = $follow \|\| $File::Find::dont_use_nlink;
626
627	my ($abs_dir, $Is_Dir);
628
629	Proc_Top_Item:
630	foreach my $TOP (@_) {
631	my $top_item = $TOP;
632
633	($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
634
635	if ($Is_MacOS) {
636	$top_item = ":$top_item"
637	if ( (-d _) && ( $top_item !~ /:/ ) );
638	} elsif ($^O eq 'MSWin32') {
639	$top_item =~ s\|/\z\|\| unless $top_item =~ m\|\w:/$\|;
640	}
641	else {
642	$top_item =~ s\|/\z\|\| unless $top_item eq '/';
643	}
644
645	$Is_Dir= 0;
646
647	if ($follow) {
648
649	if ($Is_MacOS) {
650	$cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
651
652	if ($top_item eq $File::Find::current_dir) {
653	$abs_dir = $cwd;
654	}
655	else {
656	$abs_dir = contract_name_Mac($cwd, $top_item);
657	unless (defined $abs_dir) {
658	warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
659	next Proc_Top_Item;
660	}
661	}
662
663	}
664	else {
665	if (substr($top_item,0,1) eq '/') {
666	$abs_dir = $top_item;
667	}
668	elsif ($top_item eq $File::Find::current_dir) {
669	$abs_dir = $cwd;
670	}
671	else { # care about any ../
672	$abs_dir = contract_name("$cwd/",$top_item);
673	}
674	}
675	$abs_dir= Follow_SymLink($abs_dir);
676	unless (defined $abs_dir) {
677	if ($dangling_symlinks) {
678	if (ref $dangling_symlinks eq 'CODE') {
679	$dangling_symlinks->($top_item, $cwd);
680	} else {
681	warnings::warnif "$top_item is a dangling symbolic link\n";
682	}
683	}
684	next Proc_Top_Item;
685	}
686
687	if (-d _) {
688	_find_dir_symlnk($wanted, $abs_dir, $top_item);
689	$Is_Dir= 1;
690	}
691	}
692	else { # no follow
693	$topdir = $top_item;
694	unless (defined $topnlink) {
695	warnings::warnif "Can't stat $top_item: $!\n";
696	next Proc_Top_Item;
697	}
698	if (-d _) {
699	$top_item =~ s/\.dir\z//i if $Is_VMS;
700	_find_dir($wanted, $top_item, $topnlink);
701	$Is_Dir= 1;
702	}
703	else {
704	$abs_dir= $top_item;
705	}
706	}
707
708	unless ($Is_Dir) {
709	unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
710	if ($Is_MacOS) {
711	($dir,$_) = (':', $top_item); # $File::Find::dir, $_
712	}
713	else {
714	($dir,$_) = ('./', $top_item);
715	}
716	}
717
718	$abs_dir = $dir;
719	if (( $untaint ) && (is_tainted($dir) )) {
720	( $abs_dir ) = $dir =~ m\|$untaint_pat\|;
721	unless (defined $abs_dir) {
722	if ($untaint_skip == 0) {
723	die "directory $dir is still tainted";
724	}
725	else {
726	next Proc_Top_Item;
727	}
728	}
729	}
730
731	unless ($no_chdir \|\| chdir $abs_dir) {
732	warnings::warnif "Couldn't chdir $abs_dir: $!\n";
733	next Proc_Top_Item;
734	}
735
736	$name = $abs_dir . $_; # $File::Find::name
737	$_ = $name if $no_chdir;
738
739	{ $wanted_callback->() }; # protect against wild "next"
740
741	}
742
743	unless ( $no_chdir ) {
744	if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
745	( $cwd_untainted ) = $cwd =~ m\|$untaint_pat\|;
746	unless (defined $cwd_untainted) {
747	die "insecure cwd in find(depth)";
748	}
749	$check_t_cwd = 0;
750	}
751	unless (chdir $cwd_untainted) {
752	die "Can't cd to $cwd: $!\n";
753	}
754	}
755	}
756	}
757
758	# API:
759	# $wanted
760	# $p_dir : "parent directory"
761	# $nlink : what came back from the stat
762	# preconditions:
763	# chdir (if not no_chdir) to dir
764
765	sub _find_dir($$$) {
766	my ($wanted, $p_dir, $nlink) = @_;
767	my ($CdLvl,$Level) = (0,0);
768	my @Stack;
769	my @filenames;
770	my ($subcount,$sub_nlink);
771	my $SE= [];
772	my $dir_name= $p_dir;
773	my $dir_pref;
774	my $dir_rel = $File::Find::current_dir;
775	my $tainted = 0;
776	my $no_nlink;
777
778	if ($Is_MacOS) {
779	$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
780	} elsif ($^O eq 'MSWin32') {
781	$dir_pref = ($p_dir =~ m\|\w:/$\| ? $p_dir : "$p_dir/" );
782	}
783	else {
784	$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
785	}
786
787	local ($dir, $name, $prune, *DIR);
788
789	unless ( $no_chdir \|\| ($p_dir eq $File::Find::current_dir)) {
790	my $udir = $p_dir;
791	if (( $untaint ) && (is_tainted($p_dir) )) {
792	( $udir ) = $p_dir =~ m\|$untaint_pat\|;
793	unless (defined $udir) {
794	if ($untaint_skip == 0) {
795	die "directory $p_dir is still tainted";
796	}
797	else {
798	return;
799	}
800	}
801	}
802	unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
803	warnings::warnif "Can't cd to $udir: $!\n";
804	return;
805	}
806	}
807
808	# push the starting directory
809	push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
810
811	if ($Is_MacOS) {
812	$p_dir = $dir_pref; # ensure trailing ':'
813	}
814
815	while (defined $SE) {
816	unless ($bydepth) {
817	$dir= $p_dir; # $File::Find::dir
818	$name= $dir_name; # $File::Find::name
819	$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
820	# prune may happen here
821	$prune= 0;
822	{ $wanted_callback->() }; # protect against wild "next"
823	next if $prune;
824	}
825
826	# change to that directory
827	unless ($no_chdir \|\| ($dir_rel eq $File::Find::current_dir)) {
828	my $udir= $dir_rel;
829	if ( ($untaint) && (($tainted) \|\| ($tainted = is_tainted($dir_rel) )) ) {
830	( $udir ) = $dir_rel =~ m\|$untaint_pat\|;
831	unless (defined $udir) {
832	if ($untaint_skip == 0) {
833	if ($Is_MacOS) {
834	die "directory ($p_dir) $dir_rel is still tainted";
835	}
836	else {
837	die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
838	}
839	} else { # $untaint_skip == 1
840	next;
841	}
842	}
843	}
844	unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
845	if ($Is_MacOS) {
846	warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
847	}
848	else {
849	warnings::warnif "Can't cd to (" .
850	($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
851	}
852	next;
853	}
854	$CdLvl++;
855	}
856
857	if ($Is_MacOS) {
858	$dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
859	}
860
861	$dir= $dir_name; # $File::Find::dir
862
863	# Get the list of files in the current directory.
864	unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
865	warnings::warnif "Can't opendir($dir_name): $!\n";
866	next;
867	}
868	@filenames = readdir DIR;
869	closedir(DIR);
870	@filenames = $pre_process->(@filenames) if $pre_process;
871	push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
872
873	# default: use whatever was specifid
874	# (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
875	$no_nlink = $avoid_nlink;
876	# if dir has wrong nlink count, force switch to slower stat method
877	$no_nlink = 1 if ($nlink < 2);
878
879	if ($nlink == 2 && !$no_nlink) {
880	# This dir has no subdirectories.
881	for my $FN (@filenames) {
882	next if $FN =~ $File::Find::skip_pattern;
883
884	$name = $dir_pref . $FN; # $File::Find::name
885	$_ = ($no_chdir ? $name : $FN); # $_
886	{ $wanted_callback->() }; # protect against wild "next"
887	}
888
889	}
890	else {
891	# This dir has subdirectories.
892	$subcount = $nlink - 2;
893
894	# HACK: insert directories at this position. so as to preserve
895	# the user pre-processed ordering of files.
896	# EG: directory traversal is in user sorted order, not at random.
897	my $stack_top = @Stack;
898
899	for my $FN (@filenames) {
900	next if $FN =~ $File::Find::skip_pattern;
901	if ($subcount > 0 \|\| $no_nlink) {
902	# Seen all the subdirs?
903	# check for directoriness.
904	# stat is faster for a file in the current directory
905	$sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
906
907	if (-d _) {
908	--$subcount;
909	$FN =~ s/\.dir\z//i if $Is_VMS;
910	# HACK: replace push to preserve dir traversal order
911	#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
912	splice @Stack, $stack_top, 0,
913	[$CdLvl,$dir_name,$FN,$sub_nlink];
914	}
915	else {
916	$name = $dir_pref . $FN; # $File::Find::name
917	$_= ($no_chdir ? $name : $FN); # $_
918	{ $wanted_callback->() }; # protect against wild "next"
919	}
920	}
921	else {
922	$name = $dir_pref . $FN; # $File::Find::name
923	$_= ($no_chdir ? $name : $FN); # $_
924	{ $wanted_callback->() }; # protect against wild "next"
925	}
926	}
927	}
928	}
929	continue {
930	while ( defined ($SE = pop @Stack) ) {
931	($Level, $p_dir, $dir_rel, $nlink) = @$SE;
932	if ($CdLvl > $Level && !$no_chdir) {
933	my $tmp;
934	if ($Is_MacOS) {
935	$tmp = (':' x ($CdLvl-$Level)) . ':';
936	}
937	else {
938	$tmp = join('/',('..') x ($CdLvl-$Level));
939	}
940	die "Can't cd to $dir_name" . $tmp
941	unless chdir ($tmp);
942	$CdLvl = $Level;
943	}
944
945	if ($Is_MacOS) {
946	# $pdir always has a trailing ':', except for the starting dir,
947	# where $dir_rel eq ':'
948	$dir_name = "$p_dir$dir_rel";
949	$dir_pref = "$dir_name:";
950	}
951	elsif ($^O eq 'MSWin32') {
952	$dir_name = ($p_dir =~ m\|\w:/$\| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
953	$dir_pref = "$dir_name/";
954	}
955	else {
956	$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
957	$dir_pref = "$dir_name/";
958	}
959
960	if ( $nlink == -2 ) {
961	$name = $dir = $p_dir; # $File::Find::name / dir
962	$_ = $File::Find::current_dir;
963	$post_process->(); # End-of-directory processing
964	}
965	elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
966	$name = $dir_name;
967	if ($Is_MacOS) {
968	if ($dir_rel eq ':') { # must be the top dir, where we started
969	$name =~ s\|:$\|\|; # $File::Find::name
970	$p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
971	}
972	$dir = $p_dir; # $File::Find::dir
973	$_ = ($no_chdir ? $name : $dir_rel); # $_
974	}
975	else {
976	if ( substr($name,-2) eq '/.' ) {
977	substr($name, length($name) == 2 ? -1 : -2) = '';
978	}
979	$dir = $p_dir;
980	$_ = ($no_chdir ? $dir_name : $dir_rel );
981	if ( substr($_,-2) eq '/.' ) {