Profile of File/Find.pm

Filename	/usr/share/perl/5.20/File/Find.pm
Statements	Executed 0 statements in 30.1ms

Line	State ments	Time on line	Code
1			package File::Find;
2			use 5.006;
3			use strict;
4			use warnings;
5			use warnings::register;
6			our $VERSION = '1.27';
7			require Exporter;
8			require Cwd;
9
10			#
11			# Modified to ensure sub-directory traversal order is not inverted 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 it 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. The C<&wanted> subroutine is
82			mandatory.
83
84			=item C<bydepth>
85
86			Reports the name of a directory only AFTER all its entries
87			have been reported. Entry point C<finddepth()> is a shortcut for
88			specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
89
90			=item C<preprocess>
91
92			The value should be a code reference. This code reference is used to
93			preprocess the current directory. The name of the currently processed
94			directory is in C<$File::Find::dir>. Your preprocessing function is
95			called after C<readdir()>, but before the loop that calls the C<wanted()>
96			function. It is called with a list of strings (actually file/directory
97			names) and is expected to return a list of strings. The code can be
98			used to sort the file/directory names alphabetically, numerically,
99			or to filter out directory entries based on their name alone. When
100			I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
101
102			=item C<postprocess>
103
104			The value should be a code reference. It is invoked just before leaving
105			the currently processed directory. It is called in void context with no
106			arguments. The name of the current directory is in C<$File::Find::dir>. This
107			hook is handy for summarizing a directory, such as calculating its disk
108			usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
109			no-op.
110
111			=item C<follow>
112
113			Causes symbolic links to be followed. Since directory trees with symbolic
114			links (followed) may contain files more than once and may even have
115			cycles, a hash has to be built up with an entry for each file.
116			This might be expensive both in space and time for a large
117			directory tree. See L</follow_fast> and L</follow_skip> below.
118			If either I<follow> or I<follow_fast> is in effect:
119
120			=over 6
121
122			=item *
123
124			It is guaranteed that an I<lstat> has been called before the user's
125			C<wanted()> function is called. This enables fast file checks involving S<_>.
126			Note that this guarantee no longer holds if I<follow> or I<follow_fast>
127			are not set.
128
129			=item *
130
131			There is a variable C<$File::Find::fullname> which holds the absolute
132			pathname of the file with all symbolic links resolved. If the link is
133			a dangling symbolic link, then fullname will be set to C<undef>.
134
135			=back
136
137			This is a no-op on Win32.
138
139			=item C<follow_fast>
140
141			This is similar to I<follow> except that it may report some files more
142			than once. It does detect cycles, however. Since only symbolic links
143			have to be hashed, this is much cheaper both in space and time. If
144			processing a file more than once (by the user's C<wanted()> function)
145			is worse than just taking time, the option I<follow> should be used.
146
147			This is also a no-op on Win32.
148
149			=item C<follow_skip>
150
151			C<follow_skip==1>, which is the default, causes all files which are
152			neither directories nor symbolic links to be ignored if they are about
153			to be processed a second time. If a directory or a symbolic link
154			are about to be processed a second time, File::Find dies.
155
156			C<follow_skip==0> causes File::Find to die if any file is about to be
157			processed a second time.
158
159			C<follow_skip==2> causes File::Find to ignore any duplicate files and
160			directories but to proceed normally otherwise.
161
162			=item C<dangling_symlinks>
163
164			If true and a code reference, will be called with the symbolic link
165			name and the directory it lives in as arguments. Otherwise, if true
166			and warnings are on, warning "symbolic_link_name is a dangling
167			symbolic link\n" will be issued. If false, the dangling symbolic link
168			will be silently ignored.
169
170			=item C<no_chdir>
171
172			Does not C<chdir()> to each directory as it recurses. The C<wanted()>
173			function will need to be aware of this, of course. In this case,
174			C<$_> will be the same as C<$File::Find::name>.
175
176			=item C<untaint>
177
178			If find is used in taint-mode (-T command line switch or if EUID != UID
179			or if EGID != GID) then internally directory names have to be untainted
180			before they can be chdir'ed to. Therefore they are checked against a regular
181			expression I<untaint_pattern>. Note that all names passed to the user's
182			I<wanted()> function are still tainted. If this option is used while
183			not in taint-mode, C<untaint> is a no-op.
184
185			=item C<untaint_pattern>
186
187			See above. This should be set using the C<qr> quoting operator.
188			The default is set to C<qr\|^([-+@\w./]+)$\|>.
189			Note that the parentheses are vital.
190
191			=item C<untaint_skip>
192
193			If set, a directory which fails the I<untaint_pattern> is skipped,
194			including all its sub-directories. The default is to 'die' in such a case.
195
196			=back
197
198			=head2 The wanted function
199
200			The C<wanted()> function does whatever verifications you want on
201			each file and directory. Note that despite its name, the C<wanted()>
202			function is a generic callback function, and does B<not> tell
203			File::Find if a file is "wanted" or not. In fact, its return value
204			is ignored.
205
206			The wanted function takes no arguments but rather does its work
207			through a collection of variables.
208
209			=over 4
210
211			=item C<$File::Find::dir> is the current directory name,
212
213			=item C<$_> is the current filename within that directory
214
215			=item C<$File::Find::name> is the complete pathname to the file.
216
217			=back
218
219			The above variables have all been localized and may be changed without
220			affecting data outside of the wanted function.
221
222			For example, when examining the file F</some/path/foo.ext> you will have:
223
224			$File::Find::dir = /some/path/
225			$_ = foo.ext
226			$File::Find::name = /some/path/foo.ext
227
228			You are chdir()'d to C<$File::Find::dir> when the function is called,
229			unless C<no_chdir> was specified. Note that when changing to
230			directories is in effect the root directory (F</>) is a somewhat
231			special case inasmuch as the concatenation of C<$File::Find::dir>,
232			C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
233			table below summarizes all variants:
234
235			$File::Find::name $File::Find::dir $_
236			default / / .
237			no_chdir=>0 /etc / etc
238			/etc/x /etc x
239
240			no_chdir=>1 / / /
241			/etc / /etc
242			/etc/x /etc /etc/x
243
244
245			When C<follow> or C<follow_fast> are in effect, there is
246			also a C<$File::Find::fullname>. The function may set
247			C<$File::Find::prune> to prune the tree unless C<bydepth> was
248			specified. Unless C<follow> or C<follow_fast> is specified, for
249			compatibility reasons (find.pl, find2perl) there are in addition the
250			following globals available: C<$File::Find::topdir>,
251			C<$File::Find::topdev>, C<$File::Find::topino>,
252			C<$File::Find::topmode> and C<$File::Find::topnlink>.
253
254			This library is useful for the C<find2perl> tool, which when fed,
255
256			find2perl / -name .nfs\* -mtime +7 \
257			-exec rm -f {} \; -o -fstype nfs -prune
258
259			produces something like:
260
261			sub wanted {
262			/^\.nfs.*\z/s &&
263			(($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) &&
264			int(-M _) > 7 &&
265			unlink($_)
266			\|\|
267			($nlink \|\| (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) &&
268			$dev < 0 &&
269			($File::Find::prune = 1);
270			}
271
272			Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
273			filehandle that caches the information from the preceding
274			C<stat()>, C<lstat()>, or filetest.
275
276			Here's another interesting wanted function. It will find all symbolic
277			links that don't resolve:
278
279			sub wanted {
280			-l && !-e && print "bogus link: $File::Find::name\n";
281			}
282
283			Note that you may mix directories and (non-directory) files in the list of
284			directories to be searched by the C<wanted()> function.
285
286			find(\&wanted, "./foo", "./bar", "./baz/epsilon");
287
288			In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
289			evaluated by C<wanted()>.
290
291			See also the script C<pfind> on CPAN for a nice application of this
292			module.
293
294			=head1 WARNINGS
295
296			If you run your program with the C<-w> switch, or if you use the
297			C<warnings> pragma, File::Find will report warnings for several weird
298			situations. You can disable these warnings by putting the statement
299
300			no warnings 'File::Find';
301
302			in the appropriate scope. See L<warnings> for more info about lexical
303			warnings.
304
305			=head1 CAVEAT
306
307			=over 2
308
309			=item $dont_use_nlink
310
311			You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
312			force File::Find to always stat directories. This was used for file systems
313			that do not have an C<nlink> count matching the number of sub-directories.
314			Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
315			system) and a couple of others.
316
317			You shouldn't need to set this variable, since File::Find should now detect
318			such file systems on-the-fly and switch itself to using stat. This works even
319			for parts of your file system, like a mounted CD-ROM.
320
321			If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
322
323			=item symlinks
324
325			Be aware that the option to follow symbolic links can be dangerous.
326			Depending on the structure of the directory tree (including symbolic
327			links to directories) you might traverse a given (physical) directory
328			more than once (only if C<follow_fast> is in effect).
329			Furthermore, deleting or changing files in a symbolically linked directory
330			might cause very unpleasant surprises, since you delete or change files
331			in an unknown directory.
332
333			=back
334
335			=head1 BUGS AND CAVEATS
336
337			Despite the name of the C<finddepth()> function, both C<find()> and
338			C<finddepth()> perform a depth-first search of the directory
339			hierarchy.
340
341			=head1 HISTORY
342
343			File::Find used to produce incorrect results if called recursively.
344			During the development of perl 5.8 this bug was fixed.
345			The first fixed version of File::Find was 1.01.
346
347			=head1 SEE ALSO
348
349			find, find2perl.
350
351			=cut
352
353			our @ISA = qw(Exporter);
354			our @EXPORT = qw(find finddepth);
355
356
357			use strict;
358			my $Is_VMS;
359			my $Is_Win32;
360
361			require File::Basename;
362			require File::Spec;
363
364			# Should ideally be my() not our() but local() currently
365			# refuses to operate on lexicals
366
367			our %SLnkSeen;
368			our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
369			$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
370			$pre_process, $post_process, $dangling_symlinks);
371
372			sub contract_name {
373			my ($cdir,$fn) = @_;
374
375			return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
376
377			$cdir = substr($cdir,0,rindex($cdir,'/')+1);
378
379			$fn =~ s\|^\./\|\|;
380
381			my $abs_name= $cdir . $fn;
382
383			if (substr($fn,0,3) eq '../') {
384			1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
385			}
386
387			return $abs_name;
388			}
389
390			sub PathCombine($$) {
391			my ($Base,$Name) = @_;
392			my $AbsName;
393
394			if (substr($Name,0,1) eq '/') {
395			$AbsName= $Name;
396			}
397			else {
398			$AbsName= contract_name($Base,$Name);
399			}
400
401			# (simple) check for recursion
402			my $newlen= length($AbsName);
403			if ($newlen <= length($Base)) {
404			if (($newlen == length($Base) \|\| substr($Base,$newlen,1) eq '/')
405			&& $AbsName eq substr($Base,0,$newlen))
406			{
407			return undef;
408			}
409			}
410			return $AbsName;
411			}
412
413			sub Follow_SymLink($) {
414			my ($AbsName) = @_;
415
416			my ($NewName,$DEV, $INO);
417			($DEV, $INO)= lstat $AbsName;
418
419			while (-l _) {
420			if ($SLnkSeen{$DEV, $INO}++) {
421			if ($follow_skip < 2) {
422			die "$AbsName is encountered a second time";
423			}
424			else {
425			return undef;
426			}
427			}
428			$NewName= PathCombine($AbsName, readlink($AbsName));
429			unless(defined $NewName) {
430			if ($follow_skip < 2) {
431			die "$AbsName is a recursive symbolic link";
432			}
433			else {
434			return undef;
435			}
436			}
437			else {
438			$AbsName= $NewName;
439			}
440			($DEV, $INO) = lstat($AbsName);
441			return undef unless defined $DEV; # dangling symbolic link
442			}
443
444			if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
445			if ( ($follow_skip < 1) \|\| ((-d _) && ($follow_skip < 2)) ) {
446			die "$AbsName encountered a second time";
447			}
448			else {
449			return undef;
450			}
451			}
452
453			return $AbsName;
454			}
455
456			our($dir, $name, $fullname, $prune);
457			sub _find_dir_symlnk($$$);
458			sub _find_dir($$$);
459
460			# check whether or not a scalar variable is tainted
461			# (code straight from the Camel, 3rd ed., page 561)
462			sub is_tainted_pp {
463			my $arg = shift;
464			my $nada = substr($arg, 0, 0); # zero-length
465			local $@;
466			eval { eval "# $nada" };
467			return length($@) != 0;
468			}
469
470			sub _find_opt {
471			my $wanted = shift;
472			die "invalid top directory" unless defined $_[0];
473
474			# This function must local()ize everything because callbacks may
475			# call find() or finddepth()
476
477			local %SLnkSeen;
478			local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
479			$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
480			$pre_process, $post_process, $dangling_symlinks);
481			local($dir, $name, $fullname, $prune);
482			local *_ = \my $a;
483
484			my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
485			if ($Is_VMS) {
486			# VMS returns this by default in VMS format which just doesn't
487			# work for the rest of this module.
488			$cwd = VMS::Filespec::unixpath($cwd);
489
490			# Apparently this is not expected to have a trailing space.
491			# To attempt to make VMS/UNIX conversions mostly reversible,
492			# a trailing slash is needed. The run-time functions ignore the
493			# resulting double slash, but it causes the perl tests to fail.
494			$cwd =~ s#/\z##;
495
496			# This comes up in upper case now, but should be lower.
497			# In the future this could be exact case, no need to change.
498			}
499			my $cwd_untainted = $cwd;
500			my $check_t_cwd = 1;
501			$wanted_callback = $wanted->{wanted};
502			$bydepth = $wanted->{bydepth};
503			$pre_process = $wanted->{preprocess};
504			$post_process = $wanted->{postprocess};
505			$no_chdir = $wanted->{no_chdir};
506			$full_check = $Is_Win32 ? 0 : $wanted->{follow};
507			$follow = $Is_Win32 ? 0 :
508			$full_check \|\| $wanted->{follow_fast};
509			$follow_skip = $wanted->{follow_skip};
510			$untaint = $wanted->{untaint};
511			$untaint_pat = $wanted->{untaint_pattern};
512			$untaint_skip = $wanted->{untaint_skip};
513			$dangling_symlinks = $wanted->{dangling_symlinks};
514
515			# for compatibility reasons (find.pl, find2perl)
516			local our ($topdir, $topdev, $topino, $topmode, $topnlink);
517
518			# a symbolic link to a directory doesn't increase the link count
519			$avoid_nlink = $follow \|\| $File::Find::dont_use_nlink;
520
521			my ($abs_dir, $Is_Dir);
522
523			Proc_Top_Item:
524			foreach my $TOP (@_) {
525			my $top_item = $TOP;
526			$top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
527
528			($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
529
530			if ($Is_Win32) {
531			$top_item =~ s\|[/\\]\z\|\|
532			unless $top_item =~ m{^(?:\w:)?[/\\]$};
533			}
534			else {
535			$top_item =~ s\|/\z\|\| unless $top_item eq '/';
536			}
537
538			$Is_Dir= 0;
539
540			if ($follow) {
541
542			if (substr($top_item,0,1) eq '/') {
543			$abs_dir = $top_item;
544			}
545			elsif ($top_item eq $File::Find::current_dir) {
546			$abs_dir = $cwd;
547			}
548			else { # care about any ../
549			$top_item =~ s/\.dir\z//i if $Is_VMS;
550			$abs_dir = contract_name("$cwd/",$top_item);
551			}
552			$abs_dir= Follow_SymLink($abs_dir);
553			unless (defined $abs_dir) {
554			if ($dangling_symlinks) {
555			if (ref $dangling_symlinks eq 'CODE') {
556			$dangling_symlinks->($top_item, $cwd);
557			} else {
558			warnings::warnif "$top_item is a dangling symbolic link\n";
559			}
560			}
561			next Proc_Top_Item;
562			}
563
564			if (-d _) {
565			$top_item =~ s/\.dir\z//i if $Is_VMS;
566			_find_dir_symlnk($wanted, $abs_dir, $top_item);
567			$Is_Dir= 1;
568			}
569			}
570			else { # no follow
571			$topdir = $top_item;
572			unless (defined $topnlink) {
573			warnings::warnif "Can't stat $top_item: $!\n";
574			next Proc_Top_Item;
575			}
576			if (-d _) {
577			$top_item =~ s/\.dir\z//i if $Is_VMS;
578			_find_dir($wanted, $top_item, $topnlink);
579			$Is_Dir= 1;
580			}
581			else {
582			$abs_dir= $top_item;
583			}
584			}
585
586			unless ($Is_Dir) {
587			unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
588			($dir,$_) = ('./', $top_item);
589			}
590
591			$abs_dir = $dir;
592			if (( $untaint ) && (is_tainted($dir) )) {
593			( $abs_dir ) = $dir =~ m\|$untaint_pat\|;
594			unless (defined $abs_dir) {
595			if ($untaint_skip == 0) {
596			die "directory $dir is still tainted";
597			}
598			else {
599			next Proc_Top_Item;
600			}
601			}
602			}
603
604			unless ($no_chdir \|\| chdir $abs_dir) {
605			warnings::warnif "Couldn't chdir $abs_dir: $!\n";
606			next Proc_Top_Item;
607			}
608
609			$name = $abs_dir . $_; # $File::Find::name
610			$_ = $name if $no_chdir;
611
612			{ $wanted_callback->() }; # protect against wild "next"
613
614			}
615
616			unless ( $no_chdir ) {
617			if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
618			( $cwd_untainted ) = $cwd =~ m\|$untaint_pat\|;
619			unless (defined $cwd_untainted) {
620			die "insecure cwd in find(depth)";
621			}
622			$check_t_cwd = 0;
623			}
624			unless (chdir $cwd_untainted) {
625			die "Can't cd to $cwd: $!\n";
626			}
627			}
628			}
629			}
630
631			# API:
632			# $wanted
633			# $p_dir : "parent directory"
634			# $nlink : what came back from the stat
635			# preconditions:
636			# chdir (if not no_chdir) to dir
637
638			sub _find_dir($$$) {
639			my ($wanted, $p_dir, $nlink) = @_;
640			my ($CdLvl,$Level) = (0,0);
641			my @Stack;
642			my @filenames;
643			my ($subcount,$sub_nlink);
644			my $SE= [];
645			my $dir_name= $p_dir;
646			my $dir_pref;
647			my $dir_rel = $File::Find::current_dir;
648			my $tainted = 0;
649			my $no_nlink;
650
651			if ($Is_Win32) {
652			$dir_pref
653			= ($p_dir =~ m{^(?:\w:[/\\]?\|[/\\])$} ? $p_dir : "$p_dir/" );
654			} elsif ($Is_VMS) {
655
656			# VMS is returning trailing .dir on directories
657			# and trailing . on files and symbolic links
658			# in UNIX syntax.
659			#
660
661			$p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
662
663			$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
664			}
665			else {
666			$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
667			}
668
669			local ($dir, $name, $prune, *DIR);
670
671			unless ( $no_chdir \|\| ($p_dir eq $File::Find::current_dir)) {
672			my $udir = $p_dir;
673			if (( $untaint ) && (is_tainted($p_dir) )) {
674			( $udir ) = $p_dir =~ m\|$untaint_pat\|;
675			unless (defined $udir) {
676			if ($untaint_skip == 0) {
677			die "directory $p_dir is still tainted";
678			}
679			else {
680			return;
681			}
682			}
683			}
684			unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
685			warnings::warnif "Can't cd to $udir: $!\n";
686			return;
687			}
688			}
689
690			# push the starting directory
691			push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
692
693			while (defined $SE) {
694			unless ($bydepth) {
695			$dir= $p_dir; # $File::Find::dir
696			$name= $dir_name; # $File::Find::name
697			$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
698			# prune may happen here
699			$prune= 0;
700			{ $wanted_callback->() }; # protect against wild "next"
701			next if $prune;
702			}
703
704			# change to that directory
705			unless ($no_chdir \|\| ($dir_rel eq $File::Find::current_dir)) {
706			my $udir= $dir_rel;
707			if ( ($untaint) && (($tainted) \|\| ($tainted = is_tainted($dir_rel) )) ) {
708			( $udir ) = $dir_rel =~ m\|$untaint_pat\|;
709			unless (defined $udir) {
710			if ($untaint_skip == 0) {
711			die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
712			} else { # $untaint_skip == 1
713			next;
714			}
715			}
716			}
717			unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
718			warnings::warnif "Can't cd to (" .
719			($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
720			next;
721			}
722			$CdLvl++;
723			}
724
725			$dir= $dir_name; # $File::Find::dir
726
727			# Get the list of files in the current directory.
728			unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
729			warnings::warnif "Can't opendir($dir_name): $!\n";
730			next;
731			}
732			@filenames = readdir DIR;
733			closedir(DIR);
734			@filenames = $pre_process->(@filenames) if $pre_process;
735			push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
736
737			# default: use whatever was specified
738			# (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
739			$no_nlink = $avoid_nlink;
740			# if dir has wrong nlink count, force switch to slower stat method
741			$no_nlink = 1 if ($nlink < 2);
742
743			if ($nlink == 2 && !$no_nlink) {
744			# This dir has no subdirectories.
745			for my $FN (@filenames) {
746			if ($Is_VMS) {
747			# Big hammer here - Compensate for VMS trailing . and .dir
748			# No win situation until this is changed, but this
749			# will handle the majority of the cases with breaking the fewest
750
751			$FN =~ s/\.dir\z//i;
752			$FN =~ s#\.$## if ($FN ne '.');
753			}
754			next if $FN =~ $File::Find::skip_pattern;
755
756			$name = $dir_pref . $FN; # $File::Find::name
757			$_ = ($no_chdir ? $name : $FN); # $_
758			{ $wanted_callback->() }; # protect against wild "next"
759			}
760
761			}
762			else {
763			# This dir has subdirectories.
764			$subcount = $nlink - 2;
765
766			# HACK: insert directories at this position. so as to preserve
767			# the user pre-processed ordering of files.
768			# EG: directory traversal is in user sorted order, not at random.
769			my $stack_top = @Stack;
770
771			for my $FN (@filenames) {
772			next if $FN =~ $File::Find::skip_pattern;
773			if ($subcount > 0 \|\| $no_nlink) {
774			# Seen all the subdirs?
775			# check for directoriness.
776			# stat is faster for a file in the current directory
777			$sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
778
779			if (-d _) {
780			--$subcount;
781			$FN =~ s/\.dir\z//i if $Is_VMS;
782			# HACK: replace push to preserve dir traversal order
783			#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
784			splice @Stack, $stack_top, 0,
785			[$CdLvl,$dir_name,$FN,$sub_nlink];
786			}
787			else {
788			$name = $dir_pref . $FN; # $File::Find::name
789			$_= ($no_chdir ? $name : $FN); # $_
790			{ $wanted_callback->() }; # protect against wild "next"
791			}
792			}
793			else {
794			$name = $dir_pref . $FN; # $File::Find::name
795			$_= ($no_chdir ? $name : $FN); # $_
796			{ $wanted_callback->() }; # protect against wild "next"
797			}
798			}
799			}
800			}
801			continue {
802			while ( defined ($SE = pop @Stack) ) {
803			($Level, $p_dir, $dir_rel, $nlink) = @$SE;
804			if ($CdLvl > $Level && !$no_chdir) {
805			my $tmp;
806			if ($Is_VMS) {
807			$tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
808			}
809			else {
810			$tmp = join('/',('..') x ($CdLvl-$Level));
811			}
812			die "Can't cd to $tmp from $dir_name: $!"
813			unless chdir ($tmp);
814			$CdLvl = $Level;
815			}
816
817			if ($Is_Win32) {
818			$dir_name = ($p_dir =~ m{^(?:\w:[/\\]?\|[/\\])$}
819			? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
820			$dir_pref = "$dir_name/";
821			}
822			elsif ($^O eq 'VMS') {
823			if ($p_dir =~ m/[\]>]+$/) {
824			$dir_name = $p_dir;
825			$dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
826			$dir_pref = $dir_name;
827			}
828			else {
829			$dir_name = "$p_dir/$dir_rel";
830			$dir_pref = "$dir_name/";
831			}
832			}
833			else {
834			$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
835			$dir_pref = "$dir_name/";
836			}
837
838			if ( $nlink == -2 ) {
839			$name = $dir = $p_dir; # $File::Find::name / dir
840			$_ = $File::Find::current_dir;
841			$post_process->(); # End-of-directory processing
842			}
843			elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
844			$name = $dir_name;
845			if ( substr($name,-2) eq '/.' ) {
846			substr($name, length($name) == 2 ? -1 : -2) = '';
847			}
848			$dir = $p_dir;
849			$_ = ($no_chdir ? $dir_name : $dir_rel );
850			if ( substr($_,-2) eq '/.' ) {
851			substr($_, length($_) == 2 ? -1 : -2) = '';
852			}
853			{ $wanted_callback->() }; # protect against wild "next"
854			}
855			else {
856			push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
857			last;
858			}
859			}
860			}
861			}
862
863
864			# API:
865			# $wanted
866			# $dir_loc : absolute location of a dir
867			# $p_dir : "parent directory"
868			# preconditions:
869			# chdir (if not no_chdir) to dir
870
871			sub _find_dir_symlnk($$$) {
872			my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
873			my @Stack;
874			my @filenames;
875			my $new_loc;
876			my $updir_loc = $dir_loc; # untainted parent directory
877			my $SE = [];
878			my $dir_name = $p_dir;
879			my $dir_pref;
880			my $loc_pref;
881			my $dir_rel = $File::Find::current_dir;
882			my $byd_flag; # flag for pending stack entry if $bydepth
883			my $tainted = 0;
884			my $ok = 1;
885
886			$dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
887			$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
888
889			local ($dir, $name, $fullname, $prune, *DIR);
890
891			unless ($no_chdir) {
892			# untaint the topdir
893			if (( $untaint ) && (is_tainted($dir_loc) )) {
894			( $updir_loc ) = $dir_loc =~ m\|$untaint_pat\|; # parent dir, now untainted
895			# once untainted, $updir_loc is pushed on the stack (as parent directory);
896			# hence, we don't need to untaint the parent directory every time we chdir
897			# to it later
898			unless (defined $updir_loc) {
899			if ($untaint_skip == 0) {
900			die "directory $dir_loc is still tainted";
901			}
902			else {
903			return;
904			}
905			}
906			}
907			$ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
908			unless ($ok) {
909			warnings::warnif "Can't cd to $updir_loc: $!\n";
910			return;
911			}
912			}
913
914			push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
915
916			while (defined $SE) {
917
918			unless ($bydepth) {
919			# change (back) to parent directory (always untainted)
920			unless ($no_chdir) {
921			unless (chdir $updir_loc) {
922			warnings::warnif "Can't cd to $updir_loc: $!\n";
923			next;
924			}
925			}
926			$dir= $p_dir; # $File::Find::dir
927			$name= $dir_name; # $File::Find::name
928			$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
929			$fullname= $dir_loc; # $File::Find::fullname
930			# prune may happen here
931			$prune= 0;
932			lstat($_); # make sure file tests with '_' work
933	1	1.35ms	{ $wanted_callback->() }; # protect against wild "next"
934			next if $prune;
935			}
936
937			# change to that directory
938			unless ($no_chdir \|\| ($dir_rel eq $File::Find::current_dir)) {
939			$updir_loc = $dir_loc;
940			if ( ($untaint) && (($tainted) \|\| ($tainted = is_tainted($dir_loc) )) ) {
941			# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
942			( $updir_loc ) = $dir_loc =~ m\|$untaint_pat\|;
943			unless (defined $updir_loc) {
944			if ($untaint_skip == 0) {
945			die "directory $dir_loc is still tainted";
946			}
947			else {
948			next;
949			}
950			}
951			}
952			unless (chdir $updir_loc) {
953			warnings::warnif "Can't cd to $updir_loc: $!\n";
954			next;
955			}
956			}
957
958			$dir = $dir_name; # $File::Find::dir
959
960			# Get the list of files in the current directory.
961			unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
962			warnings::warnif "Can't opendir($dir_loc): $!\n";
963			next;
964			}
965			@filenames = readdir DIR;
966			closedir(DIR);
967
968			for my $FN (@filenames) {
969			if ($Is_VMS) {
970			# Big hammer here - Compensate for VMS trailing . and .dir
971			# No win situation until this is changed, but this
972			# will handle the majority of the cases with breaking the fewest.
973
974			$FN =~ s/\.dir\z//i;
975			$FN =~ s#\.$## if ($FN ne '.');
976			}
977			next if $FN =~ $File::Find::skip_pattern;
978
979			# follow symbolic links / do an lstat
980			$new_loc = Follow_SymLink($loc_pref.$FN);
981
982			# ignore if invalid symlink
983			unless (defined $new_loc) {
984			if (!defined -l _ && $dangling_symlinks) {
985			$fullname = undef;
986			if (ref $dangling_symlinks eq 'CODE') {
987			$dangling_symlinks->($FN, $dir_pref);
988			} else {
989			warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
990			}
991			}
992			else {
993			$fullname = $loc_pref . $FN;
994			}
995			$name = $dir_pref . $FN;
996			$_ = ($no_chdir ? $name : $FN);
997			{ $wanted_callback->() };
998			next;
999			}
1000
1001			if (-d _) {
1002			if ($Is_VMS) {
1003			$FN =~ s/\.dir\z//i;
1004			$FN =~ s#\.$## if ($FN ne '.');
1005			$new_loc =~ s/\.dir\z//i;
1006			$new_loc =~ s#\.$## if ($new_loc ne '.');
1007			}
1008			push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1009			}
1010			else {
1011			$fullname = $new_loc; # $File::Find::fullname
1012			$name = $dir_pref . $FN; # $File::Find::name
1013			$_ = ($no_chdir ? $name : $FN); # $_
1014	1	28.7ms	{ $wanted_callback->() }; # protect against wild "next"
1015			}
1016			}
1017
1018			}
1019			continue {
1020			while (defined($SE = pop @Stack)) {
1021			($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1022			$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1023			$dir_pref = "$dir_name/";
1024			$loc_pref = "$dir_loc/";
1025			if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1026			unless ($no_chdir \|\| ($dir_rel eq $File::Find::current_dir)) {
1027			unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1028			warnings::warnif "Can't cd to $updir_loc: $!\n";
1029			next;
1030			}
1031			}
1032			$fullname = $dir_loc; # $File::Find::fullname
1033			$name = $dir_name; # $File::Find::name
1034			if ( substr($name,-2) eq '/.' ) {
1035			substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1036			}
1037			$dir = $p_dir; # $File::Find::dir
1038			$_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1039			if ( substr($_,-2) eq '/.' ) {
1040			substr($_, length($_) == 2 ? -1 : -2) = '';
1041			}
1042
1043			lstat($_); # make sure file tests with '_' work
1044			{ $wanted_callback->() }; # protect against wild "next"
1045			}
1046			else {
1047			push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1048			last;
1049			}
1050			}
1051			}
1052			}
1053
1054
1055			sub wrap_wanted {
1056			my $wanted = shift;
1057			if ( ref($wanted) eq 'HASH' ) {
1058			unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1059			die 'no &wanted subroutine given';
1060			}
1061			if ( $wanted->{follow} \|\| $wanted->{follow_fast}) {
1062			$wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1063			}
1064			if ( $wanted->{untaint} ) {
1065			$wanted->{untaint_pattern} = $File::Find::untaint_pattern
1066			unless defined $wanted->{untaint_pattern};
1067			$wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1068			}
1069			return $wanted;
1070			}
1071			elsif( ref( $wanted ) eq 'CODE' ) {
1072			return { wanted => $wanted };
1073			}
1074			else {
1075			die 'no &wanted subroutine given';
1076			}
1077			}
1078
1079			sub find {
1080			my $wanted = shift;
1081			_find_opt(wrap_wanted($wanted), @_);
1082			}
1083
1084			sub finddepth {
1085			my $wanted = wrap_wanted(shift);
1086			$wanted->{bydepth} = 1;
1087			_find_opt($wanted, @_);
1088			}
1089
1090			# default
1091			$File::Find::skip_pattern = qr/^\.{1,2}\z/;
1092			$File::Find::untaint_pattern = qr\|^([-+@\w./]+)$\|;
1093
1094			# These are hard-coded for now, but may move to hint files.
1095			if ($^O eq 'VMS') {
1096			$Is_VMS = 1;
1097			$File::Find::dont_use_nlink = 1;
1098			}
1099			elsif ($^O eq 'MSWin32') {
1100			$Is_Win32 = 1;
1101			}
1102
1103			# this _should_ work properly on all platforms
1104			# where File::Find can be expected to work
1105			$File::Find::current_dir = File::Spec->curdir \|\| '.';
1106
1107			$File::Find::dont_use_nlink = 1
1108			if $^O eq 'os2' \|\| $^O eq 'dos' \|\| $^O eq 'amigaos' \|\| $Is_Win32 \|\|
1109			$^O eq 'interix' \|\| $^O eq 'cygwin' \|\| $^O eq 'qnx' \|\| $^O eq 'nto';
1110
1111			# Set dont_use_nlink in your hint file if your system's stat doesn't
1112			# report the number of links in a directory as an indication
1113			# of the number of files.
1114			# See, e.g. hints/machten.sh for MachTen 2.2.
1115			unless ($File::Find::dont_use_nlink) {
1116			require Config;
1117			$File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1118			}
1119
1120			# We need a function that checks if a scalar is tainted. Either use the
1121			# Scalar::Util module's tainted() function or our (slower) pure Perl
1122			# fallback is_tainted_pp()
1123			{
1124			local $@;
1125			eval { require Scalar::Util };
1126			*is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1127			}
1128
1129			1;