← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

Filename/usr/lib/x86_64-linux-gnu/perl-base/File/Path.pm
StatementsExecuted 30 statements in 2.13ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11113µs14µsFile::Path::::BEGIN@27File::Path::BEGIN@27
1118µs8µsFile::Path::::BEGIN@3File::Path::BEGIN@3
1114µs31µsFile::Path::::BEGIN@20File::Path::BEGIN@20
1114µs8µsFile::Path::::BEGIN@29File::Path::BEGIN@29
1113µs14µsFile::Path::::BEGIN@6File::Path::BEGIN@6
1113µs4µsFile::Path::::BEGIN@4File::Path::BEGIN@4
1112µs2µsFile::Path::::BEGIN@19File::Path::BEGIN@19
1112µs2µsFile::Path::::BEGIN@7File::Path::BEGIN@7
1111µs1µsFile::Path::::BEGIN@10File::Path::BEGIN@10
1111µs1µsFile::Path::::BEGIN@8File::Path::BEGIN@8
111500ns500nsFile::Path::::__ANON__File::Path::__ANON__ (xsub)
0000s0sFile::Path::::__is_argFile::Path::__is_arg
0000s0sFile::Path::::_carpFile::Path::_carp
0000s0sFile::Path::::_croakFile::Path::_croak
0000s0sFile::Path::::_errorFile::Path::_error
0000s0sFile::Path::::_is_subdirFile::Path::_is_subdir
0000s0sFile::Path::::_mkpathFile::Path::_mkpath
0000s0sFile::Path::::_rmtreeFile::Path::_rmtree
0000s0sFile::Path::::_slash_lcFile::Path::_slash_lc
0000s0sFile::Path::::make_pathFile::Path::make_path
0000s0sFile::Path::::mkpathFile::Path::mkpath
0000s0sFile::Path::::remove_treeFile::Path::remove_tree
0000s0sFile::Path::::rmtreeFile::Path::rmtree
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package File::Path;
2
3223µs18µs
# spent 8µs within File::Path::BEGIN@3 which was called: # once (8µs+0s) by File::Temp::BEGIN@149 at line 3
use 5.005_04;
# spent 8µs making 1 call to File::Path::BEGIN@3
4216µs26µs
# spent 4µs (3+1) within File::Path::BEGIN@4 which was called: # once (3µs+1µs) by File::Temp::BEGIN@149 at line 4
use strict;
# spent 4µs making 1 call to File::Path::BEGIN@4 # spent 1µs making 1 call to strict::import
5
6224µs225µs
# spent 14µs (3+11) within File::Path::BEGIN@6 which was called: # once (3µs+11µs) by File::Temp::BEGIN@149 at line 6
use Cwd 'getcwd';
# spent 14µs making 1 call to File::Path::BEGIN@6 # spent 11µs making 1 call to Exporter::import
729µs12µs
# spent 2µs within File::Path::BEGIN@7 which was called: # once (2µs+0s) by File::Temp::BEGIN@149 at line 7
use File::Basename ();
# spent 2µs making 1 call to File::Path::BEGIN@7
8220µs11µs
# spent 1µs within File::Path::BEGIN@8 which was called: # once (1µs+0s) by File::Temp::BEGIN@149 at line 8
use File::Spec ();
# spent 1µs making 1 call to File::Path::BEGIN@8
9
10
# spent 1µs within File::Path::BEGIN@10 which was called: # once (1µs+0s) by File::Temp::BEGIN@149 at line 17
BEGIN {
1112µs if ( $] < 5.006 ) {
12
13 # can't say 'opendir my $dh, $dirname'
14 # need to initialise $dh
15 eval 'use Symbol';
16 }
1719µs11µs}
# spent 1µs making 1 call to File::Path::BEGIN@10
18
19213µs12µs
# spent 2µs within File::Path::BEGIN@19 which was called: # once (2µs+0s) by File::Temp::BEGIN@149 at line 19
use Exporter ();
# spent 2µs making 1 call to File::Path::BEGIN@19
20237µs258µs
# spent 31µs (4+27) within File::Path::BEGIN@20 which was called: # once (4µs+27µs) by File::Temp::BEGIN@149 at line 20
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
# spent 31µs making 1 call to File::Path::BEGIN@20 # spent 27µs making 1 call to vars::import
211300ns$VERSION = '2.18';
22110µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
2317µs@ISA = qw(Exporter);
241600ns@EXPORT = qw(mkpath rmtree);
251300ns@EXPORT_OK = qw(make_path remove_tree);
26
27
# spent 14µs (13+500ns) within File::Path::BEGIN@27 which was called: # once (13µs+500ns) by File::Temp::BEGIN@149 at line 42
BEGIN {
281500ns for (qw(VMS MacOS MSWin32 os2)) {
292103µs212µs
# spent 8µs (4+4) within File::Path::BEGIN@29 which was called: # once (4µs+4µs) by File::Temp::BEGIN@149 at line 29
no strict 'refs';
# spent 8µs making 1 call to File::Path::BEGIN@29 # spent 4µs making 1 call to strict::unimport
3046µs *{"_IS_\U$_"} = $^O eq $_ ? sub () { 1 } : sub () { 0 };
31 }
32
33 # These OSes complain if you want to remove a file that you have no
34 # write permission to:
35 *_FORCE_WRITABLE = (
36 grep { $^O eq $_ } qw(amigaos dos epoc MSWin32 MacOS os2)
3712µs ) ? sub () { 1 } : sub () { 0 };
38
39 # Unix-like systems need to stat each directory in order to detect
40 # race condition. MS-Windows is immune to this particular attack.
4115µs1500ns *_NEED_STAT_CHECK = !(_IS_MSWIN32()) ? sub () { 1 } : sub () { 0 };
# spent 500ns making 1 call to File::Path::__ANON__
4211.84ms114µs}
# spent 14µs making 1 call to File::Path::BEGIN@27
43
44sub _carp {
45 require Carp;
46 goto &Carp::carp;
47}
48
49sub _croak {
50 require Carp;
51 goto &Carp::croak;
52}
53
54sub _error {
55 my $arg = shift;
56 my $message = shift;
57 my $object = shift;
58
59 if ( $arg->{error} ) {
60 $object = '' unless defined $object;
61 $message .= ": $!" if $!;
62 push @{ ${ $arg->{error} } }, { $object => $message };
63 }
64 else {
65 _carp( defined($object) ? "$message for $object: $!" : "$message: $!" );
66 }
67}
68
69sub __is_arg {
70 my ($arg) = @_;
71
72 # If client code blessed an array ref to HASH, this will not work
73 # properly. We could have done $arg->isa() wrapped in eval, but
74 # that would be expensive. This implementation should suffice.
75 # We could have also used Scalar::Util:blessed, but we choose not
76 # to add this dependency
77 return ( ref $arg eq 'HASH' );
78}
79
80sub make_path {
81 push @_, {} unless @_ and __is_arg( $_[-1] );
82 goto &mkpath;
83}
84
85sub mkpath {
86 my $old_style = !( @_ and __is_arg( $_[-1] ) );
87
88 my $data;
89 my $paths;
90
91 if ($old_style) {
92 my ( $verbose, $mode );
93 ( $paths, $verbose, $mode ) = @_;
94 $paths = [$paths] unless UNIVERSAL::isa( $paths, 'ARRAY' );
95 $data->{verbose} = $verbose;
96 $data->{mode} = defined $mode ? $mode : oct '777';
97 }
98 else {
99 my %args_permitted = map { $_ => 1 } ( qw|
100 chmod
101 error
102 group
103 mask
104 mode
105 owner
106 uid
107 user
108 verbose
109 | );
110 my %not_on_win32_args = map { $_ => 1 } ( qw|
111 group
112 owner
113 uid
114 user
115 | );
116 my @bad_args = ();
117 my @win32_implausible_args = ();
118 my $arg = pop @_;
119 for my $k (sort keys %{$arg}) {
120 if (! $args_permitted{$k}) {
121 push @bad_args, $k;
122 }
123 elsif ($not_on_win32_args{$k} and _IS_MSWIN32) {
124 push @win32_implausible_args, $k;
125 }
126 else {
127 $data->{$k} = $arg->{$k};
128 }
129 }
130 _carp("Unrecognized option(s) passed to mkpath() or make_path(): @bad_args")
131 if @bad_args;
132 _carp("Option(s) implausible on Win32 passed to mkpath() or make_path(): @win32_implausible_args")
133 if @win32_implausible_args;
134 $data->{mode} = delete $data->{mask} if exists $data->{mask};
135 $data->{mode} = oct '777' unless exists $data->{mode};
136 ${ $data->{error} } = [] if exists $data->{error};
137 unless (@win32_implausible_args) {
138 $data->{owner} = delete $data->{user} if exists $data->{user};
139 $data->{owner} = delete $data->{uid} if exists $data->{uid};
140 if ( exists $data->{owner} and $data->{owner} =~ /\D/ ) {
141 my $uid = ( getpwnam $data->{owner} )[2];
142 if ( defined $uid ) {
143 $data->{owner} = $uid;
144 }
145 else {
146 _error( $data,
147 "unable to map $data->{owner} to a uid, ownership not changed"
148 );
149 delete $data->{owner};
150 }
151 }
152 if ( exists $data->{group} and $data->{group} =~ /\D/ ) {
153 my $gid = ( getgrnam $data->{group} )[2];
154 if ( defined $gid ) {
155 $data->{group} = $gid;
156 }
157 else {
158 _error( $data,
159 "unable to map $data->{group} to a gid, group ownership not changed"
160 );
161 delete $data->{group};
162 }
163 }
164 if ( exists $data->{owner} and not exists $data->{group} ) {
165 $data->{group} = -1; # chown will leave group unchanged
166 }
167 if ( exists $data->{group} and not exists $data->{owner} ) {
168 $data->{owner} = -1; # chown will leave owner unchanged
169 }
170 }
171 $paths = [@_];
172 }
173 return _mkpath( $data, $paths );
174}
175
176sub _mkpath {
177 my $data = shift;
178 my $paths = shift;
179
180 my ( @created );
181 foreach my $path ( @{$paths} ) {
182 next unless defined($path) and length($path);
183 $path .= '/' if _IS_OS2 and $path =~ /^\w:\z/s; # feature of CRT
184
185 # Logic wants Unix paths, so go with the flow.
186 if (_IS_VMS) {
187 next if $path eq '/';
188 $path = VMS::Filespec::unixify($path);
189 }
190 next if -d $path;
191 my $parent = File::Basename::dirname($path);
192 # Coverage note: It's not clear how we would test the condition:
193 # '-d $parent or $path eq $parent'
194 unless ( -d $parent or $path eq $parent ) {
195 push( @created, _mkpath( $data, [$parent] ) );
196 }
197 print "mkdir $path\n" if $data->{verbose};
198 if ( mkdir( $path, $data->{mode} ) ) {
199 push( @created, $path );
200 if ( exists $data->{owner} ) {
201
202 # NB: $data->{group} guaranteed to be set during initialisation
203 if ( !chown $data->{owner}, $data->{group}, $path ) {
204 _error( $data,
205 "Cannot change ownership of $path to $data->{owner}:$data->{group}"
206 );
207 }
208 }
209 if ( exists $data->{chmod} ) {
210 # Coverage note: It's not clear how we would trigger the next
211 # 'if' block. Failure of 'chmod' might first result in a
212 # system error: "Permission denied".
213 if ( !chmod $data->{chmod}, $path ) {
214 _error( $data,
215 "Cannot change permissions of $path to $data->{chmod}" );
216 }
217 }
218 }
219 else {
220 my $save_bang = $!;
221
222 # From 'perldoc perlvar': $EXTENDED_OS_ERROR ($^E) is documented
223 # as:
224 # Error information specific to the current operating system. At the
225 # moment, this differs from "$!" under only VMS, OS/2, and Win32
226 # (and for MacPerl). On all other platforms, $^E is always just the
227 # same as $!.
228
229 my ( $e, $e1 ) = ( $save_bang, $^E );
230 $e .= "; $e1" if $e ne $e1;
231
232 # allow for another process to have created it meanwhile
233 if ( ! -d $path ) {
234 $! = $save_bang;
235 if ( $data->{error} ) {
236 push @{ ${ $data->{error} } }, { $path => $e };
237 }
238 else {
239 _croak("mkdir $path: $e");
240 }
241 }
242 }
243 }
244 return @created;
245}
246
247sub remove_tree {
248 push @_, {} unless @_ and __is_arg( $_[-1] );
249 goto &rmtree;
250}
251
252sub _is_subdir {
253 my ( $dir, $test ) = @_;
254
255 my ( $dv, $dd ) = File::Spec->splitpath( $dir, 1 );
256 my ( $tv, $td ) = File::Spec->splitpath( $test, 1 );
257
258 # not on same volume
259 return 0 if $dv ne $tv;
260
261 my @d = File::Spec->splitdir($dd);
262 my @t = File::Spec->splitdir($td);
263
264 # @t can't be a subdir if it's shorter than @d
265 return 0 if @t < @d;
266
267 return join( '/', @d ) eq join( '/', splice @t, 0, +@d );
268}
269
270sub rmtree {
271 my $old_style = !( @_ and __is_arg( $_[-1] ) );
272
273 my ($arg, $data, $paths);
274
275 if ($old_style) {
276 my ( $verbose, $safe );
277 ( $paths, $verbose, $safe ) = @_;
278 $data->{verbose} = $verbose;
279 $data->{safe} = defined $safe ? $safe : 0;
280
281 if ( defined($paths) and length($paths) ) {
282 $paths = [$paths] unless UNIVERSAL::isa( $paths, 'ARRAY' );
283 }
284 else {
285 _carp("No root path(s) specified\n");
286 return 0;
287 }
288 }
289 else {
290 my %args_permitted = map { $_ => 1 } ( qw|
291 error
292 keep_root
293 result
294 safe
295 verbose
296 | );
297 my @bad_args = ();
298 my $arg = pop @_;
299 for my $k (sort keys %{$arg}) {
300 if (! $args_permitted{$k}) {
301 push @bad_args, $k;
302 }
303 else {
304 $data->{$k} = $arg->{$k};
305 }
306 }
307 _carp("Unrecognized option(s) passed to remove_tree(): @bad_args")
308 if @bad_args;
309 ${ $data->{error} } = [] if exists $data->{error};
310 ${ $data->{result} } = [] if exists $data->{result};
311
312 # Wouldn't it make sense to do some validation on @_ before assigning
313 # to $paths here?
314 # In the $old_style case we guarantee that each path is both defined
315 # and non-empty. We don't check that here, which means we have to
316 # check it later in the first condition in this line:
317 # if ( $ortho_root_length && _is_subdir( $ortho_root, $ortho_cwd ) ) {
318 # Granted, that would be a change in behavior for the two
319 # non-old-style interfaces.
320
321 $paths = [@_];
322 }
323
324 $data->{prefix} = '';
325 $data->{depth} = 0;
326
327 my @clean_path;
328 $data->{cwd} = getcwd() or do {
329 _error( $data, "cannot fetch initial working directory" );
330 return 0;
331 };
332 for ( $data->{cwd} ) { /\A(.*)\Z/s; $_ = $1 } # untaint
333
334 for my $p (@$paths) {
335
336 # need to fixup case and map \ to / on Windows
337 my $ortho_root = _IS_MSWIN32 ? _slash_lc($p) : $p;
338 my $ortho_cwd =
339 _IS_MSWIN32 ? _slash_lc( $data->{cwd} ) : $data->{cwd};
340 my $ortho_root_length = length($ortho_root);
341 $ortho_root_length-- if _IS_VMS; # don't compare '.' with ']'
342 if ( $ortho_root_length && _is_subdir( $ortho_root, $ortho_cwd ) ) {
343 local $! = 0;
344 _error( $data, "cannot remove path when cwd is $data->{cwd}", $p );
345 next;
346 }
347
348 if (_IS_MACOS) {
349 $p = ":$p" unless $p =~ /:/;
350 $p .= ":" unless $p =~ /:\z/;
351 }
352 elsif ( _IS_MSWIN32 ) {
353 $p =~ s{[/\\]\z}{};
354 }
355 else {
356 $p =~ s{/\z}{};
357 }
358 push @clean_path, $p;
359 }
360
361 @{$data}{qw(device inode)} = ( lstat $data->{cwd} )[ 0, 1 ] or do {
362 _error( $data, "cannot stat initial working directory", $data->{cwd} );
363 return 0;
364 };
365
366 return _rmtree( $data, \@clean_path );
367}
368
369sub _rmtree {
370 my $data = shift;
371 my $paths = shift;
372
373 my $count = 0;
374 my $curdir = File::Spec->curdir();
375 my $updir = File::Spec->updir();
376
377 my ( @files, $root );
378 ROOT_DIR:
379 foreach my $root (@$paths) {
380
381 # since we chdir into each directory, it may not be obvious
382 # to figure out where we are if we generate a message about
383 # a file name. We therefore construct a semi-canonical
384 # filename, anchored from the directory being unlinked (as
385 # opposed to being truly canonical, anchored from the root (/).
386
387 my $canon =
388 $data->{prefix}
389 ? File::Spec->catfile( $data->{prefix}, $root )
390 : $root;
391
392 my ( $ldev, $lino, $perm ) = ( lstat $root )[ 0, 1, 2 ]
393 or next ROOT_DIR;
394
395 if ( -d _ ) {
396 $root = VMS::Filespec::vmspath( VMS::Filespec::pathify($root) )
397 if _IS_VMS;
398
399 if ( !chdir($root) ) {
400
401 # see if we can escalate privileges to get in
402 # (e.g. funny protection mask such as -w- instead of rwx)
403 # This uses fchmod to avoid traversing outside of the proper
404 # location (CVE-2017-6512)
405 my $root_fh;
406 if (open($root_fh, '<', $root)) {
407 my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1];
408 $perm &= oct '7777';
409 my $nperm = $perm | oct '700';
410 local $@;
411 if (
412 !(
413 $data->{safe}
414 or $nperm == $perm
415 or !-d _
416 or $fh_dev ne $ldev
417 or $fh_inode ne $lino
418 or eval { chmod( $nperm, $root_fh ) }
419 )
420 )
421 {
422 _error( $data,
423 "cannot make child directory read-write-exec", $canon );
424 next ROOT_DIR;
425 }
426 close $root_fh;
427 }
428 if ( !chdir($root) ) {
429 _error( $data, "cannot chdir to child", $canon );
430 next ROOT_DIR;
431 }
432 }
433
434 my ( $cur_dev, $cur_inode, $perm ) = ( stat $curdir )[ 0, 1, 2 ]
435 or do {
436 _error( $data, "cannot stat current working directory", $canon );
437 next ROOT_DIR;
438 };
439
440 if (_NEED_STAT_CHECK) {
441 ( $ldev eq $cur_dev and $lino eq $cur_inode )
442 or _croak(
443"directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."
444 );
445 }
446
447 $perm &= oct '7777'; # don't forget setuid, setgid, sticky bits
448 my $nperm = $perm | oct '700';
449
450 # notabene: 0700 is for making readable in the first place,
451 # it's also intended to change it to writable in case we have
452 # to recurse in which case we are better than rm -rf for
453 # subtrees with strange permissions
454
455 if (
456 !(
457 $data->{safe}
458 or $nperm == $perm
459 or chmod( $nperm, $curdir )
460 )
461 )
462 {
463 _error( $data, "cannot make directory read+writeable", $canon );
464 $nperm = $perm;
465 }
466
467 my $d;
468 $d = gensym() if $] < 5.006;
469 if ( !opendir $d, $curdir ) {
470 _error( $data, "cannot opendir", $canon );
471 @files = ();
472 }
473 else {
474 if ( !defined ${^TAINT} or ${^TAINT} ) {
475 # Blindly untaint dir names if taint mode is active
476 @files = map { /\A(.*)\z/s; $1 } readdir $d;
477 }
478 else {
479 @files = readdir $d;
480 }
481 closedir $d;
482 }
483
484 if (_IS_VMS) {
485
486 # Deleting large numbers of files from VMS Files-11
487 # filesystems is faster if done in reverse ASCIIbetical order.
488 # include '.' to '.;' from blead patch #31775
489 @files = map { $_ eq '.' ? '.;' : $_ } reverse @files;
490 }
491
492 @files = grep { $_ ne $updir and $_ ne $curdir } @files;
493
494 if (@files) {
495
496 # remove the contained files before the directory itself
497 my $narg = {%$data};
498 @{$narg}{qw(device inode cwd prefix depth)} =
499 ( $cur_dev, $cur_inode, $updir, $canon, $data->{depth} + 1 );
500 $count += _rmtree( $narg, \@files );
501 }
502
503 # restore directory permissions of required now (in case the rmdir
504 # below fails), while we are still in the directory and may do so
505 # without a race via '.'
506 if ( $nperm != $perm and not chmod( $perm, $curdir ) ) {
507 _error( $data, "cannot reset chmod", $canon );
508 }
509
510 # don't leave the client code in an unexpected directory
511 chdir( $data->{cwd} )
512 or
513 _croak("cannot chdir to $data->{cwd} from $canon: $!, aborting.");
514
515 # ensure that a chdir upwards didn't take us somewhere other
516 # than we expected (see CVE-2002-0435)
517 ( $cur_dev, $cur_inode ) = ( stat $curdir )[ 0, 1 ]
518 or _croak(
519 "cannot stat prior working directory $data->{cwd}: $!, aborting."
520 );
521
522 if (_NEED_STAT_CHECK) {
523 ( $data->{device} eq $cur_dev and $data->{inode} eq $cur_inode )
524 or _croak( "previous directory $data->{cwd} "
525 . "changed before entering $canon, "
526 . "expected dev=$ldev ino=$lino, "
527 . "actual dev=$cur_dev ino=$cur_inode, aborting."
528 );
529 }
530
531 if ( $data->{depth} or !$data->{keep_root} ) {
532 if ( $data->{safe}
533 && ( _IS_VMS
534 ? !&VMS::Filespec::candelete($root)
535 : !-w $root ) )
536 {
537 print "skipped $root\n" if $data->{verbose};
538 next ROOT_DIR;
539 }
540 if ( _FORCE_WRITABLE and !chmod $perm | oct '700', $root ) {
541 _error( $data, "cannot make directory writeable", $canon );
542 }
543 print "rmdir $root\n" if $data->{verbose};
544 if ( rmdir $root ) {
545 push @{ ${ $data->{result} } }, $root if $data->{result};
546 ++$count;
547 }
548 else {
549 _error( $data, "cannot remove directory", $canon );
550 if (
551 _FORCE_WRITABLE
552 && !chmod( $perm,
553 ( _IS_VMS ? VMS::Filespec::fileify($root) : $root )
554 )
555 )
556 {
557 _error(
558 $data,
559 sprintf( "cannot restore permissions to 0%o",
560 $perm ),
561 $canon
562 );
563 }
564 }
565 }
566 }
567 else {
568 # not a directory
569 $root = VMS::Filespec::vmsify("./$root")
570 if _IS_VMS
571 && !File::Spec->file_name_is_absolute($root)
572 && ( $root !~ m/(?<!\^)[\]>]+/ ); # not already in VMS syntax
573
574 if (
575 $data->{safe}
576 && (
577 _IS_VMS
578 ? !&VMS::Filespec::candelete($root)
579 : !( -l $root || -w $root )
580 )
581 )
582 {
583 print "skipped $root\n" if $data->{verbose};
584 next ROOT_DIR;
585 }
586
587 my $nperm = $perm & oct '7777' | oct '600';
588 if ( _FORCE_WRITABLE
589 and $nperm != $perm
590 and not chmod $nperm, $root )
591 {
592 _error( $data, "cannot make file writeable", $canon );
593 }
594 print "unlink $canon\n" if $data->{verbose};
595
596 # delete all versions under VMS
597 for ( ; ; ) {
598 if ( unlink $root ) {
599 push @{ ${ $data->{result} } }, $root if $data->{result};
600 }
601 else {
602 _error( $data, "cannot unlink file", $canon );
603 _FORCE_WRITABLE and chmod( $perm, $root )
604 or _error( $data,
605 sprintf( "cannot restore permissions to 0%o", $perm ),
606 $canon );
607 last;
608 }
609 ++$count;
610 last unless _IS_VMS && lstat $root;
611 }
612 }
613 }
614 return $count;
615}
616
617sub _slash_lc {
618
619 # fix up slashes and case on MSWin32 so that we can determine that
620 # c:\path\to\dir is underneath C:/Path/To
621 my $path = shift;
622 $path =~ tr{\\}{/};
623 return lc($path);
624}
625
62614µs1;
627
628__END__
 
# spent 500ns within File::Path::__ANON__ which was called: # once (500ns+0s) by File::Path::BEGIN@27 at line 41
sub File::Path::__ANON__; # xsub
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.