← Index
NYTProf Performance Profile   « line view »
For /Users/brian/bin/perls/cpan5.26.1
  Run on Sat Dec 30 01:41:10 2017
Reported on Sat Dec 30 01:44:15 2017

Filename/usr/local/perls/perl-5.26.1/lib/5.26.1/File/Find.pm
StatementsExecuted 207641 statements in 1.26s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1432221705ms705msFile::Find::::CORE:lstatFile::Find::CORE:lstat (opcode)
9811352ms1.54sFile::Find::::_find_dirFile::Find::_find_dir
235711131ms131msFile::Find::::CORE:readdirFile::Find::CORE:readdir (opcode)
189292129.0ms29.0msFile::Find::::CORE:regcompFile::Find::CORE:regcomp (opcode)
23571122.0ms22.0msFile::Find::::CORE:open_dirFile::Find::CORE:open_dir (opcode)
189292116.7ms16.7msFile::Find::::CORE:matchFile::Find::CORE:match (opcode)
35835110.9ms10.9msFile::Find::::CORE:chdirFile::Find::CORE:chdir (opcode)
2357117.63ms7.63msFile::Find::::CORE:closedirFile::Find::CORE:closedir (opcode)
14322216.00ms6.00msFile::Find::::CORE:ftdirFile::Find::CORE:ftdir (opcode)
107114.91ms1.55sFile::Find::::_find_optFile::Find::_find_opt
107111.03ms1.55sFile::Find::::findFile::Find::find
10711664µs664µsFile::Find::::wrap_wantedFile::Find::wrap_wanted
10711200µs200µsFile::Find::::CORE:substFile::Find::CORE:subst (opcode)
0000s0sFile::Find::::BEGINFile::Find::BEGIN
0000s0sFile::Find::::Follow_SymLinkFile::Find::Follow_SymLink
0000s0sFile::Find::::PathCombineFile::Find::PathCombine
0000s0sFile::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
0000s0sFile::Find::::contract_nameFile::Find::contract_name
0000s0sFile::Find::::finddepthFile::Find::finddepth
0000s0sFile::Find::::is_tainted_ppFile::Find::is_tainted_pp
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;
2use 5.006;
3use strict;
4use warnings;
5use warnings::register;
6our $VERSION = '1.34';
7require Exporter;
8require Cwd;
9
10our @ISA = qw(Exporter);
11our @EXPORT = qw(find finddepth);
12
13
14use strict;
15my $Is_VMS;
16my $Is_Win32;
17
18require File::Basename;
19require File::Spec;
20
21# Should ideally be my() not our() but local() currently
22# refuses to operate on lexicals
23
24our %SLnkSeen;
25our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
26 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
27 $pre_process, $post_process, $dangling_symlinks);
28
29sub contract_name {
30 my ($cdir,$fn) = @_;
31
32 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
33
34 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
35
36 $fn =~ s|^\./||;
37
38 my $abs_name= $cdir . $fn;
39
40 if (substr($fn,0,3) eq '../') {
41 1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
42 }
43
44 return $abs_name;
45}
46
47sub PathCombine($$) {
48 my ($Base,$Name) = @_;
49 my $AbsName;
50
51 if (substr($Name,0,1) eq '/') {
52 $AbsName= $Name;
53 }
54 else {
55 $AbsName= contract_name($Base,$Name);
56 }
57
58 # (simple) check for recursion
59 my $newlen= length($AbsName);
60 if ($newlen <= length($Base)) {
61 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
62 && $AbsName eq substr($Base,0,$newlen))
63 {
64 return undef;
65 }
66 }
67 return $AbsName;
68}
69
70sub Follow_SymLink($) {
71 my ($AbsName) = @_;
72
73 my ($NewName,$DEV, $INO);
74 ($DEV, $INO)= lstat $AbsName;
75
76 while (-l _) {
77 if ($SLnkSeen{$DEV, $INO}++) {
78 if ($follow_skip < 2) {
79 die "$AbsName is encountered a second time";
80 }
81 else {
82 return undef;
83 }
84 }
85 $NewName= PathCombine($AbsName, readlink($AbsName));
86 unless(defined $NewName) {
87 if ($follow_skip < 2) {
88 die "$AbsName is a recursive symbolic link";
89 }
90 else {
91 return undef;
92 }
93 }
94 else {
95 $AbsName= $NewName;
96 }
97 ($DEV, $INO) = lstat($AbsName);
98 return undef unless defined $DEV; # dangling symbolic link
99 }
100
101 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
102 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
103 die "$AbsName encountered a second time";
104 }
105 else {
106 return undef;
107 }
108 }
109
110 return $AbsName;
111}
112
113our($dir, $name, $fullname, $prune);
114sub _find_dir_symlnk($$$);
115sub _find_dir($$$);
116
117# check whether or not a scalar variable is tainted
118# (code straight from the Camel, 3rd ed., page 561)
119sub is_tainted_pp {
120 my $arg = shift;
121 my $nada = substr($arg, 0, 0); # zero-length
122 local $@;
123 eval { eval "# $nada" };
124 return length($@) != 0;
125}
126
127
# spent 1.55s (4.91ms+1.54) within File::Find::_find_opt which was called 107 times, avg 14.5ms/call: # 107 times (4.91ms+1.54s) by File::Find::find at line 760, avg 14.5ms/call
sub _find_opt {
12810763µs my $wanted = shift;
12910763µs return unless @_;
13010766µs die "invalid top directory" unless defined $_[0];
131
132 # This function must local()ize everything because callbacks may
133 # call find() or finddepth()
134
135107105µs local %SLnkSeen;
136107150µs local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
137 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
138 $pre_process, $post_process, $dangling_symlinks);
13910751µs local($dir, $name, $fullname, $prune);
140107188µs local *_ = \my $a;
141
1421073.10ms1072.54ms my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
# spent 2.54ms making 107 calls to Cwd::getcwd, avg 24µs/call
14310734µs if ($Is_VMS) {
144 # VMS returns this by default in VMS format which just doesn't
145 # work for the rest of this module.
146 $cwd = VMS::Filespec::unixpath($cwd);
147
148 # Apparently this is not expected to have a trailing space.
149 # To attempt to make VMS/UNIX conversions mostly reversible,
150 # a trailing slash is needed. The run-time functions ignore the
151 # resulting double slash, but it causes the perl tests to fail.
152 $cwd =~ s#/\z##;
153
154 # This comes up in upper case now, but should be lower.
155 # In the future this could be exact case, no need to change.
156 }
15710752µs my $cwd_untainted = $cwd;
15810734µs my $check_t_cwd = 1;
15910760µs $wanted_callback = $wanted->{wanted};
16010743µs $bydepth = $wanted->{bydepth};
16110741µs $pre_process = $wanted->{preprocess};
16210730µs $post_process = $wanted->{postprocess};
16310743µs $no_chdir = $wanted->{no_chdir};
16410746µs $full_check = $Is_Win32 ? 0 : $wanted->{follow};
165 $follow = $Is_Win32 ? 0 :
16610749µs $full_check || $wanted->{follow_fast};
16710739µs $follow_skip = $wanted->{follow_skip};
16810734µs $untaint = $wanted->{untaint};
16910739µs $untaint_pat = $wanted->{untaint_pattern};
17010751µs $untaint_skip = $wanted->{untaint_skip};
17110731µs $dangling_symlinks = $wanted->{dangling_symlinks};
172
173 # for compatibility reasons (find.pl, find2perl)
17410778µs local our ($topdir, $topdev, $topino, $topmode, $topnlink);
175
176 # a symbolic link to a directory doesn't increase the link count
17710744µs $avoid_nlink = $follow || $File::Find::dont_use_nlink;
178
17910728µs my ($abs_dir, $Is_Dir);
180
181 Proc_Top_Item:
182107737µs foreach my $TOP (@_) {
18310746µs my $top_item = $TOP;
18410724µs $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
185
1861071.26ms107789µs ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
# spent 789µs making 107 calls to File::Find::CORE:lstat, avg 7µs/call
187
18810764µs if ($Is_Win32) {
189 $top_item =~ s|[/\\]\z||
190 unless $top_item =~ m{^(?:\w:)?[/\\]$};
191 }
192 else {
193107465µs107200µs $top_item =~ s|/\z|| unless $top_item eq '/';
# spent 200µs making 107 calls to File::Find::CORE:subst, avg 2µs/call
194 }
195
19610737µs $Is_Dir= 0;
197
19810758µs if ($follow) {
199
200 if (substr($top_item,0,1) eq '/') {
201 $abs_dir = $top_item;
202 }
203 elsif ($top_item eq $File::Find::current_dir) {
204 $abs_dir = $cwd;
205 }
206 else { # care about any ../
207 $top_item =~ s/\.dir\z//i if $Is_VMS;
208 $abs_dir = contract_name("$cwd/",$top_item);
209 }
210 $abs_dir= Follow_SymLink($abs_dir);
211 unless (defined $abs_dir) {
212 if ($dangling_symlinks) {
213 if (ref $dangling_symlinks eq 'CODE') {
214 $dangling_symlinks->($top_item, $cwd);
215 } else {
216 warnings::warnif "$top_item is a dangling symbolic link\n";
217 }
218 }
219 next Proc_Top_Item;
220 }
221
222 if (-d _) {
223 $top_item =~ s/\.dir\z//i if $Is_VMS;
224 _find_dir_symlnk($wanted, $abs_dir, $top_item);
225 $Is_Dir= 1;
226 }
227 }
228 else { # no follow
22910765µs $topdir = $top_item;
23010728µs unless (defined $topnlink) {
231 warnings::warnif "Can't stat $top_item: $!\n";
232 next Proc_Top_Item;
233 }
234107263µs10738µs if (-d _) {
# spent 38µs making 107 calls to File::Find::CORE:ftdir, avg 355ns/call
2359814µs $top_item =~ s/\.dir\z//i if $Is_VMS;
23698233µs981.54s _find_dir($wanted, $top_item, $topnlink);
# spent 1.54s making 98 calls to File::Find::_find_dir, avg 15.7ms/call
2379849µs $Is_Dir= 1;
238 }
239 else {
24094µs $abs_dir= $top_item;
241 }
242 }
243
24410726µs unless ($Is_Dir) {
245950µs9271µs unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
# spent 271µs making 9 calls to File::Basename::fileparse, avg 30µs/call
246 ($dir,$_) = ('./', $top_item);
247 }
248
24995µs $abs_dir = $dir;
25092µs if (( $untaint ) && (is_tainted($dir) )) {
251 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
252 unless (defined $abs_dir) {
253 if ($untaint_skip == 0) {
254 die "directory $dir is still tainted";
255 }
256 else {
257 next Proc_Top_Item;
258 }
259 }
260 }
261
262962µs934µs unless ($no_chdir || chdir $abs_dir) {
# spent 34µs making 9 calls to File::Find::CORE:chdir, avg 4µs/call
263 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
264 next Proc_Top_Item;
265 }
266
267912µs $name = $abs_dir . $_; # $File::Find::name
26891µs $_ = $name if $no_chdir;
269
2701813µs9138µs { $wanted_callback->() }; # protect against wild "next"
# spent 138µs making 9 calls to CPAN::CacheMgr::__ANON__[CPAN/CacheMgr.pm:136], avg 15µs/call
271
272 }
273
274107107µs unless ( $no_chdir ) {
27510750µs if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
276 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
277 unless (defined $cwd_untainted) {
278 die "insecure cwd in find(depth)";
279 }
280 $check_t_cwd = 0;
281 }
282107624µs107376µs unless (chdir $cwd_untainted) {
# spent 376µs making 107 calls to File::Find::CORE:chdir, avg 4µs/call
283 die "Can't cd to $cwd: $!\n";
284 }
285 }
286 }
287}
288
289# API:
290# $wanted
291# $p_dir : "parent directory"
292# $nlink : what came back from the stat
293# preconditions:
294# chdir (if not no_chdir) to dir
295
296
# spent 1.54s (352ms+1.18) within File::Find::_find_dir which was called 98 times, avg 15.7ms/call: # 98 times (352ms+1.18s) by File::Find::_find_opt at line 236, avg 15.7ms/call
sub _find_dir($$$) {
2979889µs my ($wanted, $p_dir, $nlink) = @_;
2989856µs my ($CdLvl,$Level) = (0,0);
2999833µs my @Stack;
300 my @filenames;
301 my ($subcount,$sub_nlink);
3029882µs my $SE= [];
3039841µs my $dir_name= $p_dir;
3049817µs my $dir_pref;
3059852µs my $dir_rel = $File::Find::current_dir;
3069836µs my $tainted = 0;
3079831µs my $no_nlink;
308
3099873µs if ($Is_Win32) {
310 $dir_pref
311 = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
312 } elsif ($Is_VMS) {
313
314 # VMS is returning trailing .dir on directories
315 # and trailing . on files and symbolic links
316 # in UNIX syntax.
317 #
318
319 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
320
321 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
322 }
323 else {
32498110µs $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
325 }
326
32798228µs local ($dir, $name, $prune, *DIR);
328
3299869µs unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
3309845µs my $udir = $p_dir;
3319830µs if (( $untaint ) && (is_tainted($p_dir) )) {
332 ( $udir ) = $p_dir =~ m|$untaint_pat|;
333 unless (defined $udir) {
334 if ($untaint_skip == 0) {
335 die "directory $p_dir is still tainted";
336 }
337 else {
338 return;
339 }
340 }
341 }
34298725µs98406µs unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
# spent 406µs making 98 calls to File::Find::CORE:chdir, avg 4µs/call
343 warnings::warnif "Can't cd to $udir: $!\n";
344 return;
345 }
346 }
347
348 # push the starting directory
3499816µs push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
350
351982.06ms while (defined $SE) {
3522357602µs unless ($bydepth) {
3532357639µs $dir= $p_dir; # $File::Find::dir
3542357451µs $name= $dir_name; # $File::Find::name
3552357697µs $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
356 # prune may happen here
3572357385µs $prune= 0;
35847144.24ms235743.0ms { $wanted_callback->() }; # protect against wild "next"
# spent 43.0ms making 2357 calls to CPAN::CacheMgr::__ANON__[CPAN/CacheMgr.pm:136], avg 18µs/call
3592357428µs next if $prune;
360 }
361
362 # change to that directory
3632357900µs unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
3642259724µs my $udir= $dir_rel;
3652259283µs if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
366 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
367 unless (defined $udir) {
368 if ($untaint_skip == 0) {
369 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
370 } else { # $untaint_skip == 1
371 next;
372 }
373 }
374 }
375225911.2ms22596.84ms unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
# spent 6.84ms making 2259 calls to File::Find::CORE:chdir, avg 3µs/call
376 warnings::warnif "Can't cd to (" .
377 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
378 next;
379 }
3802259619µs $CdLvl++;
381 }
382
3832357768µs $dir= $dir_name; # $File::Find::dir
384
385 # Get the list of files in the current directory.
386235733.9ms235722.0ms unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
# spent 22.0ms making 2357 calls to File::Find::CORE:open_dir, avg 9µs/call
387 warnings::warnif "Can't opendir($dir_name): $!\n";
388 next;
389 }
3902357146ms2357131ms @filenames = readdir DIR;
# spent 131ms making 2357 calls to File::Find::CORE:readdir, avg 56µs/call
391235712.1ms23577.63ms closedir(DIR);
# spent 7.63ms making 2357 calls to File::Find::CORE:closedir, avg 3µs/call
3922357425µs @filenames = $pre_process->(@filenames) if $pre_process;
3932357306µs push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
394
395 # default: use whatever was specified
396 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
3972357564µs $no_nlink = $avoid_nlink;
398 # if dir has wrong nlink count, force switch to slower stat method
3992357581µs $no_nlink = 1 if ($nlink < 2);
400
40123571.19ms if ($nlink == 2 && !$no_nlink) {
402 # This dir has no subdirectories.
40356µs for my $FN (@filenames) {
404102µs if ($Is_VMS) {
405 # Big hammer here - Compensate for VMS trailing . and .dir
406 # No win situation until this is changed, but this
407 # will handle the majority of the cases with breaking the fewest
408
409 $FN =~ s/\.dir\z//i;
410 $FN =~ s#\.$## if ($FN ne '.');
411 }
4121076µs2037µs next if $FN =~ $File::Find::skip_pattern;
# spent 22µs making 10 calls to File::Find::CORE:regcomp, avg 2µs/call # spent 15µs making 10 calls to File::Find::CORE:match, avg 2µs/call
413
414 $name = $dir_pref . $FN; # $File::Find::name
415 $_ = ($no_chdir ? $name : $FN); # $_
416 { $wanted_callback->() }; # protect against wild "next"
417 }
418
419 }
420 else {
421 # This dir has subdirectories.
4222352548µs $subcount = $nlink - 2;
423
424 # HACK: insert directories at this position, so as to preserve
425 # the user pre-processed ordering of files (thus ensuring
426 # directory traversal is in user sorted order, not at random).
42723521.04ms my $stack_top = @Stack;
428
42923522.52ms for my $FN (@filenames) {
43018919130ms3783845.6ms next if $FN =~ $File::Find::skip_pattern;
# spent 28.9ms making 18919 calls to File::Find::CORE:regcomp, avg 2µs/call # spent 16.7ms making 18919 calls to File::Find::CORE:match, avg 881ns/call
4311421513.2ms if ($subcount > 0 || $no_nlink) {
432 # Seen all the subdirs?
433 # check for directoriness.
434 # stat is faster for a file in the current directory
43514215774ms14215704ms $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
# spent 704ms making 14215 calls to File::Find::CORE:lstat, avg 50µs/call
436
4371421536.9ms142155.96ms if (-d _) {
# spent 5.96ms making 14215 calls to File::Find::CORE:ftdir, avg 419ns/call
4382259367µs --$subcount;
4392259290µs $FN =~ s/\.dir\z//i if $Is_VMS;
440 # HACK: replace push to preserve dir traversal order
441 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
44222594.34ms splice @Stack, $stack_top, 0,
443 [$CdLvl,$dir_name,$FN,$sub_nlink];
444 }
445 else {
446119568.74ms $name = $dir_pref . $FN; # $File::Find::name
447119563.25ms $_= ($no_chdir ? $name : $FN); # $_
4482391226.9ms11956215ms { $wanted_callback->() }; # protect against wild "next"
# spent 215ms making 11956 calls to CPAN::CacheMgr::__ANON__[CPAN/CacheMgr.pm:136], avg 18µs/call
449 }
450 }
451 else {
452 $name = $dir_pref . $FN; # $File::Find::name
453 $_= ($no_chdir ? $name : $FN); # $_
454 { $wanted_callback->() }; # protect against wild "next"
455 }
456 }
457 }
458 }
459 continue {
46023573.55ms while ( defined ($SE = pop @Stack) ) {
46122592.33ms ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
4622259784µs if ($CdLvl > $Level && !$no_chdir) {
4631110167µs my $tmp;
4641110269µs if ($Is_VMS) {
465 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
466 }
467 else {
46811101.28ms $tmp = join('/',('..') x ($CdLvl-$Level));
469 }
47011105.63ms11103.29ms die "Can't cd to $tmp from $dir_name: $!"
# spent 3.29ms making 1110 calls to File::Find::CORE:chdir, avg 3µs/call
471 unless chdir ($tmp);
4721110367µs $CdLvl = $Level;
473 }
474
47522595.63ms if ($Is_Win32) {
476 $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
477 ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
478 $dir_pref = "$dir_name/";
479 }
480 elsif ($^O eq 'VMS') {
481 if ($p_dir =~ m/[\]>]+$/) {
482 $dir_name = $p_dir;
483 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
484 $dir_pref = $dir_name;
485 }
486 else {
487 $dir_name = "$p_dir/$dir_rel";
488 $dir_pref = "$dir_name/";
489 }
490 }
491 else {
49222593.12ms $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
4932259481µs $dir_pref = "$dir_name/";
494 }
495
4962259797µs if ( $nlink == -2 ) {
497 $name = $dir = $p_dir; # $File::Find::name / dir
498 $_ = $File::Find::current_dir;
499 $post_process->(); # End-of-directory processing
500 }
501 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
502 $name = $dir_name;
503 if ( substr($name,-2) eq '/.' ) {
504 substr($name, length($name) == 2 ? -1 : -2) = '';
505 }
506 $dir = $p_dir;
507 $_ = ($no_chdir ? $dir_name : $dir_rel );
508 if ( substr($_,-2) eq '/.' ) {
509 substr($_, length($_) == 2 ? -1 : -2) = '';
510 }
511 { $wanted_callback->() }; # protect against wild "next"
512 }
513 else {
5142259349µs push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
5152259827µs last;
516 }
517 }
518 }
519}
520
521
522# API:
523# $wanted
524# $dir_loc : absolute location of a dir
525# $p_dir : "parent directory"
526# preconditions:
527# chdir (if not no_chdir) to dir
528
529sub _find_dir_symlnk($$$) {
530 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
531 my @Stack;
532 my @filenames;
533 my $new_loc;
534 my $updir_loc = $dir_loc; # untainted parent directory
535 my $SE = [];
536 my $dir_name = $p_dir;
537 my $dir_pref;
538 my $loc_pref;
539 my $dir_rel = $File::Find::current_dir;
540 my $byd_flag; # flag for pending stack entry if $bydepth
541 my $tainted = 0;
542 my $ok = 1;
543
544 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
545 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
546
547 local ($dir, $name, $fullname, $prune, *DIR);
548
549 unless ($no_chdir) {
550 # untaint the topdir
551 if (( $untaint ) && (is_tainted($dir_loc) )) {
552 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
553 # once untainted, $updir_loc is pushed on the stack (as parent directory);
554 # hence, we don't need to untaint the parent directory every time we chdir
555 # to it later
556 unless (defined $updir_loc) {
557 if ($untaint_skip == 0) {
558 die "directory $dir_loc is still tainted";
559 }
560 else {
561 return;
562 }
563 }
564 }
565 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
566 unless ($ok) {
567 warnings::warnif "Can't cd to $updir_loc: $!\n";
568 return;
569 }
570 }
571
572 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
573
574 while (defined $SE) {
575
576 unless ($bydepth) {
577 # change (back) to parent directory (always untainted)
578 unless ($no_chdir) {
579 unless (chdir $updir_loc) {
580 warnings::warnif "Can't cd to $updir_loc: $!\n";
581 next;
582 }
583 }
584 $dir= $p_dir; # $File::Find::dir
585 $name= $dir_name; # $File::Find::name
586 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
587 $fullname= $dir_loc; # $File::Find::fullname
588 # prune may happen here
589 $prune= 0;
590 lstat($_); # make sure file tests with '_' work
591 { $wanted_callback->() }; # protect against wild "next"
592 next if $prune;
593 }
594
595 # change to that directory
596 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
597 $updir_loc = $dir_loc;
598 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
599 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
600 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
601 unless (defined $updir_loc) {
602 if ($untaint_skip == 0) {
603 die "directory $dir_loc is still tainted";
604 }
605 else {
606 next;
607 }
608 }
609 }
610 unless (chdir $updir_loc) {
611 warnings::warnif "Can't cd to $updir_loc: $!\n";
612 next;
613 }
614 }
615
616 $dir = $dir_name; # $File::Find::dir
617
618 # Get the list of files in the current directory.
619 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
620 warnings::warnif "Can't opendir($dir_loc): $!\n";
621 next;
622 }
623 @filenames = readdir DIR;
624 closedir(DIR);
625
626 for my $FN (@filenames) {
627 if ($Is_VMS) {
628 # Big hammer here - Compensate for VMS trailing . and .dir
629 # No win situation until this is changed, but this
630 # will handle the majority of the cases with breaking the fewest.
631
632 $FN =~ s/\.dir\z//i;
633 $FN =~ s#\.$## if ($FN ne '.');
634 }
635 next if $FN =~ $File::Find::skip_pattern;
636
637 # follow symbolic links / do an lstat
638 $new_loc = Follow_SymLink($loc_pref.$FN);
639
640 # ignore if invalid symlink
641 unless (defined $new_loc) {
642 if (!defined -l _ && $dangling_symlinks) {
643 $fullname = undef;
644 if (ref $dangling_symlinks eq 'CODE') {
645 $dangling_symlinks->($FN, $dir_pref);
646 } else {
647 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
648 }
649 }
650 else {
651 $fullname = $loc_pref . $FN;
652 }
653 $name = $dir_pref . $FN;
654 $_ = ($no_chdir ? $name : $FN);
655 { $wanted_callback->() };
656 next;
657 }
658
659 if (-d _) {
660 if ($Is_VMS) {
661 $FN =~ s/\.dir\z//i;
662 $FN =~ s#\.$## if ($FN ne '.');
663 $new_loc =~ s/\.dir\z//i;
664 $new_loc =~ s#\.$## if ($new_loc ne '.');
665 }
666 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
667 }
668 else {
669 $fullname = $new_loc; # $File::Find::fullname
670 $name = $dir_pref . $FN; # $File::Find::name
671 $_ = ($no_chdir ? $name : $FN); # $_
672 { $wanted_callback->() }; # protect against wild "next"
673 }
674 }
675
676 }
677 continue {
678 while (defined($SE = pop @Stack)) {
679 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
680 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
681 $dir_pref = "$dir_name/";
682 $loc_pref = "$dir_loc/";
683 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
684 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
685 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
686 warnings::warnif "Can't cd to $updir_loc: $!\n";
687 next;
688 }
689 }
690 $fullname = $dir_loc; # $File::Find::fullname
691 $name = $dir_name; # $File::Find::name
692 if ( substr($name,-2) eq '/.' ) {
693 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
694 }
695 $dir = $p_dir; # $File::Find::dir
696 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
697 if ( substr($_,-2) eq '/.' ) {
698 substr($_, length($_) == 2 ? -1 : -2) = '';
699 }
700
701 lstat($_); # make sure file tests with '_' work
702 { $wanted_callback->() }; # protect against wild "next"
703 }
704 else {
705 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
706 last;
707 }
708 }
709 }
710}
711
712
713
# spent 664µs within File::Find::wrap_wanted which was called 107 times, avg 6µs/call: # 107 times (664µs+0s) by File::Find::find at line 760, avg 6µs/call
sub wrap_wanted {
71410736µs my $wanted = shift;
715107793µs if ( ref($wanted) eq 'HASH' ) {
716 # RT #122547
717 my %valid_options = map {$_ => 1} qw(
718 wanted
719 bydepth
720 preprocess
721 postprocess
722 follow
723 follow_fast
724 follow_skip
725 dangling_symlinks
726 no_chdir
727 untaint
728 untaint_pattern
729 untaint_skip
730 );
731 my @invalid_options = ();
732 for my $v (keys %{$wanted}) {
733 push @invalid_options, $v unless exists $valid_options{$v};
734 }
735 warn "Invalid option(s): @invalid_options" if @invalid_options;
736
737 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
738 die 'no &wanted subroutine given';
739 }
740 if ( $wanted->{follow} || $wanted->{follow_fast}) {
741 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
742 }
743 if ( $wanted->{untaint} ) {
744 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
745 unless defined $wanted->{untaint_pattern};
746 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
747 }
748 return $wanted;
749 }
750 elsif( ref( $wanted ) eq 'CODE' ) {
751 return { wanted => $wanted };
752 }
753 else {
754 die 'no &wanted subroutine given';
755 }
756}
757
758
# spent 1.55s (1.03ms+1.55) within File::Find::find which was called 107 times, avg 14.5ms/call: # 107 times (1.03ms+1.55s) by CPAN::CacheMgr::disk_usage at line 137 of CPAN/CacheMgr.pm, avg 14.5ms/call
sub find {
75910779µs my $wanted = shift;
760107767µs2141.55s _find_opt(wrap_wanted($wanted), @_);
# spent 1.55s making 107 calls to File::Find::_find_opt, avg 14.5ms/call # spent 664µs making 107 calls to File::Find::wrap_wanted, avg 6µs/call
761}
762
763sub finddepth {
764 my $wanted = wrap_wanted(shift);
765 $wanted->{bydepth} = 1;
766 _find_opt($wanted, @_);
767}
768
769# default
770$File::Find::skip_pattern = qr/^\.{1,2}\z/;
771$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
772
773# These are hard-coded for now, but may move to hint files.
774if ($^O eq 'VMS') {
775 $Is_VMS = 1;
776 $File::Find::dont_use_nlink = 1;
777}
778elsif ($^O eq 'MSWin32') {
779 $Is_Win32 = 1;
780}
781
782# this _should_ work properly on all platforms
783# where File::Find can be expected to work
784$File::Find::current_dir = File::Spec->curdir || '.';
785
786$File::Find::dont_use_nlink = 1
787 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
788 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto';
789
790# Set dont_use_nlink in your hint file if your system's stat doesn't
791# report the number of links in a directory as an indication
792# of the number of files.
793# See e.g. hints/haiku.sh for Haiku.
794unless ($File::Find::dont_use_nlink) {
795 require Config;
796 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
797}
798
799# We need a function that checks if a scalar is tainted. Either use the
800# Scalar::Util module's tainted() function or our (slower) pure Perl
801# fallback is_tainted_pp()
802{
803 local $@;
804 eval { require Scalar::Util };
805 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
806}
807
8081;
809
810__END__
 
