← Index
NYTProf Performance Profile   « line view »
For Makefile.PL
  Run on Sun Mar 1 16:04:44 2015
Reported on Sun Mar 1 16:09:02 2015

FilenameC:/tmp64ng/perl/lib/File/Find.pm
StatementsExecuted 766 statements in 31.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
672115.6ms15.6msFile::Find::::CORE:lstatFile::Find::CORE:lstat (opcode)
1110s0sFile::Find::::BEGIN@2File::Find::BEGIN@2
1110s0sFile::Find::::BEGIN@3File::Find::BEGIN@3
1110s0sFile::Find::::BEGIN@357File::Find::BEGIN@357
1110s0sFile::Find::::BEGIN@4File::Find::BEGIN@4
1110s0sFile::Find::::BEGIN@5File::Find::BEGIN@5
6310s0sFile::Find::::CORE:chdirFile::Find::CORE:chdir (opcode)
4110s0sFile::Find::::CORE:closedirFile::Find::CORE:closedir (opcode)
67210s0sFile::Find::::CORE:ftdirFile::Find::CORE:ftdir (opcode)
79410s0sFile::Find::::CORE:matchFile::Find::CORE:match (opcode)
4110s0sFile::Find::::CORE:open_dirFile::Find::CORE:open_dir (opcode)
2210s0sFile::Find::::CORE:qrFile::Find::CORE:qr (opcode)
4110s0sFile::Find::::CORE:readdirFile::Find::CORE:readdir (opcode)
74110s0sFile::Find::::CORE:regcompFile::Find::CORE:regcomp (opcode)
1110s0sFile::Find::::CORE:substFile::Find::CORE:subst (opcode)
0000s0sFile::Find::::Follow_SymLinkFile::Find::Follow_SymLink
0000s0sFile::Find::::PathCombineFile::Find::PathCombine
1110s15.6msFile::Find::::_find_dirFile::Find::_find_dir
0000s0sFile::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
1110s15.6msFile::Find::::_find_optFile::Find::_find_opt
0000s0sFile::Find::::contract_nameFile::Find::contract_name
1110s15.6msFile::Find::::findFile::Find::find
0000s0sFile::Find::::finddepthFile::Find::finddepth
0000s0sFile::Find::::is_tainted_ppFile::Find::is_tainted_pp
1110s0sFile::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
1package File::Find;
220s10s
# spent 0s within File::Find::BEGIN@2 which was called: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 2
use 5.006;
# spent 0s making 1 call to File::Find::BEGIN@2
320s20s
# spent 0s within File::Find::BEGIN@3 which was called: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 3
use strict;
# spent 0s making 1 call to File::Find::BEGIN@3 # spent 0s making 1 call to strict::import
420s20s
# spent 0s within File::Find::BEGIN@4 which was called: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 4
use warnings;
# spent 0s making 1 call to File::Find::BEGIN@4 # spent 0s making 1 call to warnings::import
520s20s
# spent 0s within File::Find::BEGIN@5 which was called: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 5
use warnings::register;
# spent 0s making 1 call to File::Find::BEGIN@5 # spent 0s making 1 call to warnings::register::import
610sour $VERSION = '1.27';
710srequire Exporter;
810srequire 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
18File::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
35These are functions for searching through directory trees doing work
36on each file found similar to the Unix I<find> command. File::Find
37exports two functions, C<find> and C<finddepth>. They work similarly
38but have subtle differences.
39
40=over 4
41
42=item B<find>
43
44 find(\&wanted, @directories);
45 find(\%options, @directories);
46
47C<find()> does a depth-first search over the given C<@directories> in
48the order they are given. For each file or directory found, it calls
49the C<&wanted> subroutine. (See below for details on how to use the
50C<&wanted> function). Additionally, for each directory found, it will
51C<chdir()> into that directory and continue the search, invoking the
52C<&wanted> function on each file or subdirectory in the directory.
53
54=item B<finddepth>
55
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
58
59C<finddepth()> works just like C<find()> except that it invokes the
60C<&wanted> function for a directory I<after> invoking it for the
61directory's contents. It does a postorder traversal instead of a
62preorder traversal, working from the bottom of the directory tree up
63where C<find()> works from the top of the tree down.
64
65=back
66
67=head2 %options
68
69The first argument to C<find()> is either a code reference to your
70C<&wanted> function, or a hash reference describing the operations
71to be performed for each file. The
72code reference is described in L<The wanted function> below.
73
74Here are the possible keys for the hash:
75
76=over 3
77
78=item C<wanted>
79
80The value should be a code reference. This code reference is
81described in L<The wanted function> below. The C<&wanted> subroutine is
82mandatory.
83
84=item C<bydepth>
85
86Reports the name of a directory only AFTER all its entries
87have been reported. Entry point C<finddepth()> is a shortcut for
88specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
89
90=item C<preprocess>
91
92The value should be a code reference. This code reference is used to
93preprocess the current directory. The name of the currently processed
94directory is in C<$File::Find::dir>. Your preprocessing function is
95called after C<readdir()>, but before the loop that calls the C<wanted()>
96function. It is called with a list of strings (actually file/directory
97names) and is expected to return a list of strings. The code can be
98used to sort the file/directory names alphabetically, numerically,
99or to filter out directory entries based on their name alone. When
100I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
101
102=item C<postprocess>
103
104The value should be a code reference. It is invoked just before leaving
105the currently processed directory. It is called in void context with no
106arguments. The name of the current directory is in C<$File::Find::dir>. This
107hook is handy for summarizing a directory, such as calculating its disk
108usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
109no-op.
110
111=item C<follow>
112
113Causes symbolic links to be followed. Since directory trees with symbolic
114links (followed) may contain files more than once and may even have
115cycles, a hash has to be built up with an entry for each file.
116This might be expensive both in space and time for a large
117directory tree. See L</follow_fast> and L</follow_skip> below.
118If either I<follow> or I<follow_fast> is in effect:
119
120=over 6
121
122=item *
123
124It is guaranteed that an I<lstat> has been called before the user's
125C<wanted()> function is called. This enables fast file checks involving S<_>.
126Note that this guarantee no longer holds if I<follow> or I<follow_fast>
127are not set.
128
129=item *
130
131There is a variable C<$File::Find::fullname> which holds the absolute
132pathname of the file with all symbolic links resolved. If the link is
133a dangling symbolic link, then fullname will be set to C<undef>.
134
135=back
136
137This is a no-op on Win32.
138
139=item C<follow_fast>
140
141This is similar to I<follow> except that it may report some files more
142than once. It does detect cycles, however. Since only symbolic links
143have to be hashed, this is much cheaper both in space and time. If
144processing a file more than once (by the user's C<wanted()> function)
145is worse than just taking time, the option I<follow> should be used.
146
147This is also a no-op on Win32.
148
149=item C<follow_skip>
150
151C<follow_skip==1>, which is the default, causes all files which are
152neither directories nor symbolic links to be ignored if they are about
153to be processed a second time. If a directory or a symbolic link
154are about to be processed a second time, File::Find dies.
155
156C<follow_skip==0> causes File::Find to die if any file is about to be
157processed a second time.
158
159C<follow_skip==2> causes File::Find to ignore any duplicate files and
160directories but to proceed normally otherwise.
161
162=item C<dangling_symlinks>
163
164If true and a code reference, will be called with the symbolic link
165name and the directory it lives in as arguments. Otherwise, if true
166and warnings are on, warning "symbolic_link_name is a dangling
167symbolic link\n" will be issued. If false, the dangling symbolic link
168will be silently ignored.
169
170=item C<no_chdir>
171
172Does not C<chdir()> to each directory as it recurses. The C<wanted()>
173function will need to be aware of this, of course. In this case,
174C<$_> will be the same as C<$File::Find::name>.
175
176=item C<untaint>
177
178If find is used in taint-mode (-T command line switch or if EUID != UID
179or if EGID != GID) then internally directory names have to be untainted
180before they can be chdir'ed to. Therefore they are checked against a regular
181expression I<untaint_pattern>. Note that all names passed to the user's
182I<wanted()> function are still tainted. If this option is used while
183not in taint-mode, C<untaint> is a no-op.
184
185=item C<untaint_pattern>
186
187See above. This should be set using the C<qr> quoting operator.
188The default is set to C<qr|^([-+@\w./]+)$|>.
189Note that the parentheses are vital.
190
191=item C<untaint_skip>
192
193If set, a directory which fails the I<untaint_pattern> is skipped,
194including all its sub-directories. The default is to 'die' in such a case.
195
196=back
197
198=head2 The wanted function
199
200The C<wanted()> function does whatever verifications you want on
201each file and directory. Note that despite its name, the C<wanted()>
202function is a generic callback function, and does B<not> tell
203File::Find if a file is "wanted" or not. In fact, its return value
204is ignored.
205
206The wanted function takes no arguments but rather does its work
207through 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
219The above variables have all been localized and may be changed without
220affecting data outside of the wanted function.
221
222For 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
228You are chdir()'d to C<$File::Find::dir> when the function is called,
229unless C<no_chdir> was specified. Note that when changing to
230directories is in effect the root directory (F</>) is a somewhat
231special case inasmuch as the concatenation of C<$File::Find::dir>,
232C<'/'> and C<$_> is not literally equal to C<$File::Find::name>. The
233table 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
245When C<follow> or C<follow_fast> are in effect, there is
246also a C<$File::Find::fullname>. The function may set
247C<$File::Find::prune> to prune the tree unless C<bydepth> was
248specified. Unless C<follow> or C<follow_fast> is specified, for
249compatibility reasons (find.pl, find2perl) there are in addition the
250following globals available: C<$File::Find::topdir>,
251C<$File::Find::topdev>, C<$File::Find::topino>,
252C<$File::Find::topmode> and C<$File::Find::topnlink>.
253
254This 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
259produces 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
272Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
273filehandle that caches the information from the preceding
274C<stat()>, C<lstat()>, or filetest.
275
276Here's another interesting wanted function. It will find all symbolic
277links that don't resolve:
278
279 sub wanted {
280 -l && !-e && print "bogus link: $File::Find::name\n";
281 }
282
283Note that you may mix directories and (non-directory) files in the list of
284directories to be searched by the C<wanted()> function.
285
286 find(\&wanted, "./foo", "./bar", "./baz/epsilon");
287
288In the example above, no file in F<./baz/> other than F<./baz/epsilon> will be
289evaluated by C<wanted()>.
290
291See also the script C<pfind> on CPAN for a nice application of this
292module.
293
294=head1 WARNINGS
295
296If you run your program with the C<-w> switch, or if you use the
297C<warnings> pragma, File::Find will report warnings for several weird
298situations. You can disable these warnings by putting the statement
299
300 no warnings 'File::Find';
301
302in the appropriate scope. See L<warnings> for more info about lexical
303warnings.
304
305=head1 CAVEAT
306
307=over 2
308
309=item $dont_use_nlink
310
311You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
312force File::Find to always stat directories. This was used for file systems
313that do not have an C<nlink> count matching the number of sub-directories.
314Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
315system) and a couple of others.
316
317You shouldn't need to set this variable, since File::Find should now detect
318such file systems on-the-fly and switch itself to using stat. This works even
319for parts of your file system, like a mounted CD-ROM.
320
321If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
322
323=item symlinks
324
325Be aware that the option to follow symbolic links can be dangerous.
326Depending on the structure of the directory tree (including symbolic
327links to directories) you might traverse a given (physical) directory
328more than once (only if C<follow_fast> is in effect).
329Furthermore, deleting or changing files in a symbolically linked directory
330might cause very unpleasant surprises, since you delete or change files
331in an unknown directory.
332
333=back
334
335=head1 BUGS AND CAVEATS
336
337Despite the name of the C<finddepth()> function, both C<find()> and
338C<finddepth()> perform a depth-first search of the directory
339hierarchy.
340
341=head1 HISTORY
342
343File::Find used to produce incorrect results if called recursively.
344During the development of perl 5.8 this bug was fixed.
345The first fixed version of File::Find was 1.01.
346
347=head1 SEE ALSO
348
349find, find2perl.
350
351=cut
352
35310sour @ISA = qw(Exporter);
35410sour @EXPORT = qw(find finddepth);
355
356
357215.6ms20s
# spent 0s within File::Find::BEGIN@357 which was called: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 357
use strict;
# spent 0s making 1 call to File::Find::BEGIN@357 # spent 0s making 1 call to strict::import
35810smy $Is_VMS;
359my $Is_Win32;
360
36110srequire File::Basename;
36210srequire File::Spec;
363
364# Should ideally be my() not our() but local() currently
365# refuses to operate on lexicals
366
36710sour %SLnkSeen;
36810sour ($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
372sub 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
390sub 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
413sub 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
45610sour($dir, $name, $fullname, $prune);
457sub _find_dir_symlnk($$$);
458sub _find_dir($$$);
459
460# check whether or not a scalar variable is tainted
461# (code straight from the Camel, 3rd ed., page 561)
462sub 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
# spent 15.6ms (0s+15.6) within File::Find::_find_opt which was called: # once (0s+15.6ms) by File::Find::find at line 1081
sub _find_opt {
47110s my $wanted = shift;
47210s die "invalid top directory" unless defined $_[0];
473
474 # This function must local()ize everything because callbacks may
475 # call find() or finddepth()
476
47710s local %SLnkSeen;
47810s 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);
48110s local($dir, $name, $fullname, $prune);
48210s local *_ = \my $a;
483
48410s10s my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
# spent 0s making 1 call to Cwd::_win32_cwd
48510s 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 }
49910s my $cwd_untainted = $cwd;
50010s my $check_t_cwd = 1;
50110s $wanted_callback = $wanted->{wanted};
50210s $bydepth = $wanted->{bydepth};
50310s $pre_process = $wanted->{preprocess};
50410s $post_process = $wanted->{postprocess};
50510s $no_chdir = $wanted->{no_chdir};
50610s $full_check = $Is_Win32 ? 0 : $wanted->{follow};
50710s $follow = $Is_Win32 ? 0 :
508 $full_check || $wanted->{follow_fast};
50910s $follow_skip = $wanted->{follow_skip};
51010s $untaint = $wanted->{untaint};
51110s $untaint_pat = $wanted->{untaint_pattern};
51210s $untaint_skip = $wanted->{untaint_skip};
51310s $dangling_symlinks = $wanted->{dangling_symlinks};
514
515 # for compatibility reasons (find.pl, find2perl)
51610s local our ($topdir, $topdev, $topino, $topmode, $topnlink);
517
518 # a symbolic link to a directory doesn't increase the link count
51910s $avoid_nlink = $follow || $File::Find::dont_use_nlink;
520
52110s my ($abs_dir, $Is_Dir);
522
523 Proc_Top_Item:
52410s foreach my $TOP (@_) {
52510s my $top_item = $TOP;
52610s $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
527
52810s10s ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
# spent 0s making 1 call to File::Find::CORE:lstat
529
53010s if ($Is_Win32) {
53110s20s $top_item =~ s|[/\\]\z||
# spent 0s making 1 call to File::Find::CORE:match # spent 0s making 1 call to File::Find::CORE:subst
532 unless $top_item =~ m{^(?:\w:)?[/\\]$};
533 }
534 else {
535 $top_item =~ s|/\z|| unless $top_item eq '/';
536 }
537
53810s $Is_Dir= 0;
539
54010s 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
57110s $topdir = $top_item;
57210s unless (defined $topnlink) {
573 warnings::warnif "Can't stat $top_item: $!\n";
574 next Proc_Top_Item;
575 }
57610s10s if (-d _) {
# spent 0s making 1 call to File::Find::CORE:ftdir
57710s $top_item =~ s/\.dir\z//i if $Is_VMS;
57810s115.6ms _find_dir($wanted, $top_item, $topnlink);
# spent 15.6ms making 1 call to File::Find::_find_dir
57910s $Is_Dir= 1;
580 }
581 else {
582 $abs_dir= $top_item;
583 }
584 }
585
58610s 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
61610s unless ( $no_chdir ) {
61710s 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 }
62410s10s unless (chdir $cwd_untainted) {
# spent 0s making 1 call to File::Find::CORE:chdir
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
# spent 15.6ms (0s+15.6) within File::Find::_find_dir which was called: # once (0s+15.6ms) by File::Find::_find_opt at line 578
sub _find_dir($$$) {
63910s my ($wanted, $p_dir, $nlink) = @_;
64010s my ($CdLvl,$Level) = (0,0);
64110s my @Stack;
642 my @filenames;
643 my ($subcount,$sub_nlink);
64410s my $SE= [];
64510s my $dir_name= $p_dir;
64610s my $dir_pref;
64710s my $dir_rel = $File::Find::current_dir;
64810s my $tainted = 0;
64910s my $no_nlink;
650
65110s if ($Is_Win32) {
65210s10s $dir_pref
# spent 0s making 1 call to File::Find::CORE:match
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
66910s local ($dir, $name, $prune, *DIR);
670
67110s 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
69110s push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
692
69310s while (defined $SE) {
69440s unless ($bydepth) {
69540s $dir= $p_dir; # $File::Find::dir
69640s $name= $dir_name; # $File::Find::name
69740s $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
698 # prune may happen here
69940s $prune= 0;
70080s40s { $wanted_callback->() }; # protect against wild "next"
# spent 0s making 4 calls to ExtUtils::Manifest::__ANON__[ExtUtils/Manifest.pm:196], avg 0s/call
70140s next if $prune;
702 }
703
704 # change to that directory
70540s unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
70630s my $udir= $dir_rel;
70730s 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 }
71730s30s unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
# spent 0s making 3 calls to File::Find::CORE:chdir, avg 0s/call
718 warnings::warnif "Can't cd to (" .
719 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
720 next;
721 }
72230s $CdLvl++;
723 }
724
72540s $dir= $dir_name; # $File::Find::dir
726
727 # Get the list of files in the current directory.
72840s40s unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
# spent 0s making 4 calls to File::Find::CORE:open_dir, avg 0s/call
729 warnings::warnif "Can't opendir($dir_name): $!\n";
730 next;
731 }
73240s40s @filenames = readdir DIR;
# spent 0s making 4 calls to File::Find::CORE:readdir, avg 0s/call
73340s40s closedir(DIR);
# spent 0s making 4 calls to File::Find::CORE:closedir, avg 0s/call
73440s @filenames = $pre_process->(@filenames) if $pre_process;
73540s 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)
73940s $no_nlink = $avoid_nlink;
740 # if dir has wrong nlink count, force switch to slower stat method
74140s $no_nlink = 1 if ($nlink < 2);
742
74340s 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.
76440s $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.
76940s my $stack_top = @Stack;
770
77140s for my $FN (@filenames) {
772740s1480s next if $FN =~ $File::Find::skip_pattern;
# spent 0s making 74 calls to File::Find::CORE:match, avg 0s/call # spent 0s making 74 calls to File::Find::CORE:regcomp, avg 0s/call
773660s 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
7776615.6ms6615.6ms $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
# spent 15.6ms making 66 calls to File::Find::CORE:lstat, avg 236µs/call
778
779660s660s if (-d _) {
# spent 0s making 66 calls to File::Find::CORE:ftdir, avg 0s/call
78030s --$subcount;
78130s $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];
78430s splice @Stack, $stack_top, 0,
785 [$CdLvl,$dir_name,$FN,$sub_nlink];
786 }
787 else {
788630s $name = $dir_pref . $FN; # $File::Find::name
789630s $_= ($no_chdir ? $name : $FN); # $_
7901260s630s { $wanted_callback->() }; # protect against wild "next"
# spent 0s making 63 calls to ExtUtils::Manifest::__ANON__[ExtUtils/Manifest.pm:196], avg 0s/call
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 {
80240s while ( defined ($SE = pop @Stack) ) {
80330s ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
80430s if ($CdLvl > $Level && !$no_chdir) {
80520s my $tmp;
80620s if ($Is_VMS) {
807 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
808 }
809 else {
81020s $tmp = join('/',('..') x ($CdLvl-$Level));
811 }
81220s20s die "Can't cd to $tmp from $dir_name: $!"
# spent 0s making 2 calls to File::Find::CORE:chdir, avg 0s/call
813 unless chdir ($tmp);
81420s $CdLvl = $Level;
815 }
816
81730s if ($Is_Win32) {
81830s30s $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
# spent 0s making 3 calls to File::Find::CORE:match, avg 0s/call
819 ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
82030s $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
83830s 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 {
85630s push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
85730s 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
871sub _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 { $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 { $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
# spent 0s within File::Find::wrap_wanted which was called: # once (0s+0s) by File::Find::find at line 1081
sub wrap_wanted {
105610s my $wanted = shift;
105710s if ( ref($wanted) eq 'HASH' ) {
105810s unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1059 die 'no &wanted subroutine given';
1060 }
106110s if ( $wanted->{follow} || $wanted->{follow_fast}) {
1062 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1063 }
106410s 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 }
106910s 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
# spent 15.6ms (0s+15.6) within File::Find::find which was called: # once (0s+15.6ms) by ExtUtils::Manifest::manifind at line 202 of ExtUtils/Manifest.pm
sub find {
108010s my $wanted = shift;
108110s215.6ms _find_opt(wrap_wanted($wanted), @_);
# spent 15.6ms making 1 call to File::Find::_find_opt # spent 0s making 1 call to File::Find::wrap_wanted
1082}
1083
1084sub finddepth {
1085 my $wanted = wrap_wanted(shift);
1086 $wanted->{bydepth} = 1;
1087 _find_opt($wanted, @_);
1088}
1089
1090# default
109110s10s$File::Find::skip_pattern = qr/^\.{1,2}\z/;
# spent 0s making 1 call to File::Find::CORE:qr
109210s10s$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
# spent 0s making 1 call to File::Find::CORE:qr
1093
1094# These are hard-coded for now, but may move to hint files.
109510sif ($^O eq 'VMS') {
1096 $Is_VMS = 1;
1097 $File::Find::dont_use_nlink = 1;
1098}
1099elsif ($^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
110510s10s$File::Find::current_dir = File::Spec->curdir || '.';
# spent 0s making 1 call to File::Spec::Unix::curdir
1106
110710s$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.
111510sunless ($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{
112420s local $@;
112520s eval { require Scalar::Util };
112610s *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1127}
1128
112910s1;
 
# spent 0s within File::Find::CORE:chdir which was called 6 times, avg 0s/call: # 3 times (0s+0s) by File::Find::_find_dir at line 717, avg 0s/call # 2 times (0s+0s) by File::Find::_find_dir at line 812, avg 0s/call # once (0s+0s) by File::Find::_find_opt at line 624
sub File::Find::CORE:chdir; # opcode
# spent 0s within File::Find::CORE:closedir which was called 4 times, avg 0s/call: # 4 times (0s+0s) by File::Find::_find_dir at line 733, avg 0s/call
sub File::Find::CORE:closedir; # opcode
# spent 0s within File::Find::CORE:ftdir which was called 67 times, avg 0s/call: # 66 times (0s+0s) by File::Find::_find_dir at line 779, avg 0s/call # once (0s+0s) by File::Find::_find_opt at line 576
sub File::Find::CORE:ftdir; # opcode
# spent 15.6ms within File::Find::CORE:lstat which was called 67 times, avg 233µs/call: # 66 times (15.6ms+0s) by File::Find::_find_dir at line 777, avg 236µs/call # once (0s+0s) by File::Find::_find_opt at line 528
sub File::Find::CORE:lstat; # opcode
# spent 0s within File::Find::CORE:match which was called 79 times, avg 0s/call: # 74 times (0s+0s) by File::Find::_find_dir at line 772, avg 0s/call # 3 times (0s+0s) by File::Find::_find_dir at line 818, avg 0s/call # once (0s+0s) by File::Find::_find_opt at line 531 # once (0s+0s) by File::Find::_find_dir at line 652
sub File::Find::CORE:match; # opcode
# spent 0s within File::Find::CORE:open_dir which was called 4 times, avg 0s/call: # 4 times (0s+0s) by File::Find::_find_dir at line 728, avg 0s/call
sub File::Find::CORE:open_dir; # opcode
# spent 0s within File::Find::CORE:qr which was called 2 times, avg 0s/call: # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 1091 # once (0s+0s) by ExtUtils::Manifest::BEGIN@7 at line 1092
sub File::Find::CORE:qr; # opcode
# spent 0s within File::Find::CORE:readdir which was called 4 times, avg 0s/call: # 4 times (0s+0s) by File::Find::_find_dir at line 732, avg 0s/call
sub File::Find::CORE:readdir; # opcode
# spent 0s within File::Find::CORE:regcomp which was called 74 times, avg 0s/call: # 74 times (0s+0s) by File::Find::_find_dir at line 772, avg 0s/call
sub File::Find::CORE:regcomp; # opcode
# spent 0s within File::Find::CORE:subst which was called: # once (0s+0s) by File::Find::_find_opt at line 531
sub File::Find::CORE:subst; # opcode
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.