File Coverage

blib/lib/Moxie.pm

Criterion	Covered	Total	%
statement	93	93	100.0
branch	12	16	75.0
condition	5	6	83.3
subroutine	18	18	100.0
pod	0	1	0.0
total	128	134	95.5

package Moxie;
# ABSTRACT: Not Another Moose Clone

use v5.22;
use warnings;
use experimental qw[
    signatures
    postderef
];

use experimental    (); # need this later when we load features
use Module::Runtime (); # load things so they DWIM
use BEGIN::Lift     (); # fake some keywords
use Method::Traits  (); # for accessor/method generators

use MOP;
use MOP::Util;

use Moxie::Object;
use Moxie::Object::Immutable;
use Moxie::Traits::Provider;

our $VERSION   = '0.07';
our $AUTHORITY = 'cpan:STEVAN';

sub import ($class, %opts) {
    # get the caller ...
    my $caller = caller;

    # make the assumption that if we are
    # loaded outside of main then we are
    # likely being loaded in a class, so
    # turn on all the features
    if ( $caller ne 'main' ) {
        $class->import_into( $caller, \%opts );
    }
}

sub import_into ($class, $caller, $opts) {

    # NOTE:
    # create the meta-object, we start
    # with this as a role, but it will
    # get "cast" to a class if there
    # is a need for it.
    my $meta = MOP::Role->new( name => $caller );

    # turn on strict/warnings
    strict->import;
    warnings->import;

    # so we can have fun with attributes ...
    warnings->unimport('reserved');

    # turn on signatures and more
    experimental->import($_) foreach qw[
        signatures

        postderef
        postderef_qq

        current_sub
        lexical_subs

        say
        state
    ];

    # turn on refaliasing if we have it ...
    experimental->import('refaliasing') if $] >= 5.022;

    # turn on declared refs if we have it ...
    experimental->import('declared_refs') if $] >= 5.026;

    # import has, extend and with keyword

    BEGIN::Lift::install(
        ($caller, 'has') => sub ($name, @args) {

            # NOTE:
            # Handle the simple case of `has $name => $code`
            # by converting it into the more complex
            # `has $name => %opts` version, just easier
            # to maintain internal consistency.
            # - SL

            @args = ( default => $args[0] )
                if scalar @args == 1
                && ref $args[0] eq 'CODE';

            my %args = @args;

            # NOTE:
            # handle the simple case of `required => 1`
            # by providing this default error message
            # with the name embedded. This has to be done
            # here because the Initializer object does
            # not know the name (nor does it need to)
            # - SL

            # TODO - i18n the error message
            $args{required} = 'A value for `'.$name.'` is required'
                if exists $args{required}
                && $args{required} =~ /^1$/;

            my $initializer = MOP::Slot::Initializer->new(
                within_package => $meta->name,
                %args
            );

            $meta->add_slot( $name, $initializer );
            return;
        }
    );

    BEGIN::Lift::install(
        ($caller, 'extends') => sub (@isa) {
            Module::Runtime::use_package_optimistically( $_ ) foreach @isa;
            ($meta->isa('MOP::Class')
                ? $meta
                : do {
                    # FIXME:
                    # This is gross ... - SL
                    Internals::SvREADONLY( $$meta, 0 );
                    bless $meta => 'MOP::Class'; # cast into class
                    Internals::SvREADONLY( $$meta, 1 );
                    $meta;
                }
            )->set_superclasses( @isa );
            return;
        }
    );

    BEGIN::Lift::install(
        ($caller, 'with') => sub (@does) {
            Module::Runtime::use_package_optimistically( $_ ) foreach @does;
            $meta->set_roles( @does );
            return;
        }
    );

    # setup the base traits,
    my @traits = Moxie::Traits::Provider::list_providers();
    # and anything we were asked to load ...
    if ( exists $opts->{'traits'} ) {
        foreach my $trait ( $opts->{'traits'}->@* ) {
            if ( $trait eq ':experimental' ) {
                push @traits => Moxie::Traits::Provider::list_experimental_providers();;
            }
            else {
                push @traits => $trait;
            }
        }
    }

    # then schedule the trait collection ...
    Method::Traits->import_into( $meta->name, @traits );

    # install our class finalizer
    MOP::Util::defer_until_UNITCHECK(sub {

        # pre-populate the cache for all the slots (if it is a class)
        MOP::Util::inherit_slots( $meta );

        # apply roles ...
        MOP::Util::compose_roles( $meta );

        # TODO:
        # Consider locking the %HAS hash now, this will
        # prevent anyone from adding new fields after
        # compile time.
        # - SL

    });
}

1;

__END__