Perl：如何迭代符号表以查找 Foo::Bar 的所有加载子类？

Question

我有一个模块，它正在为其所属的包定义异常。异常是用Exception::Class::Nested声明的。

为了便于讨论，我们假设该模块名为 Foo::Bar::Exception，并且它定义的所有异常都是该模块的第一级子类（例如，Foo::Bar::Exception:DoNotDoThat）。我关心的所有异常都在这个模块文件中定义；我对任何其他模块对我所做的任何额外子类化不感兴趣。

对于我的 import 方法，我想构建一个包含所有已定义异常的列表，并且我想通过以某种方式遍历符号表来实现这一点，而不是保留一个可以获取的硬编码列表与定义不同步，必须手动维护。

那么，Foo::Bar::Exception->import如何迭代Foo::Bar::Exception的符号表来查找所有异常（首先-级别子类）已在模块中声明？这只是我感兴趣的活动加载符号表；没有文件系统搜索等。

谢谢！

[附录]

由于我的所有异常子类名称都以 Exception 或 Error 结尾，这看起来越来越接近我想要的

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

：括号是不必要的，但我添加它是为了清楚地了解数组上下文。

Answer 1

Foo::Bar::Exception 的符号表是 %Foo::Bar::Exception::，所以你可以这样写：

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

Answer 2

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

MRO::Compat 启用 mro API 在 5.10 之前的 perls 上，否则不会有它（尽管 get_isarev在 5.10+ 上快得多），get_isarev 返回从指定类继承（直接或间接）的类，最终的 grep 是因为 get_isarev > 是一种启发式函数——它永远不会错过继承您指定的类，但面对运行时@ISA修改，它可能会报告实际上不再继承您的类的类。因此，->isa 检查可确保该类仍然存在并且仍然是一个子类。

编辑：刚刚注意到您只对命名空间下的包感兴趣，但我仍然认为使用 mro API 是查找它们的良好基础 - 只需添加还有 grep /^Foo::Bar::Exception::/ :)

Answer 3

由于继承问题（显然是由 Exception::Class 或 Exception::Class::Nested 引入的），我选择了纯符号表路线。

长名称（例如、Foo::Bar::Exception:DoNotDoThat）和短名称（DoNotDoThat）都是可导出的；默认情况下会导出长名称。 （不清楚这是否有必要，但似乎没有什么害处。）

如果短名被导出，这就会起作用：

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

这与@Eric的答案非常接近，但在我看到他的答案之前就得出了。

谢谢大家！