← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Class/Inspector.pm
StatementsExecuted 22 statements in 1.82ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11144µs49µsClass::Inspector::::BEGIN@51Class::Inspector::BEGIN@51
11115µs15µsClass::Inspector::::BEGIN@42Class::Inspector::BEGIN@42
11112µs22µsClass::Inspector::::BEGIN@45Class::Inspector::BEGIN@45
11110µs14µsClass::Inspector::::BEGIN@46Class::Inspector::BEGIN@46
1118µs19µsClass::Inspector::::BEGIN@540Class::Inspector::BEGIN@540
1118µs17µsClass::Inspector::::BEGIN@553Class::Inspector::BEGIN@553
1117µs61µsClass::Inspector::::BEGIN@50Class::Inspector::BEGIN@50
1113µs3µsClass::Inspector::::BEGIN@47Class::Inspector::BEGIN@47
2212µs2µ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::::_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
3=pod
4
5=head1 NAME
6
7Class::Inspector - Get information about a class and its structure
8
9=head1 SYNOPSIS
10
11 use Class::Inspector;
12
13 # Is a class installed and/or loaded
14 Class::Inspector->installed( 'Foo::Class' );
15 Class::Inspector->loaded( 'Foo::Class' );
16
17 # Filename related information
18 Class::Inspector->filename( 'Foo::Class' );
19 Class::Inspector->resolved_filename( 'Foo::Class' );
20
21 # Get subroutine related information
22 Class::Inspector->functions( 'Foo::Class' );
23 Class::Inspector->function_refs( 'Foo::Class' );
24 Class::Inspector->function_exists( 'Foo::Class', 'bar' );
25 Class::Inspector->methods( 'Foo::Class', 'full', 'public' );
26
27 # Find all loaded subclasses or something
28 Class::Inspector->subclasses( 'Foo::Class' );
29
30=head1 DESCRIPTION
31
32Class::Inspector allows you to get information about a loaded class. Most or
33all of this information can be found in other ways, but they aren't always
34very friendly, and usually involve a relatively high level of Perl wizardry,
35or strange and unusual looking code. Class::Inspector attempts to provide
36an easier, more friendly interface to this information.
37
38=head1 METHODS
39
40=cut
41
42243µs115µs
# spent 15µs within Class::Inspector::BEGIN@42 which was called: # once (15µs+0s) by File::ShareDir::BEGIN@116 at line 42
use 5.006;
# spent 15µs making 1 call to Class::Inspector::BEGIN@42
43# We don't want to use strict refs anywhere in this module, since we do a
44# lot of things in here that aren't strict refs friendly.
45220µs233µs
# spent 22µs (12+11) within Class::Inspector::BEGIN@45 which was called: # once (12µs+11µs) by File::ShareDir::BEGIN@116 at line 45
use strict qw{vars subs};
# spent 22µs making 1 call to Class::Inspector::BEGIN@45 # spent 11µs making 1 call to strict::import
46218µs218µs
# spent 14µs (10+4) within Class::Inspector::BEGIN@46 which was called: # once (10µs+4µs) by File::ShareDir::BEGIN@116 at line 46
use warnings;
# spent 14µs making 1 call to Class::Inspector::BEGIN@46 # spent 4µs making 1 call to warnings::import
47223µs13µs
# spent 3µs within Class::Inspector::BEGIN@47 which was called: # once (3µs+0s) by File::ShareDir::BEGIN@116 at line 47
use File::Spec ();
# spent 3µs making 1 call to Class::Inspector::BEGIN@47
48
49# Globals
50296µs2115µs
# spent 61µs (7+54) within Class::Inspector::BEGIN@50 which was called: # once (7µs+54µs) by File::ShareDir::BEGIN@116 at line 50
use vars qw{$VERSION $RE_IDENTIFIER $RE_CLASS $UNIX};
# spent 61µs making 1 call to Class::Inspector::BEGIN@50 # spent 54µs making 1 call to vars::import
51
# spent 49µs (44+5) within Class::Inspector::BEGIN@51 which was called: # once (44µs+5µs) by File::ShareDir::BEGIN@116 at line 68
BEGIN {
521400ns $VERSION = '1.28';
53
54 # If Unicode is available, enable it so that the
55 # pattern matches below match unicode method names.
56 # We can safely ignore any failure here.
571100ns SCOPE: {
581900ns local $@;
59123µs eval "require utf8; utf8->import";
# spent 4µs executing statements in string eval
60 }
61
62 # Predefine some regexs
6316µs12µs $RE_IDENTIFIER = qr/\A[^\W\d]\w*\z/s;
# spent 2µs making 1 call to Class::Inspector::CORE:qr
6413µs1900ns $RE_CLASS = qr/\A[^\W\d]\w*(?:(?:\'|::)\w+)*\z/s;
# spent 900ns making 1 call to Class::Inspector::CORE:qr
65
66 # Are we on something Unix-like?
6714µs $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' );
6811.20ms149µs}
# spent 49µs making 1 call to Class::Inspector::BEGIN@51
69
- -
74#####################################################################
75# Basic Methods
76
77=pod
78
79=head2 installed $class
80
81The C<installed> static method tries to determine if a class is installed
82on the machine, or at least available to Perl. It does this by wrapping
83around C<resolved_filename>.
84
85Returns true if installed/available, false if the class is not installed,
86or C<undef> if the class name is invalid.
87
88=cut
89
90sub installed {
91 my $class = shift;
92 !! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0]));
93}
94
95=pod
96
97=head2 loaded $class
98
99The C<loaded> static method tries to determine if a class is loaded by
100looking for symbol table entries.
101
102This method it uses to determine this will work even if the class does not
103have its own file, but is contained inside a single file with multiple
104classes in it. Even in the case of some sort of run-time loading class
105being used, these typically leave some trace in the symbol table, so an
106L<Autoload> or L<Class::Autouse>-based class should correctly appear
107loaded.
108
109Returns true if the class is loaded, false if not, or C<undef> if the
110class name is invalid.
111
112=cut
113
114sub loaded {
115 my $class = shift;
116 my $name = $class->_class(shift) or return undef;
117 $class->_loaded($name);
118}
119
120sub _loaded {
121 my $class = shift;
122 my $name = shift;
123
124 # Handle by far the two most common cases
125 # This is very fast and handles 99% of cases.
126 return 1 if defined ${"${name}::VERSION"};
127 return 1 if @{"${name}::ISA"};
128
129 # Are there any symbol table entries other than other namespaces
130 foreach ( keys %{"${name}::"} ) {
131 next if substr($_, -2, 2) eq '::';
132 return 1 if defined &{"${name}::$_"};
133 }
134
135 # No functions, and it doesn't have a version, and isn't anything.
136 # As an absolute last resort, check for an entry in %INC
137 my $filename = $class->_inc_filename($name);
138 return 1 if defined $INC{$filename};
139
140 '';
141}
142
143=pod
144
145=head2 filename $class
146
147For a given class, returns the base filename for the class. This will NOT
148be a fully resolved filename, just the part of the filename BELOW the
149C<@INC> entry.
150
151 print Class->filename( 'Foo::Bar' );
152 > Foo/Bar.pm
153
154This filename will be returned with the right seperator for the local
155platform, and should work on all platforms.
156
157Returns the filename on success or C<undef> if the class name is invalid.
158
159=cut
160
161sub filename {
162 my $class = shift;
163 my $name = $class->_class(shift) or return undef;
164 File::Spec->catfile( split /(?:\'|::)/, $name ) . '.pm';
165}
166
167=pod
168
169=head2 resolved_filename $class, @try_first
170
171For a given class, the C<resolved_filename> static method returns the fully
172resolved filename for a class. That is, the file that the class would be
173loaded from.
174
175This is not nescesarily the file that the class WAS loaded from, as the
176value returned is determined each time it runs, and the C<@INC> include
177path may change.
178
179To get the actual file for a loaded class, see the C<loaded_filename>
180method.
181
182Returns the filename for the class, or C<undef> if the class name is
183invalid.
184
185=cut
186
187sub resolved_filename {
188 my $class = shift;
189 my $filename = $class->_inc_filename(shift) or return undef;
190 my @try_first = @_;
191
192 # Look through the @INC path to find the file
193 foreach ( @try_first, @INC ) {
194 my $full = "$_/$filename";
195 next unless -e $full;
196 return $UNIX ? $full : $class->_inc_to_local($full);
197 }
198
199 # File not found
200 '';
201}
202
203=pod
204
205=head2 loaded_filename $class
206
207For a given loaded class, the C<loaded_filename> static method determines
208(via the C<%INC> hash) the name of the file that it was originally loaded
209from.
210
211Returns a resolved file path, or false if the class did not have it's own
212file.
213
214=cut
215
216sub loaded_filename {
217 my $class = shift;
218 my $filename = $class->_inc_filename(shift);
219 $UNIX ? $INC{$filename} : $class->_inc_to_local($INC{$filename});
220}
221
- -
226#####################################################################
227# Sub Related Methods
228
229=pod
230
231=head2 functions $class
232
233For a loaded class, the C<functions> static method returns a list of the
234names of all the functions in the classes immediate namespace.
235
236Note that this is not the METHODS of the class, just the functions.
237
238Returns a reference to an array of the function names on success, or C<undef>
239if the class name is invalid or the class is not loaded.
240
241=cut
242
243sub functions {
244 my $class = shift;
245 my $name = $class->_class(shift) or return undef;
246 return undef unless $class->loaded( $name );
247
248 # Get all the CODE symbol table entries
249 my @functions = sort grep { /$RE_IDENTIFIER/o }
250 grep { defined &{"${name}::$_"} }
251 keys %{"${name}::"};
252 \@functions;
253}
254
255=pod
256
257=head2 function_refs $class
258
259For a loaded class, the C<function_refs> static method returns references to
260all the functions in the classes immediate namespace.
261
262Note that this is not the METHODS of the class, just the functions.
263
264Returns a reference to an array of C<CODE> refs of the functions on
265success, or C<undef> if the class is not loaded.
266
267=cut
268
269sub function_refs {
270 my $class = shift;
271 my $name = $class->_class(shift) or return undef;
272 return undef unless $class->loaded( $name );
273
274 # Get all the CODE symbol table entries, but return
275 # the actual CODE refs this time.
276 my @functions = map { \&{"${name}::$_"} }
277 sort grep { /$RE_IDENTIFIER/o }
278 grep { defined &{"${name}::$_"} }
279 keys %{"${name}::"};
280 \@functions;
281}
282
283=pod
284
285=head2 function_exists $class, $function
286
287Given a class and function name the C<function_exists> static method will
288check to see if the function exists in the class.
289
290Note that this is as a function, not as a method. To see if a method
291exists for a class, use the C<can> method for any class or object.
292
293Returns true if the function exists, false if not, or C<undef> if the
294class or function name are invalid, or the class is not loaded.
295
296=cut
297
298sub function_exists {
299 my $class = shift;
300 my $name = $class->_class( shift ) or return undef;
301 my $function = shift or return undef;
302
303 # Only works if the class is loaded
304 return undef unless $class->loaded( $name );
305
306 # Does the GLOB exist and its CODE part exist
307 defined &{"${name}::$function"};
308}
309
310=pod
311
312=head2 methods $class, @options
313
314For a given class name, the C<methods> static method will returns ALL
315the methods available to that class. This includes all methods available
316from every class up the class' C<@ISA> tree.
317
318Returns a reference to an array of the names of all the available methods
319on success, or C<undef> if the class name is invalid or the class is not
320loaded.
321
322A number of options are available to the C<methods> method that will alter
323the results returned. These should be listed after the class name, in any
324order.
325
326 # Only get public methods
327 my $method = Class::Inspector->methods( 'My::Class', 'public' );
328
329=over 4
330
331=item public
332
333The C<public> option will return only 'public' methods, as defined by the Perl
334convention of prepending an underscore to any 'private' methods. The C<public>
335option will effectively remove any methods that start with an underscore.
336
337=item private
338
339The C<private> options will return only 'private' methods, as defined by the
340Perl convention of prepending an underscore to an private methods. The
341C<private> option will effectively remove an method that do not start with an
342underscore.
343
344B<Note: The C<public> and C<private> options are mutually exclusive>
345
346=item full
347
348C<methods> normally returns just the method name. Supplying the C<full> option
349will cause the methods to be returned as the full names. That is, instead of
350returning C<[ 'method1', 'method2', 'method3' ]>, you would instead get
351C<[ 'Class::method1', 'AnotherClass::method2', 'Class::method3' ]>.
352
353=item expanded
354
355The C<expanded> option will cause a lot more information about method to be
356returned. Instead of just the method name, you will instead get an array
357reference containing the method name as a single combined name, ala C<full>,
358the seperate class and method, and a CODE ref to the actual function ( if
359available ). Please note that the function reference is not guarenteed to
360be available. C<Class::Inspector> is intended at some later time, work
361with modules that have some some of common run-time loader in place ( e.g
362C<Autoloader> or C<Class::Autouse> for example.
363
364The response from C<methods( 'Class', 'expanded' )> would look something like
365the following.
366
367 [
368 [ 'Class::method1', 'Class', 'method1', \&Class::method1 ],
369 [ 'Another::method2', 'Another', 'method2', \&Another::method2 ],
370 [ 'Foo::bar', 'Foo', 'bar', \&Foo::bar ],
371 ]
372
373=back
374
375=cut
376
377sub methods {
378 my $class = shift;
379 my $name = $class->_class( shift ) or return undef;
380 my @arguments = map { lc $_ } @_;
381
382 # Process the arguments to determine the options
383 my %options = ();
384 foreach ( @arguments ) {
385 if ( $_ eq 'public' ) {
386 # Only get public methods
387 return undef if $options{private};
388 $options{public} = 1;
389
390 } elsif ( $_ eq 'private' ) {
391 # Only get private methods
392 return undef if $options{public};
393 $options{private} = 1;
394
395 } elsif ( $_ eq 'full' ) {
396 # Return the full method name
397 return undef if $options{expanded};
398 $options{full} = 1;
399
400 } elsif ( $_ eq 'expanded' ) {
401 # Returns class, method and function ref
402 return undef if $options{full};
403 $options{expanded} = 1;
404
405 } else {
406 # Unknown or unsupported options
407 return undef;
408 }
409 }
410
411 # Only works if the class is loaded
412 return undef unless $class->loaded( $name );
413
414 # Get the super path ( not including UNIVERSAL )
415 # Rather than using Class::ISA, we'll use an inlined version
416 # that implements the same basic algorithm.
417 my @path = ();
418 my @queue = ( $name );
419 my %seen = ( $name => 1 );
420 while ( my $cl = shift @queue ) {
421 push @path, $cl;
422 unshift @queue, grep { ! $seen{$_}++ }
423 map { s/^::/main::/; s/\'/::/g; $_ }
424 ( @{"${cl}::ISA"} );
425 }
426
427 # Find and merge the function names across the entire super path.
428 # Sort alphabetically and return.
429 my %methods = ();
430 foreach my $namespace ( @path ) {
431 my @functions = grep { ! $methods{$_} }
432 grep { /$RE_IDENTIFIER/o }
433 grep { defined &{"${namespace}::$_"} }
434 keys %{"${namespace}::"};
435 foreach ( @functions ) {
436 $methods{$_} = $namespace;
437 }
438 }
439
440 # Filter to public or private methods if needed
441 my @methodlist = sort keys %methods;
442 @methodlist = grep { ! /^\_/ } @methodlist if $options{public};
443 @methodlist = grep { /^\_/ } @methodlist if $options{private};
444
445 # Return in the correct format
446 @methodlist = map { "$methods{$_}::$_" } @methodlist if $options{full};
447 @methodlist = map {
448 [ "$methods{$_}::$_", $methods{$_}, $_, \&{"$methods{$_}::$_"} ]
449 } @methodlist if $options{expanded};
450
451 \@methodlist;
452}
453
- -
458#####################################################################
459# Search Methods
460
461=pod
462
463=head2 subclasses $class
464
465The C<subclasses> static method will search then entire namespace (and thus
466B<all> currently loaded classes) to find all classes that are subclasses
467of the class provided as a the parameter.
468
469The actual test will be done by calling C<isa> on the class as a static
470method. (i.e. C<My::Class-E<gt>isa($class)>.
471
472Returns a reference to a list of the loaded classes that match the class
473provided, or false is none match, or C<undef> if the class name provided
474is invalid.
475
476=cut
477
478sub subclasses {
479 my $class = shift;
480 my $name = $class->_class( shift ) or return undef;
481
482 # Prepare the search queue
483 my @found = ();
484 my @queue = grep { $_ ne 'main' } $class->_subnames('');
485 while ( @queue ) {
486 my $c = shift(@queue); # c for class
487 if ( $class->_loaded($c) ) {
488 # At least one person has managed to misengineer
489 # a situation in which ->isa could die, even if the
490 # class is real. Trap these cases and just skip
491 # over that (bizarre) class. That would at limit
492 # problems with finding subclasses to only the
493 # modules that have broken ->isa implementation.
494 local $@;
495 eval {
496 if ( $c->isa($name) ) {
497 # Add to the found list, but don't add the class itself
498 push @found, $c unless $c eq $name;
499 }
500 };
501 }
502
503 # Add any child namespaces to the head of the queue.
504 # This keeps the queue length shorted, and allows us
505 # not to have to do another sort at the end.
506 unshift @queue, map { "${c}::$_" } $class->_subnames($c);
507 }
508
509 @found ? \@found : '';
510}
511
512sub _subnames {
513 my ($class, $name) = @_;
514 return sort
515 grep {
516 substr($_, -2, 2, '') eq '::'
517 and
518 /$RE_IDENTIFIER/o
519 }
520 keys %{"${name}::"};
521}
522
- -
527#####################################################################
528# Children Related Methods
529
530# These can go undocumented for now, until I decide if its best to
531# just search the children in namespace only, or if I should do it via
532# the file system.
533
534# Find all the loaded classes below us
535sub children {
536 my $class = shift;
537 my $name = $class->_class(shift) or return ();
538
539 # Find all the Foo:: elements in our symbol table
540296µs229µs
# spent 19µs (8+11) within Class::Inspector::BEGIN@540 which was called: # once (8µs+11µs) by File::ShareDir::BEGIN@116 at line 540
no strict 'refs';
# spent 19µs making 1 call to Class::Inspector::BEGIN@540 # spent 11µs making 1 call to strict::unimport
541 map { "${name}::$_" } sort grep { s/::$// } keys %{"${name}::"};
542}
543
544# As above, but recursively
545sub recursive_children {
546 my $class = shift;
547 my $name = $class->_class(shift) or return ();
548 my @children = ( $name );
549
550 # Do the search using a nicer, more memory efficient
551 # variant of actual recursion.
552 my $i = 0;
5532276µs226µs
# spent 17µs (8+9) within Class::Inspector::BEGIN@553 which was called: # once (8µs+9µs) by File::ShareDir::BEGIN@116 at line 553
no strict 'refs';
# spent 17µs making 1 call to Class::Inspector::BEGIN@553 # spent 9µs making 1 call to strict::unimport
554 while ( my $namespace = $children[$i++] ) {
555 push @children, map { "${namespace}::$_" }
556 grep { ! /^::/ } # Ignore things like ::ISA::CACHE::
557 grep { s/::$// }
558 keys %{"${namespace}::"};
559 }
560
561 sort @children;
562}
563
- -
568#####################################################################
569# Private Methods
570
571# Checks and expands ( if needed ) a class name
572sub _class {
573 my $class = shift;
574 my $name = shift or return '';
575
576 # Handle main shorthand
577 return 'main' if $name eq '::';
578 $name =~ s/\A::/main::/;
579
580 # Check the class name is valid
581 $name =~ /$RE_CLASS/o ? $name : '';
582}
583
584# Create a INC-specific filename, which always uses '/'
585# regardless of platform.
586sub _inc_filename {
587 my $class = shift;
588 my $name = $class->_class(shift) or return undef;
589 join( '/', split /(?:\'|::)/, $name ) . '.pm';
590}
591
592# Convert INC-specific file name to local file name
593sub _inc_to_local {
594 # Shortcut in the Unix case
595 return $_[1] if $UNIX;
596
597 # On other places, we have to deal with an unusual path that might look
598 # like C:/foo/bar.pm which doesn't fit ANY normal pattern.
599 # Putting it through splitpath/dir and back again seems to normalise
600 # it to a reasonable amount.
601 my $class = shift;
602 my $inc_name = shift or return undef;
603 my ($vol, $dir, $file) = File::Spec->splitpath( $inc_name );
604 $dir = File::Spec->catdir( File::Spec->splitdir( $dir || "" ) );
605 File::Spec->catpath( $vol, $dir, $file || "" );
606}
607
60812µs1;
609
610=pod
611
612=head1 SUPPORT
613
614Bugs should be reported via the CPAN bug tracker
615
616L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Inspector>
617
618For other issues, or commercial enhancement or support, contact the author.
619
620=head1 AUTHOR
621
622Adam Kennedy E<lt>adamk@cpan.orgE<gt>
623
624=head1 SEE ALSO
625
626L<http://ali.as/>, L<Class::Handle>
627
628=head1 COPYRIGHT
629
630Copyright 2002 - 2012 Adam Kennedy.
631
632This program is free software; you can redistribute
633it and/or modify it under the same terms as Perl itself.
634
635The full text of the license can be found in the
636LICENSE file included with this module.
637
638=cut
 
# spent 2µs within Class::Inspector::CORE:qr which was called 2 times, avg 1µs/call: # once (2µs+0s) by Class::Inspector::BEGIN@51 at line 63 # once (900ns+0s) by Class::Inspector::BEGIN@51 at line 64
sub Class::Inspector::CORE:qr; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.