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 42use 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. 45use strict qw{vars subs}; 46use File::Spec (); 47 48# Globals 49use vars qw{$VERSION $RE_IDENT $RE_CLASS $UNIX}; 50BEGIN { 51 $VERSION = '1.16'; 52 53 # Predefine some regexs 54 $RE_IDENT = qr/\A[^\W\d]\w*\z/s; 55 $RE_CLASS = qr/\A[^\W\d]\w*(?:(?:'|::)[^\W\d]\w*)*\z/s; 56 57 # Are we on something Unix-like? 58 $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' ); 59} 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 81sub installed { 82 my $class = shift; 83 !! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0])); 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 105sub loaded { 106 my $class = shift; 107 my $name = $class->_class(shift) or return undef; 108 $class->_loaded($name); 109} 110 111sub _loaded { 112 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}::"} ) { 121 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); 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 177sub resolved_filename { 178 my $class = shift; 179 my $filename = $class->_inc_filename(shift) or return undef; 180 my @try_first = @_; 181 182 # Look through the @INC path to find the file 183 foreach ( @try_first, @INC ) { 184 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 206sub loaded_filename { 207 my $class = shift; 208 my $filename = $class->_inc_filename(shift); 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 529 no strict 'refs'; 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; 542 no strict 'refs'; 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 561sub _class { 562 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. 575sub _inc_filename { 576 my $class = shift; 577 my $name = $class->_class(shift) or return undef; 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 5951; 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>cpan@ali.asE<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. All rights reserved. 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 630