← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/share/perl5/Path/Class/Dir.pm
StatementsExecuted 69 statements in 2.15ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1115.31ms7.07msPath::Class::Dir::::BEGIN@14 Path::Class::Dir::BEGIN@14
1112.12ms2.28msPath::Class::Dir::::BEGIN@13 Path::Class::Dir::BEGIN@13
111914µs6.17msPath::Class::Dir::::BEGIN@12 Path::Class::Dir::BEGIN@12
111223µs11.3msPath::Class::Dir::::BEGIN@10 Path::Class::Dir::BEGIN@10
32266µs162µsPath::Class::Dir::::new Path::Class::Dir::new
52232µs105µsPath::Class::Dir::::stringify Path::Class::Dir::stringify
1119µs73µsPath::Class::Dir::::file Path::Class::Dir::file
1119µs17µsPath::Class::File::::BEGIN@1Path::Class::File::BEGIN@1
1116µs6µsPath::Class::Dir::::BEGIN@8 Path::Class::Dir::BEGIN@8
1114µs4µsPath::Class::Dir::::BEGIN@15 Path::Class::Dir::BEGIN@15
1113µs3µsPath::Class::Dir::::BEGIN@9 Path::Class::Dir::BEGIN@9
1111µs1µsPath::Class::Dir::::file_class Path::Class::Dir::file_class
0000s0sPath::Class::Dir::::__ANON__[:169] Path::Class::Dir::__ANON__[:169]
0000s0sPath::Class::Dir::::__ANON__[:182] Path::Class::Dir::__ANON__[:182]
0000s0sPath::Class::Dir::::__ANON__[:205] Path::Class::Dir::__ANON__[:205]
0000s0sPath::Class::Dir::::__ANON__[:213] Path::Class::Dir::__ANON__[:213]
0000s0sPath::Class::Dir::::__ANON__[:218] Path::Class::Dir::__ANON__[:218]
0000s0sPath::Class::Dir::::__ANON__[:224] Path::Class::Dir::__ANON__[:224]
0000s0sPath::Class::Dir::::_is_local_dot_dir Path::Class::Dir::_is_local_dot_dir
0000s0sPath::Class::Dir::::as_foreign Path::Class::Dir::as_foreign
0000s0sPath::Class::Dir::::basename Path::Class::Dir::basename
0000s0sPath::Class::Dir::::children Path::Class::Dir::children
0000s0sPath::Class::Dir::::components Path::Class::Dir::components
0000s0sPath::Class::Dir::::contains Path::Class::Dir::contains
0000s0sPath::Class::Dir::::dir_list Path::Class::Dir::dir_list
0000s0sPath::Class::Dir::::is_dir Path::Class::Dir::is_dir
0000s0sPath::Class::Dir::::mkpath Path::Class::Dir::mkpath
0000s0sPath::Class::Dir::::next Path::Class::Dir::next
0000s0sPath::Class::Dir::::open Path::Class::Dir::open
0000s0sPath::Class::Dir::::parent Path::Class::Dir::parent
0000s0sPath::Class::Dir::::recurse Path::Class::Dir::recurse
0000s0sPath::Class::Dir::::relative Path::Class::Dir::relative
0000s0sPath::Class::Dir::::remove Path::Class::Dir::remove
0000s0sPath::Class::Dir::::rmtree Path::Class::Dir::rmtree
0000s0sPath::Class::Dir::::subdir Path::Class::Dir::subdir
0000s0sPath::Class::Dir::::subsumes Path::Class::Dir::subsumes
0000s0sPath::Class::Dir::::tempfile Path::Class::Dir::tempfile
0000s0sPath::Class::Dir::::traverse Path::Class::Dir::traverse
0000s0sPath::Class::Dir::::traverse_if Path::Class::Dir::traverse_if
0000s0sPath::Class::Dir::::volume Path::Class::Dir::volume
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1234µs225µs
# spent 17µs (9+8) within Path::Class::File::BEGIN@1 which was called: # once (9µs+8µs) by Path::Class::File::BEGIN@8 at line 1
use strict;
# spent 17µs making 1 call to Path::Class::File::BEGIN@1 # spent 8µs making 1 call to strict::import
2
3package Path::Class::Dir;
4{
52900ns $Path::Class::Dir::VERSION = '0.33';
6}
7
8219µs16µs
# spent 6µs within Path::Class::Dir::BEGIN@8 which was called: # once (6µs+0s) by Path::Class::File::BEGIN@8 at line 8
use Path::Class::File;
# spent 6µs making 1 call to Path::Class::Dir::BEGIN@8
9222µs13µs
# spent 3µs within Path::Class::Dir::BEGIN@9 which was called: # once (3µs+0s) by Path::Class::File::BEGIN@8 at line 9
use Carp();
# spent 3µs making 1 call to Path::Class::Dir::BEGIN@9
10278µs222.4ms
# spent 11.3ms (223µs+11.1) within Path::Class::Dir::BEGIN@10 which was called: # once (223µs+11.1ms) by Path::Class::File::BEGIN@8 at line 10
use parent qw(Path::Class::Entity);
# spent 11.3ms making 1 call to Path::Class::Dir::BEGIN@10 # spent 11.0ms making 1 call to parent::import
11
12288µs16.17ms
# spent 6.17ms (914µs+5.25) within Path::Class::Dir::BEGIN@12 which was called: # once (914µs+5.25ms) by Path::Class::File::BEGIN@8 at line 12
use IO::Dir ();
# spent 6.17ms making 1 call to Path::Class::Dir::BEGIN@12
13290µs12.28ms
# spent 2.28ms (2.12+161µs) within Path::Class::Dir::BEGIN@13 which was called: # once (2.12ms+161µs) by Path::Class::File::BEGIN@8 at line 13
use File::Path ();
# spent 2.28ms making 1 call to Path::Class::Dir::BEGIN@13
142134µs17.07ms
# spent 7.07ms (5.31+1.76) within Path::Class::Dir::BEGIN@14 which was called: # once (5.31ms+1.76ms) by Path::Class::File::BEGIN@8 at line 14
use File::Temp ();
# spent 7.07ms making 1 call to Path::Class::Dir::BEGIN@14
1521.57ms14µs
# spent 4µs within Path::Class::Dir::BEGIN@15 which was called: # once (4µs+0s) by Path::Class::File::BEGIN@8 at line 15
use Scalar::Util ();
# spent 4µs making 1 call to Path::Class::Dir::BEGIN@15
16
17# updir & curdir on the local machine, for screening them out in
18# children(). Note that they don't respect 'foreign' semantics.
19112µs24µsmy $Updir = __PACKAGE__->_spec->updir;
# spent 2µs making 1 call to Path::Class::Entity::_spec # spent 2µs making 1 call to File::Spec::Unix::updir
2012µs22µsmy $Curdir = __PACKAGE__->_spec->curdir;
# spent 1µs making 1 call to File::Spec::Unix::curdir # spent 500ns making 1 call to Path::Class::Entity::_spec
21
22
# spent 162µs (66+96) within Path::Class::Dir::new which was called 3 times, avg 54µs/call: # 2 times (49µs+78µs) by Path::Class::File::new at line 27 of Path/Class/File.pm, avg 64µs/call # once (17µs+18µs) by PONAPI::Server::ConfigReader::__ANON__[lib/PONAPI/Server/ConfigReader.pm:15] at line 15 of lib/PONAPI/Server/ConfigReader.pm
sub new {
2336µs37µs my $self = shift->SUPER::new();
# spent 7µs making 3 calls to Path::Class::Entity::new, avg 2µs/call
24
25 # If the only arg is undef, it's probably a mistake. Without this
26 # special case here, we'd return the root directory, which is a
27 # lousy thing to do to someone when they made a mistake. Return
28 # undef instead.
2932µs return if @_==1 && !defined($_[0]);
30
3134µs336µs my $s = $self->_spec;
# spent 36µs making 3 calls to Path::Class::Entity::_spec, avg 12µs/call
32
3333µs120µs my $first = (@_ == 0 ? $s->curdir :
# spent 20µs making 1 call to Path::Class::Dir::stringify
34 $_[0] eq '' ? (shift, $s->rootdir) :
35 shift()
36 );
37
3832µs $self->{dirs} = [];
39313µs43µs if ( Scalar::Util::blessed($first) && $first->isa("Path::Class::Dir") ) {
# spent 2µs making 3 calls to Scalar::Util::blessed, avg 767ns/call # spent 600ns making 1 call to UNIVERSAL::isa
4011µs $self->{volume} = $first->{volume};
4111µs push @{$self->{dirs}}, @{$first->{dirs}};
42 }
43 else {
4427µs424µs ($self->{volume}, my $dirs) = $s->splitpath( $s->canonpath("$first") , 1);
# spent 20µs making 2 calls to File::Spec::Unix::canonpath, avg 10µs/call # spent 4µs making 2 calls to File::Spec::Unix::splitpath, avg 2µs/call
4527µs45µs push @{$self->{dirs}}, $dirs eq $s->rootdir ? "" : $s->splitdir($dirs);
# spent 3µs making 2 calls to File::Spec::Unix::splitdir, avg 1µs/call # spent 2µs making 2 calls to File::Spec::Unix::rootdir, avg 1µs/call
46 }
47
48 push @{$self->{dirs}}, map {
4932µs Scalar::Util::blessed($_) && $_->isa("Path::Class::Dir")
50 ? @{$_->{dirs}}
51 : $s->splitdir($_)
52 } @_;
53
54
5537µs return $self;
56}
57
5813µs
# spent 1µs within Path::Class::Dir::file_class which was called: # once (1µs+0s) by Path::Class::Dir::file at line 89
sub file_class { "Path::Class::File" }
59
60sub is_dir { 1 }
61
62sub as_foreign {
63 my ($self, $type) = @_;
64
65 my $foreign = do {
66 local $self->{file_spec_class} = $self->_spec_class($type);
67 $self->SUPER::new;
68 };
69
70 # Clone internal structure
71 $foreign->{volume} = $self->{volume};
72 my ($u, $fu) = ($self->_spec->updir, $foreign->_spec->updir);
73 $foreign->{dirs} = [ map {$_ eq $u ? $fu : $_} @{$self->{dirs}}];
74 return $foreign;
75}
76
77
# spent 105µs (32+72) within Path::Class::Dir::stringify which was called 5 times, avg 21µs/call: # 4 times (26µs+58µs) by Path::Class::File::stringify at line 47 of Path/Class/File.pm, avg 21µs/call # once (6µs+14µs) by Path::Class::Dir::new at line 33
sub stringify {
7851µs my $self = shift;
7953µs54µs my $s = $self->_spec;
# spent 4µs making 5 calls to Path::Class::Entity::_spec, avg 760ns/call
80 return $s->catpath($self->{volume},
81521µs1069µs $s->catdir(@{$self->{dirs}}),
# spent 59µs making 5 calls to File::Spec::Unix::catdir, avg 12µs/call # spent 10µs making 5 calls to File::Spec::Unix::catpath, avg 2µs/call
82 '');
83}
84
85sub volume { shift()->{volume} }
86
87
# spent 73µs (9+64) within Path::Class::Dir::file which was called: # once (9µs+64µs) by PONAPI::Server::ConfigReader::_build_conf at line 33 of lib/PONAPI/Server/ConfigReader.pm
sub file {
881900ns local $Path::Class::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class};
8916µs264µs return $_[0]->file_class->new(@_);
# spent 63µs making 1 call to Path::Class::File::new # spent 1µs making 1 call to Path::Class::Dir::file_class
90}
91
92sub basename { shift()->{dirs}[-1] }
93
94sub dir_list {
95 my $self = shift;
96 my $d = $self->{dirs};
97 return @$d unless @_;
98
99 my $offset = shift;
100 if ($offset < 0) { $offset = $#$d + $offset + 1 }
101
102 return wantarray ? @$d[$offset .. $#$d] : $d->[$offset] unless @_;
103
104 my $length = shift;
105 if ($length < 0) { $length = $#$d + $length + 1 - $offset }
106 return @$d[$offset .. $length + $offset - 1];
107}
108
109sub components {
110 my $self = shift;
111 return $self->dir_list(@_);
112}
113
114sub subdir {
115 my $self = shift;
116 return $self->new($self, @_);
117}
118
119sub parent {
120 my $self = shift;
121 my $dirs = $self->{dirs};
122 my ($curdir, $updir) = ($self->_spec->curdir, $self->_spec->updir);
123
124 if ($self->is_absolute) {
125 my $parent = $self->new($self);
126 pop @{$parent->{dirs}} if @$dirs > 1;
127 return $parent;
128
129 } elsif ($self eq $curdir) {
130 return $self->new($updir);
131
132 } elsif (!grep {$_ ne $updir} @$dirs) { # All updirs
133 return $self->new($self, $updir); # Add one more
134
135 } elsif (@$dirs == 1) {
136 return $self->new($curdir);
137
138 } else {
139 my $parent = $self->new($self);
140 pop @{$parent->{dirs}};
141 return $parent;
142 }
143}
144
145sub relative {
146 # File::Spec->abs2rel before version 3.13 returned the empty string
147 # when the two paths were equal - work around it here.
148 my $self = shift;
149 my $rel = $self->_spec->abs2rel($self->stringify, @_);
150 return $self->new( length $rel ? $rel : $self->_spec->curdir );
151}
152
153sub open { IO::Dir->new(@_) }
154sub mkpath { File::Path::mkpath(shift()->stringify, @_) }
155sub rmtree { File::Path::rmtree(shift()->stringify, @_) }
156
157sub remove {
158 rmdir( shift() );
159}
160
161sub traverse {
162 my $self = shift;
163 my ($callback, @args) = @_;
164 my @children = $self->children;
165 return $self->$callback(
166 sub {
167 my @inner_args = @_;
168 return map { $_->traverse($callback, @inner_args) } @children;
169 },
170 @args
171 );
172}
173
174sub traverse_if {
175 my $self = shift;
176 my ($callback, $condition, @args) = @_;
177 my @children = grep { $condition->($_) } $self->children;
178 return $self->$callback(
179 sub {
180 my @inner_args = @_;
181 return map { $_->traverse_if($callback, $condition, @inner_args) } @children;
182 },
183 @args
184 );
185}
186
187sub recurse {
188 my $self = shift;
189 my %opts = (preorder => 1, depthfirst => 0, @_);
190
191 my $callback = $opts{callback}
192 or Carp::croak( "Must provide a 'callback' parameter to recurse()" );
193
194 my @queue = ($self);
195
196 my $visit_entry;
197 my $visit_dir =
198 $opts{depthfirst} && $opts{preorder}
199 ? sub {
200 my $dir = shift;
201 my $ret = $callback->($dir);
202 unless( ($ret||'') eq $self->PRUNE ) {
203 unshift @queue, $dir->children;
204 }
205 }
206 : $opts{preorder}
207 ? sub {
208 my $dir = shift;
209 my $ret = $callback->($dir);
210 unless( ($ret||'') eq $self->PRUNE ) {
211 push @queue, $dir->children;
212 }
213 }
214 : sub {
215 my $dir = shift;
216 $visit_entry->($_) foreach $dir->children;
217 $callback->($dir);
218 };
219
220 $visit_entry = sub {
221 my $entry = shift;
222 if ($entry->is_dir) { $visit_dir->($entry) } # Will call $callback
223 else { $callback->($entry) }
224 };
225
226 while (@queue) {
227 $visit_entry->( shift @queue );
228 }
229}
230
231sub children {
232 my ($self, %opts) = @_;
233
234 my $dh = $self->open or Carp::croak( "Can't open directory $self: $!" );
235
236 my @out;
237 while (defined(my $entry = $dh->read)) {
238 next if !$opts{all} && $self->_is_local_dot_dir($entry);
239 next if ($opts{no_hidden} && $entry =~ /^\./);
240 push @out, $self->file($entry);
241 $out[-1] = $self->subdir($entry) if -d $out[-1];
242 }
243 return @out;
244}
245
246sub _is_local_dot_dir {
247 my $self = shift;
248 my $dir = shift;
249
250 return ($dir eq $Updir or $dir eq $Curdir);
251}
252
253sub next {
254 my $self = shift;
255 unless ($self->{dh}) {
256 $self->{dh} = $self->open or Carp::croak( "Can't open directory $self: $!" );
257 }
258
259 my $next = $self->{dh}->read;
260 unless (defined $next) {
261 delete $self->{dh};
262 ## no critic
263 return undef;
264 }
265
266 # Figure out whether it's a file or directory
267 my $file = $self->file($next);
268 $file = $self->subdir($next) if -d $file;
269 return $file;
270}
271
272sub subsumes {
273 my ($self, $other) = @_;
274 die "No second entity given to subsumes()" unless $other;
275
276 $other = $self->new($other) unless UNIVERSAL::isa($other, __PACKAGE__);
277 $other = $other->dir unless $other->is_dir;
278
279 if ($self->is_absolute) {
280 $other = $other->absolute;
281 } elsif ($other->is_absolute) {
282 $self = $self->absolute;
283 }
284
285 $self = $self->cleanup;
286 $other = $other->cleanup;
287
288 if ($self->volume) {
289 return 0 unless $other->volume eq $self->volume;
290 }
291
292 # The root dir subsumes everything (but ignore the volume because
293 # we've already checked that)
294 return 1 if "@{$self->{dirs}}" eq "@{$self->new('')->{dirs}}";
295
296 my $i = 0;
297 while ($i <= $#{ $self->{dirs} }) {
298 return 0 if $i > $#{ $other->{dirs} };
299 return 0 if $self->{dirs}[$i] ne $other->{dirs}[$i];
300 $i++;
301 }
302 return 1;
303}
304
305sub contains {
306 my ($self, $other) = @_;
307 return !!(-d $self and (-e $other or -l $other) and $self->subsumes($other));
308}
309
310sub tempfile {
311 my $self = shift;
312 return File::Temp::tempfile(@_, DIR => $self->stringify);
313}
314
31514µs1;
316__END__