demonstrate eval tracking

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

package MooseX::Antlers::EvalTracker;

use Moose;
use Scalar::Util qw(weaken refaddr);
use PadWalker qw(closed_over);
use namespace::clean -except => 'meta';

has '_original_eval_closure' => (is => 'ro', lazy_build => 1);
has '_our_eval_closure' => (is => 'ro', lazy_build => 1);

has 'recorded_coderefs' => (is => 'ro', default => sub { {} });

has 'is_enabled' => (is => 'rw');

sub _build__original_eval_closure {
  Class::MOP::Method::Generated->can('_eval_closure');
}

sub _build__our_eval_closure {
  my $eval_tracker = shift;
  my $orig = $eval_tracker->_original_eval_closure;
  weaken($eval_tracker); # avoid circ ref-ing $self
  # _eval_closure returns a CODE ref and we want that too
  sub {
    my $self = shift;
    # 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;
  };
}

sub enable {
  my $self = shift;
  return if $self->is_enabled;
  $self->_install('our');
  $self->is_enabled(1);
  return;
}

sub disable {
  my $self = shift;
  return unless $self->is_enabled;
  $self->_install('original');
  $self->is_enabled(0);
  return;
}

sub _install {
  my ($self, $type) = @_;
  my $code = $self->${\"_${type}_eval_closure"};
  { # we're instrumenting the MOP so bypass it and use the old fashioned way
    no strict 'refs'; no warnings 'redefine';
    *Class::MOP::Method::Generated::_eval_closure = $code;
  }
}

sub _eval_closure_called_for {
  my ($self, $cr, $captures, $body) = @_;
  use Data::Dumper; $Data::Dumper::Indent = 1;
  my %captured = %{closed_over $cr};
  delete @{$captures}{grep !exists($captured{$_}), keys %$captures};
  warn Dumper($captures);
  warn Dumper($body);
}

sub DEMOLISH { shift->disable }

1;