1 package MooseX::Antlers::Compiler;
5 use String::TT qw(strip tt);
7 use aliased 'MooseX::Antlers::RefTracker';
8 use aliased 'MooseX::Antlers::EvalTracker';
9 use aliased 'MooseX::Antlers::RefFilter';
11 has [ qw(_target _attr_refs _attr_et _im_et _raw_source) ] => (is => 'rw');
13 sub load_with_compiler {
14 my ($class, $target) = @_;
15 $class->new->load($target);
19 my ($self, $target) = @_;
23 my $orig_import = Moose->can('import');
24 no warnings 'redefine';
25 local *Moose::import = sub {
27 Moose->$orig_import({ into => $targ });
28 my $has = $targ->can('has');
31 *{"${targ}::has"} = sub {
33 map RefTracker->trace_refs( $_ => \@_ ),
34 '(\@_)', '$has_args{'.perlstring($_[0]).'}'
36 my $et = EvalTracker->new->enable;
38 $attr_et{$_[0]} = $et->disable;
43 my $orig_immutable = Moose::Meta::Class->can('make_immutable');
44 local *Moose::Meta::Class::make_immutable = sub {
45 my $et = EvalTracker->new->enable;
46 $orig_immutable->(@_);
47 $im_et = $et->disable;
50 Class::MOP::load_class($target);
51 $self->_attr_refs(\%attr_refs);
52 $self->_attr_et(\%attr_et);
53 $self->_im_et($im_et);
54 $self->_target($target);
55 (my $pm_file = $target) =~ s/::/\//g;
56 $self->_raw_source(scalar io($INC{"${pm_file}.pm"})->slurp);
62 my %attr_et = %{$self->_attr_et};
63 my %attr_refs = %{$self->_attr_refs};
64 my $im_et = $self->_im_et;
65 my $target = $self->_target;
67 foreach my $attr_name (keys %attr_refs) {
68 $attr_construct{$attr_name}
69 = $attr_et{$attr_name}->serialized_construction(
70 $attr_refs{$attr_name}[0]
73 my $im_construct = $im_et->serialized_construction(
74 { map %{$_->[1]}, values %attr_refs }
76 my $preamble = strip tt q{
81 [% FOREACH a IN attr_construct_h %]
88 sub MooseX::Antlers::ImmutableHackFor::[% target %]::make_immutable {
91 use MooseX::Antlers::StealImport
98 $has_args{$_[0]} = \@_;
99 ($replay_has{$_[0]}||die "Can't find replay for $_[0]")
102 meta => sub { 'MooseX::Antlers::ImmutableHackFor::[% target %]' }
106 my $postamble = strip q{
107 no MooseX::Antlers::StealImport qw(Moose);
110 my $compiled = join("\n", $preamble, $self->_raw_source, $postamble);