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

我有一个模块，它为它所属的包定义异常。使用

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

---

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

用于

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

在5.10之前版本的perls上启用API，否则将无法使用该API（尽管

get_isarev

在5.10+上的速度要快得多，

get_isarev

返回从命名类继承（直接或间接）的类，最后一个grep是因为

get_isarev

是一个启发式函数——它永远不会错过继承您指定的类的类，但是在运行时

@ISA

修改时，它可能会报告一个实际上不再继承您的类的类。因此，

->isa

检查确保类仍然存在，并且仍然是一个子类

---

编辑：只注意到你只对名字空间下的包感兴趣的部分，但我仍然认为使用MRO API是找到它们的一个很好的基础——仅仅是在一个<代码> GRP/^ Fo::Bar：：异常：//< >代码>：

< P>由于继承问题（显然是由

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的答案非常接近，但在我看到他的答案之前就推导出来了

---

谢谢大家！

我在

grep

上得到了一个

无法调用未删节引用的方法“isa”

，所以

@classes

中的某些内容是未删节的。这是Perl v5.10.1。刚刚检查：

@classes

正在设置为空arrayref，

[]

.Oops.缺少取消引用。已编辑。但如果为空，则继承设置不正确。继承应通过

Exception:：Class

或

Exception:：Class:：Nested

进行设置，因为它们是实际创建包/类的对象。

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