| Filename | /home/s1/perl5/perlbrew/perls/perl-5.22.1/lib/site_perl/5.22.1/Class/Inspector.pm |
| Statements | Executed 220 statements in 2.95ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.63ms | 5.29ms | Class::Inspector::BEGIN@47 |
| 1 | 1 | 1 | 407µs | 413µs | Class::Inspector::BEGIN@51 |
| 1 | 1 | 1 | 330µs | 476µs | Class::Inspector::methods |
| 80 | 2 | 1 | 57µs | 57µs | Class::Inspector::CORE:match (opcode) |
| 1 | 1 | 1 | 32µs | 32µs | Class::Inspector::BEGIN@42 |
| 1 | 1 | 1 | 30µs | 30µs | Class::Inspector::_loaded |
| 1 | 1 | 1 | 23µs | 23µs | Class::Inspector::CORE:sort (opcode) |
| 2 | 2 | 1 | 21µs | 33µs | Class::Inspector::_class |
| 1 | 1 | 1 | 11µs | 26µs | Class::Inspector::BEGIN@540 |
| 1 | 1 | 1 | 10µs | 66µs | Class::Inspector::BEGIN@50 |
| 1 | 1 | 1 | 9µs | 47µs | Class::Inspector::loaded |
| 1 | 1 | 1 | 9µs | 29µs | Class::Inspector::BEGIN@45 |
| 1 | 1 | 1 | 9µs | 20µs | Class::Inspector::BEGIN@553 |
| 1 | 1 | 1 | 9µs | 18µs | Class::Inspector::BEGIN@46 |
| 2 | 2 | 1 | 4µs | 4µs | Class::Inspector::CORE:qr (opcode) |
| 2 | 2 | 1 | 3µs | 3µs | Class::Inspector::CORE:regcomp (opcode) |
| 2 | 1 | 1 | 2µs | 2µs | Class::Inspector::CORE:subst (opcode) |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::_inc_filename |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::_inc_to_local |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::_subnames |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::children |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::filename |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::function_exists |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::function_refs |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::functions |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::installed |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::loaded_filename |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::recursive_children |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::resolved_filename |
| 0 | 0 | 0 | 0s | 0s | Class::Inspector::subclasses |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::Inspector; | ||||
| 2 | |||||
| 3 | =pod | ||||
| 4 | |||||
| 5 | =head1 NAME | ||||
| 6 | |||||
| 7 | Class::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 | |||||
| 32 | Class::Inspector allows you to get information about a loaded class. Most or | ||||
| 33 | all of this information can be found in other ways, but they aren't always | ||||
| 34 | very friendly, and usually involve a relatively high level of Perl wizardry, | ||||
| 35 | or strange and unusual looking code. Class::Inspector attempts to provide | ||||
| 36 | an easier, more friendly interface to this information. | ||||
| 37 | |||||
| 38 | =head1 METHODS | ||||
| 39 | |||||
| 40 | =cut | ||||
| 41 | |||||
| 42 | 2 | 62µs | 1 | 32µs | # spent 32µs within Class::Inspector::BEGIN@42 which was called:
# once (32µs+0s) by DateTime::Format::Alami::new at line 42 # spent 32µ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. | ||||
| 45 | 2 | 29µs | 2 | 49µs | # spent 29µs (9+20) within Class::Inspector::BEGIN@45 which was called:
# once (9µs+20µs) by DateTime::Format::Alami::new at line 45 # spent 29µs making 1 call to Class::Inspector::BEGIN@45
# spent 20µs making 1 call to strict::import |
| 46 | 2 | 25µs | 2 | 27µs | # spent 18µs (9+9) within Class::Inspector::BEGIN@46 which was called:
# once (9µs+9µs) by DateTime::Format::Alami::new at line 46 # spent 18µs making 1 call to Class::Inspector::BEGIN@46
# spent 9µs making 1 call to warnings::import |
| 47 | 2 | 245µs | 1 | 5.29ms | # spent 5.29ms (2.63+2.66) within Class::Inspector::BEGIN@47 which was called:
# once (2.63ms+2.66ms) by DateTime::Format::Alami::new at line 47 # spent 5.29ms making 1 call to Class::Inspector::BEGIN@47 |
| 48 | |||||
| 49 | # Globals | ||||
| 50 | 2 | 141µs | 2 | 121µs | # spent 66µs (10+56) within Class::Inspector::BEGIN@50 which was called:
# once (10µs+56µs) by DateTime::Format::Alami::new at line 50 # spent 66µs making 1 call to Class::Inspector::BEGIN@50
# spent 56µs making 1 call to vars::import |
| 51 | # spent 413µs (407+6) within Class::Inspector::BEGIN@51 which was called:
# once (407µs+6µs) by DateTime::Format::Alami::new at line 68 | ||||
| 52 | 1 | 400ns | $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. | ||||
| 57 | SCOPE: { | ||||
| 58 | 2 | 2µs | local $@; | ||
| 59 | 1 | 29µs | eval "require utf8; utf8->import"; # spent 354µs executing statements in string eval | ||
| 60 | } | ||||
| 61 | |||||
| 62 | # Predefine some regexs | ||||
| 63 | 1 | 8µs | 1 | 3µs | $RE_IDENTIFIER = qr/\A[^\W\d]\w*\z/s; # spent 3µs making 1 call to Class::Inspector::CORE:qr |
| 64 | 1 | 3µs | 1 | 800ns | $RE_CLASS = qr/\A[^\W\d]\w*(?:(?:\'|::)\w+)*\z/s; # spent 800ns making 1 call to Class::Inspector::CORE:qr |
| 65 | |||||
| 66 | # Are we on something Unix-like? | ||||
| 67 | 1 | 4µs | $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' ); | ||
| 68 | 1 | 1.46ms | 1 | 413µs | } # spent 413µs making 1 call to Class::Inspector::BEGIN@51 |
| 69 | |||||
| - - | |||||
| 74 | ##################################################################### | ||||
| 75 | # Basic Methods | ||||
| 76 | |||||
| 77 | =pod | ||||
| 78 | |||||
| 79 | =head2 installed $class | ||||
| 80 | |||||
| 81 | The C<installed> static method tries to determine if a class is installed | ||||
| 82 | on the machine, or at least available to Perl. It does this by wrapping | ||||
| 83 | around C<resolved_filename>. | ||||
| 84 | |||||
| 85 | Returns true if installed/available, false if the class is not installed, | ||||
| 86 | or C<undef> if the class name is invalid. | ||||
| 87 | |||||
| 88 | =cut | ||||
| 89 | |||||
| 90 | sub 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 | |||||
| 99 | The C<loaded> static method tries to determine if a class is loaded by | ||||
| 100 | looking for symbol table entries. | ||||
| 101 | |||||
| 102 | This method it uses to determine this will work even if the class does not | ||||
| 103 | have its own file, but is contained inside a single file with multiple | ||||
| 104 | classes in it. Even in the case of some sort of run-time loading class | ||||
| 105 | being used, these typically leave some trace in the symbol table, so an | ||||
| 106 | L<Autoload> or L<Class::Autouse>-based class should correctly appear | ||||
| 107 | loaded. | ||||
| 108 | |||||
| 109 | Returns true if the class is loaded, false if not, or C<undef> if the | ||||
| 110 | class name is invalid. | ||||
| 111 | |||||
| 112 | =cut | ||||
| 113 | |||||
| 114 | # spent 47µs (9+37) within Class::Inspector::loaded which was called:
# once (9µs+37µs) by Class::Inspector::methods at line 412 | ||||
| 115 | 1 | 200ns | my $class = shift; | ||
| 116 | 1 | 1µs | 1 | 7µs | my $name = $class->_class(shift) or return undef; # spent 7µs making 1 call to Class::Inspector::_class |
| 117 | 1 | 5µs | 1 | 30µs | $class->_loaded($name); # spent 30µs making 1 call to Class::Inspector::_loaded |
| 118 | } | ||||
| 119 | |||||
| 120 | # spent 30µs within Class::Inspector::_loaded which was called:
# once (30µs+0s) by Class::Inspector::loaded at line 117 | ||||
| 121 | 1 | 200ns | my $class = shift; | ||
| 122 | 1 | 200ns | my $name = shift; | ||
| 123 | |||||
| 124 | # Handle by far the two most common cases | ||||
| 125 | # This is very fast and handles 99% of cases. | ||||
| 126 | 1 | 4µs | return 1 if defined ${"${name}::VERSION"}; | ||
| 127 | 1 | 3µs | return 1 if @{"${name}::ISA"}; | ||
| 128 | |||||
| 129 | # Are there any symbol table entries other than other namespaces | ||||
| 130 | 1 | 17µs | foreach ( keys %{"${name}::"} ) { | ||
| 131 | 1 | 1µs | next if substr($_, -2, 2) eq '::'; | ||
| 132 | 1 | 7µs | 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 | |||||
| 147 | For a given class, returns the base filename for the class. This will NOT | ||||
| 148 | be a fully resolved filename, just the part of the filename BELOW the | ||||
| 149 | C<@INC> entry. | ||||
| 150 | |||||
| 151 | print Class->filename( 'Foo::Bar' ); | ||||
| 152 | > Foo/Bar.pm | ||||
| 153 | |||||
| 154 | This filename will be returned with the right seperator for the local | ||||
| 155 | platform, and should work on all platforms. | ||||
| 156 | |||||
| 157 | Returns the filename on success or C<undef> if the class name is invalid. | ||||
| 158 | |||||
| 159 | =cut | ||||
| 160 | |||||
| 161 | sub 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 | |||||
| 171 | For a given class, the C<resolved_filename> static method returns the fully | ||||
| 172 | resolved filename for a class. That is, the file that the class would be | ||||
| 173 | loaded from. | ||||
| 174 | |||||
| 175 | This is not nescesarily the file that the class WAS loaded from, as the | ||||
| 176 | value returned is determined each time it runs, and the C<@INC> include | ||||
| 177 | path may change. | ||||
| 178 | |||||
| 179 | To get the actual file for a loaded class, see the C<loaded_filename> | ||||
| 180 | method. | ||||
| 181 | |||||
| 182 | Returns the filename for the class, or C<undef> if the class name is | ||||
| 183 | invalid. | ||||
| 184 | |||||
| 185 | =cut | ||||
| 186 | |||||
| 187 | sub 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 | |||||
| 207 | For 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 | ||||
| 209 | from. | ||||
| 210 | |||||
| 211 | Returns a resolved file path, or false if the class did not have it's own | ||||
| 212 | file. | ||||
| 213 | |||||
| 214 | =cut | ||||
| 215 | |||||
| 216 | sub 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 | |||||
| 233 | For a loaded class, the C<functions> static method returns a list of the | ||||
| 234 | names of all the functions in the classes immediate namespace. | ||||
| 235 | |||||
| 236 | Note that this is not the METHODS of the class, just the functions. | ||||
| 237 | |||||
| 238 | Returns a reference to an array of the function names on success, or C<undef> | ||||
| 239 | if the class name is invalid or the class is not loaded. | ||||
| 240 | |||||
| 241 | =cut | ||||
| 242 | |||||
| 243 | sub 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 | |||||
| 259 | For a loaded class, the C<function_refs> static method returns references to | ||||
| 260 | all the functions in the classes immediate namespace. | ||||
| 261 | |||||
| 262 | Note that this is not the METHODS of the class, just the functions. | ||||
| 263 | |||||
| 264 | Returns a reference to an array of C<CODE> refs of the functions on | ||||
| 265 | success, or C<undef> if the class is not loaded. | ||||
| 266 | |||||
| 267 | =cut | ||||
| 268 | |||||
| 269 | sub 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 | |||||
| 287 | Given a class and function name the C<function_exists> static method will | ||||
| 288 | check to see if the function exists in the class. | ||||
| 289 | |||||
| 290 | Note that this is as a function, not as a method. To see if a method | ||||
| 291 | exists for a class, use the C<can> method for any class or object. | ||||
| 292 | |||||
| 293 | Returns true if the function exists, false if not, or C<undef> if the | ||||
| 294 | class or function name are invalid, or the class is not loaded. | ||||
| 295 | |||||
| 296 | =cut | ||||
| 297 | |||||
| 298 | sub 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 | |||||
| 314 | For a given class name, the C<methods> static method will returns ALL | ||||
| 315 | the methods available to that class. This includes all methods available | ||||
| 316 | from every class up the class' C<@ISA> tree. | ||||
| 317 | |||||
| 318 | Returns a reference to an array of the names of all the available methods | ||||
| 319 | on success, or C<undef> if the class name is invalid or the class is not | ||||
| 320 | loaded. | ||||
| 321 | |||||
| 322 | A number of options are available to the C<methods> method that will alter | ||||
| 323 | the results returned. These should be listed after the class name, in any | ||||
| 324 | order. | ||||
| 325 | |||||
| 326 | # Only get public methods | ||||
| 327 | my $method = Class::Inspector->methods( 'My::Class', 'public' ); | ||||
| 328 | |||||
| 329 | =over 4 | ||||
| 330 | |||||
| 331 | =item public | ||||
| 332 | |||||
| 333 | The C<public> option will return only 'public' methods, as defined by the Perl | ||||
| 334 | convention of prepending an underscore to any 'private' methods. The C<public> | ||||
| 335 | option will effectively remove any methods that start with an underscore. | ||||
| 336 | |||||
| 337 | =item private | ||||
| 338 | |||||
| 339 | The C<private> options will return only 'private' methods, as defined by the | ||||
| 340 | Perl convention of prepending an underscore to an private methods. The | ||||
| 341 | C<private> option will effectively remove an method that do not start with an | ||||
| 342 | underscore. | ||||
| 343 | |||||
| 344 | B<Note: The C<public> and C<private> options are mutually exclusive> | ||||
| 345 | |||||
| 346 | =item full | ||||
| 347 | |||||
| 348 | C<methods> normally returns just the method name. Supplying the C<full> option | ||||
| 349 | will cause the methods to be returned as the full names. That is, instead of | ||||
| 350 | returning C<[ 'method1', 'method2', 'method3' ]>, you would instead get | ||||
| 351 | C<[ 'Class::method1', 'AnotherClass::method2', 'Class::method3' ]>. | ||||
| 352 | |||||
| 353 | =item expanded | ||||
| 354 | |||||
| 355 | The C<expanded> option will cause a lot more information about method to be | ||||
| 356 | returned. Instead of just the method name, you will instead get an array | ||||
| 357 | reference containing the method name as a single combined name, ala C<full>, | ||||
| 358 | the seperate class and method, and a CODE ref to the actual function ( if | ||||
| 359 | available ). Please note that the function reference is not guarenteed to | ||||
| 360 | be available. C<Class::Inspector> is intended at some later time, work | ||||
| 361 | with modules that have some some of common run-time loader in place ( e.g | ||||
| 362 | C<Autoloader> or C<Class::Autouse> for example. | ||||
| 363 | |||||
| 364 | The response from C<methods( 'Class', 'expanded' )> would look something like | ||||
| 365 | the 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 | |||||
| 377 | # spent 476µs (330+145) within Class::Inspector::methods which was called:
# once (330µs+145µs) by DateTime::Format::Alami::new at line 55 of lib/DateTime/Format/Alami.pm | ||||
| 378 | 1 | 400ns | my $class = shift; | ||
| 379 | 1 | 2µs | 1 | 26µs | my $name = $class->_class( shift ) or return undef; # spent 26µs making 1 call to Class::Inspector::_class |
| 380 | 1 | 1µs | my @arguments = map { lc $_ } @_; | ||
| 381 | |||||
| 382 | # Process the arguments to determine the options | ||||
| 383 | 1 | 700ns | my %options = (); | ||
| 384 | 1 | 1µs | 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 | 1 | 4µs | 1 | 47µs | return undef unless $class->loaded( $name ); # spent 47µs making 1 call to Class::Inspector::loaded |
| 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 | 1 | 500ns | my @path = (); | ||
| 418 | 1 | 500ns | my @queue = ( $name ); | ||
| 419 | 1 | 1µs | my %seen = ( $name => 1 ); | ||
| 420 | 1 | 10µs | while ( my $cl = shift @queue ) { | ||
| 421 | 1 | 400ns | push @path, $cl; | ||
| 422 | unshift @queue, grep { ! $seen{$_}++ } | ||||
| 423 | map { s/^::/main::/; s/\'/::/g; $_ } | ||||
| 424 | 1 | 2µs | ( @{"${cl}::ISA"} ); | ||
| 425 | } | ||||
| 426 | |||||
| 427 | # Find and merge the function names across the entire super path. | ||||
| 428 | # Sort alphabetically and return. | ||||
| 429 | 1 | 500ns | my %methods = (); | ||
| 430 | 1 | 700ns | foreach my $namespace ( @path ) { | ||
| 431 | my @functions = grep { ! $methods{$_} } | ||||
| 432 | 78 | 173µs | 79 | 50µs | grep { /$RE_IDENTIFIER/o } # spent 49µs making 78 calls to Class::Inspector::CORE:match, avg 627ns/call
# spent 1µs making 1 call to Class::Inspector::CORE:regcomp |
| 433 | grep { defined &{"${namespace}::$_"} } | ||||
| 434 | 1 | 120µs | keys %{"${namespace}::"}; | ||
| 435 | 1 | 3µs | foreach ( @functions ) { | ||
| 436 | 78 | 30µs | $methods{$_} = $namespace; | ||
| 437 | } | ||||
| 438 | } | ||||
| 439 | |||||
| 440 | # Filter to public or private methods if needed | ||||
| 441 | 1 | 40µs | 1 | 23µs | my @methodlist = sort keys %methods; # spent 23µs making 1 call to Class::Inspector::CORE:sort |
| 442 | 1 | 300ns | @methodlist = grep { ! /^\_/ } @methodlist if $options{public}; | ||
| 443 | 1 | 100ns | @methodlist = grep { /^\_/ } @methodlist if $options{private}; | ||
| 444 | |||||
| 445 | # Return in the correct format | ||||
| 446 | 1 | 100ns | @methodlist = map { "$methods{$_}::$_" } @methodlist if $options{full}; | ||
| 447 | @methodlist = map { | ||||
| 448 | [ "$methods{$_}::$_", $methods{$_}, $_, \&{"$methods{$_}::$_"} ] | ||||
| 449 | 1 | 100ns | } @methodlist if $options{expanded}; | ||
| 450 | |||||
| 451 | 1 | 9µs | \@methodlist; | ||
| 452 | } | ||||
| 453 | |||||
| - - | |||||
| 458 | ##################################################################### | ||||
| 459 | # Search Methods | ||||
| 460 | |||||
| 461 | =pod | ||||
| 462 | |||||
| 463 | =head2 subclasses $class | ||||
| 464 | |||||
| 465 | The C<subclasses> static method will search then entire namespace (and thus | ||||
| 466 | B<all> currently loaded classes) to find all classes that are subclasses | ||||
| 467 | of the class provided as a the parameter. | ||||
| 468 | |||||
| 469 | The actual test will be done by calling C<isa> on the class as a static | ||||
| 470 | method. (i.e. C<My::Class-E<gt>isa($class)>. | ||||
| 471 | |||||
| 472 | Returns a reference to a list of the loaded classes that match the class | ||||
| 473 | provided, or false is none match, or C<undef> if the class name provided | ||||
| 474 | is invalid. | ||||
| 475 | |||||
| 476 | =cut | ||||
| 477 | |||||
| 478 | sub 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 | |||||
| 512 | sub _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 | ||||
| 535 | sub children { | ||||
| 536 | my $class = shift; | ||||
| 537 | my $name = $class->_class(shift) or return (); | ||||
| 538 | |||||
| 539 | # Find all the Foo:: elements in our symbol table | ||||
| 540 | 2 | 118µs | 2 | 40µs | # spent 26µs (11+14) within Class::Inspector::BEGIN@540 which was called:
# once (11µs+14µs) by DateTime::Format::Alami::new at line 540 # spent 26µs making 1 call to Class::Inspector::BEGIN@540
# spent 14µs making 1 call to strict::unimport |
| 541 | map { "${name}::$_" } sort grep { s/::$// } keys %{"${name}::"}; | ||||
| 542 | } | ||||
| 543 | |||||
| 544 | # As above, but recursively | ||||
| 545 | sub 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; | ||||
| 553 | 2 | 349µs | 2 | 31µs | # spent 20µs (9+11) within Class::Inspector::BEGIN@553 which was called:
# once (9µs+11µs) by DateTime::Format::Alami::new at line 553 # spent 20µs making 1 call to Class::Inspector::BEGIN@553
# spent 11µ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 | ||||
| 572 | sub _class { | ||||
| 573 | 2 | 400ns | my $class = shift; | ||
| 574 | 2 | 400ns | my $name = shift or return ''; | ||
| 575 | |||||
| 576 | # Handle main shorthand | ||||
| 577 | 2 | 700ns | return 'main' if $name eq '::'; | ||
| 578 | 2 | 9µs | 2 | 2µs | $name =~ s/\A::/main::/; # spent 2µs making 2 calls to Class::Inspector::CORE:subst, avg 800ns/call |
| 579 | |||||
| 580 | # Check the class name is valid | ||||
| 581 | 2 | 27µs | 3 | 10µs | $name =~ /$RE_CLASS/o ? $name : ''; # spent 8µs making 2 calls to Class::Inspector::CORE:match, avg 4µs/call
# spent 2µs making 1 call to Class::Inspector::CORE:regcomp |
| 582 | } | ||||
| 583 | |||||
| 584 | # Create a INC-specific filename, which always uses '/' | ||||
| 585 | # regardless of platform. | ||||
| 586 | sub _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 | ||||
| 593 | sub _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 | |||||
| 608 | 1 | 3µs | 1; | ||
| 609 | |||||
| 610 | =pod | ||||
| 611 | |||||
| 612 | =head1 SUPPORT | ||||
| 613 | |||||
| 614 | Bugs should be reported via the CPAN bug tracker | ||||
| 615 | |||||
| 616 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Inspector> | ||||
| 617 | |||||
| 618 | For other issues, or commercial enhancement or support, contact the author. | ||||
| 619 | |||||
| 620 | =head1 AUTHOR | ||||
| 621 | |||||
| 622 | Adam Kennedy E<lt>adamk@cpan.orgE<gt> | ||||
| 623 | |||||
| 624 | =head1 SEE ALSO | ||||
| 625 | |||||
| 626 | L<http://ali.as/>, L<Class::Handle> | ||||
| 627 | |||||
| 628 | =head1 COPYRIGHT | ||||
| 629 | |||||
| 630 | Copyright 2002 - 2012 Adam Kennedy. | ||||
| 631 | |||||
| 632 | This program is free software; you can redistribute | ||||
| 633 | it and/or modify it under the same terms as Perl itself. | ||||
| 634 | |||||
| 635 | The full text of the license can be found in the | ||||
| 636 | LICENSE file included with this module. | ||||
| 637 | |||||
| 638 | =cut | ||||
sub Class::Inspector::CORE:match; # opcode | |||||
sub Class::Inspector::CORE:qr; # opcode | |||||
sub Class::Inspector::CORE:regcomp; # opcode | |||||
# spent 23µs within Class::Inspector::CORE:sort which was called:
# once (23µs+0s) by Class::Inspector::methods at line 441 | |||||
# spent 2µs within Class::Inspector::CORE:subst which was called 2 times, avg 800ns/call:
# 2 times (2µs+0s) by Class::Inspector::_class at line 578, avg 800ns/call |