Perlでインスタンスに対するRole適用を行うための匿名クラスとre-blessを用いた実装例

perl-role-sample.pl

use 5.014000;

use Package::Stash;
use Scalar::Util qw/blessed refaddr/;
use Module::Functions;

package Role::Foo {
    sub foo {
        my $self = shift;
        return "role foo by $self->{name}";
    }
}

package X {
    sub foo {
        my $self = shift;
        return "original foo by $self->{name}";
    }
}

my $x = bless { name => 'xxx' }, 'X'; # X のインスタンスを生成
say $x->foo(); # => original foo by xxx

# xのインスタンスを拡張するための匿名クラス名(x_pkg)を生成
my $x_pkg = blessed($x).'::__ANON__::O'.refaddr($x).time;
my $x_pkg_stash = Package::Stash->new($x_pkg);

# x_pkgでXを継承させる
$x_pkg_stash->add_symbol('@ISA' => [blessed($x)]);

# x_pkgにroleのサブルーチンを移植する(Roleのapply)
for my $subname (get_public_functions("Role::Foo")) {
    my $subref = Role::Foo->can($subname);
    $x_pkg_stash->add_symbol('&'.$subname => $subref);
}

# x_pkgに再blessする
#   1. x_pkgはXを継承しているので振る舞いを継承している
#   2. x_pkgはRole::Fooの振る舞いを移植されているのでRole::Fooの振る舞いができる
bless $x, $x_pkg;

# 結果としてfooメソッドがRoleのapplyによってoverrideされるのでrole fooが呼ばれる
say $x->foo(); # => role foo by xxx

解説のために長々と書いているがこれを一般化した実装としてRole::Tinyなどがあるので普通はそっちを使うと良いです