added clone and inherit fix to Field::Mutable::HiddenArray

[catagits/Reaction.git] / lib / Reaction / Role.pm

diff --git a/lib/Reaction/Role.pm b/lib/Reaction/Role.pm
index ea5b948..ea09925 100644 (file)
--- a/lib/Reaction/Role.pm
+++ b/lib/Reaction/Role.pm
@@ -4,34 +4,38 @@ use Moose::Role ();
 use Reaction::ClassExporter;
 use Reaction::Class;
 use Moose::Meta::Class;
+
 #TODO: review for Reaction::Object switch / Reaction::Meta::Class
-*Moose::Meta::Role::add_method = sub {
-  Moose::Meta::Class->can("add_method")->(@_);
+
+use namespace::clean -except => [ qw(meta) ];
+
+
+override exports_for_package => sub {
+  my ($self, $package) = @_;
+  my %exports = $self->SUPER::exports_for_package($package);
+  delete $exports{class};
+  $exports{role} = sub { $self->do_role_sub($package, @_); };
+  return %exports;
 };
 
-class Role which {
-
-  override exports_for_package => sub {
-    my ($self, $package) = @_;
-    my %exports = $self->SUPER::exports_for_package($package);
-    delete $exports{class};
-    $exports{role} = sub { $self->do_role_sub($package, @_); };
-    return %exports;
-  };
-  
-  override next_import_package => sub { 'Moose::Role' };
-  
-  override default_base => sub { () };
-
-  implements do_role_sub => as {
-    my ($self, $package, $role, $which, $setup) = @_;
-    confess "Invalid role declaration, should be: role Role which { ... }"
-      unless ($which eq 'which' && ref($setup) eq 'CODE');
-    $self->setup_and_cleanup($role, $setup);
-  };
+override next_import_package => sub { 'Moose::Role' };
+
+override default_base => sub { () };
 
+override add_method_to_target => sub {
+  my ($self, $target, $method) = @_;
+  $target->meta->alias_method(@$method);
 };
-  
+sub do_role_sub {
+  my ($self, $package, $role, $which, $setup) = @_;
+  confess "Invalid role declaration, should be: role Role which { ... }"
+    unless ($which eq 'which' && ref($setup) eq 'CODE');
+  $self->setup_and_cleanup($role, $setup);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+
 1;
 
 =head1 NAME