Profile of File/Find.pm

← 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
Statements | Executed 29 statements in 2.65ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 11µs | 11µs | File::Find::::BEGIN@2File::Find::BEGIN@2
1 | 1 | 1 | 4µs | 8µs | File::Find::::BEGIN@7File::Find::BEGIN@7
1 | 1 | 1 | 4µs | 5µs | File::Find::::BEGIN@3File::Find::BEGIN@3
1 | 1 | 1 | 4µs | 5µs | File::Find::::BEGIN@13File::Find::BEGIN@13
1 | 1 | 1 | 3µs | 19µs | File::Find::::BEGIN@4File::Find::BEGIN@4
1 | 1 | 1 | 3µs | 16µs | File::Find::::BEGIN@5File::Find::BEGIN@5
0 | 0 | 0 | 0s | 0s | File::Find::::Follow_SymLinkFile::Find::Follow_SymLink
0 | 0 | 0 | 0s | 0s | File::Find::::PathCombineFile::Find::PathCombine
0 | 0 | 0 | 0s | 0s | File::Find::::_find_dirFile::Find::_find_dir
0 | 0 | 0 | 0s | 0s | File::Find::::_find_dir_symlnkFile::Find::_find_dir_symlnk
0 | 0 | 0 | 0s | 0s | File::Find::::_find_optFile::Find::_find_opt
0 | 0 | 0 | 0s | 0s | File::Find::::_is_absoluteFile::Find::_is_absolute
0 | 0 | 0 | 0s | 0s | File::Find::::_is_rootFile::Find::_is_root
0 | 0 | 0 | 0s | 0s | File::Find::::contract_nameFile::Find::contract_name
0 | 0 | 0 | 0s | 0s | File::Find::::findFile::Find::find
0 | 0 | 0 | 0s | 0s | File::Find::::finddepthFile::Find::finddepth
0 | 0 | 0 | 0s | 0s | File::Find::::is_tainted_ppFile::Find::is_tainted_pp
0 | 0 | 0 | 0s | 0s | File::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package File::Find;
2 | 2 | 26µs | 1 | 11µ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
3 | 2 | 14µs | 2 | 7µ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
4 | 2 | 12µs | 2 | 36µ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
5 | 2 | 24µs | 2 | 28µ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
6 | 1 | 300ns |  |  | our $VERSION = '1.43';
7 | 2 | 22µs | 2 | 12µ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
8 | 1 | 400ns |  |  | require Cwd;
9 |  |  |  |  |
10 | 1 | 800ns |  |  | our @EXPORT = qw(find finddepth);
11 |  |  |  |  |
12 |  |  |  |  |
13 | 2 | 2.52ms | 2 | 6µ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
14 | 1 | 1µs |  |  | my $Is_VMS = $^O eq 'VMS';
15 | 1 | 200ns |  |  | my $Is_Win32 = $^O eq 'MSWin32';
16 |  |  |  |  |
17 | 1 | 300ns |  |  | require File::Basename;
18 | 1 | 200ns |  |  | require File::Spec;
19 |  |  |  |  |
20 |  |  |  |  | # Should ideally be my() not our() but local() currently
21 |  |  |  |  | # refuses to operate on lexicals
22 |  |  |  |  |
23 |  |  |  |  | our %SLnkSeen;
24 |  |  |  |  | our ($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 |  |  |  |  |
28 |  |  |  |  | sub 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 |  |  |  |  |
46 |  |  |  |  | sub _is_absolute {
47 |  |  |  |  | return $_[0] =~ m|^(?:[A-Za-z]:)?/| if $Is_Win32;
48 |  |  |  |  | return substr($_[0], 0, 1) eq '/';
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | sub _is_root {
52 |  |  |  |  | return $_[0] =~ m|^(?:[A-Za-z]:)?/\z| if $Is_Win32;
53 |  |  |  |  | return $_[0] eq '/';
54 |  |  |  |  | }
55 |  |  |  |  |
56 |  |  |  |  | sub 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 |  |  |  |  |
79 |  |  |  |  | sub 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 |  |  |  |  |
125 |  |  |  |  | our($dir, $name, $fullname, $prune);
126 |  |  |  |  | sub _find_dir_symlnk($$$);
127 |  |  |  |  | sub _find_dir($$$);
128 |  |  |  |  |
129 |  |  |  |  | # check whether or not a scalar variable is tainted
130 |  |  |  |  | # (code straight from the Camel, 3rd ed., page 561)
131 |  |  |  |  | sub 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 |  |  |  |  |
140 |  |  |  |  | sub _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 |  |  |  |  |
306 |  |  |  |  | sub _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 |  |  |  |  |
531 |  |  |  |  | sub _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 |  |  |  |  |
716 |  |  |  |  | sub 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 |  |  |  |  |
761 |  |  |  |  | sub find {
762 |  |  |  |  | my $wanted = shift;
763 |  |  |  |  | _find_opt(wrap_wanted($wanted), @_);
764 |  |  |  |  | }
765 |  |  |  |  |
766 |  |  |  |  | sub finddepth {
767 |  |  |  |  | my $wanted = wrap_wanted(shift);
768 |  |  |  |  | $wanted->{bydepth} = 1;
769 |  |  |  |  | _find_opt($wanted, @_);
770 |  |  |  |  | }
771 |  |  |  |  |
772 |  |  |  |  | # default
773 | 1 | 5µs | 1 | 2µs | $File::Find::skip_pattern = qr/^\.{1,2}\z/; # spent 2µs making 1 call to CORE::qr
774 | 1 | 2µs | 1 | 400ns | $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
778 | 1 | 4µs | 1 | 1µs | $File::Find::current_dir = File::Spec->curdir || '.'; # spent 1µs making 1 call to File::Spec::Unix::curdir
779 |  |  |  |  |
780 | 1 | 100ns |  |  | $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 |  |  |  |  | {
786 | 2 | 300ns |  |  | local $@;
787 | 2 | 700ns |  |  | eval { require Scalar::Util };
788 | 1 | 1µs |  |  | *is_tainted = $@ ? \&is_tainted_pp : \&Scalar::Util::tainted;
789 |  |  |  |  | }
790 |  |  |  |  |
791 | 1 | 7µs |  |  | 1;
792 |  |  |  |  |
793 |  |  |  |  | __END__