# spent 10.9ms within File::Find::CORE:chdir which was called 3583 times, avg 3µs/call: # 2259 times (6.84ms+0s) by File::Find::_find_dir at line 375, avg 3µs/call # 1110 times (3.29ms+0s) by File::Find::_find_dir at line 470, avg 3µs/call # 107 times (376µs+0s) by File::Find::_find_opt at line 282, avg 4µs/call # 98 times (406µs+0s) by File::Find::_find_dir at line 342, avg 4µs/call # 9 times (34µs+0s) by File::Find::_find_opt at line 262, avg 4µs/call
sub File::Find::CORE:chdir; # opcode
# spent 7.63ms within File::Find::CORE:closedir which was called 2357 times, avg 3µs/call: # 2357 times (7.63ms+0s) by File::Find::_find_dir at line 391, avg 3µs/call
sub File::Find::CORE:closedir; # opcode
# spent 6.00ms within File::Find::CORE:ftdir which was called 14322 times, avg 419ns/call: # 14215 times (5.96ms+0s) by File::Find::_find_dir at line 437, avg 419ns/call # 107 times (38µs+0s) by File::Find::_find_opt at line 234, avg 355ns/call
sub File::Find::CORE:ftdir; # opcode
# spent 705ms within File::Find::CORE:lstat which was called 14322 times, avg 49µs/call: # 14215 times (704ms+0s) by File::Find::_find_dir at line 435, avg 50µs/call # 107 times (789µs+0s) by File::Find::_find_opt at line 186, avg 7µs/call
sub File::Find::CORE:lstat; # opcode
# spent 16.7ms within File::Find::CORE:match which was called 18929 times, avg 881ns/call: # 18919 times (16.7ms+0s) by File::Find::_find_dir at line 430, avg 881ns/call # 10 times (15µs+0s) by File::Find::_find_dir at line 412, avg 2µs/call
sub File::Find::CORE:match; # opcode
# spent 22.0ms within File::Find::CORE:open_dir which was called 2357 times, avg 9µs/call: # 2357 times (22.0ms+0s) by File::Find::_find_dir at line 386, avg 9µs/call
sub File::Find::CORE:open_dir; # opcode
# spent 131ms within File::Find::CORE:readdir which was called 2357 times, avg 56µs/call: # 2357 times (131ms+0s) by File::Find::_find_dir at line 390, avg 56µs/call
sub File::Find::CORE:readdir; # opcode
# spent 29.0ms within File::Find::CORE:regcomp which was called 18929 times, avg 2µs/call: # 18919 times (28.9ms+0s) by File::Find::_find_dir at line 430, avg 2µs/call # 10 times (22µs+0s) by File::Find::_find_dir at line 412, avg 2µs/call
sub File::Find::CORE:regcomp; # opcode
# spent 200µs within File::Find::CORE:subst which was called 107 times, avg 2µs/call: # 107 times (200µs+0s) by File::Find::_find_opt at line 193, avg 2µs/call
sub File::Find::CORE:subst; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.