X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FCompiler.pm;h=63060463a49f3302bdf4d1f0a2b18d7220eec6e6;hb=f56affb648486c4a45e35a042f8a8281394f1ddc;hp=5b73429e8e358f8f4899fac5e9824ecd0237bc2f;hpb=6029ad7beb4b3c7882674a9066ba56b2e2208d75;p=gitmo%2FMooseX-Compiler.git

diff --git a/lib/MooseX/Compiler.pm b/lib/MooseX/Compiler.pm
index 5b73429..6306046 100644
--- a/lib/MooseX/Compiler.pm
+++ b/lib/MooseX/Compiler.pm
@@ -3,6 +3,7 @@ package MooseX::Compiler;
 use strict;
 use warnings;
 
+use B;
 use Module::Runtime qw( module_notional_filename );
 use PPI::Document;
 use Scalar::Util qw( blessed );
@@ -30,29 +31,58 @@ has _class_meta => (
     default  => sub { $_[0]->class()->meta() },
 );
 
+has _ppi_document => (
+    is       => 'ro',
+    isa      => 'PPI::Document',
+    init_arg => undef,
+    lazy     => 1,
+    builder  => '_build_ppi_document',
+);
+
+has _package_statement => (
+    is       => 'ro',
+    isa      => 'PPI::Statement::Package',
+    init_arg => undef,
+    lazy     => 1,
+    builder  => '_build_package_statement',
+);
+
 sub compile_class {
-    my $self  = shift;
+    my $self = shift;
 
-    my $code
-        = join q{},
-        $self->_adjusted_class_content(),
-        $self->_adjusted_role_content(),
-        $self->_inlined_attribute_code();
+    $self->_modify_class_content();
+    $self->_inline_roles();
+    $self->_inline_constructor();
+    $self->_inline_attributes();
 
-    return $code;
+    return $self->_ppi_document()->content();
 }
 
-sub _adjusted_class_content {
+sub _modify_class_content {
     my $self = shift;
 
-    my $pm_file = module_notional_filename( $self->class() );
-    my $path_to_class = $INC{$pm_file}
-        or die "Cannot find $pm_file in %INC!";
+    $self->_fixup_line_numbers();
+    $self->_do_not_use_moose();
+    $self->_inline_parents();
+    $self->_load_required_modules();
 
-    my $doc = PPI::Document->new( $path_to_class->stringify() )
-        or die PPI::Document->errstr();
+    return;
+}
+
+sub _fixup_line_numbers {
+    my $self = shift;
+
+    my $code = "#line 3\n";
+    $self->_package_statement()->snext_sibling()->insert_before( $_->clone() )
+        for PPI::Document->new( \$code )->children();
+
+    return;
+}
+
+sub _do_not_use_moose {
+    my $self = shift;
 
-    my $use_nodes = $doc->find(
+    my $use_nodes = $self->_ppi_document()->find(
         sub {
             my $node = $_[1];
             return undef
@@ -80,15 +110,110 @@ sub _adjusted_class_content {
         $node->remove();
     }
 
-    return $doc->content();
+    return;
 }
 
-sub _adjusted_role_content {
-    return q{};
+sub _inline_parents {
+    my $self = shift;
+
+    my @supers = $self->_class_meta()->superclasses();
+    return unless @supers;
+
+    my $code = 'use parent ';
+    $code .= join ', ', map { B::perlstring($_) } @supers;
+    $code .= ";\n";
+
+    $self->_package_statement()->insert_after( $_->clone() )
+        for PPI::Document->new( \$code )->children();
+
+    return;
 }
 
-sub _inlined_attribute_code {
-    return q{};
+sub _load_required_modules {
+    my $self = shift;
+
+    my $code = "use Scalar::Util ();\nuse Moose::Error::Util ();\nuse Carp ();\n";
+
+    $self->_package_statement()->insert_after( $_->clone() )
+        for PPI::Document->new( \$code )->children();
+
+    return;
+}
+
+sub _inline_roles {
+    return;
+}
+
+sub _inline_constructor {
+    my $self = shift;
+
+    my $constructor = join "\n",
+        (
+        'sub new {',
+        $self->_class_meta()->_inline_new_object(),
+        '}'
+        );
+
+    $constructor .= "\n\n";
+
+    $self->_insert_before_end($constructor);
+
+    return;
+}
+
+sub _inline_attributes {
+    return;
+}
+
+sub _insert_before_end {
+    my $self = shift;
+    my $code = shift;
+
+    my $end_node = $self->_ppi_document()->find_first(
+        sub {
+            my $node = $_[1];
+
+            return 1
+                if $node->isa('PPI::Statement') && $node->content() =~ /^1;/;
+            return 0;
+        }
+    );
+
+    die 'Cannot find the end of the class (looking for a line match /^1;/)'
+        unless $end_node;
+
+    $end_node->insert_before( $_->clone() )
+        for PPI::Document->new( \$code )->children();
+
+    return;
+}
+
+sub _build_ppi_document {
+    my $self = shift;
+
+    my $pm_file       = module_notional_filename( $self->class() );
+    my $path_to_class = $INC{$pm_file}
+        or die "Cannot find $pm_file in %INC!";
+
+    return PPI::Document->new( $path_to_class->stringify() )
+        or die PPI::Document->errstr();
+}
+
+sub _build_package_statement {
+    my $self = shift;
+
+    my $package_stmt = $self->_ppi_document()->find_first(
+        sub {
+            my $node = $_[1];
+            return 1 if $_[1]->isa('PPI::Statement::Package');
+            return 0;
+        }
+    );
+
+    die 'Cannot find a package statement in this code'
+        unless $package_stmt;
+
+    return $package_stmt;
 }
 
 __PACKAGE__->meta()->make_immutable();