From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 7 May 2012 16:52:12 +0000 (+0000)
Subject: reset handlemoose state on mutation
X-Git-Tag: v0.091004~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c49212f407aeac8a2870b90600b36bc6639e89c;p=gitmo%2FMoo.git

reset handlemoose state on mutation
---

diff --git a/lib/Moo.pm b/lib/Moo.pm
index 5d47641..3f099c2 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -26,10 +26,12 @@ sub import {
       Moo->_constructor_maker_for($target)
          ->register_attribute_specs(%{$old->all_attribute_specs});
     }
+    $class->_maybe_reset_handlemoose($target);
   };
   _install_coderef "${target}::with" => "Moo::with" => sub {
     require Moo::Role;
     Moo::Role->apply_roles_to_package($target, $_[0]);
+    $class->_maybe_reset_handlemoose($target);
   };
   $MAKERS{$target} = {};
   _install_coderef "${target}::has" => "Moo::has" => sub {
@@ -38,6 +40,7 @@ sub import {
           ->register_attribute_specs($name, \%spec);
     $class->_accessor_maker_for($target)
           ->generate_method($target, $name, \%spec);
+    $class->_maybe_reset_handlemoose($target);
   };
   foreach my $type (qw(before after around)) {
     _install_coderef "${target}::${type}" => "Moo::${type}" => sub {
@@ -56,6 +59,13 @@ sub import {
   }
 }
 
+sub _maybe_reset_handlemoose {
+  my ($class, $target) = @_;
+  if ($INC{"Moo/HandleMoose.pm"}) {
+    Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
+  }
+}
+
 sub _accessor_maker_for {
   my ($class, $target) = @_;
   return unless $MAKERS{$target};
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
index 0f87ec9..3c6b785 100644
--- a/lib/Moo/HandleMoose.pm
+++ b/lib/Moo/HandleMoose.pm
@@ -19,6 +19,14 @@ sub inject_all {
   @Moo::HandleMoose::FakeConstructor::ISA = 'Moose::Meta::Method::Constructor';
 }
 
+sub maybe_reinject_fake_metaclass_for {
+  my ($name) = @_;
+  our %DID_INJECT;
+  if (delete $DID_INJECT{$name}) {
+    inject_fake_metaclass_for($name);
+  }
+}
+
 sub inject_fake_metaclass_for {
   my ($name) = @_;
   require Class::MOP;
@@ -27,8 +35,6 @@ sub inject_fake_metaclass_for {
   );
 }
 
-our %DID_INJECT;
-
 {
   package Moo::HandleMoose::FakeConstructor;
 
@@ -38,6 +44,7 @@ our %DID_INJECT;
 
 sub inject_real_metaclass_for {
   my ($name) = @_;
+  our %DID_INJECT;
   return Class::MOP::get_metaclass_by_name($name) if $DID_INJECT{$name};
   require Moose; require Moo; require Moo::Role;
   Class::MOP::remove_metaclass_by_name($name);
diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index 68581f0..ff147d4 100644
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -12,6 +12,7 @@ our %INFO;
 
 sub import {
   my $target = caller;
+  my ($me) = @_;
   strictures->import;
   return if $INFO{$target}; # already exported into this package
   # get symbol table reference
@@ -23,11 +24,43 @@ sub import {
       Method::Generate::Accessor->new
     })->generate_method($target, $name, \%spec);
     push @{$INFO{$target}{attributes}||=[]}, $name, \%spec;
+    $me->_maybe_reset_handlemoose($target);
   };
+  # install before/after/around subs
+  foreach my $type (qw(before after around)) {
+    *{_getglob "${target}::${type}"} = sub {
+      require Class::Method::Modifiers;
+      push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
+      $me->_maybe_reset_handlemoose($target);
+    };
+  }
+  *{_getglob "${target}::requires"} = sub {
+    push @{$INFO{$target}{requires}||=[]}, @_;
+    $me->_maybe_reset_handlemoose($target);
+  };
+  *{_getglob "${target}::with"} = sub {
+    $me->apply_roles_to_package($target, @_);
+    $me->_maybe_reset_handlemoose($target);
+  };
+  # grab all *non-constant* (stash slot is not a scalarref) subs present
+  # in the symbol table and store their refaddrs (no need to forcibly
+  # inflate constant subs into real subs) - also add '' to here (this
+  # is used later) with a map to the coderefs in case of copying or re-use
+  my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash);
+  @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods;
+  # a role does itself
+  $Role::Tiny::APPLIED_TO{$target} = { $target => undef };
+
   if ($INC{'Moo/HandleMoose.pm'}) {
     Moo::HandleMoose::inject_fake_metaclass_for($target);
   }
-  goto &Role::Tiny::import;
+}
+
+sub _maybe_reset_handlemoose {
+  my ($class, $target) = @_;
+  if ($INC{"Moo/HandleMoose.pm"}) {
+    Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
+  }
 }
 
 sub _inhale_if_moose {
diff --git a/xt/lib/ExampleMooRoleWithAttribute.pm b/xt/lib/ExampleMooRoleWithAttribute.pm
index a1f1884..6306d11 100644
--- a/xt/lib/ExampleMooRoleWithAttribute.pm
+++ b/xt/lib/ExampleMooRoleWithAttribute.pm
@@ -1,6 +1,9 @@
 package ExampleMooRoleWithAttribute;;
 use Moo::Role;
 # Note that autoclean here is the key bit!
+# It causes the metaclass to be loaded and used before the 'has' fires
+# so Moo needs to blow it away again at that point so the attribute gets
+# added
 use namespace::autoclean;
 
 has output_to => (