X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Antlers.git;a=blobdiff_plain;f=lib%2FMooseX%2FAntlers%2FCompiler.pm;fp=lib%2FMooseX%2FAntlers%2FCompiler.pm;h=0c0345a2a5acc32ec4ee4966f4ae0b59ea8c2689;hp=0d9e4371d234cf4c5997cca6d4fb9ee86f51d615;hb=3691d03f42d4f21f78221c4d6edb9d03a950c896;hpb=de39aa891a9cab952356a03e3ed39277178cb673 diff --git a/lib/MooseX/Antlers/Compiler.pm b/lib/MooseX/Antlers/Compiler.pm index 0d9e437..0c0345a 100644 --- a/lib/MooseX/Antlers/Compiler.pm +++ b/lib/MooseX/Antlers/Compiler.pm @@ -4,6 +4,8 @@ use Moose; use IO::All qw(io); use String::TT qw(strip tt); use B qw(perlstring); +use Data::Dumper::Concise; +use Scalar::Util qw(refaddr); use aliased 'MooseX::Antlers::RefTracker'; use aliased 'MooseX::Antlers::EvalTracker'; use aliased 'MooseX::Antlers::RefFilter'; @@ -64,16 +66,15 @@ sub compiled_source { my $im_et = $self->_im_et; my $target = $self->_target; my %attr_construct; + my $all_refs = { map %{$_->[1]}, values %attr_refs }; 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 $im_construct = $im_et->serialized_construction($all_refs); + my $preamble = tt strip q{ my %replay_has; my %has_args; BEGIN { @@ -86,7 +87,15 @@ sub compiled_source { ); } sub MooseX::Antlers::ImmutableHackFor::[% target %]::make_immutable { - [% im_construct %] + [% im_construct %] + no warnings 'redefine'; + *[% target %]::meta = sub { + my $meta_code = do { local $/; <[% target %]::DATA> }; + local $@; + my $meta = eval $meta_code; + die $@ if $@; + $meta; + }; } use MooseX::Antlers::StealImport Moose => { @@ -103,8 +112,12 @@ sub compiled_source { }; }; - my $postamble = strip q{ + my $meta_construct = $self->_meta_construction_code($all_refs); + + my $postamble = tt strip q{ no MooseX::Antlers::StealImport qw(Moose); + __DATA__ + [% meta_construct %] }; my $compiled = join("\n", $preamble, $self->_raw_source, $postamble); @@ -112,4 +125,33 @@ sub compiled_source { return $compiled; } +sub _meta_construction_code { + my ($self, $all_refs) = @_; + my $target = $self->_target; + my $meta_obj = $target->meta; + my $mappings = { + %$all_refs, + map +(refaddr($target->can($_)) => '\&'.$target.'::'.$_), + $meta_obj->get_method_list, 'meta' + }; + my $filter = RefFilter->new( + external_mappings => $mappings, + root_name => '$meta' + ); + my $filtered_meta = Dumper($filter->visit($meta_obj)); + my $meta_fixup = $filter->fixup_code; + my $target_string = perlstring($target); + return tt strip q{ + require Moose; + my $meta = [% filtered_meta %]; + [% meta_fixup %] + Class::MOP::store_metaclass_by_name([% target_string %] => $meta); + no warnings 'redefine'; + *[% target %]::meta = sub { + Moose::Meta::Class->initialize( ref($_[0]) || $_[0] ); + }; + $meta; + }; +} + 1;