Guest User

Untitled

a guest
May 27th, 2018
90
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.26 KB | None | 0 0
  1. use 5.014000;
  2.  
  3. use Package::Stash;
  4. use Scalar::Util qw/blessed refaddr/;
  5. use Module::Functions;
  6.  
  7. package Role::Foo {
  8. sub foo {
  9. my $self = shift;
  10. return "role foo by $self->{name}";
  11. }
  12. }
  13.  
  14. package X {
  15. sub foo {
  16. my $self = shift;
  17. return "original foo by $self->{name}";
  18. }
  19. }
  20.  
  21. my $x = bless { name => 'xxx' }, 'X'; # X のインスタンスを生成
  22. say $x->foo(); # => original foo by xxx
  23.  
  24. # xのインスタンスを拡張するための匿名クラス名(x_pkg)を生成
  25. my $x_pkg = blessed($x).'::__ANON__::O'.refaddr($x).time;
  26. my $x_pkg_stash = Package::Stash->new($x_pkg);
  27.  
  28. # x_pkgでXを継承させる
  29. $x_pkg_stash->add_symbol('@ISA' => [blessed($x)]);
  30.  
  31. # x_pkgにroleのサブルーチンを移植する(Roleのapply)
  32. for my $subname (get_public_functions("Role::Foo")) {
  33. my $subref = Role::Foo->can($subname);
  34. $x_pkg_stash->add_symbol('&'.$subname => $subref);
  35. }
  36.  
  37. # x_pkgに再blessする
  38. # 1. x_pkgはXを継承しているので振る舞いを継承している
  39. # 2. x_pkgはRole::Fooの振る舞いを移植されているのでRole::Fooの振る舞いができる
  40. bless $x, $x_pkg;
  41.  
  42. # 結果としてfooメソッドがRoleのapplyによってoverrideされるのでrole fooが呼ばれる
  43. say $x->foo(); # => role foo by xxx
Add Comment
Please, Sign In to add comment