Remove warning

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

diff --git a/lib/MooseX/Antlers/EvalTracker.pm b/lib/MooseX/Antlers/EvalTracker.pm
index e2cc227..d56a5aa 100644 (file)
--- a/lib/MooseX/Antlers/EvalTracker.pm
+++ b/lib/MooseX/Antlers/EvalTracker.pm
@@ -1,11 +1,15 @@
 package MooseX::Antlers::EvalTracker;
 
 use Moose;
+use MooseX::Antlers::ErrorThrower;
+use aliased 'MooseX::Antlers::RefFilter';
 use Scalar::Util qw(weaken refaddr);
 use PadWalker qw(closed_over);
 use Sub::Identify qw(sub_fullname);
 use B qw(perlstring);
 use namespace::clean -except => 'meta';
+use String::TT qw(tt strip);
+use Data::Dumper::Concise;
 
 has '_original_eval_closure' => (is => 'ro', lazy_build => 1);
 has '_our_eval_closure' => (is => 'ro', lazy_build => 1);
@@ -25,14 +29,13 @@ sub _build__our_eval_closure {
   # _eval_closure returns a CODE ref and we want that too
   sub {
     my $self = shift;
-    # ... screwed over here by $attr->default(...) and ->trigger(...)
-    # in the bloody inlined subs. XXX slap stevan, fix Moose
-    # until we stop passing these let's make anything that uses it
-    # crash out so at least we don't break anything
-    #delete @{$_[0]}{qw($meta $attr)};
-    my $cr = $self->$orig(@_);
-    $eval_tracker->_eval_closure_called_for($cr => @_);
-    return $cr;
+    if ($_[0]->{'$attr'} || $_[0]->{'$attrs'}) {
+      die "Closing over meta-attribute, can't handle this. Suspect you used initializer - can't support that yet, sorry. Patches welcome.";
+    }
+    $_[0]->{'$meta'} = \'MooseX::Antlers::ErrorThrower';
+    my ($cr, $e) = $self->$orig(@_);
+    $eval_tracker->_eval_closure_called_for($cr => @_) unless $e;
+    return ($cr, $e);
   };
 }
 
@@ -41,7 +44,7 @@ sub enable {
   return if $self->is_enabled;
   $self->_install('our');
   $self->is_enabled(1);
-  return;
+  return $self;
 }
 
 sub disable {
@@ -49,7 +52,7 @@ sub disable {
   return unless $self->is_enabled;
   $self->_install('original');
   $self->is_enabled(0);
-  return;
+  return $self;
 }
 
 sub _install {
@@ -71,6 +74,36 @@ sub _eval_closure_called_for {
   #warn Dumper($body);
 }
 
+sub serialized_construction {
+  my ($self, $externals) = @_;
+  my $code = strip q{
+    package Class::MOP::Method::Generated;
+    use strict;
+    use warnings;
+  };
+  foreach my $recorded (@{$self->recorded_coderefs}) {
+    my ($cr, $captures, $body) = @{$recorded};
+    my $name = sub_fullname($cr);
+    my $name_string = perlstring($name);
+    my $filter = RefFilter->new(
+      external_mappings => $externals,
+      root_name => '$__captures'
+    );
+    my $filtered_captures = Dumper($filter->visit($captures));
+    my $fixup_code = $filter->fixup_code;
+    my $use_captures = $self->_generate_capture_constructor($captures);
+    $code .= strip tt q{
+      {
+        my $__captures = [% filtered_captures %];
+        [% fixup_code %]
+        [% use_captures %]
+        *[% name %] = Sub::Name::subname [% name_string %] => [% body %];
+      }
+    };
+  }
+  return $code;
+}
+    
 sub _generate_coderef_constructor {
   my ($self, $entry) = @_;
   my ($cr, $captures, $body) = @{$entry};