Simplify test code a bit

[gitmo/MooseX-Compiler.git] / lib / MooseX / Compiler.pm

package MooseX::Compiler;

use strict;
use warnings;

use Module::Runtime qw( module_notional_filename );
use PPI::Document;
use Scalar::Util qw( blessed );

use Moose;
use Moose::Util::TypeConstraints;

my $moose_class = subtype, as 'ClassName', where {
    $_[0]->can('meta')
        && blessed $_[0]->meta()
        && $_[0]->meta()->isa('Moose::Meta::Class');
};

has class => (
    is       => 'ro',
    isa      => $moose_class,
    required => 1,
);

has _class_meta => (
    is       => 'ro',
    isa      => 'Moose::Meta::Class',
    init_arg => undef,
    lazy     => 1,
    default  => sub { $_[0]->class()->meta() },
);

sub compile_class {
    my $self  = shift;

    my $code
        = join q{},
        $self->_adjusted_class_content(),
        $self->_adjusted_role_content(),
        $self->_inlined_attribute_code();

    return $code;
}

sub _adjusted_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!";

    my $doc = PPI::Document->new( $path_to_class->stringify() )
        or die PPI::Document->errstr();

    my $use_nodes = $doc->find(
        sub {
            my $node = $_[1];
            return undef
                if $node->isa('PPI::Statement')
                    && !$node->isa('PPI::Statement::Include');
            return undef if $node->isa('PPI::Structure');
            return 1
                if $node->isa('PPI::Statement::Include')
                    && $node->module() =~ /^Moose/;
            return 0;
        }
    );

    for my $node ( @{$use_nodes} ) {
        my $replacement_code .=
            defined $node->module_version()
            ? join(
            q{ },
            'use', $node->module(), $node->module_version(), '()', ';',
            )
            : '# ' . $node->content();

        $node->insert_before( $_->clone() )
            for PPI::Document->new( \$replacement_code )->children();
        $node->remove();
    }

    return $doc->content();
}

sub _adjusted_role_content {
    return q{};
}

sub _inlined_attribute_code {
    return q{};
}

__PACKAGE__->meta()->make_immutable();

1;