← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:07 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/File/Find.pm
StatementsExecuted 1097 statements in 5.97ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
411606µs11.1msFile::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
4521332µs511µsFile::Find::::Follow_SymLinkFile::Find::Follow_SymLink
411186µs11.4msFile::Find::::_find_optFile::Find::_find_opt
4921179µs179µsFile::Find::::CORE:lstatFile::Find::CORE:lstat (opcode)
411100µs100µsFile::Find::::CORE:open_dirFile::Find::CORE:open_dir (opcode)
41177µs77µsFile::Find::::CORE:readdirFile::Find::CORE:readdir (opcode)
491137µs37µsFile::Find::::CORE:regcompFile::Find::CORE:regcomp (opcode)
41131µs31µsFile::Find::::CORE:closedirFile::Find::CORE:closedir (opcode)
41130µs30µsFile::Find::::wrap_wantedFile::Find::wrap_wanted
41130µs11.5msFile::Find::::findFile::Find::find
491125µs25µsFile::Find::::CORE:matchFile::Find::CORE:match (opcode)
11123µs23µsFile::Find::::BEGIN@2File::Find::BEGIN@2
41120µs20µsFile::Find::::CORE:statFile::Find::CORE:stat (opcode)
452110µs10µsFile::Find::::CORE:ftdirFile::Find::CORE:ftdir (opcode)
451110µs10µsFile::Find::::CORE:ftlinkFile::Find::CORE:ftlink (opcode)
1118µs83µsFile::Find::::BEGIN@5File::Find::BEGIN@5
1118µs10µsFile::Find::::BEGIN@424File::Find::BEGIN@424
1117µs15µsFile::Find::::BEGIN@4File::Find::BEGIN@4
1116µs9µsFile::Find::::BEGIN@3File::Find::BEGIN@3
2216µs6µsFile::Find::::CORE:qrFile::Find::CORE:qr (opcode)
4113µs3µsFile::Find::::CORE:substFile::Find::CORE:subst (opcode)
0000s0sFile::Find::::PathCombineFile::Find::PathCombine
0000s0sFile::Find::::_find_dirFile::Find::_find_dir
0000s0sFile::Find::::contract_nameFile::Find::contract_name
0000s0sFile::Find::::contract_name_MacFile::Find::contract_name_Mac
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;
2327µs123µs
# spent 23µs within File::Find::BEGIN@2 which was called: # once (23µs+0s) by Module::Find::BEGIN@8 at line 2
use 5.006;
# spent 23µs making 1 call to File::Find::BEGIN@2
3319µs211µs
# spent 9µs (6+2) within File::Find::BEGIN@3 which was called: # once (6µs+2µs) by Module::Find::BEGIN@8 at line 3
use strict;
# spent 9µs making 1 call to File::Find::BEGIN@3 # spent 2µs making 1 call to strict::import
4315µs222µs
# spent 15µs (7+8) within File::Find::BEGIN@4 which was called: # once (7µs+8µs) by Module::Find::BEGIN@8 at line 4
use warnings;
# spent 15µs making 1 call to File::Find::BEGIN@4 # spent 8µs making 1 call to warnings::import
53210µs2158µs
# spent 83µs (8+75) within File::Find::BEGIN@5 which was called: # once (8µs+75µs) by Module::Find::BEGIN@8 at line 5
use warnings::register;
# spent 83µs making 1 call to File::Find::BEGIN@5 # spent 75µs making 1 call to warnings::register::import
61900nsour $VERSION = '1.15';
711µsrequire Exporter;
81600nsrequire Cwd;
9
10#
11# Modified to ensure sub-directory traversal order is not inverded 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 I<follow_fast> and I<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
283See also the script C<pfind> on CPAN for a nice application of this
284module.
285
286=head1 WARNINGS
287
288If you run your program with the C<-w> switch, or if you use the
289C<warnings> pragma, File::Find will report warnings for several weird
290situations. You can disable these warnings by putting the statement
291
292 no warnings 'File::Find';
293
294in the appropriate scope. See L<perllexwarn> for more info about lexical
295warnings.
296
297=head1 CAVEAT
298
299=over 2
300
301=item $dont_use_nlink
302
303You can set the variable C<$File::Find::dont_use_nlink> to 1, if you want to
304force File::Find to always stat directories. This was used for file systems
305that do not have an C<nlink> count matching the number of sub-directories.
306Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file
307system) and a couple of others.
308
309You shouldn't need to set this variable, since File::Find should now detect
310such file systems on-the-fly and switch itself to using stat. This works even
311for parts of your file system, like a mounted CD-ROM.
312
313If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs.
314
315=item symlinks
316
317Be aware that the option to follow symbolic links can be dangerous.
318Depending on the structure of the directory tree (including symbolic
319links to directories) you might traverse a given (physical) directory
320more than once (only if C<follow_fast> is in effect).
321Furthermore, deleting or changing files in a symbolically linked directory
322might cause very unpleasant surprises, since you delete or change files
323in an unknown directory.
324
325=back
326
327=head1 NOTES
328
329=over 4
330
331=item *
332
333Mac OS (Classic) users should note a few differences:
334
335=over 4
336
337=item *
338
339The path separator is ':', not '/', and the current directory is denoted
340as ':', not '.'. You should be careful about specifying relative pathnames.
341While a full path always begins with a volume name, a relative pathname
342should always begin with a ':'. If specifying a volume name only, a
343trailing ':' is required.
344
345=item *
346
347C<$File::Find::dir> is guaranteed to end with a ':'. If C<$_>
348contains the name of a directory, that name may or may not end with a
349':'. Likewise, C<$File::Find::name>, which contains the complete
350pathname to that directory, and C<$File::Find::fullname>, which holds
351the absolute pathname of that directory with all symbolic links resolved,
352may or may not end with a ':'.
353
354=item *
355
356The default C<untaint_pattern> (see above) on Mac OS is set to
357C<qr|^(.+)$|>. Note that the parentheses are vital.
358
359=item *
360
361The invisible system file "Icon\015" is ignored. While this file may
362appear in every directory, there are some more invisible system files
363on every volume, which are all located at the volume root level (i.e.
364"MacintoshHD:"). These system files are B<not> excluded automatically.
365Your filter may use the following code to recognize invisible files or
366directories (requires Mac::Files):
367
368 use Mac::Files;
369
370 # invisible() -- returns 1 if file/directory is invisible,
371 # 0 if it's visible or undef if an error occurred
372
373 sub invisible($) {
374 my $file = shift;
375 my ($fileCat, $fileInfo);
376 my $invisible_flag = 1 << 14;
377
378 if ( $fileCat = FSpGetCatInfo($file) ) {
379 if ($fileInfo = $fileCat->ioFlFndrInfo() ) {
380 return (($fileInfo->fdFlags & $invisible_flag) && 1);
381 }
382 }
383 return undef;
384 }
385
386Generally, invisible files are system files, unless an odd application
387decides to use invisible files for its own purposes. To distinguish
388such files from system files, you have to look at the B<type> and B<creator>
389file attributes. The MacPerl built-in functions C<GetFileInfo(FILE)> and
390C<SetFileInfo(CREATOR, TYPE, FILES)> offer access to these attributes
391(see MacPerl.pm for details).
392
393Files that appear on the desktop actually reside in an (hidden) directory
394named "Desktop Folder" on the particular disk volume. Note that, although
395all desktop files appear to be on the same "virtual" desktop, each disk
396volume actually maintains its own "Desktop Folder" directory.
397
398=back
399
400=back
401
402=head1 BUGS AND CAVEATS
403
404Despite the name of the C<finddepth()> function, both C<find()> and
405C<finddepth()> perform a depth-first search of the directory
406hierarchy.
407
408=head1 HISTORY
409
410File::Find used to produce incorrect results if called recursively.
411During the development of perl 5.8 this bug was fixed.
412The first fixed version of File::Find was 1.01.
413
414=head1 SEE ALSO
415
416find, find2perl.
417
418=cut
419
420112µsour @ISA = qw(Exporter);
4211800nsour @EXPORT = qw(find finddepth);
422
423
42433.93ms212µs
# spent 10µs (8+2) within File::Find::BEGIN@424 which was called: # once (8µs+2µs) by Module::Find::BEGIN@8 at line 424
use strict;
# spent 10µs making 1 call to File::Find::BEGIN@424 # spent 2µs making 1 call to strict::import
4251400nsmy $Is_VMS;
4261100nsmy $Is_MacOS;
427
42811µsrequire File::Basename;
4291600nsrequire File::Spec;
430
431# Should ideally be my() not our() but local() currently
432# refuses to operate on lexicals
433
4341300nsour %SLnkSeen;
4351600nsour ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
436 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
437 $pre_process, $post_process, $dangling_symlinks);
438
439sub contract_name {
440 my ($cdir,$fn) = @_;
441
442 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
443
444 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
445
446 $fn =~ s|^\./||;
447
448 my $abs_name= $cdir . $fn;
449
450 if (substr($fn,0,3) eq '../') {
451 1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
452 }
453
454 return $abs_name;
455}
456
457# return the absolute name of a directory or file
458sub contract_name_Mac {
459 my ($cdir,$fn) = @_;
460 my $abs_name;
461
462 if ($fn =~ /^(:+)(.*)$/) { # valid pathname starting with a ':'
463
464 my $colon_count = length ($1);
465 if ($colon_count == 1) {
466 $abs_name = $cdir . $2;
467 return $abs_name;
468 }
469 else {
470 # need to move up the tree, but
471 # only if it's not a volume name
472 for (my $i=1; $i<$colon_count; $i++) {
473 unless ($cdir =~ /^[^:]+:$/) { # volume name
474 $cdir =~ s/[^:]+:$//;
475 }
476 else {
477 return undef;
478 }
479 }
480 $abs_name = $cdir . $2;
481 return $abs_name;
482 }
483
484 }
485 else {
486
487 # $fn may be a valid path to a directory or file or (dangling)
488 # symlink, without a leading ':'
489 if ( (-e $fn) || (-l $fn) ) {
490 if ($fn =~ /^[^:]+:/) { # a volume name like DataHD:*
491 return $fn; # $fn is already an absolute path
492 }
493 else {
494 $abs_name = $cdir . $fn;
495 return $abs_name;
496 }
497 }
498 else { # argh!, $fn is not a valid directory/file
499 return undef;
500 }
501 }
502}
503
504sub PathCombine($$) {
505 my ($Base,$Name) = @_;
506 my $AbsName;
507
508 if ($Is_MacOS) {
509 # $Name is the resolved symlink (always a full path on MacOS),
510 # i.e. there's no need to call contract_name_Mac()
511 $AbsName = $Name;
512
513 # (simple) check for recursion
514 if ( ( $Base =~ /^$AbsName/) && (-d $AbsName) ) { # recursion
515 return undef;
516 }
517 }
518 else {
519 if (substr($Name,0,1) eq '/') {
520 $AbsName= $Name;
521 }
522 else {
523 $AbsName= contract_name($Base,$Name);
524 }
525
526 # (simple) check for recursion
527 my $newlen= length($AbsName);
528 if ($newlen <= length($Base)) {
529 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
530 && $AbsName eq substr($Base,0,$newlen))
531 {
532 return undef;
533 }
534 }
535 }
536 return $AbsName;
537}
538
539
# spent 511µs (332+179) within File::Find::Follow_SymLink which was called 45 times, avg 11µs/call: # 41 times (287µs+162µs) by File::Find::_find_dir_symlnk at line 1179, avg 11µs/call # 4 times (45µs+17µs) by File::Find::_find_opt at line 696, avg 16µs/call
sub Follow_SymLink($) {
540270541µs my ($AbsName) = @_;
541
542 my ($NewName,$DEV, $INO);
54345168µs ($DEV, $INO)= lstat $AbsName;
# spent 168µs making 45 calls to File::Find::CORE:lstat, avg 4µs/call
544
5454510µs while (-l _) {
# spent 10µs making 45 calls to File::Find::CORE:ftlink, avg 231ns/call
546 if ($SLnkSeen{$DEV, $INO}++) {
547 if ($follow_skip < 2) {
548 die "$AbsName is encountered a second time";
549 }
550 else {
551 return undef;
552 }
553 }
554 $NewName= PathCombine($AbsName, readlink($AbsName));
555 unless(defined $NewName) {
556 if ($follow_skip < 2) {
557 die "$AbsName is a recursive symbolic link";
558 }
559 else {
560 return undef;
561 }
562 }
563 else {
564 $AbsName= $NewName;
565 }
566 ($DEV, $INO) = lstat($AbsName);
567 return undef unless defined $DEV; # dangling symbolic link
568 }
569
570 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
571 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
572 die "$AbsName encountered a second time";
573 }
574 else {
575 return undef;
576 }
577 }
578
579 return $AbsName;
580}
581
5821100nsour($dir, $name, $fullname, $prune);
583sub _find_dir_symlnk($$$);
584sub _find_dir($$$);
585
586# check whether or not a scalar variable is tainted
587# (code straight from the Camel, 3rd ed., page 561)
588sub is_tainted_pp {
589 my $arg = shift;
590 my $nada = substr($arg, 0, 0); # zero-length
591 local $@;
592 eval { eval "# $nada" };
593 return length($@) != 0;
594}
595
596
# spent 11.4ms (186µs+11.2) within File::Find::_find_opt which was called 4 times, avg 2.85ms/call: # 4 times (186µs+11.2ms) by File::Find::find at line 1297, avg 2.85ms/call
sub _find_opt {
597104134µs my $wanted = shift;
598 die "invalid top directory" unless defined $_[0];
599
600 # This function must local()ize everything because callbacks may
601 # call find() or finddepth()
602
603 local %SLnkSeen;
604 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
605 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
606 $pre_process, $post_process, $dangling_symlinks);
607 local($dir, $name, $fullname, $prune);
608 local *_ = \my $a;
609
610437µs my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
# spent 37µs making 4 calls to Cwd::getcwd, avg 9µs/call
611 if ($Is_VMS) {
612 # VMS returns this by default in VMS format which just doesn't
613 # work for the rest of this module.
614 $cwd = VMS::Filespec::unixpath($cwd);
615
616 # Apparently this is not expected to have a trailing space.
617 # To attempt to make VMS/UNIX conversions mostly reversable,
618 # a trailing slash is needed. The run-time functions ignore the
619 # resulting double slash, but it causes the perl tests to fail.
620 $cwd =~ s#/\z##;
621
622 # This comes up in upper case now, but should be lower.
623 # In the future this could be exact case, no need to change.
624 }
625 my $cwd_untainted = $cwd;
626 my $check_t_cwd = 1;
627 $wanted_callback = $wanted->{wanted};
628 $bydepth = $wanted->{bydepth};
629 $pre_process = $wanted->{preprocess};
630 $post_process = $wanted->{postprocess};
631 $no_chdir = $wanted->{no_chdir};
632 $full_check = $^O eq 'MSWin32' ? 0 : $wanted->{follow};
633 $follow = $^O eq 'MSWin32' ? 0 :
634 $full_check || $wanted->{follow_fast};
635 $follow_skip = $wanted->{follow_skip};
636 $untaint = $wanted->{untaint};
637 $untaint_pat = $wanted->{untaint_pattern};
638 $untaint_skip = $wanted->{untaint_skip};
639 $dangling_symlinks = $wanted->{dangling_symlinks};
640
641 # for compatibility reasons (find.pl, find2perl)
642 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
643
644 # a symbolic link to a directory doesn't increase the link count
645 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
646
647 my ($abs_dir, $Is_Dir);
648
649 Proc_Top_Item:
650 foreach my $TOP (@_) {
6512852µs my $top_item = $TOP;
652
653420µs ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
# spent 20µs making 4 calls to File::Find::CORE:stat, avg 5µs/call
654
655413µs if ($Is_MacOS) {
656 $top_item = ":$top_item"
657 if ( (-d _) && ( $top_item !~ /:/ ) );
658 } elsif ($^O eq 'MSWin32') {
659 $top_item =~ s|/\z|| unless $top_item =~ m|\w:/$|;
660 }
661 else {
66243µs $top_item =~ s|/\z|| unless $top_item eq '/';
# spent 3µs making 4 calls to File::Find::CORE:subst, avg 675ns/call
663 }
664
665 $Is_Dir= 0;
666
6671623µs if ($follow) {
668
669410µs if ($Is_MacOS) {
670 $cwd = "$cwd:" unless ($cwd =~ /:$/); # for safety
671
672 if ($top_item eq $File::Find::current_dir) {
673 $abs_dir = $cwd;
674 }
675 else {
676 $abs_dir = contract_name_Mac($cwd, $top_item);
677 unless (defined $abs_dir) {
678 warnings::warnif "Can't determine absolute path for $top_item (No such file or directory)\n";
679 next Proc_Top_Item;
680 }
681 }
682
683 }
684 else {
685 if (substr($top_item,0,1) eq '/') {
686 $abs_dir = $top_item;
687 }
688 elsif ($top_item eq $File::Find::current_dir) {
689 $abs_dir = $cwd;
690 }
691 else { # care about any ../
692 $top_item =~ s/\.dir\z//i if $Is_VMS;
693 $abs_dir = contract_name("$cwd/",$top_item);
694 }
695 }
696462µs $abs_dir= Follow_SymLink($abs_dir);
# spent 62µs making 4 calls to File::Find::Follow_SymLink, avg 16µs/call
697 unless (defined $abs_dir) {
698 if ($dangling_symlinks) {
699 if (ref $dangling_symlinks eq 'CODE') {
700 $dangling_symlinks->($top_item, $cwd);
701 } else {
702 warnings::warnif "$top_item is a dangling symbolic link\n";
703 }
704 }
705 next Proc_Top_Item;
706 }
707
7081210µs41µs if (-d _) {
# spent 1µs making 4 calls to File::Find::CORE:ftdir, avg 300ns/call
709 $top_item =~ s/\.dir\z//i if $Is_VMS;
710411.1ms _find_dir_symlnk($wanted, $abs_dir, $top_item);
# spent 11.1ms making 4 calls to File::Find::_find_dir_symlnk, avg 2.77ms/call
711 $Is_Dir= 1;
712 }
713 }
714 else { # no follow
715 $topdir = $top_item;
716 unless (defined $topnlink) {
717 warnings::warnif "Can't stat $top_item: $!\n";
718 next Proc_Top_Item;
719 }
720 if (-d _) {
721 $top_item =~ s/\.dir\z//i if $Is_VMS;
722 _find_dir($wanted, $top_item, $topnlink);
723 $Is_Dir= 1;
724 }
725 else {
726 $abs_dir= $top_item;
727 }
728 }
729
730 unless ($Is_Dir) {
731 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
732 if ($Is_MacOS) {
733 ($dir,$_) = (':', $top_item); # $File::Find::dir, $_
734 }
735 else {
736 ($dir,$_) = ('./', $top_item);
737 }
738 }
739
740 $abs_dir = $dir;
741 if (( $untaint ) && (is_tainted($dir) )) {
742 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
743 unless (defined $abs_dir) {
744 if ($untaint_skip == 0) {
745 die "directory $dir is still tainted";
746 }
747 else {
748 next Proc_Top_Item;
749 }
750 }
751 }
752
753 unless ($no_chdir || chdir $abs_dir) {
754 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
755 next Proc_Top_Item;
756 }
757
758 $name = $abs_dir . $_; # $File::Find::name
759 $_ = $name if $no_chdir;
760
761 { $wanted_callback->() }; # protect against wild "next"
762
763 }
764
765 unless ( $no_chdir ) {
766 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
767 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
768 unless (defined $cwd_untainted) {
769 die "insecure cwd in find(depth)";
770 }
771 $check_t_cwd = 0;
772 }
773 unless (chdir $cwd_untainted) {
774 die "Can't cd to $cwd: $!\n";
775 }
776 }
777 }
778}
779
780# API:
781# $wanted
782# $p_dir : "parent directory"
783# $nlink : what came back from the stat
784# preconditions:
785# chdir (if not no_chdir) to dir
786
787sub _find_dir($$$) {
788 my ($wanted, $p_dir, $nlink) = @_;
789 my ($CdLvl,$Level) = (0,0);
790 my @Stack;
791 my @filenames;
792 my ($subcount,$sub_nlink);
793 my $SE= [];
794 my $dir_name= $p_dir;
795 my $dir_pref;
796 my $dir_rel = $File::Find::current_dir;
797 my $tainted = 0;
798 my $no_nlink;
799
800 if ($Is_MacOS) {
801 $dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
802 } elsif ($^O eq 'MSWin32') {
803 $dir_pref = ($p_dir =~ m|\w:/?$| ? $p_dir : "$p_dir/" );
804 } elsif ($^O eq 'VMS') {
805
806 # VMS is returning trailing .dir on directories
807 # and trailing . on files and symbolic links
808 # in UNIX syntax.
809 #
810
811 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
812
813 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
814 }
815 else {
816 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
817 }
818
819 local ($dir, $name, $prune, *DIR);
820
821 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
822 my $udir = $p_dir;
823 if (( $untaint ) && (is_tainted($p_dir) )) {
824 ( $udir ) = $p_dir =~ m|$untaint_pat|;
825 unless (defined $udir) {
826 if ($untaint_skip == 0) {
827 die "directory $p_dir is still tainted";
828 }
829 else {
830 return;
831 }
832 }
833 }
834 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
835 warnings::warnif "Can't cd to $udir: $!\n";
836 return;
837 }
838 }
839
840 # push the starting directory
841 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
842
843 if ($Is_MacOS) {
844 $p_dir = $dir_pref; # ensure trailing ':'
845 }
846
847 while (defined $SE) {
848 unless ($bydepth) {
849 $dir= $p_dir; # $File::Find::dir
850 $name= $dir_name; # $File::Find::name
851 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
852 # prune may happen here
853 $prune= 0;
854 { $wanted_callback->() }; # protect against wild "next"
855 next if $prune;
856 }
857
858 # change to that directory
859 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
860 my $udir= $dir_rel;
861 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
862 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
863 unless (defined $udir) {
864 if ($untaint_skip == 0) {
865 if ($Is_MacOS) {
866 die "directory ($p_dir) $dir_rel is still tainted";
867 }
868 else {
869 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
870 }
871 } else { # $untaint_skip == 1
872 next;
873 }
874 }
875 }
876 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
877 if ($Is_MacOS) {
878 warnings::warnif "Can't cd to ($p_dir) $udir: $!\n";
879 }
880 else {
881 warnings::warnif "Can't cd to (" .
882 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
883 }
884 next;
885 }
886 $CdLvl++;
887 }
888
889 if ($Is_MacOS) {
890 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
891 }
892
893 $dir= $dir_name; # $File::Find::dir
894
895 # Get the list of files in the current directory.
896 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
897 warnings::warnif "Can't opendir($dir_name): $!\n";
898 next;
899 }
900 @filenames = readdir DIR;
901 closedir(DIR);
902 @filenames = $pre_process->(@filenames) if $pre_process;
903 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
904
905 # default: use whatever was specifid
906 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
907 $no_nlink = $avoid_nlink;
908 # if dir has wrong nlink count, force switch to slower stat method
909 $no_nlink = 1 if ($nlink < 2);
910
911 if ($nlink == 2 && !$no_nlink) {
912 # This dir has no subdirectories.
913 for my $FN (@filenames) {
914 if ($Is_VMS) {
915 # Big hammer here - Compensate for VMS trailing . and .dir
916 # No win situation until this is changed, but this
917 # will handle the majority of the cases with breaking the fewest
918
919 $FN =~ s/\.dir\z//i;
920 $FN =~ s#\.$## if ($FN ne '.');
921 }
922 next if $FN =~ $File::Find::skip_pattern;
923
924 $name = $dir_pref . $FN; # $File::Find::name
925 $_ = ($no_chdir ? $name : $FN); # $_
926 { $wanted_callback->() }; # protect against wild "next"
927 }
928
929 }
930 else {
931 # This dir has subdirectories.
932 $subcount = $nlink - 2;
933
934 # HACK: insert directories at this position. so as to preserve
935 # the user pre-processed ordering of files.
936 # EG: directory traversal is in user sorted order, not at random.
937 my $stack_top = @Stack;
938
939 for my $FN (@filenames) {
940 next if $FN =~ $File::Find::skip_pattern;
941 if ($subcount > 0 || $no_nlink) {
942 # Seen all the subdirs?
943 # check for directoriness.
944 # stat is faster for a file in the current directory
945 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
946
947 if (-d _) {
948 --$subcount;
949 $FN =~ s/\.dir\z//i if $Is_VMS;
950 # HACK: replace push to preserve dir traversal order
951 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
952 splice @Stack, $stack_top, 0,
953 [$CdLvl,$dir_name,$FN,$sub_nlink];
954 }
955 else {
956 $name = $dir_pref . $FN; # $File::Find::name
957 $_= ($no_chdir ? $name : $FN); # $_
958 { $wanted_callback->() }; # protect against wild "next"
959 }
960 }
961 else {
962 $name = $dir_pref . $FN; # $File::Find::name
963 $_= ($no_chdir ? $name : $FN); # $_
964 { $wanted_callback->() }; # protect against wild "next"
965 }
966 }
967 }
968 }
969 continue {
970 while ( defined ($SE = pop @Stack) ) {
971 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
972 if ($CdLvl > $Level && !$no_chdir) {
973 my $tmp;
974 if ($Is_MacOS) {
975 $tmp = (':' x ($CdLvl-$Level)) . ':';
976 }
977 elsif ($Is_VMS) {
978 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
979 }
980 else {
981 $tmp = join('/',('..') x ($CdLvl-$Level));
982 }
983 die "Can't cd to $tmp from $dir_name"
984 unless chdir ($tmp);
985 $CdLvl = $Level;
986 }
987
988 if ($Is_MacOS) {
989 # $pdir always has a trailing ':', except for the starting dir,
990 # where $dir_rel eq ':'
991 $dir_name = "$p_dir$dir_rel";
992 $dir_pref = "$dir_name:";
993 }
994 elsif ($^O eq 'MSWin32') {
995 $dir_name = ($p_dir =~ m|\w:/?$| ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
996 $dir_pref = "$dir_name/";
997 }
998 elsif ($^O eq 'VMS') {
999 if ($p_dir =~ m/[\]>]+$/) {
1000 $dir_name = $p_dir;
1001 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
1002 $dir_pref = $dir_name;
1003 }
1004 else {
1005 $dir_name = "$p_dir/$dir_rel";
1006 $dir_pref = "$dir_name/";
1007 }
1008 }
1009 else {
1010 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1011 $dir_pref = "$dir_name/";
1012 }
1013
1014 if ( $nlink == -2 ) {
1015 $name = $dir = $p_dir; # $File::Find::name / dir
1016 $_ = $File::Find::current_dir;
1017 $post_process->(); # End-of-directory processing
1018 }
1019 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
1020 $name = $dir_name;
1021 if ($Is_MacOS) {
1022 if ($dir_rel eq ':') { # must be the top dir, where we started
1023 $name =~ s|:$||; # $File::Find::name
1024 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1025 }
1026 $dir = $p_dir; # $File::Find::dir
1027 $_ = ($no_chdir ? $name : $dir_rel); # $_
1028 }
1029 else {
1030 if ( substr($name,-2) eq '/.' ) {
1031 substr($name, length($name) == 2 ? -1 : -2) = '';
1032 }
1033 $dir = $p_dir;
1034 $_ = ($no_chdir ? $dir_name : $dir_rel );
1035 if ( substr($_,-2) eq '/.' ) {
1036 substr($_, length($_) == 2 ? -1 : -2) = '';
1037 }
1038 }
1039 { $wanted_callback->() }; # protect against wild "next"
1040 }
1041 else {
1042 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
1043 last;
1044 }
1045 }
1046 }
1047}
1048
1049
1050# API:
1051# $wanted
1052# $dir_loc : absolute location of a dir
1053# $p_dir : "parent directory"
1054# preconditions:
1055# chdir (if not no_chdir) to dir
1056
1057
# spent 11.1ms (606µs+10.5) within File::Find::_find_dir_symlnk which was called 4 times, avg 2.77ms/call: # 4 times (606µs+10.5ms) by File::Find::_find_opt at line 710, avg 2.77ms/call
sub _find_dir_symlnk($$$) {
10587683µs my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
1059 my @Stack;
1060 my @filenames;
1061 my $new_loc;
1062 my $updir_loc = $dir_loc; # untainted parent directory
1063 my $SE = [];
1064 my $dir_name = $p_dir;
1065 my $dir_pref;
1066 my $loc_pref;
1067 my $dir_rel = $File::Find::current_dir;
1068 my $byd_flag; # flag for pending stack entry if $bydepth
1069 my $tainted = 0;
1070 my $ok = 1;
1071
107286µs if ($Is_MacOS) {
1073 $dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
1074 $loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
1075 } else {
1076 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
1077 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
1078 }
1079
1080 local ($dir, $name, $fullname, $prune, *DIR);
1081
1082 unless ($no_chdir) {
1083 # untaint the topdir
1084 if (( $untaint ) && (is_tainted($dir_loc) )) {
1085 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
1086 # once untainted, $updir_loc is pushed on the stack (as parent directory);
1087 # hence, we don't need to untaint the parent directory every time we chdir
1088 # to it later
1089 unless (defined $updir_loc) {
1090 if ($untaint_skip == 0) {
1091 die "directory $dir_loc is still tainted";
1092 }
1093 else {
1094 return;
1095 }
1096 }
1097 }
1098 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
1099 unless ($ok) {
1100 warnings::warnif "Can't cd to $updir_loc: $!\n";
1101 return;
1102 }
1103 }
1104
1105 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
1106
1107 if ($Is_MacOS) {
1108 $p_dir = $dir_pref; # ensure trailing ':'
1109 }
1110
111136271µs while (defined $SE) {
1112
11133631µs unless ($bydepth) {
1114 # change (back) to parent directory (always untainted)
1115 unless ($no_chdir) {
1116 unless (chdir $updir_loc) {
1117 warnings::warnif "Can't cd to $updir_loc: $!\n";
1118 next;
1119 }
1120 }
1121 $dir= $p_dir; # $File::Find::dir
1122 $name= $dir_name; # $File::Find::name
1123 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
1124 $fullname= $dir_loc; # $File::Find::fullname
1125 # prune may happen here
1126 $prune= 0;
1127411µs lstat($_); # make sure file tests with '_' work
# spent 11µs making 4 calls to File::Find::CORE:lstat, avg 3µs/call
112845µs4775µs { $wanted_callback->() }; # protect against wild "next"
# spent 775µs making 4 calls to Module::Find::_wanted, avg 194µs/call
1129 next if $prune;
1130 }
1131
1132 # change to that directory
1133 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1134 $updir_loc = $dir_loc;
1135 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
1136 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
1137 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
1138 unless (defined $updir_loc) {
1139 if ($untaint_skip == 0) {
1140 die "directory $dir_loc is still tainted";
1141 }
1142 else {
1143 next;
1144 }
1145 }
1146 }
1147 unless (chdir $updir_loc) {
1148 warnings::warnif "Can't cd to $updir_loc: $!\n";
1149 next;
1150 }
1151 }
1152
1153 if ($Is_MacOS) {
1154 $dir_name = "$dir_name:" unless ($dir_name =~ /:$/);
1155 }
1156
1157 $dir = $dir_name; # $File::Find::dir
1158
1159 # Get the list of files in the current directory.
11604100µs unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
# spent 100µs making 4 calls to File::Find::CORE:open_dir, avg 25µs/call
1161 warnings::warnif "Can't opendir($dir_loc): $!\n";
1162 next;
1163 }
1164477µs @filenames = readdir DIR;
# spent 77µs making 4 calls to File::Find::CORE:readdir, avg 19µs/call
1165431µs closedir(DIR);
# spent 31µs making 4 calls to File::Find::CORE:closedir, avg 8µs/call
1166
1167 for my $FN (@filenames) {
1168221348µs if ($Is_VMS) {
1169 # Big hammer here - Compensate for VMS trailing . and .dir
1170 # No win situation until this is changed, but this
1171 # will handle the majority of the cases with breaking the fewest.
1172
1173 $FN =~ s/\.dir\z//i;
1174 $FN =~ s#\.$## if ($FN ne '.');
1175 }
11769861µs next if $FN =~ $File::Find::skip_pattern;
# spent 37µs making 49 calls to File::Find::CORE:regcomp, avg 747ns/call # spent 25µs making 49 calls to File::Find::CORE:match, avg 508ns/call
1177
1178 # follow symbolic links / do an lstat
117941448µs $new_loc = Follow_SymLink($loc_pref.$FN);
# spent 448µs making 41 calls to File::Find::Follow_SymLink, avg 11µs/call
1180
1181 # ignore if invalid symlink
1182 unless (defined $new_loc) {
1183 if (!defined -l _ && $dangling_symlinks) {
1184 if (ref $dangling_symlinks eq 'CODE') {
1185 $dangling_symlinks->($FN, $dir_pref);
1186 } else {
1187 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
1188 }
1189 }
1190
1191 $fullname = undef;
1192 $name = $dir_pref . $FN;
1193 $_ = ($no_chdir ? $name : $FN);
1194 { $wanted_callback->() };
1195 next;
1196 }
1197
119816456µs419µs if (-d _) {
# spent 9µs making 41 calls to File::Find::CORE:ftdir, avg 224ns/call
1199 if ($Is_VMS) {
1200 $FN =~ s/\.dir\z//i;
1201 $FN =~ s#\.$## if ($FN ne '.');
1202 $new_loc =~ s/\.dir\z//i;
1203 $new_loc =~ s#\.$## if ($new_loc ne '.');
1204 }
1205 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
1206 }
1207 else {
1208 $fullname = $new_loc; # $File::Find::fullname
1209 $name = $dir_pref . $FN; # $File::Find::name
1210 $_ = ($no_chdir ? $name : $FN); # $_
12114142µs418.97ms { $wanted_callback->() }; # protect against wild "next"
# spent 8.97ms making 41 calls to Module::Find::_wanted, avg 219µs/call
1212 }
1213 }
1214
1215 }
1216 continue {
1217 while (defined($SE = pop @Stack)) {
1218 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1219 if ($Is_MacOS) {
1220 # $p_dir always has a trailing ':', except for the starting dir,
1221 # where $dir_rel eq ':'
1222 $dir_name = "$p_dir$dir_rel";
1223 $dir_pref = "$dir_name:";
1224 $loc_pref = ($dir_loc =~ /:$/) ? $dir_loc : "$dir_loc:";
1225 }
1226 else {
1227 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1228 $dir_pref = "$dir_name/";
1229 $loc_pref = "$dir_loc/";
1230 }
1231 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1232 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1233 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1234 warnings::warnif "Can't cd to $updir_loc: $!\n";
1235 next;
1236 }
1237 }
1238 $fullname = $dir_loc; # $File::Find::fullname
1239 $name = $dir_name; # $File::Find::name
1240 if ($Is_MacOS) {
1241 if ($dir_rel eq ':') { # must be the top dir, where we started
1242 $name =~ s|:$||; # $File::Find::name
1243 $p_dir = "$p_dir:" unless ($p_dir =~ /:$/);
1244 }
1245 $dir = $p_dir; # $File::Find::dir
1246 $_ = ($no_chdir ? $name : $dir_rel); # $_
1247 }
1248 else {
1249 if ( substr($name,-2) eq '/.' ) {
1250 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1251 }
1252 $dir = $p_dir; # $File::Find::dir
1253 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1254 if ( substr($_,-2) eq '/.' ) {
1255 substr($_, length($_) == 2 ? -1 : -2) = '';
1256 }
1257 }
1258
1259 lstat($_); # make sure file tests with '_' work
1260 { $wanted_callback->() }; # protect against wild "next"
1261 }
1262 else {
1263 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1264 last;
1265 }
1266 }
1267 }
1268}
1269
1270
1271
# spent 30µs within File::Find::wrap_wanted which was called 4 times, avg 7µs/call: # 4 times (30µs+0s) by File::Find::find at line 1297, avg 7µs/call
sub wrap_wanted {
127286µs my $wanted = shift;
12731625µs if ( ref($wanted) eq 'HASH' ) {
1274 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1275 die 'no &wanted subroutine given';
1276 }
1277 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1278 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1279 }
1280 if ( $wanted->{untaint} ) {
1281 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1282 unless defined $wanted->{untaint_pattern};
1283 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1284 }
1285 return $wanted;
1286 }
1287 elsif( ref( $wanted ) eq 'CODE' ) {
1288 return { wanted => $wanted };
1289 }
1290 else {
1291 die 'no &wanted subroutine given';
1292 }
1293}
1294
1295
# spent 11.5ms (30µs+11.4) within File::Find::find which was called 4 times, avg 2.86ms/call: # 4 times (30µs+11.4ms) by Module::Find::_find at line 193 of Module/Find.pm, avg 2.86ms/call
sub find {
1296826µs my $wanted = shift;
1297811.4ms _find_opt(wrap_wanted($wanted), @_);
# spent 11.4ms making 4 calls to File::Find::_find_opt, avg 2.85ms/call # spent 30µs making 4 calls to File::Find::wrap_wanted, avg 7µs/call
1298}
1299
1300sub finddepth {
1301 my $wanted = wrap_wanted(shift);
1302 $wanted->{bydepth} = 1;
1303 _find_opt($wanted, @_);
1304}
1305
1306# default
1307116µs14µs$File::Find::skip_pattern = qr/^\.{1,2}\z/;
# spent 4µs making 1 call to File::Find::CORE:qr
130814µs12µs$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
# spent 2µs making 1 call to File::Find::CORE:qr
1309
1310# These are hard-coded for now, but may move to hint files.
131113µsif ($^O eq 'VMS') {
1312 $Is_VMS = 1;
1313 $File::Find::dont_use_nlink = 1;
1314}
1315elsif ($^O eq 'MacOS') {
1316 $Is_MacOS = 1;
1317 $File::Find::dont_use_nlink = 1;
1318 $File::Find::skip_pattern = qr/^Icon\015\z/;
1319 $File::Find::untaint_pattern = qr|^(.+)$|;
1320}
1321
1322# this _should_ work properly on all platforms
1323# where File::Find can be expected to work
1324110µs13µs$File::Find::current_dir = File::Spec->curdir || '.';
# spent 3µs making 1 call to File::Spec::Unix::curdir
1325
132612µs$File::Find::dont_use_nlink = 1
1327 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
1328 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1329 $^O eq 'nto';
1330
1331# Set dont_use_nlink in your hint file if your system's stat doesn't
1332# report the number of links in a directory as an indication
1333# of the number of files.
1334# See, e.g. hints/machten.sh for MachTen 2.2.
133539µsunless ($File::Find::dont_use_nlink) {
1336 require Config;
133711µs16µs $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
# spent 6µs making 1 call to Config::FETCH
1338}
1339
1340# We need a function that checks if a scalar is tainted. Either use the
1341# Scalar::Util module's tainted() function or our (slower) pure Perl
1342# fallback is_tainted_pp()
1343{
134445µs local $@;
134511µs eval { require Scalar::Util };
1346 *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1347}
1348
1349119µs1;
 
