| 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 | Path::Class::Dir::BEGIN@14 |
| 1 | 1 | 1 | 2.12ms | 2.28ms | Path::Class::Dir::BEGIN@13 |
| 1 | 1 | 1 | 914µs | 6.17ms | Path::Class::Dir::BEGIN@12 |
| 1 | 1 | 1 | 223µs | 11.3ms | Path::Class::Dir::BEGIN@10 |
| 3 | 2 | 2 | 66µs | 162µs | Path::Class::Dir::new |
| 5 | 2 | 2 | 32µs | 105µs | Path::Class::Dir::stringify |
| 1 | 1 | 1 | 9µs | 73µs | Path::Class::Dir::file |
| 1 | 1 | 1 | 9µs | 17µs | Path::Class::File::BEGIN@1 |
| 1 | 1 | 1 | 6µs | 6µs | Path::Class::Dir::BEGIN@8 |
| 1 | 1 | 1 | 4µs | 4µs | Path::Class::Dir::BEGIN@15 |
| 1 | 1 | 1 | 3µs | 3µs | Path::Class::Dir::BEGIN@9 |
| 1 | 1 | 1 | 1µs | 1µs | Path::Class::Dir::file_class |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:169] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:182] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:205] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:213] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:218] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::__ANON__[:224] |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::_is_local_dot_dir |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::as_foreign |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::basename |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::children |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::components |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::contains |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::dir_list |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::is_dir |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::mkpath |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::next |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::open |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::parent |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::recurse |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::relative |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::remove |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::rmtree |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::subdir |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::subsumes |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::tempfile |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::traverse |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::traverse_if |
| 0 | 0 | 0 | 0s | 0s | Path::Class::Dir::volume |
| 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__ |