← Index
NYTProf Performance Profile   « block view • line view • sub view »
For C:/lo/libo-master/solenv/bin/make_installer.pl
  Run on Mon Sep 24 00:52:54 2012
Reported on Mon Sep 24 07:34:31 2012

Filename/usr/lib/perl5/5.14/File/Find.pm
StatementsExecuted 34 statements in 8.70ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111241µs241µsFile::Find::::BEGIN@2File::Find::BEGIN@2
11121µs25µsFile::Find::::BEGIN@349File::Find::BEGIN@349
22116µs16µsFile::Find::::CORE:qrFile::Find::CORE:qr (opcode)
11115µs35µsFile::Find::::BEGIN@4File::Find::BEGIN@4
11115µs223µsFile::Find::::BEGIN@5File::Find::BEGIN@5
11115µs20µsFile::Find::::BEGIN@3File::Find::BEGIN@3
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::::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;
22195µs1241µs
# spent 241µs within File::Find::BEGIN@2 which was called: # once (241µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 2
use 5.006;
# spent 241µs making 1 call to File::Find::BEGIN@2
3253µs226µs
# spent 20µs (15+6) within File::Find::BEGIN@3 which was called: # once (15µs+6µs) by Archive::Zip::Archive::BEGIN@7 at line 3
use strict;
# spent 20µs making 1 call to File::Find::BEGIN@3 # spent 6µs making 1 call to strict::import
4256µs254µs
# spent 35µs (15+19) within File::Find::BEGIN@4 which was called: # once (15µs+19µs) by Archive::Zip::Archive::BEGIN@7 at line 4
use warnings;
# spent 35µs making 1 call to File::Find::BEGIN@4 # spent 19µs making 1 call to warnings::import
52509µs2431µs
# spent 223µs (15+208) within File::Find::BEGIN@5 which was called: # once (15µs+208µs) by Archive::Zip::Archive::BEGIN@7 at line 5
use warnings::register;
# spent 223µs making 1 call to File::Find::BEGIN@5 # spent 208µs making 1 call to warnings::register::import
612µsour $VERSION = '1.19';
712µsrequire Exporter;
811µsrequire Cwd;
9
10#
11# Modified to ensure sub-directory traversal order is not inverted by stack
12# push and pops. That is remains in the same order as in the directory file,
13# or user pre-processing (EG:sorted).
14#
15
16=head1 NAME
17
18File::Find - Traverse a directory tree.
19
20=head1 SYNOPSIS
21
22 use File::Find;
23 find(\&wanted, @directories_to_search);
24 sub wanted { ... }
25
26 use File::Find;
27 finddepth(\&wanted, @directories_to_search);
28 sub wanted { ... }
29
30 use File::Find;
31 find({ wanted => \&process, follow => 1 }, '.');
32
33=head1 DESCRIPTION
34
35These are functions for searching through directory trees doing work
36on each file found similar to the Unix I<find> command. File::Find
37exports two functions, C<find> and C<finddepth>. They work similarly
38but have subtle differences.
39
40=over 4
41
42=item B<find>
43
44 find(\&wanted, @directories);
45 find(\%options, @directories);
46
47C<find()> does a depth-first search over the given C<@directories> in
48the order they are given. For each file or directory found, it calls
49the C<&wanted> subroutine. (See below for details on how to use the
50C<&wanted> function). Additionally, for each directory found, it will
51C<chdir()> into that directory and continue the search, invoking the
52C<&wanted> function on each file or subdirectory in the directory.
53
54=item B<finddepth>
55
56 finddepth(\&wanted, @directories);
57 finddepth(\%options, @directories);
58
59C<finddepth()> works just like C<find()> except that it invokes the
60C<&wanted> function for a directory I<after> invoking it for the
61directory's contents. It does a postorder traversal instead of a
62preorder traversal, working from the bottom of the directory tree up
63where C<find()> works from the top of the tree down.
64
65=back
66
67=head2 %options
68
69The first argument to C<find()> is either a code reference to your
70C<&wanted> function, or a hash reference describing the operations
71to be performed for each file. The
72code reference is described in L<The wanted function> below.
73
74Here are the possible keys for the hash:
75
76=over 3
77
78=item C<wanted>
79
80The value should be a code reference. This code reference is
81described in L<The wanted function> below. The C<&wanted> subroutine is
82mandatory.
83
84=item C<bydepth>
85
86Reports the name of a directory only AFTER all its entries
87have been reported. Entry point C<finddepth()> is a shortcut for
88specifying C<< { bydepth => 1 } >> in the first argument of C<find()>.
89
90=item C<preprocess>
91
92The value should be a code reference. This code reference is used to
93preprocess the current directory. The name of the currently processed
94directory is in C<$File::Find::dir>. Your preprocessing function is
95called after C<readdir()>, but before the loop that calls the C<wanted()>
96function. It is called with a list of strings (actually file/directory
97names) and is expected to return a list of strings. The code can be
98used to sort the file/directory names alphabetically, numerically,
99or to filter out directory entries based on their name alone. When
100I<follow> or I<follow_fast> are in effect, C<preprocess> is a no-op.
101
102=item C<postprocess>
103
104The value should be a code reference. It is invoked just before leaving
105the currently processed directory. It is called in void context with no
106arguments. The name of the current directory is in C<$File::Find::dir>. This
107hook is handy for summarizing a directory, such as calculating its disk
108usage. When I<follow> or I<follow_fast> are in effect, C<postprocess> is a
109no-op.
110
111=item C<follow>
112
113Causes symbolic links to be followed. Since directory trees with symbolic
114links (followed) may contain files more than once and may even have
115cycles, a hash has to be built up with an entry for each file.
116This might be expensive both in space and time for a large
117directory tree. See 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 BUGS AND CAVEATS
328
329Despite the name of the C<finddepth()> function, both C<find()> and
330C<finddepth()> perform a depth-first search of the directory
331hierarchy.
332
333=head1 HISTORY
334
335File::Find used to produce incorrect results if called recursively.
336During the development of perl 5.8 this bug was fixed.
337The first fixed version of File::Find was 1.01.
338
339=head1 SEE ALSO
340
341find, find2perl.
342
343=cut
344
345115µsour @ISA = qw(Exporter);
34612µsour @EXPORT = qw(find finddepth);
347
348
34927.68ms229µs
# spent 25µs (21+4) within File::Find::BEGIN@349 which was called: # once (21µs+4µs) by Archive::Zip::Archive::BEGIN@7 at line 349
use strict;
# spent 25µs making 1 call to File::Find::BEGIN@349 # spent 4µs making 1 call to strict::import
3501500nsmy $Is_VMS;
3511500nsmy $Is_Win32;
352
35311µsrequire File::Basename;
35411µsrequire File::Spec;
355
356# Should ideally be my() not our() but local() currently
357# refuses to operate on lexicals
358
3591500nsour %SLnkSeen;
3601500nsour ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
361 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
362 $pre_process, $post_process, $dangling_symlinks);
363
364sub contract_name {
365 my ($cdir,$fn) = @_;
366
367 return substr($cdir,0,rindex($cdir,'/')) if $fn eq $File::Find::current_dir;
368
369 $cdir = substr($cdir,0,rindex($cdir,'/')+1);
370
371 $fn =~ s|^\./||;
372
373 my $abs_name= $cdir . $fn;
374
375 if (substr($fn,0,3) eq '../') {
376 1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
377 }
378
379 return $abs_name;
380}
381
382sub PathCombine($$) {
383 my ($Base,$Name) = @_;
384 my $AbsName;
385
386 if (substr($Name,0,1) eq '/') {
387 $AbsName= $Name;
388 }
389 else {
390 $AbsName= contract_name($Base,$Name);
391 }
392
393 # (simple) check for recursion
394 my $newlen= length($AbsName);
395 if ($newlen <= length($Base)) {
396 if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/')
397 && $AbsName eq substr($Base,0,$newlen))
398 {
399 return undef;
400 }
401 }
402 return $AbsName;
403}
404
405sub Follow_SymLink($) {
406 my ($AbsName) = @_;
407
408 my ($NewName,$DEV, $INO);
409 ($DEV, $INO)= lstat $AbsName;
410
411 while (-l _) {
412 if ($SLnkSeen{$DEV, $INO}++) {
413 if ($follow_skip < 2) {
414 die "$AbsName is encountered a second time";
415 }
416 else {
417 return undef;
418 }
419 }
420 $NewName= PathCombine($AbsName, readlink($AbsName));
421 unless(defined $NewName) {
422 if ($follow_skip < 2) {
423 die "$AbsName is a recursive symbolic link";
424 }
425 else {
426 return undef;
427 }
428 }
429 else {
430 $AbsName= $NewName;
431 }
432 ($DEV, $INO) = lstat($AbsName);
433 return undef unless defined $DEV; # dangling symbolic link
434 }
435
436 if ($full_check && defined $DEV && $SLnkSeen{$DEV, $INO}++) {
437 if ( ($follow_skip < 1) || ((-d _) && ($follow_skip < 2)) ) {
438 die "$AbsName encountered a second time";
439 }
440 else {
441 return undef;
442 }
443 }
444
445 return $AbsName;
446}
447
44810sour($dir, $name, $fullname, $prune);
449sub _find_dir_symlnk($$$);
450sub _find_dir($$$);
451
452# check whether or not a scalar variable is tainted
453# (code straight from the Camel, 3rd ed., page 561)
454sub is_tainted_pp {
455 my $arg = shift;
456 my $nada = substr($arg, 0, 0); # zero-length
457 local $@;
458 eval { eval "# $nada" };
459 return length($@) != 0;
460}
461
462sub _find_opt {
463 my $wanted = shift;
464 die "invalid top directory" unless defined $_[0];
465
466 # This function must local()ize everything because callbacks may
467 # call find() or finddepth()
468
469 local %SLnkSeen;
470 local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
471 $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
472 $pre_process, $post_process, $dangling_symlinks);
473 local($dir, $name, $fullname, $prune);
474 local *_ = \my $a;
475
476 my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
477 if ($Is_VMS) {
478 # VMS returns this by default in VMS format which just doesn't
479 # work for the rest of this module.
480 $cwd = VMS::Filespec::unixpath($cwd);
481
482 # Apparently this is not expected to have a trailing space.
483 # To attempt to make VMS/UNIX conversions mostly reversable,
484 # a trailing slash is needed. The run-time functions ignore the
485 # resulting double slash, but it causes the perl tests to fail.
486 $cwd =~ s#/\z##;
487
488 # This comes up in upper case now, but should be lower.
489 # In the future this could be exact case, no need to change.
490 }
491 my $cwd_untainted = $cwd;
492 my $check_t_cwd = 1;
493 $wanted_callback = $wanted->{wanted};
494 $bydepth = $wanted->{bydepth};
495 $pre_process = $wanted->{preprocess};
496 $post_process = $wanted->{postprocess};
497 $no_chdir = $wanted->{no_chdir};
498 $full_check = $Is_Win32 ? 0 : $wanted->{follow};
499 $follow = $Is_Win32 ? 0 :
500 $full_check || $wanted->{follow_fast};
501 $follow_skip = $wanted->{follow_skip};
502 $untaint = $wanted->{untaint};
503 $untaint_pat = $wanted->{untaint_pattern};
504 $untaint_skip = $wanted->{untaint_skip};
505 $dangling_symlinks = $wanted->{dangling_symlinks};
506
507 # for compatibility reasons (find.pl, find2perl)
508 local our ($topdir, $topdev, $topino, $topmode, $topnlink);
509
510 # a symbolic link to a directory doesn't increase the link count
511 $avoid_nlink = $follow || $File::Find::dont_use_nlink;
512
513 my ($abs_dir, $Is_Dir);
514
515 Proc_Top_Item:
516 foreach my $TOP (@_) {
517 my $top_item = $TOP;
518
519 ($topdev,$topino,$topmode,$topnlink) = $follow ? stat $top_item : lstat $top_item;
520
521 if ($Is_Win32) {
522 $top_item =~ s|[/\\]\z||
523 unless $top_item =~ m{^(?:\w:)?[/\\]$};
524 }
525 else {
526 $top_item =~ s|/\z|| unless $top_item eq '/';
527 }
528
529 $Is_Dir= 0;
530
531 if ($follow) {
532
533 if (substr($top_item,0,1) eq '/') {
534 $abs_dir = $top_item;
535 }
536 elsif ($top_item eq $File::Find::current_dir) {
537 $abs_dir = $cwd;
538 }
539 else { # care about any ../
540 $top_item =~ s/\.dir\z//i if $Is_VMS;
541 $abs_dir = contract_name("$cwd/",$top_item);
542 }
543 $abs_dir= Follow_SymLink($abs_dir);
544 unless (defined $abs_dir) {
545 if ($dangling_symlinks) {
546 if (ref $dangling_symlinks eq 'CODE') {
547 $dangling_symlinks->($top_item, $cwd);
548 } else {
549 warnings::warnif "$top_item is a dangling symbolic link\n";
550 }
551 }
552 next Proc_Top_Item;
553 }
554
555 if (-d _) {
556 $top_item =~ s/\.dir\z//i if $Is_VMS;
557 _find_dir_symlnk($wanted, $abs_dir, $top_item);
558 $Is_Dir= 1;
559 }
560 }
561 else { # no follow
562 $topdir = $top_item;
563 unless (defined $topnlink) {
564 warnings::warnif "Can't stat $top_item: $!\n";
565 next Proc_Top_Item;
566 }
567 if (-d _) {
568 $top_item =~ s/\.dir\z//i if $Is_VMS;
569 _find_dir($wanted, $top_item, $topnlink);
570 $Is_Dir= 1;
571 }
572 else {
573 $abs_dir= $top_item;
574 }
575 }
576
577 unless ($Is_Dir) {
578 unless (($_,$dir) = File::Basename::fileparse($abs_dir)) {
579 ($dir,$_) = ('./', $top_item);
580 }
581
582 $abs_dir = $dir;
583 if (( $untaint ) && (is_tainted($dir) )) {
584 ( $abs_dir ) = $dir =~ m|$untaint_pat|;
585 unless (defined $abs_dir) {
586 if ($untaint_skip == 0) {
587 die "directory $dir is still tainted";
588 }
589 else {
590 next Proc_Top_Item;
591 }
592 }
593 }
594
595 unless ($no_chdir || chdir $abs_dir) {
596 warnings::warnif "Couldn't chdir $abs_dir: $!\n";
597 next Proc_Top_Item;
598 }
599
600 $name = $abs_dir . $_; # $File::Find::name
601 $_ = $name if $no_chdir;
602
603 { $wanted_callback->() }; # protect against wild "next"
604
605 }
606
607 unless ( $no_chdir ) {
608 if ( ($check_t_cwd) && (($untaint) && (is_tainted($cwd) )) ) {
609 ( $cwd_untainted ) = $cwd =~ m|$untaint_pat|;
610 unless (defined $cwd_untainted) {
611 die "insecure cwd in find(depth)";
612 }
613 $check_t_cwd = 0;
614 }
615 unless (chdir $cwd_untainted) {
616 die "Can't cd to $cwd: $!\n";
617 }
618 }
619 }
620}
621
622# API:
623# $wanted
624# $p_dir : "parent directory"
625# $nlink : what came back from the stat
626# preconditions:
627# chdir (if not no_chdir) to dir
628
629sub _find_dir($$$) {
630 my ($wanted, $p_dir, $nlink) = @_;
631 my ($CdLvl,$Level) = (0,0);
632 my @Stack;
633 my @filenames;
634 my ($subcount,$sub_nlink);
635 my $SE= [];
636 my $dir_name= $p_dir;
637 my $dir_pref;
638 my $dir_rel = $File::Find::current_dir;
639 my $tainted = 0;
640 my $no_nlink;
641
642 if ($Is_Win32) {
643 $dir_pref
644 = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$} ? $p_dir : "$p_dir/" );
645 } elsif ($Is_VMS) {
646
647 # VMS is returning trailing .dir on directories
648 # and trailing . on files and symbolic links
649 # in UNIX syntax.
650 #
651
652 $p_dir =~ s/\.(dir)?$//i unless $p_dir eq '.';
653
654 $dir_pref = ($p_dir =~ m/[\]>]+$/ ? $p_dir : "$p_dir/" );
655 }
656 else {
657 $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
658 }
659
660 local ($dir, $name, $prune, *DIR);
661
662 unless ( $no_chdir || ($p_dir eq $File::Find::current_dir)) {
663 my $udir = $p_dir;
664 if (( $untaint ) && (is_tainted($p_dir) )) {
665 ( $udir ) = $p_dir =~ m|$untaint_pat|;
666 unless (defined $udir) {
667 if ($untaint_skip == 0) {
668 die "directory $p_dir is still tainted";
669 }
670 else {
671 return;
672 }
673 }
674 }
675 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
676 warnings::warnif "Can't cd to $udir: $!\n";
677 return;
678 }
679 }
680
681 # push the starting directory
682 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
683
684 while (defined $SE) {
685 unless ($bydepth) {
686 $dir= $p_dir; # $File::Find::dir
687 $name= $dir_name; # $File::Find::name
688 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
689 # prune may happen here
690 $prune= 0;
691 { $wanted_callback->() }; # protect against wild "next"
692 next if $prune;
693 }
694
695 # change to that directory
696 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
697 my $udir= $dir_rel;
698 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_rel) )) ) {
699 ( $udir ) = $dir_rel =~ m|$untaint_pat|;
700 unless (defined $udir) {
701 if ($untaint_skip == 0) {
702 die "directory (" . ($p_dir ne '/' ? $p_dir : '') . "/) $dir_rel is still tainted";
703 } else { # $untaint_skip == 1
704 next;
705 }
706 }
707 }
708 unless (chdir ($Is_VMS && $udir !~ /[\/\[<]+/ ? "./$udir" : $udir)) {
709 warnings::warnif "Can't cd to (" .
710 ($p_dir ne '/' ? $p_dir : '') . "/) $udir: $!\n";
711 next;
712 }
713 $CdLvl++;
714 }
715
716 $dir= $dir_name; # $File::Find::dir
717
718 # Get the list of files in the current directory.
719 unless (opendir DIR, ($no_chdir ? $dir_name : $File::Find::current_dir)) {
720 warnings::warnif "Can't opendir($dir_name): $!\n";
721 next;
722 }
723 @filenames = readdir DIR;
724 closedir(DIR);
725 @filenames = $pre_process->(@filenames) if $pre_process;
726 push @Stack,[$CdLvl,$dir_name,"",-2] if $post_process;
727
728 # default: use whatever was specified
729 # (if $nlink >= 2, and $avoid_nlink == 0, this will switch back)
730 $no_nlink = $avoid_nlink;
731 # if dir has wrong nlink count, force switch to slower stat method
732 $no_nlink = 1 if ($nlink < 2);
733
734 if ($nlink == 2 && !$no_nlink) {
735 # This dir has no subdirectories.
736 for my $FN (@filenames) {
737 if ($Is_VMS) {
738 # Big hammer here - Compensate for VMS trailing . and .dir
739 # No win situation until this is changed, but this
740 # will handle the majority of the cases with breaking the fewest
741
742 $FN =~ s/\.dir\z//i;
743 $FN =~ s#\.$## if ($FN ne '.');
744 }
745 next if $FN =~ $File::Find::skip_pattern;
746
747 $name = $dir_pref . $FN; # $File::Find::name
748 $_ = ($no_chdir ? $name : $FN); # $_
749 { $wanted_callback->() }; # protect against wild "next"
750 }
751
752 }
753 else {
754 # This dir has subdirectories.
755 $subcount = $nlink - 2;
756
757 # HACK: insert directories at this position. so as to preserve
758 # the user pre-processed ordering of files.
759 # EG: directory traversal is in user sorted order, not at random.
760 my $stack_top = @Stack;
761
762 for my $FN (@filenames) {
763 next if $FN =~ $File::Find::skip_pattern;
764 if ($subcount > 0 || $no_nlink) {
765 # Seen all the subdirs?
766 # check for directoriness.
767 # stat is faster for a file in the current directory
768 $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];
769
770 if (-d _) {
771 --$subcount;
772 $FN =~ s/\.dir\z//i if $Is_VMS;
773 # HACK: replace push to preserve dir traversal order
774 #push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
775 splice @Stack, $stack_top, 0,
776 [$CdLvl,$dir_name,$FN,$sub_nlink];
777 }
778 else {
779 $name = $dir_pref . $FN; # $File::Find::name
780 $_= ($no_chdir ? $name : $FN); # $_
781 { $wanted_callback->() }; # protect against wild "next"
782 }
783 }
784 else {
785 $name = $dir_pref . $FN; # $File::Find::name
786 $_= ($no_chdir ? $name : $FN); # $_
787 { $wanted_callback->() }; # protect against wild "next"
788 }
789 }
790 }
791 }
792 continue {
793 while ( defined ($SE = pop @Stack) ) {
794 ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
795 if ($CdLvl > $Level && !$no_chdir) {
796 my $tmp;
797 if ($Is_VMS) {
798 $tmp = '[' . ('-' x ($CdLvl-$Level)) . ']';
799 }
800 else {
801 $tmp = join('/',('..') x ($CdLvl-$Level));
802 }
803 die "Can't cd to $tmp from $dir_name"
804 unless chdir ($tmp);
805 $CdLvl = $Level;
806 }
807
808 if ($Is_Win32) {
809 $dir_name = ($p_dir =~ m{^(?:\w:[/\\]?|[/\\])$}
810 ? "$p_dir$dir_rel" : "$p_dir/$dir_rel");
811 $dir_pref = "$dir_name/";
812 }
813 elsif ($^O eq 'VMS') {
814 if ($p_dir =~ m/[\]>]+$/) {
815 $dir_name = $p_dir;
816 $dir_name =~ s/([\]>]+)$/.$dir_rel$1/;
817 $dir_pref = $dir_name;
818 }
819 else {
820 $dir_name = "$p_dir/$dir_rel";
821 $dir_pref = "$dir_name/";
822 }
823 }
824 else {
825 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
826 $dir_pref = "$dir_name/";
827 }
828
829 if ( $nlink == -2 ) {
830 $name = $dir = $p_dir; # $File::Find::name / dir
831 $_ = $File::Find::current_dir;
832 $post_process->(); # End-of-directory processing
833 }
834 elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
835 $name = $dir_name;
836 if ( substr($name,-2) eq '/.' ) {
837 substr($name, length($name) == 2 ? -1 : -2) = '';
838 }
839 $dir = $p_dir;
840 $_ = ($no_chdir ? $dir_name : $dir_rel );
841 if ( substr($_,-2) eq '/.' ) {
842 substr($_, length($_) == 2 ? -1 : -2) = '';
843 }
844 { $wanted_callback->() }; # protect against wild "next"
845 }
846 else {
847 push @Stack,[$CdLvl,$p_dir,$dir_rel,-1] if $bydepth;
848 last;
849 }
850 }
851 }
852}
853
854
855# API:
856# $wanted
857# $dir_loc : absolute location of a dir
858# $p_dir : "parent directory"
859# preconditions:
860# chdir (if not no_chdir) to dir
861
862sub _find_dir_symlnk($$$) {
863 my ($wanted, $dir_loc, $p_dir) = @_; # $dir_loc is the absolute directory
864 my @Stack;
865 my @filenames;
866 my $new_loc;
867 my $updir_loc = $dir_loc; # untainted parent directory
868 my $SE = [];
869 my $dir_name = $p_dir;
870 my $dir_pref;
871 my $loc_pref;
872 my $dir_rel = $File::Find::current_dir;
873 my $byd_flag; # flag for pending stack entry if $bydepth
874 my $tainted = 0;
875 my $ok = 1;
876
877 $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
878 $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
879
880 local ($dir, $name, $fullname, $prune, *DIR);
881
882 unless ($no_chdir) {
883 # untaint the topdir
884 if (( $untaint ) && (is_tainted($dir_loc) )) {
885 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|; # parent dir, now untainted
886 # once untainted, $updir_loc is pushed on the stack (as parent directory);
887 # hence, we don't need to untaint the parent directory every time we chdir
888 # to it later
889 unless (defined $updir_loc) {
890 if ($untaint_skip == 0) {
891 die "directory $dir_loc is still tainted";
892 }
893 else {
894 return;
895 }
896 }
897 }
898 $ok = chdir($updir_loc) unless ($p_dir eq $File::Find::current_dir);
899 unless ($ok) {
900 warnings::warnif "Can't cd to $updir_loc: $!\n";
901 return;
902 }
903 }
904
905 push @Stack,[$dir_loc,$updir_loc,$p_dir,$dir_rel,-1] if $bydepth;
906
907 while (defined $SE) {
908
909 unless ($bydepth) {
910 # change (back) to parent directory (always untainted)
911 unless ($no_chdir) {
912 unless (chdir $updir_loc) {
913 warnings::warnif "Can't cd to $updir_loc: $!\n";
914 next;
915 }
916 }
917 $dir= $p_dir; # $File::Find::dir
918 $name= $dir_name; # $File::Find::name
919 $_= ($no_chdir ? $dir_name : $dir_rel ); # $_
920 $fullname= $dir_loc; # $File::Find::fullname
921 # prune may happen here
922 $prune= 0;
923 lstat($_); # make sure file tests with '_' work
924 { $wanted_callback->() }; # protect against wild "next"
925 next if $prune;
926 }
927
928 # change to that directory
929 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
930 $updir_loc = $dir_loc;
931 if ( ($untaint) && (($tainted) || ($tainted = is_tainted($dir_loc) )) ) {
932 # untaint $dir_loc, what will be pushed on the stack as (untainted) parent dir
933 ( $updir_loc ) = $dir_loc =~ m|$untaint_pat|;
934 unless (defined $updir_loc) {
935 if ($untaint_skip == 0) {
936 die "directory $dir_loc is still tainted";
937 }
938 else {
939 next;
940 }
941 }
942 }
943 unless (chdir $updir_loc) {
944 warnings::warnif "Can't cd to $updir_loc: $!\n";
945 next;
946 }
947 }
948
949 $dir = $dir_name; # $File::Find::dir
950
951 # Get the list of files in the current directory.
952 unless (opendir DIR, ($no_chdir ? $dir_loc : $File::Find::current_dir)) {
953 warnings::warnif "Can't opendir($dir_loc): $!\n";
954 next;
955 }
956 @filenames = readdir DIR;
957 closedir(DIR);
958
959 for my $FN (@filenames) {
960 if ($Is_VMS) {
961 # Big hammer here - Compensate for VMS trailing . and .dir
962 # No win situation until this is changed, but this
963 # will handle the majority of the cases with breaking the fewest.
964
965 $FN =~ s/\.dir\z//i;
966 $FN =~ s#\.$## if ($FN ne '.');
967 }
968 next if $FN =~ $File::Find::skip_pattern;
969
970 # follow symbolic links / do an lstat
971 $new_loc = Follow_SymLink($loc_pref.$FN);
972
973 # ignore if invalid symlink
974 unless (defined $new_loc) {
975 if (!defined -l _ && $dangling_symlinks) {
976 if (ref $dangling_symlinks eq 'CODE') {
977 $dangling_symlinks->($FN, $dir_pref);
978 } else {
979 warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
980 }
981 }
982
983 $fullname = undef;
984 $name = $dir_pref . $FN;
985 $_ = ($no_chdir ? $name : $FN);
986 { $wanted_callback->() };
987 next;
988 }
989
990 if (-d _) {
991 if ($Is_VMS) {
992 $FN =~ s/\.dir\z//i;
993 $FN =~ s#\.$## if ($FN ne '.');
994 $new_loc =~ s/\.dir\z//i;
995 $new_loc =~ s#\.$## if ($new_loc ne '.');
996 }
997 push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];
998 }
999 else {
1000 $fullname = $new_loc; # $File::Find::fullname
1001 $name = $dir_pref . $FN; # $File::Find::name
1002 $_ = ($no_chdir ? $name : $FN); # $_
1003 { $wanted_callback->() }; # protect against wild "next"
1004 }
1005 }
1006
1007 }
1008 continue {
1009 while (defined($SE = pop @Stack)) {
1010 ($dir_loc, $updir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
1011 $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
1012 $dir_pref = "$dir_name/";
1013 $loc_pref = "$dir_loc/";
1014 if ( $byd_flag < 0 ) { # must be finddepth, report dirname now
1015 unless ($no_chdir || ($dir_rel eq $File::Find::current_dir)) {
1016 unless (chdir $updir_loc) { # $updir_loc (parent dir) is always untainted
1017 warnings::warnif "Can't cd to $updir_loc: $!\n";
1018 next;
1019 }
1020 }
1021 $fullname = $dir_loc; # $File::Find::fullname
1022 $name = $dir_name; # $File::Find::name
1023 if ( substr($name,-2) eq '/.' ) {
1024 substr($name, length($name) == 2 ? -1 : -2) = ''; # $File::Find::name
1025 }
1026 $dir = $p_dir; # $File::Find::dir
1027 $_ = ($no_chdir ? $dir_name : $dir_rel); # $_
1028 if ( substr($_,-2) eq '/.' ) {
1029 substr($_, length($_) == 2 ? -1 : -2) = '';
1030 }
1031
1032 lstat($_); # make sure file tests with '_' work
1033 { $wanted_callback->() }; # protect against wild "next"
1034 }
1035 else {
1036 push @Stack,[$dir_loc, $updir_loc, $p_dir, $dir_rel,-1] if $bydepth;
1037 last;
1038 }
1039 }
1040 }
1041}
1042
1043
1044sub wrap_wanted {
1045 my $wanted = shift;
1046 if ( ref($wanted) eq 'HASH' ) {
1047 unless( exists $wanted->{wanted} and ref( $wanted->{wanted} ) eq 'CODE' ) {
1048 die 'no &wanted subroutine given';
1049 }
1050 if ( $wanted->{follow} || $wanted->{follow_fast}) {
1051 $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
1052 }
1053 if ( $wanted->{untaint} ) {
1054 $wanted->{untaint_pattern} = $File::Find::untaint_pattern
1055 unless defined $wanted->{untaint_pattern};
1056 $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
1057 }
1058 return $wanted;
1059 }
1060 elsif( ref( $wanted ) eq 'CODE' ) {
1061 return { wanted => $wanted };
1062 }
1063 else {
1064 die 'no &wanted subroutine given';
1065 }
1066}
1067
1068sub find {
1069 my $wanted = shift;
1070 _find_opt(wrap_wanted($wanted), @_);
1071}
1072
1073sub finddepth {
1074 my $wanted = wrap_wanted(shift);
1075 $wanted->{bydepth} = 1;
1076 _find_opt($wanted, @_);
1077}
1078
1079# default
1080130µs113µs$File::Find::skip_pattern = qr/^\.{1,2}\z/;
# spent 13µs making 1 call to File::Find::CORE:qr
108117µs13µs$File::Find::untaint_pattern = qr|^([-+@\w./]+)$|;
# spent 3µs making 1 call to File::Find::CORE:qr
1082
1083# These are hard-coded for now, but may move to hint files.
108413µsif ($^O eq 'VMS') {
1085 $Is_VMS = 1;
1086 $File::Find::dont_use_nlink = 1;
1087}
1088elsif ($^O eq 'MSWin32') {
1089 $Is_Win32 = 1;
1090}
1091
1092# this _should_ work properly on all platforms
1093# where File::Find can be expected to work
1094116µs16µs$File::Find::current_dir = File::Spec->curdir || '.';
# spent 6µs making 1 call to File::Spec::Unix::curdir
1095
109614µs$File::Find::dont_use_nlink = 1
1097 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 ||
1098 $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'epoc' || $^O eq 'qnx' ||
1099 $^O eq 'nto';
1100
1101# Set dont_use_nlink in your hint file if your system's stat doesn't
1102# report the number of links in a directory as an indication
1103# of the number of files.
1104# See, e.g. hints/machten.sh for MachTen 2.2.
11051500nsunless ($File::Find::dont_use_nlink) {
1106 require Config;
1107 $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
1108}
1109
1110# We need a function that checks if a scalar is tainted. Either use the
1111# Scalar::Util module's tainted() function or our (slower) pure Perl
1112# fallback is_tainted_pp()
1113{
111422µs local $@;
111524µs eval { require Scalar::Util };
111615µs *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
1117}
1118
11191102µs1;
 
# spent 16µs within File::Find::CORE:qr which was called 2 times, avg 8µs/call: # once (13µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 1080 # once (3µs+0s) by Archive::Zip::Archive::BEGIN@7 at line 1081
sub File::Find::CORE:qr; # opcode