在 Moose 中，我如何判断一个对象的类是否是另一个对象的类的子类？答案

【问题标题】：In Moose, how can I tell whether one object's class is a subclass of another object's class?在 Moose 中，我如何判断一个对象的类是否是另一个对象的类的子类？
【发布时间】：2011-04-25 17:09:40
【问题描述】：

假设我有两个对象 $obj1 和 $obj2 都是 Moose 类的实例。我想知道以下哪一项适用：

$obj1的类与$obj2的类相同；
$obj1 的类是$obj2 的子类；
$obj1 的类是$obj2 的超类；
两个对象的类都不是另一个对象的子类。

我该怎么做？

【问题讨论】：

标签： perl inheritance introspection moose

【解决方案1】：

$obj1 的类与$obj2 的类相同吗？
```
ref $obj1 eq ref $obj2;
```
$obj1 的类是 $obj2 的子类吗？
```
$obj1->isa(ref $obj2);
```
$obj1 的类是 $obj2 的超类吗？
```
$obj2->isa(ref $obj1);
```
两个对象的类都不是另一个对象的子类。

见上文。

更新：

响应 cmets 关于在运行时应用的角色：

package My::X;

use Moose; use namespace::autoclean;

sub boo { }

__PACKAGE__->meta->make_immutable;

package My::Y;

use Moose; use namespace::autoclean;

extends 'My::X';

__PACKAGE__->meta->make_immutable;

package My::Z;

use Moose::Role; use namespace::autoclean;

requires 'boo';

package main;

use Test::More tests => 2;

use Moose::Util qw( apply_all_roles );

my $x = My::X->new;
my $y = My::Y->new;

ok($y->isa(ref $x), 'Before role was applied at runtime');

apply_all_roles($x, 'My::Z');

ok($y->isa(ref $x), 'After role was applied at runtime');

输出：

1..2
ok 1 - 在运行时应用角色之前
不行 2 - 在运行时应用角色之后
# 在 C:\Temp\t.pl 第 36 行测试“在运行时应用角色后”失败。
# 看起来你在 2 中的 1 次测试中失败了。

【讨论】：

在 Moose 中，您可以为单个对象添加角色或特征吗？如果您正在寻找等效行为，这是这种想法出错的领域之一。
实际上，我打算使用这个逻辑来使 $obj1 和 $obj2 可合并，即使在某些情况下其中一个是另一个的子类。所以我需要决定使用哪个类的合并代码。（也就是说，如果我打电话给$obj1->merge_with($obj2)，如果有必要，电话会倒转成$obj2->merge_with($obj1)。）
@brian 你可以，但它不会导致这些 sn-ps 给出错误的答案，至少在纯粹的 Liskov 可替代性意义上（例如：如果 Subclass 继承自 Base，$a 是一个实例Base+Role （在运行时应用于 $a），并且 $b 是 Subclass 的一个实例，它会说 $b 的类不是 $a 类的子类——但在非常有用的意义上这是真的。）
@hobbs：你确定吗？我认为->isa 测试将通过，即使基类具有子类没有的角色（这将违反 Liskov）。

【解决方案2】：

使用Moose 中的Class::MOP 基础，您可以内省所有这些信息。

例如：

{
    package Daddy;
    use Moose;
}

{
    package Kid;
    use Moose;
    extends 'Daddy';
}

my $son      = Kid->new;
my $daughter = Kid->new;

my $sons_class                  = ($son->meta->class_precedence_list)[0];
my $daughters_class             = ($daughter->meta->class_precedence_list)[0];

my @sons_subclasses             = $son->meta->subclasses;     # or better...
my @daughters_subclasses        = $daughter->meta->direct_subclasses;

my @sons_superclasses           = $son->meta->superclasses;

my @Daddies_children            = Daddy->meta->direct_subclasses;

另请参阅此 SO 问题/答案How can I find all the packages that inherit from a package in Perl?

/I3az/

【讨论】：

如果您使用 Moose，向 Moose 询问答案可能是正确的方法。 :)