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]};