Moose应用方法修饰符两次

Question

基础架构

我使用Moose作为框架在perl中构建了一个信息检索工具。

我有一个带有Base的插件的类层次结构作为插件的公共基类，特定于访问方法的插件从这些插件继承（方法是HTTP，FTP，IMAP，...）。

从这些子类中，实际的工作类继承（每个数据源一个插件）。

我使用Moose角色将源特定行为组合到实际的工作类中（例如，在HTTP源中启用对SSL客户端证书的支持）。

问题

方法特定类之一（Base::A）需要角色R。角色R也使用相同的角色S，然后由工作类X使用，继承自Base::A。

我的问题是R中的方法修饰符被应用到X两次。有没有办法阻止Moose将方法修饰符应用于已经应用于其中一个父类的类？

实施例

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

use v5.14;

{
    package R;

    use Moose::Role;

    before 'bar' => sub { say "R::before'bar'()" }
}

{
    package S;

    use Moose::Role;
    with 'R';

    before 'bar' => sub { say "S::before'bar'()" }
}

{
    package Base;

    use Moose;

    sub foo { say "Hello foo()"; }
}

{
    package Base::A;

    use Moose;
    extends 'Base';
    with 'R';

    sub bar { $_[0]->foo(); say "Hello bar()"; }
}

{
    package X;

    use Moose;
    extends 'Base::A';
    with 'S';
}


package main;

my $a = X->new();

$a->bar();

实际输出

S::before'bar'()
R::before'bar'()
R::before'bar'()
Hello bar()

预期产出

第R::before'bar'()行应该只出现一次。

Answer 1

首先，您的示例可以更简单：

{
    package R;
    use Moose::Role;
    before 'bar' => sub { say "R::before'bar'()" }
}

{
    package Base;
    use Moose;
    with 'R';

    sub foo { say "Hello foo()"; }
    sub bar { $_[0]->foo(); say "Hello bar()"; }
}

{
    package X;
    use Moose;
    extends 'Base';
    with 'R';
}


package main;

X->new()->bar();

输出结果为：

R::before'bar'()
R::before'bar'()
Hello foo()
Hello bar()

为什么

我同意这有点出乎意料，但如果你考虑一下这一切都是有道理的。角色不是基类，角色不是实现的接口（参见Java），角色甚至不是Python语义中的“mixins”（在Python中我们实际上是从mixin继承的，但这只是语言限制）。角色只是您应用于班级的一系列功能（属性，方法，修饰符等）。这是一次性行动。有角色的班级不“记住”它，它只是在创建班级时被应用。您不会从角色继承，因此您不应期望Moose实施某些diamond来合并同一角色的多个应用。

另一方面，如果您尝试执行with qw(R S);，则R令人惊讶地（或可能不是真的）仅应用一次。

怎么做

现在回答实际问题。既然你想要你的＆＃34;之前＆＃34;为了相互覆盖，你可以放弃使用before并将其重构为一个简单的方法（就像你不支持这些修饰符的任何其他语言一样）：

sub bar {
    my ($self) = @_;

    $self->_before_bar_hook();
    # ...
}

sub _before_bar_hook {}

结论

修改器和角色之前/之后都是非常先进的Moose功能，而且我并没有对一些奇怪的副作用感到惊讶（这样你就已经发现了）。虽然我相信我的解释大多是正确的，但我不建议使用需要这些解释的东西。

我个人完全避免使用修改器之前/之后，因为我更喜欢显式调用钩子（如上所示）。

Answer 2

您可以使用参数化角色来阻止包装子：

#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

{   package R;
    use MooseX::Role::Parameterized;

    parameter should_wrap_bar => (
        isa => 'Bool',
        default => 1,
    );

    role {
        my ($param) = @_;
        before 'bar' => sub { say "R::before'bar'()" }
            if $param->{should_wrap_bar};
    };
}

{   package Base;
    use Moose;
    with 'R';

    sub foo { say "Hello foo()"; }
    sub bar { $_[0]->foo(); say "Hello bar()"; }
}

{   package X;
    use Moose;
    extends 'Base';
    with R => { should_wrap_bar => 0 };
}

package main;
X->new->bar;