Given a base class and a list of classes derived from it:
package base
{
# ...
}
package foo
{
our #ISA = 'base';
# ...
}
package bar
{
our #ISA = 'base';
# ...
}
Is there a runtime way to get a list of classes which have base as parent?
I know I could easily work around this by adding their names to a list manually, but I was wondering if base itself could tell me who inherited from it.
Since Perl 5.10, Perl has come with a module called mro which includes a whole bunch of functions for inspecting class hierarchies.
You can find child classes of My::Class using:
use mro;
my $base_class = 'My::Class';
print "$_\n" for #{ mro::get_isarev( $base_class ) };
The mro documentation includes various caveats, such as the fact that calling it on the 'UNIVERSAL' package doesn't work properly. There will be other cases it copes badly with, but if you're "doing normal stuff", it should work.
If you don't know the names of all the "potential" classes, you can recursively iterate through the complete "namespace".
sub inspect {
my ($package, $search_for) = #_;
my #result;
my $keys = 'sort keys (%' . $package . '::)';
$package=~ s/main:://;
my #keys = eval $keys;
foreach my $lookup (#keys) {
$lookup =~ s/main:://;
if ($lookup =~ /(.*)::$/) {
push #result, inspect($package.'::'.$1, $search_for);
}
}
push #result, $package
if $package->isa($search_for);
return #result;
}
so in your example:
print "Number of derived classes: " . (inspect('main', 'base') -1) . "\n";
we have to extract one, as the class is an instance of its own.
AFAIK base doesn't store the "class-tree" anywhere.
Related
After realizing the sad state of code coverage on our unit tests at work I am trying to create a utility that will scan our code base and flag files that don't have 100%. I found two approaches that get all of the methods:
Access symbol table directly:
for my $classname ( #ARGV ) {
eval "require $classname";
die "Can't load $classname $EVAL_ERROR"
if $EVAL_ERROR;
no strict 'refs';
METHODS:
for my $sym ( keys %{ "${classname}::" } ) {
next METHODS unless defined &{"${classname}::${sym}"};
print "$sym\n";
}
}
Use the Class::Inspector module from CPAN:
for my $classname ( #ARGV ) {
my #methods = Class::Inspector->methods($classname, 'public');
print Dumper \#methods;
}
these two approaches produce similar results; The problem with these is that they show all of the methods available to the entire module, not just the methods defined inside of that module.
Is there some way to distinguish between methods accessible to a module and methods defined explicitly inside of a module?
Note: I am not attempting to create a full code coverage test, for my use case I just want to test that all of the methods have been called at least once. Complete coverage tests like Devel::Cover are overkill for us.
Each sub (or more specifically, each CV), remembers which package it was originally declared in. Test case:
Foo.pm:
package Foo;
sub import {
*{caller . "::foo"} = sub{};
}
1;
Bar.pm:
package Bar;
use Foo;
our $bar; # introduces *Bar::bar which does not have a CODE slot
sub baz {}
1;
Accessing the symbol table now gives both foo and baz. By the way, I'd write that code like this (for reasons that will become clear in a moment):
my $classname = 'Bar';
for my $glob (values %{ "${classname}::" }) {
my $sub = *$glob{CODE} or next;
say *$glob{NAME};
}
Next, we have to look into the B module to introspect the underlying C data structure. We do this with the B::svref_2object function. This will produce a B::CV object which has the convenient STASH field (which returns a B::HV object which has a NAME field):
use B ();
my $classname = 'Bar';
for my $glob (values %{ "${classname}::" }) {
my $sub = *$glob{CODE} or next;
my $cv = B::svref_2object($sub);
$cv->STASH->NAME eq $classname or next;
say *$glob{NAME};
}
Add a few sanity checks, and this should work quite well.
Dynamic class/module loading should not be done via string eval. Instead I recommend Module::Runtime:
Module::Runtime::require_module($classname);
Is it possible to get all valid methods for a particular Perl class?
I am trying to manipulate the symbol table of a class and get all of its methods. I found I can separate out the subroutines from the non-subroutines via the $obj->can($method), but that doesn't do exactly what I think it does.
The following returns:
subroutine, Property, croak, Group, confess, carp, File
However, subroutine isn't a method, (just a subroutine), and croak, confess, and carp were all imported into my package.
What I really want to print out is:
Property,Group, File
But I'll take:
subroutine, Property,Group, File
Below is my program:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my $sections = Section_group->new;
say join ", ", $sections->Sections;
package Section_group;
use Carp;
sub new {
return bless {}, shift;
}
sub Add {
my $self = shift;
my $section = shift;
}
sub Sections {
my $self = shift;
my #sections;
for my $symbol ( keys %Section_group:: ) {
next if $symbol eq "new"; # This is a constructor
next if $symbol eq "Add"; # Not interested in this method
next if $symbol eq "Sections"; # This is it's own method
push #sections, $symbol if $self->can($symbol);
}
return wantarray ? #sections : \#sections;
}
sub subroutine {
my $param1 = shift;
my $param2 = shift;
}
sub Group {
my $self = shift;
my $section = shift;
}
sub File {
my $self = shift;
my $section = shift;
}
sub Property {
my $self = shift;
my $section = shift;
}
This is fairly trivial. We only want to keep those sub names that were originally defined in our package. Every CV (code value) has a pointer to the package where it was defined. Thanks to B, we can examine that:
use B ();
...
if (my $coderef = $self->can($symbol)) {
my $cv = B::svref_2object $coderef;
push #sections, $symbol if $cv->STASH->NAME eq __PACKAGE__;
}
# Output as wanted
That is, we perform introspection using svref_2object. This returns a Perl object representing an internal perl data structure.
If we look into a coderef, we get a B::CV object, which represents the internal CV. The STASH field in a CV points to the Stash where it was defined. As you know, a Stash is just a special hash (internally represented as a HV), so $cv->STASH returns a B::HV. The NAME field of a HV contains the fully qualified package name of the Stash if the HV is a Stash, and not a regular hash.
Now we have all the info we need, and can compare the wanted package name to the name of the stash of the coderef.
Of course, this is simplified, and you will want to recurse through #ISA for general classes.
Nobody likes polluted namespaces. Thankfully, there are modules that remove foreign symbols from the Stash, e.g. namespace::clean. This is no problem when the CVs of all subs you are calling are known at compile time.
What are you trying to do? Why does it matter how a class defined or implements a method it responds to?
Perl is a dynamic language, so that means that methods don't have to exist at all. With AUTOLOAD, a method might be perfectly fine and callable, but never show up in the symbol table. A good interface would make can work in those cases, but there might be cases where a class or an object decides to respond to that with false.
The Package::Stash module can help you find defined subroutines in a particular namespace, but as you say, they might not be defined in the same file. The methods in a class might come from an inherited class. If you care about where they come from, you're probably doing it wrong.
Is this possible using Perl:
my #array = ($class1,$class2,$class3);
foreach my $c (#array)
{
my $temp = $c->new();
$temp->run($var1,$var2);
}
The idea behind this is that the array will always contain different class names. I would then like to create an object of that class and run a method from it. Each class is somewhat similar but contains its own logic in the run method?
If this is not possible, is there a different way i could do this?
Is this bad programming?
You need to make sure that the run-Method is always accessible:
my #array = ($class1,$class2,$class3);
foreach my $class (#array) {
my $temp = $class->new();
if ($temp->can('run') {
$temp->run($var1,$var2);
} else {
...
}
}
What makes a class in perl is the bless statement. You bless a reference with a name of a class, and wham!, it's that class. Nothing too special about it.
Of course, you could end up with a class with no methods which might be a bit of a problem. However, I do this for subclasses where subclasses share a common parent class, but the type of the class changes the behavior of the class:
Package Main_class;
use Carp;
sub new {
my $class = shift; #We'll ignore this one
my $subclass = shift; #This is my actual class
my $self = {};
my $class .= "::$subclass";
bless $self, $class; #Now, it's my class!
if ( not $self->isa($class) ) {
croak qw(Subclass "$subclass" is an invalid subclass);
}
return $self;
}
In my program, I'll do this:
my $object = Main_class->new($subclass);
And, if I don't want my program to die...
my $object;
eval {
$object = Main_class->new($subclass);
}
if ( $# ) {
Here be dragons.... #What do you do if that object creation failed...
}
Here's an example of a program where I do this.
Here I'm reading in a file of questions and their types. I read in the macro name, and the type of question it is. I then use my parent class to create the object, but I bless it with the correct subclass. What is important is to use the isa universal method available to all classes. I test whether the object I created is actually a subclass to my class.
Previous answers cover what you are looking for, but I would probably add that Module::Runtime can be helpful if you'd rather not need to explicitly use()/require() each class' package when doing this sort of thing:
use Module::Runtime;
for my $cls (#classes) {
my $obj = use_module($cls)->new;
...
}
use strict;
use warnings;
use class1;
use class2;
use class3;
my #array = qw(class1 class2 class3);
foreach my $c (#array)
{
my ($var1, $var2) = (12,34);
my $temp = eval { $c->new };
$temp->run($var1,$var2);
}
untested but this is the sort of things you should be investigating. You do need to 'use' any class you are using and always use strict to save yourself hours future problems
I have a class called Question, and a bunch of sub-classes depending on the type of question. I can create objects against the sub-classes, but I shouldn't be able to create an object of class Question itself:
#! /usr/bin/env perl
use strict;
use warnings;
#
# LOAD IN YOUR QUESTIONS HERE
#
my #list_of_questions;
for my $question_type qw(Science Math English Dumb) {
my $class = "Question::$question_type";
my $question = $class->new;
push #list_of_questions, $question;
}
package Question;
use Carp;
sub new {
my $class = shift;
my $self = {};
if ( $class = eq "Question" ) {
carp qq(Need to make object a sub-class of "Question");
return;
}
bless $self, $class;
return $self;
}
yadda, yadda, yadda...
package Question::Math;
use parent qw(Question);
yadda, yadda, yadda...
package Question::Science;
use parent qw(Question);
yadda, yadda, yadda...
package Question::English;
use parent qw(Question);
yadda, yadda, yadda...
Notice these are not modules, but merely classes I've defined to be used in my program. Thus, I can't test module loading at runtime.
When I run the above, I get:
Can't locate object method "new" via package "Question::Dumb" (perhaps you forgot to load "Question::Dumb"?)
Is there any way to catch for this particular error, so I can handle it myself? I know I could create an array of valid types, but I was hoping someway of being able to add new question type without having to remember to update my array.
AFAICT what you want to do is check the symbol table to see if your "class" (aka "package") has been defined or not. Doing it manually is no hardship, but Class::Load provides slightly more readable sugar and applies "heuristics" - whatever that means. If you don't want to use this module then the source code for is_class_loaded will lead you to whatever answer you're actually seeking.
use Class::Load qw(is_class_loaded);
for my $question_type (qw(Math English Science Dumb)) {
my $class = "Question::$question_type";
if(!is_class_loaded($class)) {
# construct your new package at runtime, then
}
new_question($class);
}
Your variable name ("class_type") was weird, so I fixed it. I also don't know whether Module::Load is better, but we use Class::Load for this at work.
Edit: bare qw()s are deprecated in one of the newer Perls (5.14?). It's a stupid deprecation, but it's there, so we all have to learn to wrap our qw() foreachs in parens now.
You can't have an expression like Invalid::Class->new() not throw an exception in the calling code, but you can wrap it in exception handling and wrap that inside a method. The standard pattern is to supply a 'type' argument describing the subclass you which to create to a factory method. A common anti-pattern is to put that factory method on the base class, creating a circular dependency and having to do more work than should be required.
It is usual to have the factory method on the interface class and to have it construct sub-classes of an unrelated, dedicated base class, possibly warning or throwing when it fails. In code, that looks pretty much like so:
package Question;
use Try::Tiny;
use Carp qw/carp/;
sub new {
my ($class, $type, #args) = #_;
# could do some munging on $type to make it a class name here
my $real_class = "Question::$type";
return try {
$real_class->new(#args);
} catch {
# could differentiate exception types here
carp qq(Invalid Question type "$type");
};
}
package Question::Base;
sub new {
my ($class) = #_;
return bless {} => $class;
}
package Question::Math;
use base 'Question::Base'; # `use parent` expects to load a module
package main;
use Test::More tests => 2;
use Test::Warn;
isa_ok(Question->new('Math'), 'Question::Math');
warning_like(
sub { Question->new('Dumb') }, # I hear there's no such thing
qr/^Invalid Question/
);
Here's what I finally did:
package Question;
use Carp;
sub new {
my $class = shift;
my %params = #_;
#
# Standardize the Parameters
# Remove the dash, double-dash in front of the parameter and
# lowercase the name. Thus, -Question, --question, and question
# are all the same parameter.
#
my %option_hash;
my $question_type;
for my $key (keys %params) {
my $value = $params{$key};
$key =~ s/^-*//; #Remove leading dashes
$key = ucfirst ( lc $key ); #Make Key look like Method Name
if ( $key eq "Type" ) {
$question_type = ucfirst (lc $value);
}
else {
$option_hash{$key} = $value;
}
}
if ( not defined $question_type ) {
carp qq(Parameter "type" required for creating a new question.);
return;
}
#
# The real "class" of this question includes the question type
#
my $self = {};
$class .= "::$question_type";
bless $self, $class;
#
# All _real does is return a _true_ value. This method is in this
# class, so all sub-classes automatically inherit it. If the eval
# fails, this isn't a subclass, or someone wrote their own `_real_
# method in their sub-class.
#
eval { $self->_real; };
if ( $# ) {
carp qq(Invalid question type of $question_type);
return;
}
#
# Everything looks good! Let's fill up our question object
#
for my $method ( keys %option_hash ) {
my $method_set;
eval { $method_set = $self->$method( $option_hash{$method} ) };
if ( $# or not $method_set ) {
carp qq(Can't set "$method" for question type "$question_type");
return;
}
}
return $self;
}
Now, I'm setting my question like this:
my $question = Question->new(
--type => Integer,
--question => "Pick a number between 1 and 10.",
--help => "Try using the top row of your keyboard...",
--from => "1",
--to => "10",
);
if ( not defined $question ) {
die qq(The question is invalid!);
}
Darch use of the Try::Tiny is nice. It looks way better than wrapping everything in an eval. Unfortunately, it's not a standard module. This program is going on almost 100 separate systems, and using CPAN modules is too difficult. This is especially true since these systems are behind a firewall and can't access the CPAN website.
I basically use Darch's method except I create a _real method in my super-class that I try after I bless the object. If it executes (that's all I really care), then this is a sub-class of my super-class.
This does what I really want: Hide my sub-classes behind my superclass -- much like File::Spec does. Most of my classes have the same methods, and a few have one or two extra methods. For example, my Regex question type has a Pattern method that allows me to make sure the answer given matches a given pattern.
How do you loop over all the methods of a class in Perl? Are there any good online references to Perl introspection or reflection?
The recommendation Todd Gardner gave to use Moose is a good one, but the example code he chose isn't very helpful.
If you're inspecting a non-Moose using class, you'd do something like this:
use Some::Class;
use Class::MOP;
my $meta = Class::MOP::Class->initialize('Some::Class');
for my $meth ( $meta->get_all_methods ) {
print $meth->fully_qualified_name, "\n";
}
See the Class::MOP::Class docs for more details on how to do introspection.
You'll also note that I used Class::MOP instead of Moose. Class::MOP (MOP = Meta-Object Protocol) is the base on which Moose builds. If you're working with non-Moose classes, using Moose to introspect doesn't gain you anything.
If you wanted, you could use Moose () and Moose::Meta::Class->initialize instead of CMOP.
You can easily get a list of the defined methods of a class using the answers already provided. However, Perl is a dynamic language, which means more methods may be defined later. There really isn't a way to get a list of all of the methods to which any particular class will handle. For a lot more detail on this sort of stuff, I have a few chapters in Mastering Perl.
People are giving you (and upvoting) answers without telling you about the limitations.
Adam mentions his Class::Inspector, but it doesn't really work because it's trying to do something a dynamic language doesn't do (and that's be static :) For instance, here's a snippet where Class::Inspector returns no methods, but I can still call the VERSION method (as well as isa and can):
BEGIN {
package Foo;
our $VERSION = '1.23'
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports nothing
print Foo->VERSION, "\n";
Here's another case where I can call any method I like, but Class::Inspector only returns AUTOLOAD (and still missing VERSION, isa, and can):
BEGIN {
package Foo;
our $VERSION = '1.23';
my $object = bless {}, __PACKAGE__;
sub AUTOLOAD { $object }
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports only "AUTOLOAD"
print Foo->dog->cat->bird, "\n";
Curiously, everyone seems to ignore UNIVERSAL, probably because they don't explicitly handle it since it's only virtually in #ISA. I can add a debug method to every class, and Class::Inspector still misses it even though it's a defined method:
BEGIN {
sub UNIVERSAL::debug { "Hello debugger!\n" }
package Foo;
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # still reports nothing
print Foo->debug, "\n";
Class::MOP has the same limitations.
Not every module is going to use AUTOLOAD, but it's not an obscure or rare feature either. If you don't mind that you are going to miss some of the methods then Class::Inspector or Class::MOP might be okay. It's just not going to give you a list of every method you can call on a class or an object in every case.
If you have a class or an object and you want to know if you can call a particular method, use can(). Wrap it in an eval block so can can call can() on things that aren't even objects to still get back false, instead of death, in those cases:
if( eval { $object->can( 'method_name' ) } )
{
$object->( #args );
}
In the general case, you'll have to inspect the symbol table (unless you use Moose). For example, to list the methods defined in the IO::File package:
use IO::File;
no strict 'refs';
print join ', ', grep { defined &{"IO::File::$_"} } keys %{IO::File::};
The hash %{IO::File::} is the symbol table of the IO::File package, and the grep filters out non-subroutine entries (e.g. package variables).
To extend this to include inherited methods, you have to recursively search the symbol tables of the parent classes (#IO::File::ISA).
Here is a complete example:
sub list_methods_for_class {
my $class = shift;
eval "require $class";
no strict 'refs';
my #methods = grep { defined &{$class . "::$_"} } keys %{$class . "::"};
push #methods, list_methods_for_class($_) foreach #{$class . "::ISA"};
return #methods;
}
For more info on packages and symbol tables, see the perlmod man page.
Depends if you mean, any class, or if you were implementing your own. For the latter, I use Moose, which offers a very clean syntax for these features. From the cookbook:
my %attributes = %{ $self->meta->get_attribute_map };
for my $name ( sort keys %attributes ) {
my $attribute = $attributes{$name};
if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled')
# ... keeps on
You probably want Class::Inspector->methods('Your::Class').
Nuff said.
I'll just leave this here for when I forget it. This is extremely powerful; too bad it is so out of the way that most Perl programmers never get to experience it.
package Foo;
use strict;
sub foo1 {};
sub foo2 {};
our $foo3 = sub{};
my $foo4 = "hello, world!";
package Bar;
use strict;
# woo, we're javascript!
(sub {
*Bar::foo1 = sub { print "hi!"; };
*Bar::foo2 = sub { print "hello!"; };
$Bar::foo1 = 200;
})->();
package main;
use strict;
use Data::Dumper;
$Data::Dumper::Deparse = 1;
print Dumper \%Data::Dumper::;
print Dumper \%Foo::;
print Dumper \%Bar::;