多重继承 - 选择了错误的重载

Multiple inheritance - wrong overload selected

我正在尝试多重继承,希望在不使用 Moose 等包的情况下掌握它的窍门来解决幕后问题。

我有两个基础 classes,LeftRight,在一个“破碎的”钻石中:

Left  Right
   \   /
   Multi

他们都为 "" 实现了 overload。在任何基础 classes 中调用以下名为 perform 的方法时,这些方法应该使用此重载来打印对象的该部分的表示。 Multi 如此实现 perform

sub perform {
    my $self = shift;
    $self->Left::perform;
    $self->Right::perform;
}

发生的事情是两个基 classes perform 方法都按预期调用,但是当这些方法调用任何其他方法(如 "" 重载)时,它将永远是 Left 中的那个。但是,如果 Right 的实例是单独创建的(不是作为 Multi 的一部分),它将调用正确的方法。

这是我尝试过的(在 v5.26.1 和 v5.32.1 中):

#!/usr/bin/perl

use strict;
use warnings;

package Left; #----------------------------------------------------------------

sub new {
    my ($class, @args) = @_;
    my $self = bless {}, $class;
    return $self->_init(@args);
}

sub _init {
    my $self = shift;
    $self->{_leftval} = shift;
    return $self;
}

sub value { shift->{_leftval}; }

use overload '""' => sub {
    my $self = shift;
    'Left(' . $self->value . ')';
};

sub perform {
    my $self = shift;
    print '# LEFT ' . $self . "\n";
}

package Right; #---------------------------------------------------------------

sub new {
    my ($class, @args) = @_;
    my $self = bless {}, $class;
    return $self->_init(@args);
}

sub _init {
    my $self = shift;
    $self->{_rightval} = shift;
    return $self;
}

sub value { shift->{_rightval}; }

use overload '""' => sub {
    my $self = shift;
    'Right(' . $self->value . ')';
};

sub perform {
    my $self = shift;
    print '# RIGHT ' . $self . "\n";
}

package Multi; #---------------------------------------------------------------
use parent -norequire, 'Left', 'Right' ;

sub new {
    my ($class, @args) = @_;
    my $self = bless {}, $class;
    return $self->_init(@args);
}

sub _init {
    my $self = shift;
    $self->Left::_init(shift);
    $self->Right::_init(shift);
    return $self;
}

sub perform {
    my $self = shift;
    $self->Left::perform;
    $self->Right::perform;
}

package main; #----------------------------------------------------------------

my $l = Left->new("a Left");
my $r = Right->new("a Right");
my $m = Multi->new("lEfT", "rIgHt");

$l->perform;
$r->perform;
print "---- and now a Multi ----\n";
$m->perform;

预期输出:

# LEFT Left(a Left)
# RIGHT Right(a Right)
---- and now a Multi ----
# LEFT Left(lEfT)
# RIGHT Right(rIgHt)

实际输出(注意最后一行):

# LEFT Left(a Left)
# RIGHT Right(a Right)
---- and now a Multi ----
# LEFT Left(lEfT)
# RIGHT Left(lEfT)

I wonder how to make a method in this scenario select its own package's methods

像这样重新祝福$self有帮助吗:

package Right;

# [...]

sub perform {
    my $self = shift;
    if (ref $self ne "Right") {
        bless $self, "Right";
    }
    print '# RIGHT ' . $self . "\n";
}

这是在 的基础上构建的。 bless $self, 'Right' in Right::perform 似乎有效地打破了继承。第二次调用 $m->perform 直接调用 Right::perform - Multi::perform 甚至没有被调用。

作为解决方法,我添加了一个祝福语境 class,它在创造时祝福 并在毁灭时祝福 。我必须在所有可能调用另一个包中的任何方法的方法中创建这些上下文之一。

package Reblesser; #-----------------------------------------------------------

sub new {
    my $class = shift;
    my $self = bless {
        object => shift,
        class => shift
    }, $class;
    $self->rebless;
    $self;
}

sub rebless {
    my $self = shift;
    bless $self->{object}, $self->{class} if(ref $self->{object} ne $self->{class});
}

sub DESTROY {
    shift->rebless;
}

现在 Left::perform 变为:

sub perform {
    my $self = shift;
    my $ctx = Reblesser->new($self, __PACKAGE__);
    print '# LEFT ' . $self . "\n";
}

Right::perform:

sub perform {
    my $self = shift;
    my $ctx = Reblesser->new($self, __PACKAGE__);
    print '# RIGHT ' . $self . "\n";
}

Multi::perform:

sub perform {
    my $self = shift;
    my $ctx = Reblesser->new($self, __PACKAGE__);
    $self->Left::perform;
    $self->Right::perform;
}

输出(即使有多个 $m->perform 调用):

# LEFT Left(a Left)
# RIGHT Right(a Right)
---- and now a Multi ----
# LEFT Left(lEfT)
# RIGHT Right(rIgHt)

根据对象的 class 而非调用者的 namespace/package/class 解析虚方法。

在 Perl 中,一个方法是否为虚方法不是一个内在方法 属性。这取决于它如何被调用。

$o->method   # Virtual method

避免这种情况需要指定 class

$o->Class::method

您不需要虚拟方法调用,因此您需要更改调用方法的方式。

package Left;

use overload '""' => \&to_string;

sub to_string {
    my $self = shift;
    'Left(' . $self->value . ')';
}

sub perform {
    my $self = shift;
    print '# LEFT ' . $self->Left::to_string() . "\n";
}

除了这一切都是错误的。如果这是一种方法,这将是有道理的。但我们正在谈论每一种方法。这是红旗的空袭警报

我们这里要的是组合,而不是继承。 Multi IS A Left 和 IS A Right 是不正确的。相反,Multi 有一个左边和一个右边。

package Multi; #---------------------------------------------------------------
use parent -norequire, 'Left', 'Right' ;

sub new {
    my ($class, @args) = @_;
    my $self = bless {}, $class;
    return $self->_init(@args);
}

sub _init {
    my $self = shift;
    $self->{ left  } = Left ->new(shift);
    $self->{ right } = Right->new(shift);
    return $self;
}

sub perform {
    my $self = shift;
    $self->{ left  }->perform;
    $self->{ right }->perform;
}