Get list of methods/functions defined explicitly in a module - perl

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);

Related

Get a list of classes derived from given base class in Perl

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.

Perl Import Package in different Namespace

is it possible to import (use) a perl module within a different namespace?
Let's say I have a Module A (XS Module with no methods Exported #EXPORT is empty) and I have no way of changing the module.
This Module has a Method A::open
currently I can use that Module in my main program (package main) by calling A::open I would like to have that module inside my package main so that I can directly call open
I tried to manually push every key of %A:: into %main:: however that did not work as expected.
The only way that I know to achieve what I want is by using package A; inside my main program, effectively changing the package of my program from main to A.
Im not satisfied with this. I would really like to keep my program inside package main.
Is there any way to achieve this and still keep my program in package main?
Offtopic: Yes I know usually you would not want to import everything into your namespace but this module is used by us extensively and we don't want to type A:: (well the actual module name is way longer which isn't making the situation better)in front of hundreds or thousands of calls
This is one of those "impossible" situations, where the clear solution -- to rework that module -- is off limits.
But, you can alias that package's subs names, from its symbol table, to the same names in main. Worse than being rude, this comes with a glitch: it catches all names that that package itself imported in any way. However, since this package is a fixed quantity it stands to reason that you can establish that list (and even hard-code it). It is just this one time, right?
main
use warnings;
use strict;
use feature 'say';
use OffLimits;
GET_SUBS: {
# The list of names to be excluded
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
my #subs = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#subs) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
my $name = name('name() called from ' . __PACKAGE__);
my $id = id('id() called from ' . __PACKAGE__);
say "name() returned: $name";
say "id() returned: $id";
with OffLimits.pm
package OffLimits;
use warnings;
use strict;
sub name { return "In " . __PACKAGE__ . ": #_" }
sub id { return "In " . __PACKAGE__ . ": #_" }
1;
It prints
name() returned: In OffLimits: name() called from main
id() returned: In OffLimits: id() called from main
You may need that code in a BEGIN block, depending on other details.
Another option is of course to hard-code the subs to be "exported" (in #subs). Given that the module seems to be immutable in practice this option is reasonable and more reliable.
This can also be wrapped in a module, so that you have the normal, selective, importing.
WrapOffLimits.pm
package WrapOffLimits;
use warnings;
use strict;
use OffLimits;
use Exporter qw(import);
our #sub_names;
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
BEGIN {
# Or supply a hard-coded list of all module's subs in #sub_names
my $re_exclude = qr/^(?:BEGIN|import)$/; # ...
#sub_names = grep { !/$re_exclude/ } sort keys %OffLimits::;
no strict 'refs';
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ 'OffLimits::' . $sub_name };
}
};
1;
and now in the caller you can import either only some subs
use WrapOffLimits qw(name);
or all
use WrapOffLimits qw(:all);
with otherwise the same main as above for a test.
The module name is hard-coded, which should be OK as this is meant only for that module.
The following is added mostly for completeness.
One can pass the module name to the wrapper by writing one's own import sub, which is what gets used then. The import list can be passed as well, at the expense of an awkward interface of the use statement.
It goes along the lines of
package WrapModule;
use warnings;
use strict;
use OffLimits;
use Exporter qw(); # will need our own import
our ($mod_name, #sub_names);
our #EXPORT_OK = #sub_names;
our %EXPORT_TAGS = (all => \#sub_names);
sub import {
my $mod_name = splice #_, 1, 1; # remove mod name from #_ for goto
my $re_exclude = qr/^(?:BEGIN|import)$/; # etc
no strict 'refs';
#sub_names = grep { !/$re_exclude/ } sort keys %{ $mod_name . '::'};
for my $sub_name (#sub_names) {
*{ $sub_name } = \&{ $mod_name . '::' . $sub_name };
}
push #EXPORT_OK, #sub_names;
goto &Exporter::import;
}
1;
what can be used as
use WrapModule qw(OffLimits name id); # or (OffLimits :all)
or, with the list broken-up so to remind the user of the unusual interface
use WrapModule 'OffLimits', qw(name id);
When used with the main above this prints the same output.
The use statement ends up using the import sub defined in the module, which exports symbols by writing to the caller's symbol table. (If no import sub is written then the Exporter's import method is nicely used, which is how this is normally done.)
This way we are able to unpack the arguments and have the module name supplied at use invocation. With the import list supplied as well now we have to push manually to #EXPORT_OK since this can't be in the BEGIN phase. In the end the sub is replaced by Exporter::import via the (good form of) goto, to complete the job.
You can forcibly "import" a function into main using glob assignment to alias the subroutine (and you want to do it in BEGIN so it happens at compile time, before calls to that subroutine are parsed later in the file):
use strict;
use warnings;
use Other::Module;
BEGIN { *open = \&Other::Module::open }
However, another problem you might have here is that open is a builtin function, which may cause some problems. You can add use subs 'open'; to indicate that you want to override the built-in function in this case, since you aren't using an actual import function to do so.
Here is what I now came up with. Yes this is hacky and yes I also feel like I opened pandoras box with this. However at least a small dummy program ran perfectly fine.
I renamed the module in my code again. In my original post I used the example A::open actually this module does not contain any method/variable reserved by the perl core. This is why I blindly import everything here.
BEGIN {
# using the caller to determine the parent. Usually this is main but maybe we want it somewhere else in some cases
my ($parent_package) = caller;
package A;
foreach (keys(%A::)) {
if (defined $$_) {
eval '*'.$parent_package.'::'.$_.' = \$A::'.$_;
}
elsif (%$_) {
eval '*'.$parent_package.'::'.$_.' = \%A::'.$_;
}
elsif (#$_) {
eval '*'.$parent_package.'::'.$_.' = \#A::'.$_;
}
else {
eval '*'.$parent_package.'::'.$_.' = \&A::'.$_;
}
}
}

Is it possible to get all valid methods for a particular Perl class?

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.

How does an object access the symbol table for the current package?

How could I access the symbol table for the current package an object was instantiated in? For example, I have something like this:
my $object = MyModule->new;
# this looks in the current package, to see if there's a function named run_me
# I'd like to know how to do this without passing a sub reference
$object->do_your_job;
If in the implementation of do_your_job I use __PACKAGE__, it will search in the MyModule package. How could I make it look in the right package?
EDIT:I'll try to make this clearer. Suppose I have the following code:
package MyMod;
sub new {
return bless {},$_[0]
}
sub do_your_job {
my $self = shift;
# of course find_package_of is fictional here
# just for this example's sake, $pkg should be main
my $pkg = find_package_of($self);
if(defined &{ $pkg . '::run_me' }) {
# the function exists, call it.
}
}
package main;
sub run_me {
print "x should run me.\n";
}
my $x = MyMod->new;
# this should find the run_me sub in the current package and invoke it.
$x->do_your_job;
Now, $x should somehow notice that main is the current package, and search it's symbol table. I tried using Scalar::Util's blessed , but it still gave me MyModule instead of main. Hopefully, this is a bit clearer now.
You just want caller
caller tells you the package from which it was called. (Here I added some standard perl.)
use Symbol qw<qualify_to_ref>;
#...
my $pkg = caller;
my $symb = qualify_to_ref( 'run_me', $pkg );
my $run_me = *{$symb}{CODE};
$run_me->() if defined $run_me;
To look it up and see if it's defined and then look it up to call it would duplicate it as standard perl doesn't do Common Subexpression Elimination, so you might as well 1) retrieve it, and 2) check definedness of the slot, and 3) run it if it is defined.
Now if you create an object in one package and use it in another, that's not going to be too much help. You would probably need to add an additional field like 'owning_package' in the constructor.
package MyMod;
#...
sub new {
#...
$self->{owning_package} = caller || 'main';
#...
}
Now $x->{owning_package} will contain 'main'.
See perldoc -f caller:
#!/usr/bin/perl
package A;
use strict; use warnings;
sub do_your_job {
my ($self) = #_;
my ($pkg) = caller;
if ( my $sub = $pkg->can('run_me') ) {
$sub->();
}
}
package B;
use strict; use warnings;
sub test {
A->do_your_job;
}
sub run_me {
print "No, you can't!\n";
}
package main;
use strict; use warnings;
B->test;
Output:
C:\Temp> h
No, you can't!

How do I loop over all the methods of a class in Perl?

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::;