← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:31 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Class/Inspector.pm
StatementsExecuted 21 statements in 2.39ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11124µs24µsClass::Inspector::::BEGIN@3Class::Inspector::BEGIN@3
1119µs11µsClass::Inspector::::BEGIN@17Class::Inspector::BEGIN@17
1118µs15µsClass::Inspector::::BEGIN@331Class::Inspector::BEGIN@331
1118µs8µsClass::Inspector::::BEGIN@8Class::Inspector::BEGIN@8
1115µs8µsClass::Inspector::::BEGIN@344Class::Inspector::BEGIN@344
1115µs12µsClass::Inspector::::BEGIN@6Class::Inspector::BEGIN@6
1115µs31µsClass::Inspector::::BEGIN@7Class::Inspector::BEGIN@7
2213µs3µsClass::Inspector::::CORE:qrClass::Inspector::CORE:qr (opcode)
0000s0sClass::Inspector::::_classClass::Inspector::_class
0000s0sClass::Inspector::::_inc_filenameClass::Inspector::_inc_filename
0000s0sClass::Inspector::::_inc_to_localClass::Inspector::_inc_to_local
0000s0sClass::Inspector::::_loadedClass::Inspector::_loaded
0000s0sClass::Inspector::::_resolved_inc_handlerClass::Inspector::_resolved_inc_handler
0000s0sClass::Inspector::::_subnamesClass::Inspector::_subnames
0000s0sClass::Inspector::::childrenClass::Inspector::children
0000s0sClass::Inspector::::filenameClass::Inspector::filename
0000s0sClass::Inspector::::function_existsClass::Inspector::function_exists
0000s0sClass::Inspector::::function_refsClass::Inspector::function_refs
0000s0sClass::Inspector::::functionsClass::Inspector::functions
0000s0sClass::Inspector::::installedClass::Inspector::installed
0000s0sClass::Inspector::::loadedClass::Inspector::loaded
0000s0sClass::Inspector::::loaded_filenameClass::Inspector::loaded_filename
0000s0sClass::Inspector::::methodsClass::Inspector::methods
0000s0sClass::Inspector::::recursive_childrenClass::Inspector::recursive_children
0000s0sClass::Inspector::::resolved_filenameClass::Inspector::resolved_filename
0000s0sClass::Inspector::::subclassesClass::Inspector::subclasses
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Class::Inspector;
2
3240µs124µs
# spent 24µs within Class::Inspector::BEGIN@3 which was called: # once (24µs+0s) by File::ShareDir::BEGIN@131 at line 3
use 5.006;
# spent 24µs making 1 call to Class::Inspector::BEGIN@3
4# We don't want to use strict refs anywhere in this module, since we do a
5# lot of things in here that aren't strict refs friendly.
6223µs219µs
# spent 12µs (5+7) within Class::Inspector::BEGIN@6 which was called: # once (5µs+7µs) by File::ShareDir::BEGIN@131 at line 6
use strict qw{vars subs};
# spent 12µs making 1 call to Class::Inspector::BEGIN@6 # spent 7µs making 1 call to strict::import
7215µs257µs
# spent 31µs (5+26) within Class::Inspector::BEGIN@7 which was called: # once (5µs+26µs) by File::ShareDir::BEGIN@131 at line 7
use warnings;
# spent 31µs making 1 call to Class::Inspector::BEGIN@7 # spent 26µs making 1 call to warnings::import
8245µs18µs
# spent 8µs within Class::Inspector::BEGIN@8 which was called: # once (8µs+0s) by File::ShareDir::BEGIN@131 at line 8
use File::Spec ();
# spent 8µs making 1 call to Class::Inspector::BEGIN@8
9
10# ABSTRACT: Get information about a class and its structure
1111µsour $VERSION = '1.36'; # VERSION
12
13
14# If Unicode is available, enable it so that the
15# pattern matches below match unicode method names.
16# We can safely ignore any failure here.
17
# spent 11µs (9+2) within Class::Inspector::BEGIN@17 which was called: # once (9µs+2µs) by File::ShareDir::BEGIN@131 at line 23
BEGIN {
1810s local $@;
1914µs eval {
2010s require utf8;
2112µs12µs utf8->import;
# spent 2µs making 1 call to utf8::import
22 };
2311.87ms111µs}
# spent 11µs making 1 call to Class::Inspector::BEGIN@17
24
25# Predefine some regexs
2618µs12µsour $RE_IDENTIFIER = qr/\A[^\W\d]\w*\z/s;
# spent 2µs making 1 call to Class::Inspector::CORE:qr
2712µs11µsour $RE_CLASS = qr/\A[^\W\d]\w*(?:(?:\'|::)\w+)*\z/s;
# spent 1µs making 1 call to Class::Inspector::CORE:qr
28
29# Are we on something Unix-like?
3011µsour $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' );
31
32
33#####################################################################
34# Basic Methods
35
36
37sub _resolved_inc_handler {
38 my $class = shift;
39 my $filename = $class->_inc_filename(shift) or return undef;
40
41 foreach my $inc ( @INC ) {
42 my $ref = ref $inc;
43 if($ref eq 'CODE') {
44 my @ret = $inc->($inc, $filename);
45 if(@ret == 1 && ! defined $ret[0]) {
46 # do nothing.
47 } elsif(@ret) {
48 return 1;
49 }
50 }
51 elsif($ref eq 'ARRAY' && ref($inc->[0]) eq 'CODE') {
52 my @ret = $inc->[0]->($inc, $filename);
53 if(@ret) {
54 return 1;
55 }
56 }
57 elsif($ref && eval { $inc->can('INC') }) {
58 my @ret = $inc->INC($filename);
59 if(@ret) {
60 return 1;
61 }
62 }
63 }
64
65 '';
66}
67
68sub installed {
69 my $class = shift;
70 !! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0]) or $class->_resolved_inc_handler($_[0]));
71}
72
73
74sub loaded {
75 my $class = shift;
76 my $name = $class->_class(shift) or return undef;
77 $class->_loaded($name);
78}
79
80sub _loaded {
81 my $class = shift;
82 my $name = shift;
83
84 # Handle by far the two most common cases
85 # This is very fast and handles 99% of cases.
86 return 1 if defined ${"${name}::VERSION"};
87 return 1 if @{"${name}::ISA"};
88
89 # Are there any symbol table entries other than other namespaces
90 foreach ( keys %{"${name}::"} ) {
91 next if substr($_, -2, 2) eq '::';
92 return 1 if defined &{"${name}::$_"};
93 }
94
95 # No functions, and it doesn't have a version, and isn't anything.
96 # As an absolute last resort, check for an entry in %INC
97 my $filename = $class->_inc_filename($name);
98 return 1 if defined $INC{$filename};
99
100 '';
101}
102
103
104sub filename {
105 my $class = shift;
106 my $name = $class->_class(shift) or return undef;
107 File::Spec->catfile( split /(?:\'|::)/, $name ) . '.pm';
108}
109
110
111sub resolved_filename {
112 my $class = shift;
113 my $filename = $class->_inc_filename(shift) or return undef;
114 my @try_first = @_;
115
116 # Look through the @INC path to find the file
117 foreach ( @try_first, @INC ) {
118 my $full = "$_/$filename";
119 next unless -e $full;
120 return $UNIX ? $full : $class->_inc_to_local($full);
121 }
122
123 # File not found
124 '';
125}
126
127
128sub loaded_filename {
129 my $class = shift;
130 my $filename = $class->_inc_filename(shift);
131 $UNIX ? $INC{$filename} : $class->_inc_to_local($INC{$filename});
132}
133
- -
138#####################################################################
139# Sub Related Methods
140
141
142sub functions {
143 my $class = shift;
144 my $name = $class->_class(shift) or return undef;
145 return undef unless $class->loaded( $name );
146
147 # Get all the CODE symbol table entries
148 my @functions = sort grep { /$RE_IDENTIFIER/o }
149 grep { defined &{"${name}::$_"} }
150 keys %{"${name}::"};
151 \@functions;
152}
153
154
155sub function_refs {
156 my $class = shift;
157 my $name = $class->_class(shift) or return undef;
158 return undef unless $class->loaded( $name );
159
160 # Get all the CODE symbol table entries, but return
161 # the actual CODE refs this time.
162 my @functions = map { \&{"${name}::$_"} }
163 sort grep { /$RE_IDENTIFIER/o }
164 grep { defined &{"${name}::$_"} }
165 keys %{"${name}::"};
166 \@functions;
167}
168
169
170sub function_exists {
171 my $class = shift;
172 my $name = $class->_class( shift ) or return undef;
173 my $function = shift or return undef;
174
175 # Only works if the class is loaded
176 return undef unless $class->loaded( $name );
177
178 # Does the GLOB exist and its CODE part exist
179 defined &{"${name}::$function"};
180}
181
182
183sub methods {
184 my $class = shift;
185 my $name = $class->_class( shift ) or return undef;
186 my @arguments = map { lc $_ } @_;
187
188 # Process the arguments to determine the options
189 my %options = ();
190 foreach ( @arguments ) {
191 if ( $_ eq 'public' ) {
192 # Only get public methods
193 return undef if $options{private};
194 $options{public} = 1;
195
196 } elsif ( $_ eq 'private' ) {
197 # Only get private methods
198 return undef if $options{public};
199 $options{private} = 1;
200
201 } elsif ( $_ eq 'full' ) {
202 # Return the full method name
203 return undef if $options{expanded};
204 $options{full} = 1;
205
206 } elsif ( $_ eq 'expanded' ) {
207 # Returns class, method and function ref
208 return undef if $options{full};
209 $options{expanded} = 1;
210
211 } else {
212 # Unknown or unsupported options
213 return undef;
214 }
215 }
216
217 # Only works if the class is loaded
218 return undef unless $class->loaded( $name );
219
220 # Get the super path ( not including UNIVERSAL )
221 # Rather than using Class::ISA, we'll use an inlined version
222 # that implements the same basic algorithm.
223 my @path = ();
224 my @queue = ( $name );
225 my %seen = ( $name => 1 );
226 while ( my $cl = shift @queue ) {
227 push @path, $cl;
228 unshift @queue, grep { ! $seen{$_}++ }
229 map { s/^::/main::/; s/\'/::/g; $_ } ## no critic
230 map { "$_" }
231 ( @{"${cl}::ISA"} );
232 }
233
234 # Find and merge the function names across the entire super path.
235 # Sort alphabetically and return.
236 my %methods = ();
237 foreach my $namespace ( @path ) {
238 my @functions = grep { ! $methods{$_} }
239 grep { /$RE_IDENTIFIER/o }
240 grep { defined &{"${namespace}::$_"} }
241 keys %{"${namespace}::"};
242 foreach ( @functions ) {
243 $methods{$_} = $namespace;
244 }
245 }
246
247 # Filter to public or private methods if needed
248 my @methodlist = sort keys %methods;
249 @methodlist = grep { ! /^\_/ } @methodlist if $options{public};
250 @methodlist = grep { /^\_/ } @methodlist if $options{private};
251
252 # Return in the correct format
253 @methodlist = map { "$methods{$_}::$_" } @methodlist if $options{full};
254 @methodlist = map {
255 [ "$methods{$_}::$_", $methods{$_}, $_, \&{"$methods{$_}::$_"} ]
256 } @methodlist if $options{expanded};
257
258 \@methodlist;
259}
260
- -
265#####################################################################
266# Search Methods
267
268
269sub subclasses {
270 my $class = shift;
271 my $name = $class->_class( shift ) or return undef;
272
273 # Prepare the search queue
274 my @found = ();
275 my @queue = grep { $_ ne 'main' } $class->_subnames('');
276 while ( @queue ) {
277 my $c = shift(@queue); # c for class
278 if ( $class->_loaded($c) ) {
279 # At least one person has managed to misengineer
280 # a situation in which ->isa could die, even if the
281 # class is real. Trap these cases and just skip
282 # over that (bizarre) class. That would at limit
283 # problems with finding subclasses to only the
284 # modules that have broken ->isa implementation.
285 local $@;
286 eval {
287 if ( $c->isa($name) ) {
288 # Add to the found list, but don't add the class itself
289 push @found, $c unless $c eq $name;
290 }
291 };
292 }
293
294 # Add any child namespaces to the head of the queue.
295 # This keeps the queue length shorted, and allows us
296 # not to have to do another sort at the end.
297 unshift @queue, map { "${c}::$_" } $class->_subnames($c);
298 }
299
300 @found ? \@found : '';
301}
302
303sub _subnames {
304 my ($class, $name) = @_;
305 return sort
306 grep { ## no critic
307 substr($_, -2, 2, '') eq '::'
308 and
309 /$RE_IDENTIFIER/o
310 }
311 keys %{"${name}::"};
312}
313
- -
318#####################################################################
319# Children Related Methods
320
321# These can go undocumented for now, until I decide if its best to
322# just search the children in namespace only, or if I should do it via
323# the file system.
324
325# Find all the loaded classes below us
326sub children {
327 my $class = shift;
328 my $name = $class->_class(shift) or return ();
329
330 # Find all the Foo:: elements in our symbol table
331299µs222µs
# spent 15µs (8+7) within Class::Inspector::BEGIN@331 which was called: # once (8µs+7µs) by File::ShareDir::BEGIN@131 at line 331
no strict 'refs';
# spent 15µs making 1 call to Class::Inspector::BEGIN@331 # spent 7µs making 1 call to strict::unimport
332 map { "${name}::$_" } sort grep { s/::$// } keys %{"${name}::"}; ## no critic
333}
334
335# As above, but recursively
336sub recursive_children {
337 my $class = shift;
338 my $name = $class->_class(shift) or return ();
339 my @children = ( $name );
340
341 # Do the search using a nicer, more memory efficient
342 # variant of actual recursion.
343 my $i = 0;
3442275µs211µs
# spent 8µs (5+3) within Class::Inspector::BEGIN@344 which was called: # once (5µs+3µs) by File::ShareDir::BEGIN@131 at line 344
no strict 'refs';
# spent 8µs making 1 call to Class::Inspector::BEGIN@344 # spent 3µs making 1 call to strict::unimport
345 while ( my $namespace = $children[$i++] ) {
346 push @children, map { "${namespace}::$_" }
347 grep { ! /^::/ } # Ignore things like ::ISA::CACHE::
348 grep { s/::$// } ## no critic
349 keys %{"${namespace}::"};
350 }
351
352 sort @children;
353}
354
- -
359#####################################################################
360# Private Methods
361
362# Checks and expands ( if needed ) a class name
363sub _class {
364 my $class = shift;
365 my $name = shift or return '';
366
367 # Handle main shorthand
368 return 'main' if $name eq '::';
369 $name =~ s/\A::/main::/;
370
371 # Check the class name is valid
372 $name =~ /$RE_CLASS/o ? $name : '';
373}
374
375# Create a INC-specific filename, which always uses '/'
376# regardless of platform.
377sub _inc_filename {
378 my $class = shift;
379 my $name = $class->_class(shift) or return undef;
380 join( '/', split /(?:\'|::)/, $name ) . '.pm';
381}
382
383# Convert INC-specific file name to local file name
384sub _inc_to_local {
385 # Shortcut in the Unix case
386 return $_[1] if $UNIX;
387
388 # On other places, we have to deal with an unusual path that might look
389 # like C:/foo/bar.pm which doesn't fit ANY normal pattern.
390 # Putting it through splitpath/dir and back again seems to normalise
391 # it to a reasonable amount.
392 my $class = shift;
393 my $inc_name = shift or return undef;
394 my ($vol, $dir, $file) = File::Spec->splitpath( $inc_name );
395 $dir = File::Spec->catdir( File::Spec->splitdir( $dir || "" ) );
396 File::Spec->catpath( $vol, $dir, $file || "" );
397}
398
39914µs1;
400
401__END__
 
# spent 3µs within Class::Inspector::CORE:qr which was called 2 times, avg 2µs/call: # once (2µs+0s) by File::ShareDir::BEGIN@131 at line 26 # once (1µs+0s) by File::ShareDir::BEGIN@131 at line 27
sub Class::Inspector::CORE:qr; # opcode
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.