← Index
NYTProf Performance Profile   « line view »
For t/bug-md-11.t
  Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/5.38.2/File/Find.pm
StatementsExecuted 29 statements in 2.65ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11111µs11µsFile::Find::::BEGIN@2File::Find::BEGIN@2
1114µs8µsFile::Find::::BEGIN@7File::Find::BEGIN@7
1114µs5µsFile::Find::::BEGIN@3File::Find::BEGIN@3
1114µs5µsFile::Find::::BEGIN@13File::Find::BEGIN@13
1113µs19µsFile::Find::::BEGIN@4File::Find::BEGIN@4
1113µs16µsFile::Find::::BEGIN@5File::Find::BEGIN@5
0000s0sFile::Find::::Follow_SymLinkFile::Find::Follow_SymLink
0000s0sFile::Find::::PathCombineFile::Find::PathCombine
0000s0sFile::Find::::_find_dirFile::Find::_find_dir
0000s0sFile::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
0000s0sFile::Find::::_find_optFile::Find::_find_opt
0000s0sFile::Find::::_is_absoluteFile::Find::_is_absolute
0000s0sFile::Find::::_is_rootFile::Find::_is_root
0000s0sFile::Find::::contract_nameFile::Find::contract_name
0000s0sFile::Find::::findFile::Find::find
0000s0sFile::Find::::finddepthFile::Find::finddepth
0000s0sFile::Find::::is_tainted_ppFile::Find::is_tainted_pp
0000s0sFile::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;
2226µs111µs
# spent 11µs within File::Find::BEGIN@2 which was called: # once (11µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 2
use 5.006;
# spent 11µs making 1 call to File::Find::BEGIN@2
3214µs27µs
# spent 5µs (4+2) within File::Find::BEGIN@3 which was called: # once (4µs+2µs) by Archive::Zip::Archive::BEGIN@7 at line 3
use strict;
# spent 5µs making 1 call to File::Find::BEGIN@3 # spent 2µs making 1 call to strict::import
4212µs236µs
# spent 19µs (3+16) within File::Find::BEGIN@4 which was called: # once (3µs+16µs) by Archive::Zip::Archive::BEGIN@7 at line 4
use warnings;
# spent 19µs making 1 call to File::Find::BEGIN@4 # spent 16µs making 1 call to warnings::import
5224µs228µs
# spent 16µs (3+13) within File::Find::BEGIN@5 which was called: # once (3µs+13µs) by Archive::Zip::Archive::BEGIN@7 at line 5
use warnings::register;
# spent 16µs making 1 call to File::Find::BEGIN@5 # spent 13µs making 1 call to warnings::register::import
61300nsour $VERSION = '1.43';
7222µs212µs
# spent 8µs (4+4) within File::Find::BEGIN@7 which was called: # once (4µs+4µs) by Archive::Zip::Archive::BEGIN@7 at line 7
use Exporter 'import';
# spent 8µs making 1 call to File::Find::BEGIN@7 # spent 4µs making 1 call to Exporter::import
81400nsrequire Cwd;
9
101800nsour @EXPORT = qw(find finddepth);
11
12
1322.52ms26µs
# spent 5µs (4+1) within File::Find::BEGIN@13 which was called: # once (4µs+1µs) by Archive::Zip::Archive::BEGIN@7 at line 13
use strict;
# spent 5µs making 1 call to File::Find::BEGIN@13 # spent 1µs making 1 call to strict::import
1411µsmy $Is_VMS = $^O eq 'VMS';
151200nsmy $Is_Win32 = $^O eq 'MSWin32';
16
171300nsrequire File::Basename;
181200nsrequire File::Spec;
19
20# Should ideally be my() not our() but local() currently
21# refuses to operate on lexicals
22
23our %SLnkSeen;
24our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
25 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
26 $pre_process, $post_process, $dangling_symlinks);
27
28sub contract_name {
29 my ($cdir,$fn) = @_;
30
31 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
32
33 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
34
35 $fn =~ s|^\./||;
36
37 my $abs_name= $cdir . $fn;
38
39 if (substr($fn,0,3) eq '../') {
40 1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
41 }
42
43 return $abs_name;
44}
45
46sub _is_absolute {
47 return $_[0] =~ m|^(?:[A-Za-z]:)?/| if $Is_Win32;
48 return substr($_[0], 0, 1) eq '/';
49}
50
51sub _is_root {
52 return $_[0] =~ m|^(?:[A-Za-z]:)?/\z| if $Is_Win32;
53 return $_[0] eq '/';
54}
55
56sub PathCombine($$) {
57 my ($Base,$Name) = @_;
58 my $AbsName;
59
60 if (_is_absolute($Name)) {
61 $AbsName= $Name;
62 }
63 else {
64 $AbsName= contract_name($Base,$Name);
65 }
66
67 # (simple) check for recursion
68 my $newlen= length($AbsName);
69 if ($newlen <= length($Base)) {
70 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
71 && $AbsName eq substr($Base,0,$newlen))
72 {
73 return undef;
74 }
75 }
76 return $AbsName;
77}
78
79sub Follow_SymLink($) {
80 my ($AbsName) = @_;
81
82 my ($NewName,$DEV, $INO);
83 ($DEV, $INO)= lstat $AbsName;
84
85 while (-l _) {
86 if ($SLnkSeen{$DEV, $INO}++) {
87 if ($follow_skip < 2) {
88 die "$AbsName is encountered a second time";
89 }
90 else {
91 return undef;
92 }
93 }
94 my $Link = readlink($AbsName);
95 # canonicalize directory separators
96 $Link =~ s|\\|/|g if $Is_Win32;
97 $NewName= PathCombine($AbsName, $Link);
98 unless(defined $NewName) {
99 if ($follow_skip < 2) {
100 die "$AbsName is a recursive symbolic link";
101 }
102 else {
103 return undef;
104 }
105 }
106 else {
107 $AbsName= $NewName;
108 }
109 ($DEV, $INO) = lstat($AbsName);
110 return undef unless defined $DEV; # dangling symbolic link
111 }
112
113 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
114 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
115 die "$AbsName encountered a second time";
116 }
117 else {
118 return undef;
119 }
120 }
121
122 return $AbsName;
123}
124
125our($dir, $name, $fullname, $prune);
126sub _find_dir_symlnk($$$);
127sub _find_dir($$$);
128
129# check whether or not a scalar variable is tainted
130# (code straight from the Camel, 3rd ed., page 561)
131sub is_tainted_pp {
132 my $arg = shift;
133 my $nada = substr($arg, 0, 0); # zero-length
134 local $@;
135 eval { eval "# $nada" };
136 return length($@) != 0;
137}
138
139
140sub _find_opt {
141 my $wanted = shift;
142 return unless @_;
143 die "invalid top directory" unless defined $_[0];
144
145 # This function must local()ize everything because callbacks may
146 # call find() or finddepth()
147
148 local %SLnkSeen;
149 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
150 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
151 $pre_process, $post_process, $dangling_symlinks);
152 local($dir, $name, $fullname, $prune);
153 local *_ = \my $a;
154
155 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
156 if ($Is_VMS) {
157 # VMS returns this by default in VMS format which just doesn't
158 # work for the rest of this module.
159 $cwd = VMS::Filespec::unixpath($cwd);
160
161 # Apparently this is not expected to have a trailing space.
162 # To attempt to make VMS/UNIX conversions mostly reversible,
163 # a trailing slash is needed. The run-time functions ignore the
164 # resulting double slash, but it causes the perl tests to fail.
165 $cwd =~ s#/\z##;
166
167 # This comes up in upper case now, but should be lower.
168 # In the future this could be exact case, no need to change.
169 }
170 my $cwd_untainted = $cwd;
171 my $check_t_cwd = 1;
172 $wanted_callback = $wanted->{wanted};
173 $bydepth = $wanted->{bydepth};
174 $pre_process = $wanted->{preprocess};
175 $post_process = $wanted->{postprocess};
176 $no_chdir = $wanted->{no_chdir};
177 $full_check = $wanted->{follow};
178 $follow = $full_check || $wanted->{follow_fast};
179 $follow_skip = $wanted->{follow_skip};
180 $untaint = $wanted->{untaint};
181 $untaint_pat = $wanted->{untaint_pattern};
182 $untaint_skip = $wanted->{untaint_skip};
183 $dangling_symlinks = $wanted->{dangling_symlinks};
184
185 # for compatibility reasons (find.pl, find2perl)
186 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
187
188 # a symbolic link to a directory doesn't increase the link count
189 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
190
191 my ($abs_dir, $Is_Dir);
192
193 Proc_Top_Item:
194 foreach my $TOP (@_) {
195 my $top_item = $TOP;
196 $top_item = VMS::Filespec::unixify($top_item) if $Is_VMS;
197
198 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
199
200 # canonicalize directory separators
201 $top_item =~ s|[/\\]|/|g if $Is_Win32;
202
203 # no trailing / unless path is root
204 $top_item =~ s|/\z|| unless _is_root($top_item);
205
206 $Is_Dir= 0;
207
208 if ($follow) {
209
210 if (_is_absolute($top_item)) {
211 $abs_dir = $top_item;
212 }
213 elsif ($top_item eq $File::Find::current_dir) {
214 $abs_dir = $cwd;
215 }
216 else { # care about any ../
217 $top_item =~ s/\.dir\z//i if $Is_VMS;
218 $abs_dir = contract_name("$cwd/",$top_item);
219 }
220 $abs_dir= Follow_SymLink($abs_dir);
221 unless (defined $abs_dir) {
222 if ($dangling_symlinks) {
223 if (ref $dangling_symlinks eq 'CODE') {
224 $dangling_symlinks->($top_item, $cwd);
225 } else {
226 warnings::warnif "$top_item is a dangling symbolic link\n";
227 }
228 }
229 next Proc_Top_Item;
230 }
231
232 if (-d _) {
233 $top_item =~ s/\.dir\z//i if $Is_VMS;
234 _find_dir_symlnk($wanted, $abs_dir, $top_item);
235 $Is_Dir= 1;
236 }
237 }
238 else { # no follow
239 $topdir = $top_item;
240 unless (defined $topnlink) {
241 warnings::warnif "Can't stat $top_item: $!\n";
242 next Proc_Top_Item;
243 }
244 if (-d _) {
245 $top_item =~ s/\.dir\z//i if $Is_VMS;
246 _find_dir($wanted, $top_item, $topnlink);
247 $Is_Dir= 1;
248 }
249 else {
250 $abs_dir= $top_item;
251 }
252 }
253
254 unless ($Is_Dir) {
255 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
256 ($dir,$_) = ('./', $top_item);
257 }
258
259 $abs_dir = $dir;
260 if (( $untaint ) && (is_tainted($dir) )) {
261 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
262 unless (defined $abs_dir) {
263 if ($untaint_skip == 0) {
264 die "directory $dir is still tainted";
265 }
266 else {
267 next Proc_Top_Item;
268 }
269 }
270 }
271
272 unless ($no_chdir || chdir $abs_dir) {
273 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
274 next Proc_Top_Item;
275 }
276
277 $name = $abs_dir . $_; # $File::Find::name
278 $_ = $name if $no_chdir;
279
280 { $wanted_callback->() }; # protect against wild "next"
281
282 }
283
284 unless ( $no_chdir ) {
285 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
286 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
287 unless (defined $cwd_untainted) {
288 die "insecure cwd in find(depth)";
289 }
290 $check_t_cwd = 0;
291 }
292 unless (chdir $cwd_untainted) {
293 die "Can't cd to $cwd: $!\n";
294 }
295 }
296 }
297}
298
299# API:
300# $wanted
301# $p_dir : "parent directory"
302# $nlink : what came back from the stat
303# preconditions:
304# chdir (if not no_chdir) to dir
305
306sub _find_dir($$$) {
307 my ($wanted, $p_dir, $nlink) = @_;
308 my ($CdLvl,$Level) = (0,0);
309 my @Stack;
310 my @filenames;
311 my ($subcount,$sub_nlink);
312 my $SE= [];
313 my $dir_name= $p_dir;
314 my $dir_pref;
315 my $dir_rel = $File::Find::current_dir;
316 my $tainted = 0;
317 my $no_nlink;
318
319 if ($Is_VMS) {
320 # VMS is returning trailing .dir on directories
321 # and trailing . on files and symbolic links
322 # in UNIX syntax.
323 #
324
325 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
326
327 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
328 }
329 else {
330 $dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/";
331 }
332
333 local ($dir, $name, $prune);
334
335 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
336 my $udir = $p_dir;
337 if (( $untaint ) && (is_tainted($p_dir) )) {
338 ( $udir ) = $p_dir =~ m|$untaint_pat|;
339 unless (defined $udir) {
340 if ($untaint_skip == 0) {
341 die "directory $p_dir is still tainted";
342 }
343 else {
344 return;
345 }
346 }
347 }
348 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
349 warnings::warnif "Can't cd to $udir: $!\n";
350 return;
351 }
352 }
353
354 # push the starting directory
355 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
356
357 while (defined $SE) {
358 unless ($bydepth) {
359 $dir= $p_dir; # $File::Find::dir
360 $name= $dir_name; # $File::Find::name
361 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
362 # prune may happen here
363 $prune= 0;
364 { $wanted_callback->() }; # protect against wild "next"
365 next if $prune;
366 }
367
368 # change to that directory
369 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
370 my $udir= $dir_rel;
371 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
372 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
373 unless (defined $udir) {
374 if ($untaint_skip == 0) {
375 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
376 } else { # $untaint_skip == 1
377 next;
378 }
379 }
380 }
381 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
382 warnings::warnif "Can't cd to (" .
383 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
384 next;
385 }
386 $CdLvl++;
387 }
388
389 $dir= $dir_name; # $File::Find::dir
390
391 # Get the list of files in the current directory.
392 my $dh;
393 unless (opendir $dh, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
394 warnings::warnif "Can't opendir($dir_name): $!\n";
395 next;
396 }
397 @filenames = readdir $dh;
398 closedir($dh);
399 @filenames = $pre_process->(@filenames) if $pre_process;
400 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
401
402 # default: use whatever was specified
403 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
404 $no_nlink = $avoid_nlink;
405 # if dir has wrong nlink count, force switch to slower stat method
406 $no_nlink = 1 if ($nlink < 2);
407
408 if ($nlink == 2 && !$no_nlink) {
409 # This dir has no subdirectories.
410 for my $FN (@filenames) {
411 if ($Is_VMS) {
412 # Big hammer here - Compensate for VMS trailing . and .dir
413 # No win situation until this is changed, but this
414 # will handle the majority of the cases with breaking the fewest
415
416 $FN =~ s/\.dir\z//i;
417 $FN =~ s#\.$## if ($FN ne '.');
418 }
419 next if $FN =~ $File::Find::skip_pattern;
420
421 $name = $dir_pref . $FN; # $File::Find::name
422 $_ = ($no_chdir ? $name : $FN); # $_
423 { $wanted_callback->() }; # protect against wild "next"
424 }
425
426 }
427 else {
428 # This dir has subdirectories.
429 $subcount = $nlink - 2;
430
431 # HACK: insert directories at this position, so as to preserve
432 # the user pre-processed ordering of files (thus ensuring
433 # directory traversal is in user sorted order, not at random).
434 my $stack_top = @Stack;
435
436 for my $FN (@filenames) {
437 next if $FN =~ $File::Find::skip_pattern;
438 if ($subcount > 0 || $no_nlink) {
439 # Seen all the subdirs?
440 # check for directoriness.
441 # stat is faster for a file in the current directory
442 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
443
444 if (-d _) {
445 --$subcount;
446 $FN =~ s/\.dir\z//i if $Is_VMS;
447 # HACK: replace push to preserve dir traversal order
448 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
449 splice @Stack, $stack_top, 0,
450 [$CdLvl,$dir_name,$FN,$sub_nlink];
451 }
452 else {
453 $name = $dir_pref . $FN; # $File::Find::name
454 $_= ($no_chdir ? $name : $FN); # $_
455 { $wanted_callback->() }; # protect against wild "next"
456 }
457 }
458 else {
459 $name = $dir_pref . $FN; # $File::Find::name
460 $_= ($no_chdir ? $name : $FN); # $_
461 { $wanted_callback->() }; # protect against wild "next"
462 }
463 }
464 }
465 }
466 continue {
467 while ( defined ($SE = pop @Stack) ) {
468 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
469 if ($CdLvl > $Level && !$no_chdir) {
470 my $tmp;
471 if ($Is_VMS) {
472 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
473 }
474 else {
475 $tmp = join('/',('..') x ($CdLvl-$Level));
476 }
477 die "Can't cd to $tmp from $dir_name: $!"
478 unless chdir ($tmp);
479 $CdLvl = $Level;
480 }
481
482 if ($^O eq 'VMS') {
483 if ($p_dir =~ m/[\]>]+$/) {
484 $dir_name = $p_dir;
485 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
486 $dir_pref = $dir_name;
487 }
488 else {
489 $dir_name = "$p_dir/$dir_rel";
490 $dir_pref = "$dir_name/";
491 }
492 }
493 else {
494 $dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel";
495 $dir_pref = "$dir_name/";
496 }
497
498 if ( $nlink == -2 ) {
499 $name = $dir = $p_dir; # $File::Find::name / dir
500 $_ = $File::Find::current_dir;
501 $post_process->(); # End-of-directory processing
502 }
503 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
504 $name = $dir_name;
505 if ( substr($name,-2) eq '/.' ) {
506 substr($name, length($name) == 2 ? -1 : -2) = '';
507 }
508 $dir = $p_dir;
509 $_ = ($no_chdir ? $dir_name : $dir_rel );
510 if ( substr($_,-2) eq '/.' ) {
511 substr($_, length($_) == 2 ? -1 : -2) = '';
512 }
513 { $wanted_callback->() }; # protect against wild "next"
514 }
515 else {
516 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
517 last;
518 }
519 }
520 }
521}
522
523
524# API:
525# $wanted
526# $dir_loc : absolute location of a dir
527# $p_dir : "parent directory"
528# preconditions:
529# chdir (if not no_chdir) to dir
530
531sub _find_dir_symlnk($$$) {
532 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
533 my @Stack;
534 my @filenames;
535 my $new_loc;
536 my $updir_loc = $dir_loc; # untainted parent directory
537 my $SE = [];
538 my $dir_name = $p_dir;
539 my $dir_pref;
540 my $loc_pref;
541 my $dir_rel = $File::Find::current_dir;
542 my $byd_flag; # flag for pending stack entry if $bydepth
543 my $tainted = 0;
544 my $ok = 1;
545
546 $dir_pref = _is_root($p_dir) ? $p_dir : "$p_dir/";
547 $loc_pref = _is_root($dir_loc) ? $dir_loc : "$dir_loc/";
548
549 local ($dir, $name, $fullname, $prune);
550
551 unless ($no_chdir) {
552 # untaint the topdir
553 if (( $untaint ) && (is_tainted($dir_loc) )) {
554 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
555 # once untainted, $updir_loc is pushed on the stack (as parent directory);
556 # hence, we don't need to untaint the parent directory every time we chdir
557 # to it later
558 unless (defined $updir_loc) {
559 if ($untaint_skip == 0) {
560 die "directory $dir_loc is still tainted";
561 }
562 else {
563 return;
564 }
565 }
566 }
567 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
568 unless ($ok) {
569 warnings::warnif "Can't cd to $updir_loc: $!\n";
570 return;
571 }
572 }
573
574 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
575
576 while (defined $SE) {
577
578 unless ($bydepth) {
579 # change (back) to parent directory (always untainted)
580 unless ($no_chdir) {
581 unless (chdir $updir_loc) {
582 warnings::warnif "Can't cd to $updir_loc: $!\n";
583 next;
584 }
585 }
586 $dir= $p_dir; # $File::Find::dir
587 $name= $dir_name; # $File::Find::name
588 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
589 $fullname= $dir_loc; # $File::Find::fullname
590 # prune may happen here
591 $prune= 0;
592 lstat($_); # make sure file tests with '_' work
593 { $wanted_callback->() }; # protect against wild "next"
594 next if $prune;
595 }
596
597 # change to that directory
598 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
599 $updir_loc = $dir_loc;
600 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
601 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
602 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
603 unless (defined $updir_loc) {
604 if ($untaint_skip == 0) {
605 die "directory $dir_loc is still tainted";
606 }
607 else {
608 next;
609 }
610 }
611 }
612 unless (chdir $updir_loc) {
613 warnings::warnif "Can't cd to $updir_loc: $!\n";
614 next;
615 }
616 }
617
618 $dir = $dir_name; # $File::Find::dir
619
620 # Get the list of files in the current directory.
621 my $dh;
622 unless (opendir $dh, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
623 warnings::warnif "Can't opendir($dir_loc): $!\n";
624 next;
625 }
626 @filenames = readdir $dh;
627 closedir($dh);
628
629 for my $FN (@filenames) {
630 if ($Is_VMS) {
631 # Big hammer here - Compensate for VMS trailing . and .dir
632 # No win situation until this is changed, but this
633 # will handle the majority of the cases with breaking the fewest.
634
635 $FN =~ s/\.dir\z//i;
636 $FN =~ s#\.$## if ($FN ne '.');
637 }
638 next if $FN =~ $File::Find::skip_pattern;
639
640 # follow symbolic links / do an lstat
641 $new_loc = Follow_SymLink($loc_pref.$FN);
642
643 # ignore if invalid symlink
644 unless (defined $new_loc) {
645 if (!defined -l _ && $dangling_symlinks) {
646 $fullname = undef;
647 if (ref $dangling_symlinks eq 'CODE') {
648 $dangling_symlinks->($FN, $dir_pref);
649 } else {
650 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
651 }
652 }
653 else {
654 $fullname = $loc_pref . $FN;
655 }
656 $name = $dir_pref . $FN;
657 $_ = ($no_chdir ? $name : $FN);
658 { $wanted_callback->() };
659 next;
660 }
661
662 if (-d _) {
663 if ($Is_VMS) {
664 $FN =~ s/\.dir\z//i;
665 $FN =~ s#\.$## if ($FN ne '.');
666 $new_loc =~ s/\.dir\z//i;
667 $new_loc =~ s#\.$## if ($new_loc ne '.');
668 }
669 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
670 }
671 else {
672 $fullname = $new_loc; # $File::Find::fullname
673 $name = $dir_pref . $FN; # $File::Find::name
674 $_ = ($no_chdir ? $name : $FN); # $_
675 { $wanted_callback->() }; # protect against wild "next"
676 }
677 }
678
679 }
680 continue {
681 while (defined($SE = pop @Stack)) {
682 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
683 $dir_name = _is_root($p_dir) ? "$p_dir$dir_rel" : "$p_dir/$dir_rel";
684 $dir_pref = "$dir_name/";
685 $loc_pref = "$dir_loc/";
686 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
687 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
688 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
689 warnings::warnif "Can't cd to $updir_loc: $!\n";
690 next;
691 }
692 }
693 $fullname = $dir_loc; # $File::Find::fullname
694 $name = $dir_name; # $File::Find::name
695 if ( substr($name,-2) eq '/.' ) {
696 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
697 }
698 $dir = $p_dir; # $File::Find::dir
699 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
700 if ( substr($_,-2) eq '/.' ) {
701 substr($_, length($_) == 2 ? -1 : -2) = '';
702 }
703
704 lstat($_); # make sure file tests with '_' work
705 { $wanted_callback->() }; # protect against wild "next"
706 }
707 else {
708 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
709 last;
710 }
711 }
712 }
713}
714
715
716sub wrap_wanted {
717 my $wanted = shift;
718 if ( ref($wanted) eq 'HASH' ) {
719 # RT #122547
720 my %valid_options = map {$_ => 1} qw(
721 wanted
722 bydepth
723 preprocess
724 postprocess
725 follow
726 follow_fast
727 follow_skip
728 dangling_symlinks
729 no_chdir
730 untaint
731 untaint_pattern
732 untaint_skip
733 );
734 my @invalid_options = ();
735 for my $v (keys %{$wanted}) {
736 push @invalid_options, $v unless exists $valid_options{$v};
737 }
738 warn "Invalid option(s): @invalid_options" if @invalid_options;
739
740 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
741 die 'no &wanted subroutine given';
742 }
743 if ( $wanted->{follow} || $wanted->{follow_fast}) {
744 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
745 }
746 if ( $wanted->{untaint} ) {
747 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
748 unless defined $wanted->{untaint_pattern};
749 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
750 }
751 return $wanted;
752 }
753 elsif( ref( $wanted ) eq 'CODE' ) {
754 return { wanted => $wanted };
755 }
756 else {
757 die 'no &wanted subroutine given';
758 }
759}
760
761sub find {
762 my $wanted = shift;
763 _find_opt(wrap_wanted($wanted), @_);
764}
765
766sub finddepth {
767 my $wanted = wrap_wanted(shift);
768 $wanted->{bydepth} = 1;
769 _find_opt($wanted, @_);
770}
771
772# default
77315µs12µs$File::Find::skip_pattern = qr/^\.{1,2}\z/;
# spent 2µs making 1 call to CORE::qr
77412µs1400ns$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
# spent 400ns making 1 call to CORE::qr
775
776# this _should_ work properly on all platforms
777# where File::Find can be expected to work
77814µs11µs$File::Find::current_dir = File::Spec->curdir || '.';
# spent 1µs making 1 call to File::Spec::Unix::curdir
779
7801100ns$File::Find::dont_use_nlink = 1;
781
782# We need a function that checks if a scalar is tainted. Either use the
783# Scalar::Util module's tainted() function or our (slower) pure Perl
784# fallback is_tainted_pp()
785{
7862300ns local $@;
7872700ns eval { require Scalar::Util };
78811µs *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
789}
790
79117µs1;
792
793__END__