Filename | /usr/share/perl5/Path/Class/Dir.pm |
Statements | Executed 69 statements in 2.15ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 5.31ms | 7.07ms | BEGIN@14 | Path::Class::Dir::
1 | 1 | 1 | 2.12ms | 2.28ms | BEGIN@13 | Path::Class::Dir::
1 | 1 | 1 | 914µs | 6.17ms | BEGIN@12 | Path::Class::Dir::
1 | 1 | 1 | 223µs | 11.3ms | BEGIN@10 | Path::Class::Dir::
3 | 2 | 2 | 66µs | 162µs | new | Path::Class::Dir::
5 | 2 | 2 | 32µs | 105µs | stringify | Path::Class::Dir::
1 | 1 | 1 | 9µs | 73µs | file | Path::Class::Dir::
1 | 1 | 1 | 9µs | 17µs | BEGIN@1 | Path::Class::File::
1 | 1 | 1 | 6µs | 6µs | BEGIN@8 | Path::Class::Dir::
1 | 1 | 1 | 4µs | 4µs | BEGIN@15 | Path::Class::Dir::
1 | 1 | 1 | 3µs | 3µs | BEGIN@9 | Path::Class::Dir::
1 | 1 | 1 | 1µs | 1µs | file_class | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:169] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:182] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:205] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:213] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:218] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | __ANON__[:224] | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | _is_local_dot_dir | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | as_foreign | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | basename | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | children | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | components | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | contains | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | dir_list | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | is_dir | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | mkpath | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | next | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | open | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | parent | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | recurse | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | relative | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | remove | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | rmtree | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | subdir | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | subsumes | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | tempfile | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | traverse | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | traverse_if | Path::Class::Dir::
0 | 0 | 0 | 0s | 0s | volume | Path::Class::Dir::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 34µs | 2 | 25µ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 # spent 17µs making 1 call to Path::Class::File::BEGIN@1
# spent 8µs making 1 call to strict::import |
2 | |||||
3 | package Path::Class::Dir; | ||||
4 | { | ||||
5 | 2 | 900ns | $Path::Class::Dir::VERSION = '0.33'; | ||
6 | } | ||||
7 | |||||
8 | 2 | 19µs | 1 | 6µ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 # spent 6µs making 1 call to Path::Class::Dir::BEGIN@8 |
9 | 2 | 22µs | 1 | 3µ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 # spent 3µs making 1 call to Path::Class::Dir::BEGIN@9 |
10 | 2 | 78µs | 2 | 22.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 # spent 11.3ms making 1 call to Path::Class::Dir::BEGIN@10
# spent 11.0ms making 1 call to parent::import |
11 | |||||
12 | 2 | 88µs | 1 | 6.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 # spent 6.17ms making 1 call to Path::Class::Dir::BEGIN@12 |
13 | 2 | 90µs | 1 | 2.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 # spent 2.28ms making 1 call to Path::Class::Dir::BEGIN@13 |
14 | 2 | 134µs | 1 | 7.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 # spent 7.07ms making 1 call to Path::Class::Dir::BEGIN@14 |
15 | 2 | 1.57ms | 1 | 4µ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 # 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. | ||||
19 | 1 | 12µs | 2 | 4µs | my $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 |
20 | 1 | 2µs | 2 | 2µs | my $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 | ||||
23 | 3 | 6µs | 3 | 7µ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. | ||||
29 | 3 | 2µs | return if @_==1 && !defined($_[0]); | ||
30 | |||||
31 | 3 | 4µs | 3 | 36µs | my $s = $self->_spec; # spent 36µs making 3 calls to Path::Class::Entity::_spec, avg 12µs/call |
32 | |||||
33 | 3 | 3µs | 1 | 20µ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 | |||||
38 | 3 | 2µs | $self->{dirs} = []; | ||
39 | 3 | 13µs | 4 | 3µ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 |
40 | 1 | 1µs | $self->{volume} = $first->{volume}; | ||
41 | 1 | 1µs | push @{$self->{dirs}}, @{$first->{dirs}}; | ||
42 | } | ||||
43 | else { | ||||
44 | 2 | 7µs | 4 | 24µ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 |
45 | 2 | 7µs | 4 | 5µ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 { | ||||
49 | 3 | 2µs | Scalar::Util::blessed($_) && $_->isa("Path::Class::Dir") | ||
50 | ? @{$_->{dirs}} | ||||
51 | : $s->splitdir($_) | ||||
52 | } @_; | ||||
53 | |||||
54 | |||||
55 | 3 | 7µs | return $self; | ||
56 | } | ||||
57 | |||||
58 | 1 | 3µ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 | ||
59 | |||||
60 | sub is_dir { 1 } | ||||
61 | |||||
62 | sub 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 | ||||
78 | 5 | 1µs | my $self = shift; | ||
79 | 5 | 3µs | 5 | 4µ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}, | ||||
81 | 5 | 21µs | 10 | 69µ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 | |||||
85 | sub 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 | ||||
88 | 1 | 900ns | local $Path::Class::Foreign = $_[0]->{file_spec_class} if $_[0]->{file_spec_class}; | ||
89 | 1 | 6µs | 2 | 64µ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 | |||||
92 | sub basename { shift()->{dirs}[-1] } | ||||
93 | |||||
94 | sub 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 | |||||
109 | sub components { | ||||
110 | my $self = shift; | ||||
111 | return $self->dir_list(@_); | ||||
112 | } | ||||
113 | |||||
114 | sub subdir { | ||||
115 | my $self = shift; | ||||
116 | return $self->new($self, @_); | ||||
117 | } | ||||
118 | |||||
119 | sub 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 | |||||
145 | sub 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 | |||||
153 | sub open { IO::Dir->new(@_) } | ||||
154 | sub mkpath { File::Path::mkpath(shift()->stringify, @_) } | ||||
155 | sub rmtree { File::Path::rmtree(shift()->stringify, @_) } | ||||
156 | |||||
157 | sub remove { | ||||
158 | rmdir( shift() ); | ||||
159 | } | ||||
160 | |||||
161 | sub 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 | |||||
174 | sub 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 | |||||
187 | sub 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 | |||||
231 | sub 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 | |||||
246 | sub _is_local_dot_dir { | ||||
247 | my $self = shift; | ||||
248 | my $dir = shift; | ||||
249 | |||||
250 | return ($dir eq $Updir or $dir eq $Curdir); | ||||
251 | } | ||||
252 | |||||
253 | sub 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 | |||||
272 | sub 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 | |||||
305 | sub contains { | ||||
306 | my ($self, $other) = @_; | ||||
307 | return !!(-d $self and (-e $other or -l $other) and $self->subsumes($other)); | ||||
308 | } | ||||
309 | |||||
310 | sub tempfile { | ||||
311 | my $self = shift; | ||||
312 | return File::Temp::tempfile(@_, DIR => $self->stringify); | ||||
313 | } | ||||
314 | |||||
315 | 1 | 4µs | 1; | ||
316 | __END__ |