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