serialising roughly the right things in roughly the right order

[gitmo/MooseX-Antlers.git] / t / track_eval.t

use strict;
use warnings;
use aliased 'MooseX::Antlers::EvalTracker';
use aliased 'MooseX::Antlers::RefTracker';
use aliased 'MooseX::Antlers::RefFilter';
use Moose ();
use B qw(perlstring);
use Scalar::Util qw(refaddr);

my @trap;

{
  my $orig = Moose::Meta::Class->can('add_attribute');
  no warnings 'redefine';
  *Moose::Meta::Class::add_attribute = sub {
    my ($self, $name) = @_;
    my $root_name = 
      '$add_attribute{'.perlstring($self->name).'}'
                   .'{'.perlstring($name).'}';
    my $tracker = RefTracker->new({ root_name => $root_name });
    $tracker->visit(\@_);
    my $refs = $tracker->traced_ref_map;
    push(@trap, [ $root_name, $name, $refs ]);
    return $orig->(@_);
  };
}

my $et = EvalTracker->new;

$et->enable;

{
  package Foo;

  use Moose;

  has 'test' => (is => 'rw', trigger => sub { warn "trigger!\n" });
}

use Data::Dumper; $Data::Dumper::Indent = 1;

my $attr_root = '$meta->{attributes}{'.perlstring($trap[0][1]).'}';

my $filter_attr = RefFilter->new({
  external_mappings => $trap[0][2],
  root_name => $attr_root,
});

$trap[0][2]{refaddr(Foo->meta)} = '$meta';
my $cr = $et->recorded_coderefs->[0][0];
$trap[0][2]{refaddr($cr)} = '$coderefs[0]';

my $attr_object = Foo->meta->{attributes}{$trap[0][1]};

my $record = $filter_attr->visit($attr_object);

my $tracker = RefTracker->new({
  root_name => $attr_root,
});

$tracker->visit($record);

my $filter_captures = RefFilter->new({
  external_mappings => {
    %{$tracker->traced_ref_map}, %{$trap[0][2]},
    refaddr($attr_object) => $attr_root,
  },
  root_name => '$captures',
});

my $captures_record = $filter_captures->visit($et->recorded_coderefs->[0][1]);

warn Data::Dumper->Dump([$record],[$attr_root]);

warn 'my '.Data::Dumper->Dump([$captures_record],['$captures']);

warn $filter_captures->fixup_code;

warn 'my @coderefs = ('."\n".$et->_generate_coderef_constructor($et->recorded_coderefs->[0])."->(\$captures)\n);\n";

warn $filter_attr->fixup_code;

#warn %{$trap[0]};