← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:29 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/Class/Inspector.pm
Statements Executed675
Total Time0.005507 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
56210.000710.00071Class::Inspector::_class
31110.000610.00124Class::Inspector::_loaded
25310.000430.00069Class::Inspector::_inc_filename
31210.000320.00201Class::Inspector::loaded
1118.4e-50.00011Class::Inspector::resolved_filename
1111.5e-50.00018Class::Inspector::installed
1111.3e-54.5e-5Class::Inspector::loaded_filename
00000Class::Inspector::BEGIN
00000Class::Inspector::_inc_to_local
00000Class::Inspector::_subnames
00000Class::Inspector::children
00000Class::Inspector::filename
00000Class::Inspector::function_exists
00000Class::Inspector::function_refs
00000Class::Inspector::functions
00000Class::Inspector::methods
00000Class::Inspector::recursive_children
00000Class::Inspector::subclasses

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

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.