Moose applies method modifiers twice

Question

Basic Architecture

I built a information retrieval tool in perl, using Moose as framework.

I have a class hiearchy for plugins with Base as a common base class for plugins, from which access method specific plugins inherit (methods being HTTP, FTP, IMAP, ...).

From these child classes, the actual worker classes inherit (one plugin per data source).

I use Moose roles to compose source specific behaviour into the actual worker classes (like enabling support for SSL client certificates in HTTP sources).

Problem

One of the method specific classes (Base::A) requires a role R. The same role R is also used by role S, which then is used by a work class X, inheriting from Base::A.

My problem is that the method modifiers in R are applied twice to X. Is there a way to prevent Moose from applying method modifiers to class that are already applied to one of the parent classes?

Example

#!/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();

Actual Output

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

Expected Output

The line R::before'bar'() should appear only once.

Answer 1

First of all, your example can be much simpler:

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

The output is:

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

Why

I agree that this is kinda unexpected, but it all makes sense if you think about it. Roles are not base classes, roles are not interfaces with implementation (see Java), roles are not even “mixins” in a Python sense of this word (in Python we actually do inherit from mixins, but this is just language limitations). Roles are just bunches of features (attributes, methods, modifiers etc) you apply to your class. This is one-time action. The class that has a role doesn't “remember” it, it's just being applied as the class is created. You don't inherit from roles, so you shouldn't expect Moose to implement some diamond to merge multiple applyings of the same role.

On the other hand, if you try to do with qw(R S); then R is surprisingly (or maybe not really) is applied only once.

What to do

Now to the actual question. Since you want your "befores" to override each other, you can just forgo using before at all and refactor it to a simple method (like you do in any other languages that don't support such modifiers):

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

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

sub _before_bar_hook {}

Conclusion

Both before/after modifiers and roles are pretty advanced Moose features, and I'm not really surprised of some bizarre side effect (such that you've discovered). And though I believe my explanation is mostly correct I would not recommend to use something that requires such explanations.

Me personally avoid using before/after modifiers at all, since I prefer an explicit call of the hooks (as shown above).

Answer 2

You can use a parameterized role to prevent wrapping a sub:

#! /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;