Perl:如何遍历符号表以查找Foo :: Bar的所有已加载子类?

时间:2011-03-07 00:59:41

标签: perl exception subclassing symbol-tables

我有一个模块,它定义了它所属的包的例外。使用Exception::Class::Nested声明例外情况。

出于讨论的目的,假设该模块名为Foo::Bar::Exception,并且它定义的所有异常都是它的第一级子类(例如,{{1} })。我关心的所有异常都在此模块文件中定义;我对任何其他模块的其他子类都不感兴趣。

对于我的Foo::Bar::Exception:DoNotDoThat方法,我想构建一个列出所有定义的异常,我想通过以某种方式遍历符号表而不是保留一个可以获得的硬编码列表来实现与定义不同步,必须手动维护。

那么,import如何遍历Foo::Bar::Exception->import的符号表来查找已在模块中声明的所有异常(第一级子类)?它只是我感兴趣的有效加载符号表;没有文件系统搜索等。

谢谢!

[附录

由于我的所有异常子类名都以Foo::Bar::ExceptionException结尾,这看起来似乎已接近我想要的内容:

Error

有些括号是不必要的,但为了清楚了解数组上下文,我添加了它。

3 个答案:

答案 0 :(得分: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};
        }
    }
}

答案 1 :(得分:1)

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

MRO::Compat在5.10之前的perls上启用mro API,否则将无法使用它(尽管get_isarev 在5.10+上更快, get_isarev返回从命名类继承(直接或间接)的类,而最终的grep是因为get_isarev是一种启发式函数 - 它永远不会错过 a继承了您指定的类的类,但面对运行时@ISA修改,它可能会报告实际不再继承您的类的类。所以->isa检查确保该类仍然存在并且仍然是子类。

编辑:刚刚注意到您只对名称空间下的软件包感兴趣的部分,但我仍然认为使用mro API是找到它们的良好基础 - 只是加上grep /^Foo::Bar::Exception::/:)

答案 2 :(得分:0)

由于继承问题(显然由Exception::ClassException::Class::Nested引入),我已经使用了纯符号表路径。

两个长名称(例如Foo::Bar::Exception:DoNotDoThat)和短名称(DoNotDoThat)都是可导出的;默认情况下会导出longnames。 (不清楚是否有必要,但似乎没有任何伤害。)

如果要导出短名称,可以解决这个问题:

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的答案非常接近,但是在我看到他之前得出了。

谢谢大家!