From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 2 Apr 2012 18:27:44 +0000 (+0000)
Subject: the beginnings of Moose handling
X-Git-Tag: v0.009_015~25
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3362e41cde223d2195be29baf22532b91064f14a;p=gitmo%2FMoo.git

the beginnings of Moose handling
---

diff --git a/lib/Moo.pm b/lib/Moo.pm
index 6202171..92337f2 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -46,6 +46,9 @@ sub import {
       require Moo::Object; ('Moo::Object');
     } unless @{"${target}::ISA"};
   }
+  if ($INC{'Moo/HandleMoose.pm'}) {
+    Moo::HandleMoose::inject_fake_metaclass_for($target);
+  }
 }
 
 sub _constructor_maker_for {
diff --git a/lib/Moo/HandleMoose.pm b/lib/Moo/HandleMoose.pm
new file mode 100644
index 0000000..ce9a1c6
--- /dev/null
+++ b/lib/Moo/HandleMoose.pm
@@ -0,0 +1,70 @@
+package Moo::HandleMoose;
+
+use strictures 1;
+use Moo::_Utils;
+
+sub import { inject_all() }
+
+sub inject_all {
+  require Class::MOP;
+  inject_fake_metaclass_for($_) for grep $_ ne 'Moo::Object', keys %Moo::MAKERS;
+}
+
+sub inject_fake_metaclass_for {
+  my ($name) = @_;
+  require Class::MOP;
+  Class::MOP::store_metaclass_by_name(
+    $name, bless({ name => $name }, 'Moo::HandleMoose::FakeMetaClass')
+  );
+}
+
+our %DID_INJECT;
+
+sub inject_real_metaclass_for {
+  my ($name) = @_;
+  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);
+  my ($meta, $attr_specs) = do {
+    if (my $info = $Moo::Role::INFO{$name}) {
+      (Moose::Meta::Role->initialize($name), $info->{attributes})
+    } else {
+      my $specs = Moo->_constructor_maker_for($name)->all_attribute_specs;
+      (Moose::Meta::Class->initialize($name), $specs);
+    }
+  };
+  my %methods = %{Role::Tiny->_concrete_methods_of($name)};
+  my @attrs;
+  {
+    local @{_getstash($name)}{keys %methods};
+    foreach my $name (keys %$attr_specs) {
+      push @attrs, $meta->add_attribute($name => %{$attr_specs->{$name}});
+    }
+  }
+  foreach my $attr (@attrs) {
+    foreach my $method (@{$attr->associated_methods}) {
+      $method->{body} = $name->can($method->name);
+    }
+  }
+  $DID_INJECT{$name} = 1;
+  $meta;
+}
+
+{
+  package Moo::HandleMoose::FakeMetaClass;
+
+  sub DESTROY { }
+
+  sub AUTOLOAD {
+    my ($meth) = (our $AUTOLOAD =~ /([^:]+)$/);
+    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->$meth(@_)
+  }
+  sub can {
+    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->can(@_)
+  }
+  sub isa {
+    Moo::HandleMoose::inject_real_metaclass_for((shift)->{name})->isa(@_)
+  }
+}
+
+1;
diff --git a/lib/Moo/_Utils.pm b/lib/Moo/_Utils.pm
index 5f62a98..554789b 100644
--- a/lib/Moo/_Utils.pm
+++ b/lib/Moo/_Utils.pm
@@ -19,7 +19,7 @@ use Moo::_mro;
 
 our @EXPORT = qw(
     _getglob _install_modifier _load_module _maybe_load_module
-    _get_linear_isa
+    _get_linear_isa _getstash
 );
 
 sub _install_modifier {
diff --git a/t/moo-accessors.t b/t/moo-accessors.t
index a5d28c7..2b0f49e 100644
--- a/t/moo-accessors.t
+++ b/t/moo-accessors.t
@@ -48,4 +48,4 @@ is_deeply(
   'subclass with role ok'
 );
 
-done_testing;
+done_testing unless caller;
diff --git a/xt/handle_moose.t b/xt/handle_moose.t
new file mode 100644
index 0000000..b89b6b3
--- /dev/null
+++ b/xt/handle_moose.t
@@ -0,0 +1,17 @@
+use strictures 1;
+
+BEGIN { require "t/moo-accessors.t"; }
+
+use Moo::HandleMoose;
+
+my $meta = Class::MOP::get_metaclass_by_name('Foo');
+
+my $attr;
+
+ok($attr = $meta->get_attribute('one'), 'Meta-attribute exists');
+is($attr->get_read_method, 'one', 'Method name');
+is($attr->get_read_method_ref->body, Foo->can('one'), 'Right method');
+
+is(Foo->new(one => 1, THREE => 3)->one, 1, 'Accessor still works');
+
+done_testing;