В Moose, как я могу сказать, является ли класс одного объекта подклассом класса другого объекта?

Question

Предположим, у меня есть два объекта $obj1 и $obj2, которые оба являются экземплярами классов Moose. Я хочу выяснить, что из следующего применимо:

• $obj1 совпадает с классом $obj2;
• $obj1 является подклассом $obj2 ';
• $obj1 является суперклассом $obj2;
• Класс ни одного объекта не является подклассом класса другого.

Как я могу это сделать?

Answer 1

1. Является ли класс $obj1 таким же, как $obj2?

   ref $obj1 eq ref $obj2;
   

2. Является ли класс $obj1 подклассом $obj2 's?

   $obj1->isa(ref $obj2);
   

3. Является ли класс $obj1 суперклассом $obj2 's?

   $obj2->isa(ref $obj1);
   

4. Класс ни одного объекта не является подклассом класса другого.

   См. Выше.

Обновление:

В ответ на комментарии относительно ролей, применяемых во время выполнения:

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 - Before role was applied at runtime
not ok 2 - After role was applied at runtime
#   Failed test 'After role was applied at runtime' at C:\Temp\t.pl line 36.
# Looks like you failed 1 test of 2.

Answer 2

Используя подкрепления Class::MOP в Moose, вы можете проанализировать всю эту информацию.

Например:

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

См. Также этот вопрос / ответ Как найти все пакеты, которые наследуются от пакета в Perl?

/ I3az /