From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 26 Jun 2012 18:45:19 +0000 (+0000)
Subject: no Moo and no Moo::Role
X-Git-Tag: v0.091010~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=108f8ddcc8c9c70cdc1eb4b60210e47a1dfe1d06;p=gitmo%2FMoo.git

no Moo and no Moo::Role
---

diff --git a/Changes b/Changes
index 509755d..93452d5 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - no Moo and no Moo::Role
   - squelch used only once warnings for $Moo::HandleMoose::MOUSE
   - MooClass->meta
   - subconstructor handling for Moose classes
diff --git a/lib/Moo.pm b/lib/Moo.pm
index 51f0dc6..e80d863 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -12,12 +12,19 @@ require Moo::sification;
 
 our %MAKERS;
 
+sub _install_tracked {
+  my ($target, $name, $code) = @_;
+  $MAKERS{$target}{exports}{$name} = $code;
+  _install_coderef "${target}::${name}" => "Moo::${name}" => $code;
+}
+
 sub import {
   my $target = caller;
   my $class = shift;
   strictures->import;
   return if $MAKERS{$target}; # already exported into this package
-  _install_coderef "${target}::extends" => "Moo::extends" => sub {
+  $MAKERS{$target} = {};
+  _install_tracked $target => extends => sub {
     _load_module($_) for @_;
     # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA
     @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
@@ -33,13 +40,12 @@ sub import {
     $class->_maybe_reset_handlemoose($target);
     return;
   };
-  _install_coderef "${target}::with" => "Moo::with" => sub {
+  _install_tracked $target => with => sub {
     require Moo::Role;
     Moo::Role->apply_roles_to_package($target, @_);
     $class->_maybe_reset_handlemoose($target);
   };
-  $MAKERS{$target} = {};
-  _install_coderef "${target}::has" => "Moo::has" => sub {
+  _install_tracked $target => has => sub {
     my ($name, %spec) = @_;
     $class->_constructor_maker_for($target)
           ->register_attribute_specs($name, \%spec);
@@ -49,7 +55,7 @@ sub import {
     return;
   };
   foreach my $type (qw(before after around)) {
-    _install_coderef "${target}::${type}" => "Moo::${type}" => sub {
+    _install_tracked $target => $type => sub {
       require Class::Method::Modifiers;
       _install_modifier($target, $type, @_);
       return;
@@ -66,6 +72,11 @@ sub import {
   }
 }
 
+sub unimport {
+  my $target = caller;
+  _unimport_coderefs($target, $MAKERS{$target});
+}
+
 sub _maybe_reset_handlemoose {
   my ($class, $target) = @_;
   if ($INC{"Moo/HandleMoose.pm"}) {
diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index 5145edc..fbdd52b 100644
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -10,14 +10,21 @@ BEGIN { *INFO = \%Role::Tiny::INFO }
 
 our %INFO;
 
+sub _install_tracked {
+  my ($target, $name, $code) = @_;
+  $INFO{$target}{exports}{$name} = $code;
+  _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code;
+}
+
 sub import {
   my $target = caller;
   my ($me) = @_;
   strictures->import;
   return if $INFO{$target}; # already exported into this package
+  $INFO{$target} = {};
   # get symbol table reference
   my $stash = do { no strict 'refs'; \%{"${target}::"} };
-  _install_coderef "${target}::has" => "Moo::Role::has" => sub {
+  _install_tracked $target => has => sub {
     my ($name, %spec) = @_;
     ($INFO{$target}{accessor_maker} ||= do {
       require Method::Generate::Accessor;
@@ -28,17 +35,17 @@ sub import {
   };
   # install before/after/around subs
   foreach my $type (qw(before after around)) {
-    *{_getglob "${target}::${type}"} = sub {
+    _install_tracked $target => $type => sub {
       require Class::Method::Modifiers;
       push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
       $me->_maybe_reset_handlemoose($target);
     };
   }
-  *{_getglob "${target}::requires"} = sub {
+  _install_tracked $target => requires => sub {
     push @{$INFO{$target}{requires}||=[]}, @_;
     $me->_maybe_reset_handlemoose($target);
   };
-  *{_getglob "${target}::with"} = sub {
+  _install_tracked $target => with => sub {
     $me->apply_roles_to_package($target, @_);
     $me->_maybe_reset_handlemoose($target);
   };
@@ -56,6 +63,11 @@ sub import {
   }
 }
 
+sub unimport {
+  my $target = caller;
+  _unimport_coderefs($target, $INFO{$target});
+}
+
 sub _maybe_reset_handlemoose {
   my ($class, $target) = @_;
   if ($INC{"Moo/HandleMoose.pm"}) {
diff --git a/lib/Moo/_Utils.pm b/lib/Moo/_Utils.pm
index e6a0420..2667055 100644
--- a/lib/Moo/_Utils.pm
+++ b/lib/Moo/_Utils.pm
@@ -16,7 +16,7 @@ use Moo::_mro;
 our @EXPORT = qw(
     _getglob _install_modifier _load_module _maybe_load_module
     _get_linear_isa _getstash _install_coderef _name_coderef
-    _in_global_destruction
+    _unimport_coderefs _in_global_destruction
 );
 
 sub _in_global_destruction ();
@@ -74,6 +74,21 @@ sub _name_coderef {
   can_haz_subname ? Sub::Name::subname(@_) : $_[1];
 }
 
+sub _unimport_coderefs {
+  my ($target, $info) = @_;
+  return unless $info and my $exports = $info->{exports};
+  my %rev = reverse %$exports;
+  my $stash = _getstash($target);
+  foreach my $name (keys %$exports) {
+    if ($stash->{$name} and defined(&{$stash->{$name}})) {
+      if ($rev{$target->can($name)}) {
+        delete $stash->{$name};
+      }
+    }
+  }
+}
+
+
 sub STANDARD_DESTROY {
   my $self = shift;
 
diff --git a/t/no-moo.t b/t/no-moo.t
index c857ef4..58d9297 100644
--- a/t/no-moo.t
+++ b/t/no-moo.t
@@ -13,7 +13,22 @@ use Test::More;
   no Moo;
 }
 
+{
+  package Roller;
+
+  use Moo::Role;
+
+  no warnings 'redefine';
+
+  sub with { "with!" }
+
+  no Moo::Role;
+}
+
 ok(!Spoon->can('extends'), 'extends cleaned');
 is(Spoon->has, "has!", 'has left alone');
 
+ok(!Roller->can('has'), 'has cleaned');
+is(Roller->with, "with!", 'with left alone');
+
 done_testing;