lib/MooseX/Compiler.pm

   1 package MooseX::Compiler;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Module::Runtime qw( module_notional_filename );
   7 use PPI::Document;
   8 use Scalar::Util qw( blessed );
   9
  10 use Moose;
  11 use Moose::Util::TypeConstraints;
  12
  13 my $moose_class = subtype, as 'ClassName', where {
  14     $_[0]->can('meta')
  15         && blessed $_[0]->meta()
  16         && $_[0]->meta()->isa('Moose::Meta::Class');
  17 };
  18
  19 has class => (
  20     is       => 'ro',
  21     isa      => $moose_class,
  22     required => 1,
  23 );
  24
  25 has _class_meta => (
  26     is       => 'ro',
  27     isa      => 'Moose::Meta::Class',
  28     init_arg => undef,
  29     lazy     => 1,
  30     default  => sub { $_[0]->class()->meta() },
  31 );
  32
  33 sub compile_class {
  34     my $self  = shift;
  35
  36     my $code
  37         = join q{},
  38         $self->_adjusted_class_content(),
  39         $self->_adjusted_role_content(),
  40         $self->_inlined_attribute_code();
  41
  42     return $code;
  43 }
  44
  45 sub _adjusted_class_content {
  46     my $self = shift;
  47
  48     my $pm_file = module_notional_filename( $self->class() );
  49     my $path_to_class = $INC{$pm_file}
  50         or die "Cannot find $pm_file in %INC!";
  51
  52     my $doc = PPI::Document->new( $path_to_class->stringify() )
  53         or die PPI::Document->errstr();
  54
  55     my $use_nodes = $doc->find(
  56         sub {
  57             my $node = $_[1];
  58             return undef
  59                 if $node->isa('PPI::Statement')
  60                     && !$node->isa('PPI::Statement::Include');
  61             return undef if $node->isa('PPI::Structure');
  62             return 1
  63                 if $node->isa('PPI::Statement::Include')
  64                     && $node->module() =~ /^Moose/;
  65             return 0;
  66         }
  67     );
  68
  69     for my $node ( @{$use_nodes} ) {
  70         my $replacement_code .=
  71             defined $node->module_version()
  72             ? join(
  73             q{ },
  74             'use', $node->module(), $node->module_version(), '()', ';',
  75             )
  76             : '# ' . $node->content();
  77
  78         $node->insert_before( $_->clone() )
  79             for PPI::Document->new( \$replacement_code )->children();
  80         $node->remove();
  81     }
  82
  83     return $doc->content();
  84 }
  85
  86 sub _adjusted_role_content {
  87     return q{};
  88 }
  89
  90 sub _inlined_attribute_code {
  91     return q{};
  92 }
  93
  94 __PACKAGE__->meta()->make_immutable();
  95
  96 1;