Commit | Line | Data |
699c71b8 |
1 | use strict; |
2 | use warnings; |
3 | use aliased 'MooseX::Antlers::EvalTracker'; |
e4612bc2 |
4 | use aliased 'MooseX::Antlers::RefTracker'; |
5 | use aliased 'MooseX::Antlers::RefFilter'; |
6 | use Moose (); |
7 | use B qw(perlstring); |
8 | use Scalar::Util qw(refaddr); |
9 | |
10 | my @trap; |
11 | |
12 | { |
13 | my $orig = Moose::Meta::Class->can('add_attribute'); |
14 | no warnings 'redefine'; |
15 | *Moose::Meta::Class::add_attribute = sub { |
16 | my ($self, $name) = @_; |
17 | my $root_name = |
18 | '$add_attribute{'.perlstring($self->name).'}' |
19 | .'{'.perlstring($name).'}'; |
20 | my $tracker = RefTracker->new({ root_name => $root_name }); |
21 | $tracker->visit(\@_); |
22 | my $refs = $tracker->traced_ref_map; |
23 | push(@trap, [ $root_name, $name, $refs ]); |
24 | return $orig->(@_); |
25 | }; |
26 | } |
699c71b8 |
27 | |
28 | my $et = EvalTracker->new; |
29 | |
30 | $et->enable; |
31 | |
32 | { |
33 | package Foo; |
34 | |
35 | use Moose; |
36 | |
37 | has 'test' => (is => 'rw', trigger => sub { warn "trigger!\n" }); |
38 | } |
e4612bc2 |
39 | |
40 | use Data::Dumper; $Data::Dumper::Indent = 1; |
41 | |
42 | my $attr_root = '$meta->{attributes}{'.perlstring($trap[0][1]).'}'; |
43 | |
44 | my $filter_attr = RefFilter->new({ |
45 | external_mappings => $trap[0][2], |
46 | root_name => $attr_root, |
47 | }); |
48 | |
49 | $trap[0][2]{refaddr(Foo->meta)} = '$meta'; |
50 | my $cr = $et->recorded_coderefs->[0][0]; |
51 | $trap[0][2]{refaddr($cr)} = '$coderefs[0]'; |
52 | |
53 | my $attr_object = Foo->meta->{attributes}{$trap[0][1]}; |
54 | |
55 | my $record = $filter_attr->visit($attr_object); |
56 | |
57 | my $tracker = RefTracker->new({ |
58 | root_name => $attr_root, |
59 | }); |
60 | |
61 | $tracker->visit($record); |
62 | |
63 | my $filter_captures = RefFilter->new({ |
64 | external_mappings => { |
65 | %{$tracker->traced_ref_map}, %{$trap[0][2]}, |
66 | refaddr($attr_object) => $attr_root, |
67 | }, |
68 | root_name => '$captures', |
69 | }); |
70 | |
71 | my $captures_record = $filter_captures->visit($et->recorded_coderefs->[0][1]); |
72 | |
73 | warn Data::Dumper->Dump([$record],[$attr_root]); |
74 | |
75 | warn 'my '.Data::Dumper->Dump([$captures_record],['$captures']); |
76 | |
77 | warn $filter_captures->fixup_code; |
78 | |
79 | warn 'my @coderefs = ('."\n".$et->_generate_coderef_constructor($et->recorded_coderefs->[0])."->(\$captures)\n);\n"; |
80 | |
81 | warn $filter_attr->fixup_code; |
82 | |
83 | #warn %{$trap[0]}; |