rewrite usage in Role to DWIM (issue #1 )

eiro · Aug 27, 2013 · e89a7ef · e89a7ef
1 parent f2b6b15
commit e89a7ef
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 42 deletions.
diff --git a/lib/Method/Generate/Accessor/Role/LvalueAttribute.pm b/lib/Method/Generate/Accessor/Role/LvalueAttribute.pm
@@ -19,7 +19,8 @@ around generate_method => sub {
 
     my ($into, $name, $spec, $quote_opts) = @_;
 
-    $MooX::LvalueAttribute::INJECTED_IN{$into}
+    $MooX::LvalueAttribute::INJECTED_IN_ROLE{$into}
+      || $MooX::LvalueAttribute::INJECTED_IN_CLASS{$into}
       or return $self->$orig(@_);
 
     if ($spec->{lvalue}) {

diff --git a/lib/MooX/LvalueAttribute.pm b/lib/MooX/LvalueAttribute.pm
@@ -6,52 +6,35 @@ use strictures 1;
 require Moo;
 require Moo::Role;
 
-our %INJECTED_IN;
-our %OVERRIDEN;
+our %INJECTED_IN_ROLE;
+our %INJECTED_IN_CLASS;
 
 sub import {
     my $class = shift;
     my $target = caller;
 
     if ($Moo::Role::INFO{$target} && $Moo::Role::INFO{$target}{is_role}) {
-        # We are loaded from a Moo::Role
-        if (! $OVERRIDEN{$target} ) {
-            # We don't know yet in which class the role will be consumed, so we
-            # have to work around that, and defer the injection
-
-            my $old_accessor_maker = Moo->can('_accessor_maker_for');
-
-            my $new_accessor_maker_for = sub {
-                my ($class, $role_target) = @_;
-                my $maker = $old_accessor_maker->(@_);
-                defined $maker
-                  or return;
-                $role_target->can('__lvalue_attr_mode')
-                  && $role_target->__lvalue_attr_mode
-                  && ! $INJECTED_IN{$role_target}
-                    or return $maker;
-                Moo::Role->apply_roles_to_object(
-                    $maker,
-                    'Method::Generate::Accessor::Role::LvalueAttribute',
-                );
-                $INJECTED_IN{$role_target} = 1;
-                return $maker;
-            };
-
-            no strict 'refs';
-            no warnings 'redefine';
-            *{"${target}::__lvalue_attr_mode"} = sub { 1 }; 
-            *Moo::_accessor_maker_for = $new_accessor_maker_for;
-            $OVERRIDEN{$target} = 1
-        }
+
+        # We are loaded from a Moo role
+        $Moo::Role::INFO{$target}{accessor_maker} ||= do {
+            require Method::Generate::Accessor;
+            Method::Generate::Accessor->new
+          };
+        Moo::Role->apply_roles_to_object(
+            $Moo::Role::INFO{$target}{accessor_maker},
+            'Method::Generate::Accessor::Role::LvalueAttribute',
+        );
+        $INJECTED_IN_ROLE{$target} = 1;
+
     } elsif ($Moo::MAKERS{$target} && $Moo::MAKERS{$target}{is_class}) {
+
         # We are loaded from a Moo class
-        if ( !$INJECTED_IN{$target} ) {
+        if ( !$INJECTED_IN_CLASS{$target} ) {
             Moo::Role->apply_roles_to_object(
               Moo->_accessor_maker_for($target),
               'Method::Generate::Accessor::Role::LvalueAttribute',
             );
-            $INJECTED_IN{$target} = 1;        
+            $INJECTED_IN_CLASS{$target} = 1;        
         }
     } else {
         die "MooX::LvalueAttribute can only be used in Moo classes or Moo roles.";        

diff --git a/t/lvalue_in_role.t b/t/lvalue_in_role.t
@@ -5,6 +5,17 @@ use Test::More;
     package MyRole;
     use Moo::Role;
     use MooX::LvalueAttribute;
+
+    has three => (
+                  is => 'rw',
+                  lvalue => 1,
+                 );
+
+    has two => (
+                is => 'rw',
+                lvalue => 1,
+               );
+
 }
 
 {
@@ -13,15 +24,12 @@ use Test::More;
 
     with ('MyRole');
 
-    has two => (
-                is => 'rw',
-                lvalue => 1,
-               );
 
-    has three => (
+    has four => (
                   is => 'rw',
                   lvalue => 1,
                  );
+
 }
 
 {
@@ -41,19 +49,22 @@ use Test::More;
 }
 
 
-my $lvalue = MooLvalue->new(one => 5, two => 6);
+my $lvalue = MooLvalue->new(one => 5, two => 6, three => 3);
 is $lvalue->two, 6, "normal getter works";
 $lvalue->two(43);
 is $lvalue->two, 43, "normal setter still works";
 
 $lvalue->two = 42;
-is $lvalue->two, 42, "lvalue set works";
+is $lvalue->two, 42, "lvalue set works, defined in a role";
 is $lvalue->_lv_two(), 42, "underlying getter works";
 
 $lvalue->three = 3;
 is $lvalue->three, 3, "lvalue set works for a second attribute";
 is $lvalue->_lv_three(), 3, "underlying getter works for a second attribute";
 
+eval { $lvalue->four = 42 };
+like $@, qr/Can't modify non-lvalue subroutine/, "this attr has no lvalue";
+
 my $lvalue2 = MooLvalue->new(two => 7);
 is $lvalue2->two, 7, "different instances have different values";