metaclass dumping

[gitmo/MooseX-Antlers.git] / lib / MooseX / Antlers / Compiler.pm

diff --git a/lib/MooseX/Antlers/Compiler.pm b/lib/MooseX/Antlers/Compiler.pm
index 0d9e437..0c0345a 100644 (file)
--- a/lib/MooseX/Antlers/Compiler.pm
+++ b/lib/MooseX/Antlers/Compiler.pm
@@ -4,6 +4,8 @@ use Moose;
 use IO::All qw(io);
 use String::TT qw(strip tt);
 use B qw(perlstring);
+use Data::Dumper::Concise;
+use Scalar::Util qw(refaddr);
 use aliased 'MooseX::Antlers::RefTracker';
 use aliased 'MooseX::Antlers::EvalTracker';
 use aliased 'MooseX::Antlers::RefFilter';
@@ -64,16 +66,15 @@ sub compiled_source {
   my $im_et = $self->_im_et;
   my $target = $self->_target;
   my %attr_construct;
+  my $all_refs = { map %{$_->[1]}, values %attr_refs };
   foreach my $attr_name (keys %attr_refs) {
     $attr_construct{$attr_name}
       = $attr_et{$attr_name}->serialized_construction(
           $attr_refs{$attr_name}[0]
         );
   }
-  my $im_construct = $im_et->serialized_construction(
-    { map %{$_->[1]}, values %attr_refs }
-  );
-  my $preamble = strip tt q{
+  my $im_construct = $im_et->serialized_construction($all_refs);
+  my $preamble = tt strip q{
     my %replay_has;
     my %has_args;
     BEGIN {
@@ -86,7 +87,15 @@ sub compiled_source {
       );
     }
     sub MooseX::Antlers::ImmutableHackFor::[% target %]::make_immutable {
-  [% im_construct %]
+      [% im_construct %]
+      no warnings 'redefine';
+      *[% target %]::meta = sub {
+        my $meta_code = do { local $/; <[% target %]::DATA> };
+        local $@;
+        my $meta = eval $meta_code;
+        die $@ if $@;
+        $meta;
+      };
     }
     use MooseX::Antlers::StealImport
       Moose => {
@@ -103,8 +112,12 @@ sub compiled_source {
       };
   };
 
-  my $postamble = strip q{
+  my $meta_construct = $self->_meta_construction_code($all_refs);
+
+  my $postamble = tt strip q{
     no MooseX::Antlers::StealImport qw(Moose);
+    __DATA__
+    [% meta_construct %]
   };
 
   my $compiled = join("\n", $preamble, $self->_raw_source, $postamble);
@@ -112,4 +125,33 @@ sub compiled_source {
   return $compiled;
 }
 
+sub _meta_construction_code {
+  my ($self, $all_refs) = @_;
+  my $target = $self->_target;
+  my $meta_obj = $target->meta;
+  my $mappings = {
+    %$all_refs,
+    map +(refaddr($target->can($_)) => '\&'.$target.'::'.$_),
+      $meta_obj->get_method_list, 'meta'
+  };
+  my $filter = RefFilter->new(
+    external_mappings => $mappings,
+    root_name => '$meta'
+  );
+  my $filtered_meta = Dumper($filter->visit($meta_obj));
+  my $meta_fixup = $filter->fixup_code;
+  my $target_string = perlstring($target);
+  return tt strip q{
+    require Moose;
+    my $meta = [% filtered_meta %];
+    [% meta_fixup %]
+    Class::MOP::store_metaclass_by_name([% target_string %] => $meta);
+    no warnings 'redefine';
+    *[% target %]::meta = sub {
+      Moose::Meta::Class->initialize( ref($_[0]) || $_[0] );
+    };
+    $meta;
+  };
+}
+
 1;