view release on metacpan or  search on metacpan

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

    file    => __FILE__,
    version => $version,
);
REGISTER
}

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

    my $hide = <<'#\'HIDE_MOOSE';
#\
# disable requiring and importing of Moose from this compile class
my ( $__mx_compile_prev_require, %__mx_compile_overridden_imports );

BEGIN {
    $__mx_compile_prev_require = defined &CORE::GLOBAL::require ? \&CORE::GLOBAL::require : undef;

    no warnings 'redefine';

    # FIXME move this to Bootstrap? Bootstrap->override_global_require( class => $$quoted_class$$ )?
    *CORE::GLOBAL::require = sub {
        my ( $faked_class ) = ( $_[0] =~ m/^ ( Moose | metaclass ) \.pm $/x );

        return 1 if caller() eq $$quoted_class$$ and $faked_class;

        my $hook;

        if ( $faked_class and not $INC{$_[0]} ) {
            # load Moose or metaclass in a clean env, and then wrap it's import()
            no strict 'refs';

            my $import = "${faked_class}::import";

            my $wrapper = \&$import;

            undef *$import; # clean out the symbol so it doesn't warn about redefining

            $hook = bless [sub {
                $__mx_compile_overridden_imports{$faked_class} = \&$import; # stash the real import
                *$import = $wrapper;
            }], "MooseX::Compile::Scope::Guard";
        }

        if ( $__mx_compile_prev_require ) {
            &$__mx_compile_prev_require;
        } else {
            require $_[0];
        }
    };

    foreach my $class qw(Moose metaclass) {
        no strict 'refs';

        my $import = "${class}::import";

        $__mx_compile_overridden_imports{$class} = defined &$import && \&$import;

        *$import = sub {
            if ( caller eq $$quoted_class$$ ) {
                if ( $class eq 'Moose' ) {
                    strict->import;
                    warnings->import;
                }

                return;
            }

            if ( my $sub = $__mx_compile_overridden_imports{\$class} ) {
                goto $sub;
            }

            return;
        };
    }
}
#'HIDE_MOOSE

    $hide =~ s/\$\$(\w+)\$\$/$args{$1}/ge;

    return $hide;
}

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

    my $class = $args{class};

    my $quoted_class = dump($class);

    my $decl = $self->pmc_preamble_class_def_for_begin(%args);

    return <<ENV;
# stub the sugar
BEGIN {
    package $class;

    my \$fake_meta = bless { name => $quoted_class }, "MooseX::Compile::MetaBlackHole";
    sub meta { \$fake_meta }

$decl

    our \$__mx_is_compiled = 1;
}
ENV
}

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

    join("\n\n", $self->compile_code_symbols( %args, symbol_categories => [qw(moose_sugar moose_exports)] ) );
}

sub pmc_preamble_at_end {
    my ( $self, %args ) = @_;
    my ( $class, $code ) = @args{qw(class code)};

    return <<HOOK
# try to approximate the time that Moose generated code enters the class
# this presumes you didn't stick the moose sugar in a BEGIN { } block
my \$__mx_compile_run_at_end = bless [ sub {