--- /dev/null
+package MooseX::Antlers::Compiler;
+
+use Moose;
+use IO::All qw(io);
+use String::TT qw(strip tt);
+use B qw(perlstring);
+use aliased 'MooseX::Antlers::RefTracker';
+use aliased 'MooseX::Antlers::EvalTracker';
+use aliased 'MooseX::Antlers::RefFilter';
+
+has [ qw(_target _attr_refs _attr_et _im_et _raw_source) ] => (is => 'rw');
+
+sub load_with_compiler {
+ my ($class, $target) = @_;
+ $class->new->load($target);
+}
+
+sub load {
+ my ($self, $target) = @_;
+ my %attr_refs;
+ my %attr_et;
+ my $im_et;
+ my $orig_import = Moose->can('import');
+ no warnings 'redefine';
+ local *Moose::import = sub {
+ my $targ = caller;
+ Moose->$orig_import({ into => $targ });
+ my $has = $targ->can('has');
+ {
+ no strict 'refs';
+ *{"${targ}::has"} = sub {
+ $attr_refs{$_[0]} = [
+ map RefTracker->trace_refs( $_ => \@_ ),
+ '(\@_)', '$has_args{'.perlstring($_[0]).'}'
+ ];
+ my $et = EvalTracker->new->enable;
+ $has->(@_);
+ $attr_et{$_[0]} = $et->disable;
+ return;
+ };
+ }
+ };
+ my $orig_immutable = Moose::Meta::Class->can('make_immutable');
+ local *Moose::Meta::Class::make_immutable = sub {
+ my $et = EvalTracker->new->enable;
+ $orig_immutable->(@_);
+ $im_et = $et->disable;
+ return;
+ };
+ Class::MOP::load_class($target);
+ $self->_attr_refs(\%attr_refs);
+ $self->_attr_et(\%attr_et);
+ $self->_im_et($im_et);
+ $self->_target($target);
+ (my $pm_file = $target) =~ s/::/\//g;
+ $self->_raw_source(scalar io($INC{"${pm_file}.pm"})->slurp);
+ return $self;
+}
+
+sub compiled_source {
+ my ($self) = @_;
+ my %attr_et = %{$self->_attr_et};
+ my %attr_refs = %{$self->_attr_refs};
+ my $im_et = $self->_im_et;
+ my $target = $self->_target;
+ my %attr_construct;
+ foreach my $attr_name (keys %attr_refs) {
+ $attr_construct{$attr_name}
+ = $attr_et{$attr_name}->serialized_construction(
+ $attr_refs{$attr_name}[0]
+ );
+ }
+ my $im_construct = $im_et->serialized_construction(
+ { map %{$_->[1]}, values %attr_refs }
+ );
+ my $preamble = strip tt q{
+ my %replay_has;
+ my %has_args;
+ BEGIN {
+ %replay_has = (
+ [% FOREACH a IN attr_construct_h %]
+ [% a.key %] => sub {
+ [% a.value %]
+ }
+ [% END %]
+ );
+ }
+ sub MooseX::Antlers::ImmutableHackFor::[% target %]::make_immutable {
+ [% im_construct %]
+ }
+ use MooseX::Antlers::StealImport
+ Moose => {
+ -do => sub {
+ strict->import;
+ warnings->import;
+ },
+ has => sub {
+ $has_args{$_[0]} = \@_;
+ ($replay_has{$_[0]}||die "Can't find replay for $_[0]")
+ ->(@_);
+ },
+ meta => sub { 'MooseX::Antlers::ImmutableHackFor::[% target %]' }
+ };
+ };
+
+ my $postamble = strip q{
+ no MooseX::Antlers::StealImport qw(Moose);
+ };
+
+ my $compiled = join("\n", $preamble, $self->_raw_source, $postamble);
+
+ return $compiled;
+}
+
+1;