Profile of Path/Class/Dir.pm

← 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
Statements | Executed 69 statements in 2.15ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 5.31ms | 7.07ms | Path::Class::Dir::::BEGIN@14 Path::Class::Dir::BEGIN@14
1 | 1 | 1 | 2.12ms | 2.28ms | Path::Class::Dir::::BEGIN@13 Path::Class::Dir::BEGIN@13
1 | 1 | 1 | 914µs | 6.17ms | Path::Class::Dir::::BEGIN@12 Path::Class::Dir::BEGIN@12
1 | 1 | 1 | 223µs | 11.3ms | Path::Class::Dir::::BEGIN@10 Path::Class::Dir::BEGIN@10
3 | 2 | 2 | 66µs | 162µs | Path::Class::Dir::::new Path::Class::Dir::new
5 | 2 | 2 | 32µs | 105µs | Path::Class::Dir::::stringify Path::Class::Dir::stringify
1 | 1 | 1 | 9µs | 73µs | Path::Class::Dir::::file Path::Class::Dir::file
1 | 1 | 1 | 9µs | 17µs | Path::Class::File::::BEGIN@1Path::Class::File::BEGIN@1
1 | 1 | 1 | 6µs | 6µs | Path::Class::Dir::::BEGIN@8 Path::Class::Dir::BEGIN@8
1 | 1 | 1 | 4µs | 4µs | Path::Class::Dir::::BEGIN@15 Path::Class::Dir::BEGIN@15
1 | 1 | 1 | 3µs | 3µs | Path::Class::Dir::::BEGIN@9 Path::Class::Dir::BEGIN@9
1 | 1 | 1 | 1µs | 1µs | Path::Class::Dir::::file_class Path::Class::Dir::file_class
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:169] Path::Class::Dir::__ANON__[:169]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:182] Path::Class::Dir::__ANON__[:182]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:205] Path::Class::Dir::__ANON__[:205]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:213] Path::Class::Dir::__ANON__[:213]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:218] Path::Class::Dir::__ANON__[:218]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::__ANON__[:224] Path::Class::Dir::__ANON__[:224]
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::_is_local_dot_dir Path::Class::Dir::_is_local_dot_dir
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::as_foreign Path::Class::Dir::as_foreign
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::basename Path::Class::Dir::basename
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::children Path::Class::Dir::children
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::components Path::Class::Dir::components
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::contains Path::Class::Dir::contains
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::dir_list Path::Class::Dir::dir_list
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::is_dir Path::Class::Dir::is_dir
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::mkpath Path::Class::Dir::mkpath
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::next Path::Class::Dir::next
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::open Path::Class::Dir::open
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::parent Path::Class::Dir::parent
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::recurse Path::Class::Dir::recurse
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::relative Path::Class::Dir::relative
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::remove Path::Class::Dir::remove
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::rmtree Path::Class::Dir::rmtree
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::subdir Path::Class::Dir::subdir
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::subsumes Path::Class::Dir::subsumes
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::tempfile Path::Class::Dir::tempfile
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::traverse Path::Class::Dir::traverse
0 | 0 | 0 | 0s | 0s | Path::Class::Dir::::traverse_if Path::Class::Dir::traverse_if
0 | 0 | 0 | 0s | 0s | Path::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
--- | --- | --- | --- | --- | ---
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 use strict; # 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 use Path::Class::File; # 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 use Carp(); # 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 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 |  |  |  |  |
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 use IO::Dir (); # 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 use File::Path (); # 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 use File::Temp (); # 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 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.
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 sub new {
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 sub file_class { "Path::Class::File" }
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 sub stringify {
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 sub file {
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__