# spent 31µs within File::Find::CORE:closedir which was called 4 times, avg 8µs/call: # 4 times (31µs+0s) by File::Find::_find_dir_symlnk at line 1165, avg 8µs/call
sub File::Find::CORE:closedir; # opcode
# spent 10µs within File::Find::CORE:ftdir which was called 45 times, avg 231ns/call: # 41 times (9µs+0s) by File::Find::_find_dir_symlnk at line 1198, avg 224ns/call # 4 times (1µs+0s) by File::Find::_find_opt at line 708, avg 300ns/call
sub File::Find::CORE:ftdir; # opcode
# spent 10µs within File::Find::CORE:ftlink which was called 45 times, avg 231ns/call: # 45 times (10µs+0s) by File::Find::Follow_SymLink at line 545, avg 231ns/call
sub File::Find::CORE:ftlink; # opcode
# spent 179µs within File::Find::CORE:lstat which was called 49 times, avg 4µs/call: # 45 times (168µs+0s) by File::Find::Follow_SymLink at line 543, avg 4µs/call # 4 times (11µs+0s) by File::Find::_find_dir_symlnk at line 1127, avg 3µs/call
sub File::Find::CORE:lstat; # opcode
# spent 25µs within File::Find::CORE:match which was called 49 times, avg 508ns/call: # 49 times (25µs+0s) by File::Find::_find_dir_symlnk at line 1176, avg 508ns/call
sub File::Find::CORE:match; # opcode
# spent 100µs within File::Find::CORE:open_dir which was called 4 times, avg 25µs/call: # 4 times (100µs+0s) by File::Find::_find_dir_symlnk at line 1160, avg 25µs/call
sub File::Find::CORE:open_dir; # opcode
# spent 6µs within File::Find::CORE:qr which was called 2 times, avg 3µs/call: # once (4µs+0s) by Module::Find::BEGIN@8 at line 1307 # once (2µs+0s) by Module::Find::BEGIN@8 at line 1308
sub File::Find::CORE:qr; # opcode
# spent 77µs within File::Find::CORE:readdir which was called 4 times, avg 19µs/call: # 4 times (77µs+0s) by File::Find::_find_dir_symlnk at line 1164, avg 19µs/call
sub File::Find::CORE:readdir; # opcode
# spent 37µs within File::Find::CORE:regcomp which was called 49 times, avg 747ns/call: # 49 times (37µs+0s) by File::Find::_find_dir_symlnk at line 1176, avg 747ns/call
sub File::Find::CORE:regcomp; # opcode
# spent 20µs within File::Find::CORE:stat which was called 4 times, avg 5µs/call: # 4 times (20µs+0s) by File::Find::_find_opt at line 653, avg 5µs/call
sub File::Find::CORE:stat; # opcode
# spent 3µs within File::Find::CORE:subst which was called 4 times, avg 675ns/call: # 4 times (3µs+0s) by File::Find::_find_opt at line 662, avg 675ns/call
sub File::Find::CORE:subst; # opcode