Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Add Comment
Please, Sign In to add comment