Perl: How to iterate through symbol table to find all loaded subclasses of Foo::Bar?
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!(?:E开发者_JS百科rror|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.
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};
}
}
}
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 :)
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!
精彩评论