Perl: How to iterate through symbol table to find all loaded subclasses of Foo::Bar?

Question

I have a module which is defining exceptions for the package of which it is a part. The exceptions are being declared with Exception::Class::Nested.

For purposes of discussion, let's say that this module is named Foo::Bar::Exception, and that all of the exceptions it defines are first-level subclasses of that (e.g., Foo::Bar::Exception:DoNotDoThat). All of the exceptions I care about are defined in this module file; I'm not interested in any additional subclassing any other module does of me.

For my import method, I want to construct a list of all the exceptions being defined, and I'd like to do it by traversing the symbol table somehow rather than keeping a hard-coded list that can get out of sync with the definitions and has to be manually maintained.

So, how can Foo::Bar::Exception->import iterate through Foo::Bar::Exception's symbol table to find all the exceptions (first-level subclasses) that have been declared in the module? It's just the active loaded symbol table I'm interested in; no filesystem searches or the like.

Thanks!

[addendum]

Since all of my exception subclass names end with Exception or Error, this looks like it's getting close to what I want:

my %symtable = eval("'%' . __PACKAGE__ . '::'");
my @shortnames = grep(m!(?:Error|Exception)::$!, keys(%symtable));
@shortnames = ( map { $_ =~ s/::$//; $_; } @shortnames );
my @longnames = ( map { __PACKAGE__ . '::' . $_ } @shortnames );

Some of the parenthesisation is unnecessary, but I added it for clarity about the array context.

Eric Strom · Accepted Answer · 2011-03-07T01:54:12.243

1

The symbol table for Foo::Bar::Exception is %Foo::Bar::Exception::, so you could write:

sub import {
    for my $key (keys %Foo::Bar::Exception::) {
        if (my ($name) = $key =~ /(.+)::$/) {
           my $pkg = 'Foo::Bar::Exception::'.$name;
           no strict 'refs';
           *{caller()."::$name"} = sub () {$pkg};
        }
    }
}

edited Mar 07 '11 at 01:54

answered Mar 07 '11 at 01:46

Eric Strom

39,821
2
80
152

hobbs · Answer 2 · 2011-03-07T04:18:54.387

1

use MRO::Compat;
my @classes = @{ mro::get_isarev("Foo::Bar::Exception") };
@classes = grep $_->isa("Foo::Bar::Exception"), @classes;

MRO::Compat enables the mro API on pre-5.10 perls that otherwise wouldn't have it (although get_isarev is much faster on 5.10+), get_isarev returns classes that inherit (directly or indirectly) from the named class, and the final grep is because get_isarev is a heuristic sort of function -- it will never miss a class that does inherit the one you specified, but in the face of runtime @ISA modification it might report a class that actually doesn't inherit your class anymore. So the ->isa check makes sure that the class is still there and still a subclass.

Edit: just noticed the part where you're only interested in packages that are under the namespace as well, but I still think that using the mro API is a good foundation for finding them -- just tack on a grep /^Foo::Bar::Exception::/ as well :)

edited Mar 07 '11 at 04:18

answered Mar 07 '11 at 02:23

hobbs

223,387
19
210
288

I get a `Can't call method "isa" on unblessed reference` on the `grep`, so something in `@classes` is unblessed. This is Perl v5.10.1. Just checked: `@classes` is getting set to an empty arrayref, `[]`. – RoUS Mar 07 '11 at 03:17
Oops. missing dereference. Edited. But if it's empty then your inheritance isn't set up properly. – hobbs Mar 07 '11 at 04:19
The inheritance *should* be getting set up by `Exception::Class` or `Exception::Class::Nested`, since they're what are actually creating the packages/classes. – RoUS Mar 09 '11 at 21:16

score 0 · Answer 3 · answered Mar 09 '11 at 21:14

Due to the inheritance issues (apparently introduced by Exception::Class or Exception::Class::Nested), I've gone with the pure symbol-table route.

Both the longnames (e.g., Foo::Bar::Exception:DoNotDoThat) and the shortnames (DoNotDoThat) are exportable; the longnames are exported by default. (Unclear if that's necessary, but it seems to do no harm.)

If the shortnames are being exported, this does the trick:

my $caller = caller();
$caller ||= 'main';
my @snames = @{$EXPORT_TAGS{shortnames}};
for my $short (@snames) {
    my $exc = __PACKAGE__ . '::' . $short;
    no strict 'refs';
    *{"$caller\::$short"} = sub () { $exc };
}

which is quite close to @Eric's answer, but derived before I saw his.

Thanks, everyone!

Perl: How to iterate through symbol table to find all loaded subclasses of Foo::Bar?

3 Answers3