Filename	/usr/lib/perl5/5.14/File/Find.pm
Statements	Executed 34 statements in 8.70ms

Subroutines

Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	241µs	241µs	File::Find::::BEGIN@2File::Find::BEGIN@2
1	1	1	21µs	25µs	File::Find::::BEGIN@349File::Find::BEGIN@349
2	2	1	16µs	16µs	File::Find::::CORE:qrFile::Find::CORE:qr (opcode)
1	1	1	15µs	35µs	File::Find::::BEGIN@4File::Find::BEGIN@4
1	1	1	15µs	223µs	File::Find::::BEGIN@5File::Find::BEGIN@5
1	1	1	15µs	20µs	File::Find::::BEGIN@3File::Find::BEGIN@3
0	0	0	0s	0s	File::Find::::Follow_SymLinkFile::Find::Follow_SymLink
0	0	0	0s	0s	File::Find::::PathCombineFile::Find::PathCombine
0	0	0	0s	0s	File::Find::::_find_dirFile::Find::_find_dir
0	0	0	0s	0s	File::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
0	0	0	0s	0s	File::Find::::_find_optFile::Find::_find_opt
0	0	0	0s	0s	File::Find::::contract_nameFile::Find::contract_name
0	0	0	0s	0s	File::Find::::findFile::Find::find
0	0	0	0s	0s	File::Find::::finddepthFile::Find::finddepth
0	0	0	0s	0s	File::Find::::is_tainted_ppFile::Find::is_tainted_pp
0	0	0	0s	0s	File::Find::::wrap_wantedFile::Find::wrap_wanted

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package File::Find;
2	2	195µs	1	241µs	# spent 241µs within File::Find::BEGIN@2 which was called: # once (241µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 2 use 5.006; # spent 241µs making 1 call to File::Find::BEGIN@2
3	2	53µs	2	26µs	# spent 20µs (15+6) within File::Find::BEGIN@3 which was called: # once (15µs+6µs) by Archive::Zip::Archive::BEGIN@7 at line 3 use strict; # spent 20µs making 1 call to File::Find::BEGIN@3 # spent 6µs making 1 call to strict::import
4	2	56µs	2	54µs	# spent 35µs (15+19) within File::Find::BEGIN@4 which was called: # once (15µs+19µs) by Archive::Zip::Archive::BEGIN@7 at line 4 use warnings; # spent 35µs making 1 call to File::Find::BEGIN@4 # spent 19µs making 1 call to warnings::import
5	2	509µs	2	431µs	# spent 223µs (15+208) within File::Find::BEGIN@5 which was called: # once (15µs+208µs) by Archive::Zip::Archive::BEGIN@7 at line 5 use warnings::register; # spent 223µs making 1 call to File::Find::BEGIN@5 # spent 208µs making 1 call to warnings::register::import
6	1	2µs			our $VERSION = '1.19';
7	1	2µs			require Exporter;
8	1	1µs			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 I<follow_fast> and I<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					See also the script C<pfind> on CPAN for a nice application of this
284					module.
285
286					=head1 WARNINGS
287
288					If you run your program with the C<-w> switch, or if you use the
289					C<warnings> pragma, File::Find will report warnings for several weird
290					situations. You can disable these warnings by putting the statement
291
292					no warnings 'File::Find';
293
294					in the appropriate scope. See L<perllexwarn> for more info about lexical
295					warnings.
296
297					=head1 CAVEAT
298
299					=over 2
300
301					=item $dont_use_nlink
302
303					You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
304					force File::Find to always stat directories. This was used for file systems
305					that do not have an C<nlink> count matching the number of sub-directories.
306					Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
307					system) and a couple of others.
308
309					You shouldn't need to set this variable, since File::Find should now detect
310					such file systems on-the-fly and switch itself to using stat. This works even
311					for parts of your file system, like a mounted CD-ROM.
312
313					If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
314
315					=item symlinks
316
317					Be aware that the option to follow symbolic links can be dangerous.
318					Depending on the structure of the directory tree (including symbolic
319					links to directories) you might traverse a given (physical) directory
320					more than once (only if C<follow_fast> is in effect).
321					Furthermore, deleting or changing files in a symbolically linked directory
322					might cause very unpleasant surprises, since you delete or change files
323					in an unknown directory.
324
325					=back
326
327					=head1 BUGS AND CAVEATS
328
329					Despite the name of the C<finddepth()> function, both C<find()> and
330					C<finddepth()> perform a depth-first search of the directory
331					hierarchy.
332
333					=head1 HISTORY
334
335					File::Find used to produce incorrect results if called recursively.
336					During the development of perl 5.8 this bug was fixed.
337					The first fixed version of File::Find was 1.01.
338
339					=head1 SEE ALSO
340
341					find, find2perl.
342
343					=cut
344
345	1	15µs			our @ISA = qw(Exporter);
346	1	2µs			our @EXPORT = qw(find finddepth);
347
348
349	2	7.68ms	2	29µs	# spent 25µs (21+4) within File::Find::BEGIN@349 which was called: # once (21µs+4µs) by Archive::Zip::Archive::BEGIN@7 at line 349 use strict; # spent 25µs making 1 call to File::Find::BEGIN@349 # spent 4µs making 1 call to strict::import
350	1	500ns			my $Is_VMS;
351	1	500ns			my $Is_Win32;
352
353	1	1µs			require File::Basename;
354	1	1µs			require File::Spec;
355
356					# Should ideally be my() not our() but local() currently
357					# refuses to operate on lexicals
358
359	1	500ns			our %SLnkSeen;
360	1	500ns			our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
361					$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
362					$pre_process, $post_process, $dangling_symlinks);
363
364					sub contract_name {
365					my ($cdir,$fn) = @_;
366
367					return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
368
369					$cdir = substr($cdir,0,rindex($cdir,'/')+1);
370
371					$fn =~ s|^\./||;
372
373					my $abs_name= $cdir . $fn;
374
375					if (substr($fn,0,3) eq '../') {
376					1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
377					}
378
379					return $abs_name;
380					}
381
382					sub PathCombine($$) {
383					my ($Base,$Name) = @_;
384					my $AbsName;
385
386					if (substr($Name,0,1) eq '/') {
387					$AbsName= $Name;
388					}
389					else {
390					$AbsName= contract_name($Base,$Name);
391					}
392
393					# (simple) check for recursion
394					my $newlen= length($AbsName);
395					if ($newlen <= length($Base)) {
396					if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
397					&& $AbsName eq substr($Base,0,$newlen))
398					{
399					return undef;
400					}
401					}
402					return $AbsName;
403					}
404
405					sub Follow_SymLink($) {
406					my ($AbsName) = @_;
407
408					my ($NewName,$DEV, $INO);
409					($DEV, $INO)= lstat $AbsName;
410
411					while (-l _) {
412					if ($SLnkSeen{$DEV, $INO}++) {
413					if ($follow_skip < 2) {
414					die "$AbsName is encountered a second time";
415					}
416					else {
417					return undef;
418					}
419					}
420					$NewName= PathCombine($AbsName, readlink($AbsName));
421					unless(defined $NewName) {
422					if ($follow_skip < 2) {
423					die "$AbsName is a recursive symbolic link";
424					}
425					else {
426					return undef;
427					}
428					}
429					else {
430					$AbsName= $NewName;
431					}
432					($DEV, $INO) = lstat($AbsName);
433					return undef unless defined $DEV; # dangling symbolic link
434					}
435
436					if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
437					if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
438					die "$AbsName encountered a second time";
439					}
440					else {
441					return undef;
442					}
443					}
444
445					return $AbsName;
446					}
447
448	1	0s			our($dir, $name, $fullname, $prune);
449					sub _find_dir_symlnk($$$);
450					sub _find_dir($$$);
451
452					# check whether or not a scalar variable is tainted
453					# (code straight from the Camel, 3rd ed., page 561)
454					sub is_tainted_pp {
455					my $arg = shift;
456					my $nada = substr($arg, 0, 0); # zero-length
457					local $@;
458					eval { eval "# $nada" };
459					return length($@) != 0;
460					}
461
462					sub _find_opt {
463					my $wanted = shift;
464					die "invalid top directory" unless defined $_[0];
465
466					# This function must local()ize everything because callbacks may
467					# call find() or finddepth()
468
469					local %SLnkSeen;
470					local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
471					$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
472					$pre_process, $post_process, $dangling_symlinks);
473					local($dir, $name, $fullname, $prune);
474					local *_ = \my $a;
475
476					my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
477					if ($Is_VMS) {
478					# VMS returns this by default in VMS format which just doesn't
479					# work for the rest of this module.
480					$cwd = VMS::Filespec::unixpath($cwd);
481
482					# Apparently this is not expected to have a trailing space.
483					# To attempt to make VMS/UNIX conversions mostly reversable,
484					# a trailing slash is needed. The run-time functions ignore the
485					# resulting double slash, but it causes the perl tests to fail.
486					$cwd =~ s#/\z##;
487
488					# This comes up in upper case now, but should be lower.
489					# In the future this could be exact case, no need to change.
490					}
491					my $cwd_untainted = $cwd;
492					my $check_t_cwd = 1;
493					$wanted_callback = $wanted->{wanted};
494					$bydepth = $wanted->{bydepth};
495					$pre_process = $wanted->{preprocess};
496					$post_process = $wanted->{postprocess};
497					$no_chdir = $wanted->{no_chdir};
498					$full_check = $Is_Win32 ? 0 : $wanted->{follow};
499					$follow = $Is_Win32 ? 0 :
500					$full_check || $wanted->{follow_fast};
501					$follow_skip = $wanted->{follow_skip};
502					$untaint = $wanted->{untaint};
503					$untaint_pat = $wanted->{untaint_pattern};
504					$untaint_skip = $wanted->{untaint_skip};
505					$dangling_symlinks = $wanted->{dangling_symlinks};
506
507					# for compatibility reasons (find.pl, find2perl)
508					local our ($topdir, $topdev, $topino, $topmode, $topnlink);
509
510					# a symbolic link to a directory doesn't increase the link count
511					$avoid_nlink = $follow || $File::Find::dont_use_nlink;
512
513					my ($abs_dir, $Is_Dir);
514
515					Proc_Top_Item:
516					foreach my $TOP (@_) {
517					my $top_item = $TOP;
518
519					($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
520
521					if ($Is_Win32) {
522					$top_item =~ s|[/\\]\z||
523					unless $top_item =~ m{^(?:\w:)?[/\\]$};
524					}
525					else {
526					$top_item =~ s|/\z|| unless $top_item eq '/';
527					}
528
529					$Is_Dir= 0;
530
531					if ($follow) {
532
533					if (substr($top_item,0,1) eq '/') {
534					$abs_dir = $top_item;
535					}
536					elsif ($top_item eq $File::Find::current_dir) {
537					$abs_dir = $cwd;
538					}
539					else { # care about any ../
540					$top_item =~ s/\.dir\z//i if $Is_VMS;
541					$abs_dir = contract_name("$cwd/",$top_item);
542					}
543					$abs_dir= Follow_SymLink($abs_dir);
544					unless (defined $abs_dir) {
545					if ($dangling_symlinks) {
546					if (ref $dangling_symlinks eq 'CODE') {
547					$dangling_symlinks->($top_item, $cwd);
548					} else {
549					warnings::warnif "$top_item is a dangling symbolic link\n";
550					}
551					}
552					next Proc_Top_Item;
553					}
554
555					if (-d _) {
556					$top_item =~ s/\.dir\z//i if $Is_VMS;
557					_find_dir_symlnk($wanted, $abs_dir, $top_item);
558					$Is_Dir= 1;
559					}
560					}
561					else { # no follow
562					$topdir = $top_item;
563					unless (defined $topnlink) {
564					warnings::warnif "Can't stat $top_item: $!\n";
565					next Proc_Top_Item;
566					}
567					if (-d _) {
568					$top_item =~ s/\.dir\z//i if $Is_VMS;
569					_find_dir($wanted, $top_item, $topnlink);
570					$Is_Dir= 1;
571					}
572					else {
573					$abs_dir= $top_item;
574					}
575					}
576
577					unless ($Is_Dir) {
578					unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
579					($dir,$_) = ('./', $top_item);
580					}
581
582					$abs_dir = $dir;
583					if (( $untaint ) && (is_tainted($dir) )) {
584					( $abs_dir ) = $dir =~ m|$untaint_pat|;
585					unless (defined $abs_dir) {
586					if ($untaint_skip == 0) {
587					die "directory $dir is still tainted";
588					}
589					else {
590					next Proc_Top_Item;
591					}
592					}
593					}
594
595					unless ($no_chdir || chdir $abs_dir) {
596					warnings::warnif "Couldn't chdir $abs_dir: $!\n";
597					next Proc_Top_Item;
598					}
599
600					$name = $abs_dir . $_; # $File::Find::name
601					$_ = $name if $no_chdir;
602
603					{ $wanted_callback->() }; # protect against wild "next"
604
605					}
606
607					unless ( $no_chdir ) {
608					if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
609					( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
610					unless (defined $cwd_untainted) {
611					die "insecure cwd in find(depth)";
612					}
613					$check_t_cwd = 0;
614					}
615					unless (chdir $cwd_untainted) {
616					die "Can't cd to $cwd: $!\n";
617					}
618					}
619					}
620					}
621
622					# API:
623					# $wanted
624					# $p_dir : "parent directory"
625					# $nlink : what came back from the stat
626					# preconditions:
627					# chdir (if not no_chdir) to dir
628
629					sub _find_dir($$$) {
630					my ($wanted, $p_dir, $nlink) = @_;
631					my ($CdLvl,$Level) = (0,0);
632					my @Stack;
633					my @filenames;
634					my ($subcount,$sub_nlink);
635					my $SE= [];
636					my $dir_name= $p_dir;
637					my $dir_pref;
638					my $dir_rel = $File::Find::current_dir;
639					my $tainted = 0;
640					my $no_nlink;
641
642					if ($Is_Win32) {
643					$dir_pref
644					= ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
645					} elsif ($Is_VMS) {
646
647					# VMS is returning trailing .dir on directories
648					# and trailing . on files and symbolic links
649					# in UNIX syntax.
650					#
651
652					$p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
653
654					$dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
655					}
656					else {
657					$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
658					}
659
660					local ($dir, $name, $prune, *DIR);
661
662					unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
663					my $udir = $p_dir;
664					if (( $untaint ) && (is_tainted($p_dir) )) {
665					( $udir ) = $p_dir =~ m|$untaint_pat|;
666					unless (defined $udir) {
667					if ($untaint_skip == 0) {
668					die "directory $p_dir is still tainted";
669					}
670					else {
671					return;
672					}
673					}
674					}
675					unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
676					warnings::warnif "Can't cd to $udir: $!\n";
677					return;
678					}
679					}
680
681					# push the starting directory
682					push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
683
684					while (defined $SE) {
685					unless ($bydepth) {
686					$dir= $p_dir; # $File::Find::dir
687					$name= $dir_name; # $File::Find::name
688					$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
689					# prune may happen here
690					$prune= 0;
691					{ $wanted_callback->() }; # protect against wild "next"
692					next if $prune;
693					}
694
695					# change to that directory
696					unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
697					my $udir= $dir_rel;
698					if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
699					( $udir ) = $dir_rel =~ m|$untaint_pat|;
700					unless (defined $udir) {
701					if ($untaint_skip == 0) {
702					die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
703					} else { # $untaint_skip == 1
704					next;
705					}
706					}
707					}
708					unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
709					warnings::warnif "Can't cd to (" .
710					($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
711					next;
712					}
713					$CdLvl++;
714					}
715
716					$dir= $dir_name; # $File::Find::dir
717
718					# Get the list of files in the current directory.
719					unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
720					warnings::warnif "Can't opendir($dir_name): $!\n";
721					next;
722					}
723					@filenames = readdir DIR;
724					closedir(DIR);
725					@filenames = $pre_process->(@filenames) if $pre_process;
726					push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
727
728					# default: use whatever was specified
729					# (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
730					$no_nlink = $avoid_nlink;
731					# if dir has wrong nlink count, force switch to slower stat method
732					$no_nlink = 1 if ($nlink < 2);
733
734					if ($nlink == 2 && !$no_nlink) {
735					# This dir has no subdirectories.
736					for my $FN (@filenames) {
737					if ($Is_VMS) {
738					# Big hammer here - Compensate for VMS trailing . and .dir
739					# No win situation until this is changed, but this
740					# will handle the majority of the cases with breaking the fewest
741
742					$FN =~ s/\.dir\z//i;
743					$FN =~ s#\.$## if ($FN ne '.');
744					}
745					next if $FN =~ $File::Find::skip_pattern;
746
747					$name = $dir_pref . $FN; # $File::Find::name
748					$_ = ($no_chdir ? $name : $FN); # $_
749					{ $wanted_callback->() }; # protect against wild "next"
750					}
751
752					}
753					else {
754					# This dir has subdirectories.
755					$subcount = $nlink - 2;
756
757					# HACK: insert directories at this position. so as to preserve
758					# the user pre-processed ordering of files.
759					# EG: directory traversal is in user sorted order, not at random.
760					my $stack_top = @Stack;
761
762					for my $FN (@filenames) {
763					next if $FN =~ $File::Find::skip_pattern;
764					if ($subcount > 0 || $no_nlink) {
765					# Seen all the subdirs?
766					# check for directoriness.
767					# stat is faster for a file in the current directory
768					$sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
769
770					if (-d _) {
771					--$subcount;
772					$FN =~ s/\.dir\z//i if $Is_VMS;
773					# HACK: replace push to preserve dir traversal order
774					#push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
775					splice @Stack, $stack_top, 0,
776					[$CdLvl,$dir_name,$FN,$sub_nlink];
777					}
778					else {
779					$name = $dir_pref . $FN; # $File::Find::name
780					$_= ($no_chdir ? $name : $FN); # $_
781					{ $wanted_callback->() }; # protect against wild "next"
782					}
783					}
784					else {
785					$name = $dir_pref . $FN; # $File::Find::name
786					$_= ($no_chdir ? $name : $FN); # $_
787					{ $wanted_callback->() }; # protect against wild "next"
788					}
789					}
790					}
791					}
792					continue {
793					while ( defined ($SE = pop @Stack) ) {
794					($Level, $p_dir, $dir_rel, $nlink) = @$SE;
795					if ($CdLvl > $Level && !$no_chdir) {
796					my $tmp;
797					if ($Is_VMS) {
798					$tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
799					}
800					else {
801					$tmp = join('/',('..') x ($CdLvl-$Level));
802					}
803					die "Can't cd to $tmp from $dir_name"
804					unless chdir ($tmp);
805					$CdLvl = $Level;
806					}
807
808					if ($Is_Win32) {
809					$dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
810					? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
811					$dir_pref = "$dir_name/";
812					}
813					elsif ($^O eq 'VMS') {
814					if ($p_dir =~ m/[\]>]+$/) {
815					$dir_name = $p_dir;
816					$dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
817					$dir_pref = $dir_name;
818					}
819					else {
820					$dir_name = "$p_dir/$dir_rel";
821					$dir_pref = "$dir_name/";
822					}
823					}
824					else {
825					$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
826					$dir_pref = "$dir_name/";
827					}
828
829					if ( $nlink == -2 ) {
830					$name = $dir = $p_dir; # $File::Find::name / dir
831					$_ = $File::Find::current_dir;
832					$post_process->(); # End-of-directory processing
833					}
834					elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
835					$name = $dir_name;
836					if ( substr($name,-2) eq '/.' ) {
837					substr($name, length($name) == 2 ? -1 : -2) = '';
838					}
839					$dir = $p_dir;
840					$_ = ($no_chdir ? $dir_name : $dir_rel );
841					if ( substr($_,-2) eq '/.' ) {
842					substr($_, length($_) == 2 ? -1 : -2) = '';
843					}
844					{ $wanted_callback->() }; # protect against wild "next"
845					}
846					else {
847					push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
848					last;
849					}
850					}
851					}
852					}
853
854
855					# API:
856					# $wanted
857					# $dir_loc : absolute location of a dir
858					# $p_dir : "parent directory"
859					# preconditions:
860					# chdir (if not no_chdir) to dir
861
862					sub _find_dir_symlnk($$$) {
863					my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
864					my @Stack;
865					my @filenames;
866					my $new_loc;
867					my $updir_loc = $dir_loc; # untainted parent directory
868					my $SE = [];
869					my $dir_name = $p_dir;
870					my $dir_pref;
871					my $loc_pref;
872					my $dir_rel = $File::Find::current_dir;
873					my $byd_flag; # flag for pending stack entry if $bydepth
874					my $tainted = 0;
875					my $ok = 1;
876
877					$dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
878					$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
879
880					local ($dir, $name, $fullname, $prune, *DIR);
881
882					unless ($no_chdir) {
883					# untaint the topdir
884					if (( $untaint ) && (is_tainted($dir_loc) )) {
885					( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
886					# once untainted, $updir_loc is pushed on the stack (as parent directory);
887					# hence, we don't need to untaint the parent directory every time we chdir
888					# to it later
889					unless (defined $updir_loc) {
890					if ($untaint_skip == 0) {
891					die "directory $dir_loc is still tainted";
892					}
893					else {
894					return;
895					}
896					}
897					}
898					$ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
899					unless ($ok) {
900					warnings::warnif "Can't cd to $updir_loc: $!\n";
901					return;
902					}
903					}
904
905					push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
906
907					while (defined $SE) {
908
909					unless ($bydepth) {
910					# change (back) to parent directory (always untainted)
911					unless ($no_chdir) {
912					unless (chdir $updir_loc) {
913					warnings::warnif "Can't cd to $updir_loc: $!\n";
914					next;
915					}
916					}
917					$dir= $p_dir; # $File::Find::dir
918					$name= $dir_name; # $File::Find::name
919					$_= ($no_chdir ? $dir_name : $dir_rel ); # $_
920					$fullname= $dir_loc; # $File::Find::fullname
921					# prune may happen here
922					$prune= 0;
923					lstat($_); # make sure file tests with '_' work
924					{ $wanted_callback->() }; # protect against wild "next"
925					next if $prune;
926					}
927
928					# change to that directory
929					unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
930					$updir_loc = $dir_loc;
931					if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
932					# untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
933					( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
934					unless (defined $updir_loc) {
935					if ($untaint_skip == 0) {
936					die "directory $dir_loc is still tainted";
937					}
938					else {
939					next;
940					}
941					}
942					}
943					unless (chdir $updir_loc) {
944					warnings::warnif "Can't cd to $updir_loc: $!\n";
945					next;
946					}
947					}
948
949					$dir = $dir_name; # $File::Find::dir
950
951					# Get the list of files in the current directory.
952					unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
953					warnings::warnif "Can't opendir($dir_loc): $!\n";
954					next;
955					}
956					@filenames = readdir DIR;
957					closedir(DIR);
958
959					for my $FN (@filenames) {
960					if ($Is_VMS) {
961					# Big hammer here - Compensate for VMS trailing . and .dir
962					# No win situation until this is changed, but this
963					# will handle the majority of the cases with breaking the fewest.
964
965					$FN =~ s/\.dir\z//i;
966					$FN =~ s#\.$## if ($FN ne '.');
967					}
968					next if $FN =~ $File::Find::skip_pattern;
969
970					# follow symbolic links / do an lstat
971					$new_loc = Follow_SymLink($loc_pref.$FN);
972
973					# ignore if invalid symlink
974					unless (defined $new_loc) {
975					if (!defined -l _ && $dangling_symlinks) {
976					if (ref $dangling_symlinks eq 'CODE') {
977					$dangling_symlinks->($FN, $dir_pref);
978					} else {
979					warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
980					}
981					}
982
983					$fullname = undef;
984					$name = $dir_pref . $FN;
985					$_ = ($no_chdir ? $name : $FN);
986					{ $wanted_callback->() };
987					next;
988					}
989
990					if (-d _) {
991					if ($Is_VMS) {
992					$FN =~ s/\.dir\z//i;
993					$FN =~ s#\.$## if ($FN ne '.');
994					$new_loc =~ s/\.dir\z//i;
995					$new_loc =~ s#\.$## if ($new_loc ne '.');
996					}
997					push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
998					}
999					else {
1000					$fullname = $new_loc; # $File::Find::fullname
1001					$name = $dir_pref . $FN; # $File::Find::name
1002					$_ = ($no_chdir ? $name : $FN); # $_
1003					{ $wanted_callback->() }; # protect against wild "next"
1004					}
1005					}
1006
1007					}
1008					continue {
1009					while (defined($SE = pop @Stack)) {
1010					($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1011					$dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1012					$dir_pref = "$dir_name/";
1013					$loc_pref = "$dir_loc/";
1014					if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1015					unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1016					unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1017					warnings::warnif "Can't cd to $updir_loc: $!\n";
1018					next;
1019					}
1020					}
1021					$fullname = $dir_loc; # $File::Find::fullname
1022					$name = $dir_name; # $File::Find::name
1023					if ( substr($name,-2) eq '/.' ) {
1024					substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1025					}
1026					$dir = $p_dir; # $File::Find::dir
1027					$_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1028					if ( substr($_,-2) eq '/.' ) {
1029					substr($_, length($_) == 2 ? -1 : -2) = '';
1030					}
1031
1032					lstat($_); # make sure file tests with '_' work
1033					{ $wanted_callback->() }; # protect against wild "next"
1034					}
1035					else {
1036					push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1037					last;
1038					}
1039					}
1040					}
1041					}
1042
1043
1044					sub wrap_wanted {
1045					my $wanted = shift;
1046					if ( ref($wanted) eq 'HASH' ) {
1047					unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1048					die 'no &wanted subroutine given';
1049					}
1050					if ( $wanted->{follow} || $wanted->{follow_fast}) {
1051					$wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1052					}
1053					if ( $wanted->{untaint} ) {
1054					$wanted->{untaint_pattern} = $File::Find::untaint_pattern
1055					unless defined $wanted->{untaint_pattern};
1056					$wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1057					}
1058					return $wanted;
1059					}
1060					elsif( ref( $wanted ) eq 'CODE' ) {
1061					return { wanted => $wanted };
1062					}
1063					else {
1064					die 'no &wanted subroutine given';
1065					}
1066					}
1067
1068					sub find {
1069					my $wanted = shift;
1070					_find_opt(wrap_wanted($wanted), @_);
1071					}
1072
1073					sub finddepth {
1074					my $wanted = wrap_wanted(shift);
1075					$wanted->{bydepth} = 1;
1076					_find_opt($wanted, @_);
1077					}
1078
1079					# default
1080	1	30µs	1	13µs	$File::Find::skip_pattern = qr/^\.{1,2}\z/; # spent 13µs making 1 call to File::Find::CORE:qr
1081	1	7µs	1	3µs	$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|; # spent 3µs making 1 call to File::Find::CORE:qr
1082
1083					# These are hard-coded for now, but may move to hint files.
1084	1	3µs			if ($^O eq 'VMS') {
1085					$Is_VMS = 1;
1086					$File::Find::dont_use_nlink = 1;
1087					}
1088					elsif ($^O eq 'MSWin32') {
1089					$Is_Win32 = 1;
1090					}
1091
1092					# this _should_ work properly on all platforms
1093					# where File::Find can be expected to work
1094	1	16µs	1	6µs	$File::Find::current_dir = File::Spec->curdir || '.'; # spent 6µs making 1 call to File::Spec::Unix::curdir
1095
1096	1	4µs			$File::Find::dont_use_nlink = 1
1097					if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
1098					$^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1099					$^O eq 'nto';
1100
1101					# Set dont_use_nlink in your hint file if your system's stat doesn't
1102					# report the number of links in a directory as an indication
1103					# of the number of files.
1104					# See, e.g. hints/machten.sh for MachTen 2.2.
1105	1	500ns			unless ($File::Find::dont_use_nlink) {
1106					require Config;
1107					$File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1108					}
1109
1110					# We need a function that checks if a scalar is tainted. Either use the
1111					# Scalar::Util module's tainted() function or our (slower) pure Perl
1112					# fallback is_tainted_pp()
1113					{
1114	4	9µs			local $@;
1115	1	2µs			eval { require Scalar::Util };
1116					*is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1117					}
1118
1119	1	102µs			1;
					# spent 16µs within File::Find::CORE:qr which was called 2 times, avg 8µs/call: # once (13µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 1080 # once (3µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 1081 sub File::Find::CORE:qr; # opcode