view release on metacpan or  search on metacpan

lib/MooseX/Compile.pm  view on Meta::CPAN

use constant DEBUG => MooseX::Compile::Base::DEBUG();
use constant default_compiler_class => "MooseX::Compile::Compiler";

use Devel::INC::Sorted qw(inc_add_floating);

BEGIN {
    inc_add_floating(sub {
        my ( $self, $file ) = @_;

        if ( DEBUG ) {
            foreach my $pkg qw(
                Moose
                Moose::Meta::Class

                Class::MOP
                Class::MOP::Class

                metaclass

                Moose::Util::TypeConstraints
                Moose::Meta::TypeConstraint
                Moose::Meta::TypeCoercion
            ) {
                ( my $pkg_file = "$pkg.pm" ) =~ s{::}{/}g;
                require Carp and Carp::carp("loading $pkg") if $file eq $pkg_file;
            }
        }

        if ( $ENV{MX_COMPILE_CLEAN} ) {
            foreach my $dir ( grep { not ref } @INC ) {
                my $full = "$dir/$file";

                my $pmc = "${full}c";
                ( my $mopc = $full ) =~ s/\.pm$/.mopc/;

                if ( -e $pmc && -e $mopc ) {
                    warn "removing compiled class for file '$file'\n" if DEBUG;
                    unlink $pmc or die "Can't remove pmc file (unlink($pmc)): $!";
                    unlink $mopc or die "Can't remove cached metaclass (unlink($mopc)): $!";
                }
            }
        }

        return;
    });
}

sub import {
    my ($self, @args) = @_;

    my ( $class, $file ) = caller();

    if ( $MooseX::Compile::Bootstrap::known_pmc_files{$file} ) {
        return $self->import_from_pmc( $class, $file, @args );
    } else {
        warn "class '$class' requires compilation\n" if DEBUG;

        require Check::UnitCheck;
        Check::UnitCheck::unitcheckify(sub {
            warn "compilation unit of class '$class' calling UNITCHECK\n" if DEBUG;
            $self->unit_check( $class, $file, @args );
        });

        require Moose;
        shift; unshift @_, "Moose";
        goto \&Moose::import;
    }
}

sub import_from_pmc {

}

sub unit_check {
    my ( $self, $class, $file, @args ) = @_;

    $self->compile_from_import(
        class => $class,
        file  => $file,
        @args,
    );
}

sub compile_from_import {
    my ( $self, %args ) = @_;

    if ( $ENV{MX_COMPILE_IMPLICIT_ANCESTORS} ) {
        warn "implicitly compiling all ancestors of class '$args{class}'\n" if DEBUG;
        $self->compile_ancestors( %args );
    }

    $self->compile_class( %args );
}

sub compile_ancestors {
    my ( $self, %args ) = @_;

    my $class = $args{class};
    my $files = $args{files} || {};

    foreach my $superclass ( reverse $class->meta->linearized_isa ) {
        next if $superclass eq $class;
        warn "compiling '$class' superclass '$superclass'\n" if DEBUG;
        $self->compile_class( %args, class => $superclass, file => $files->{$superclass} );
    }
}

sub compile_class {
    my ( $self, %args ) = @_;

    my $compiler = $self->create_compiler( %args );

    $compiler->compile_class( %args );
}

sub compiler_class {
    my ( $self, %args ) = @_;

    $args{compiler_class} || $self->default_compiler_class;
}