view release on metacpan or  search on metacpan

lib/Acme/Mitey/Cards/Mite.pm  view on Meta::CPAN

sub croak   { unshift @_, 'croak'  ; goto \&_error_handler }
sub confess { unshift @_, 'confess'; goto \&_error_handler }

# Exportable guard function
{
    my $GUARD_PACKAGE = __PACKAGE__ . '::Guard';
    *{"$GUARD_PACKAGE\::DESTROY"} = sub { $_[0][0] or $_[0][1]->() };
    *{"$GUARD_PACKAGE\::restore"} = sub { $_[0]->DESTROY; $_[0][0] = true };
    *{"$GUARD_PACKAGE\::dismiss"} = sub {                 $_[0][0] = true };
    *{"$GUARD_PACKAGE\::peek"}    = sub { $_[0][2] };
    *guard = sub (&) { bless [ 0, @_ ] => $GUARD_PACKAGE };
}

# Exportable lock and unlock
sub _lul {
    my ( $lul, $ref ) = @_;
    if ( ref $ref eq 'ARRAY' ) {
        &Internals::SvREADONLY( $ref, $lul );
        &Internals::SvREADONLY( \$_, $lul ) for @$ref;
        return;
    }
    if ( ref $ref eq 'HASH' ) {
        &Internals::hv_clear_placeholders( $ref );
        &Internals::SvREADONLY( $ref, $lul );
        &Internals::SvREADONLY( \$_, $lul ) for values %$ref;
        return;
    }
    return;
}

sub lock {
    unshift @_, true;
    goto \&_lul;
}

sub unlock {
    my $ref = shift;
    _lul( 0 , $ref );
    &guard( sub { _lul( 1, $ref ) } );
}

sub _is_compiling {
    defined $Mite::COMPILING and $Mite::COMPILING eq __PACKAGE__;
}

sub import {
    my $me = shift;
    my %arg = map +( lc($_) => true ), @_;
    my ( $caller, $file ) = caller;

    if( _is_compiling() ) {
        require Mite::Project;
        'Mite::Project'->default->inject_mite_functions(
            'package' => $caller,
            'file'    => $file,
            'arg'     => \%arg,
            'shim'    => $me,
        );
    }
    else {
        # Try to determine original filename for caller, minus libdir.
        # This would normally be in %INC but caller hasn't finished loading yet.
        require File::Spec;
        my $orig = $file;
        for my $base ( @INC ) {
            $base eq substr $file, 0, length $base
            and -f File::Spec->catfile( $base, substr $file, 1 + length $base )
            and $orig = File::Spec->abs2rel( $file, $base )
            and last;
        }

        # Changes to this filename must be coordinated with Mite::Compiled
        my $mite_file = $orig . '.mite.pm';
        local $@;
        if ( not eval { require $mite_file; 1 } ) {
            my $e = $@;
            croak "Compiled Mite file ($mite_file) for $file is missing or an error occurred loading it: $e";
        }
    }

    'warnings'->import;
    'strict'->import;
    'namespace::autoclean'->import( -cleanee => $caller )
        if _HAS_AUTOCLEAN && !$arg{'-unclean'};
}

{
    my ( $cb_before, $cb_after );
    sub _finalize_application_roletiny {
        my ( $me, $role, $caller, $args ) = @_;
        if ( $INC{'Role/Hooks.pm'} ) {
            $cb_before ||= \%Role::Hooks::CALLBACKS_BEFORE_APPLY;
            $cb_after  ||= \%Role::Hooks::CALLBACKS_AFTER_APPLY;
        }
        if ( $cb_before ) {
            $_->( $role, $caller ) for @{ $cb_before->{$role} || [] };
        }
        'Role::Tiny'->_check_requires( $caller, $role );
        my $info = $Role::Tiny::INFO{$role};
        for ( @{ $info->{modifiers} || [] } ) {
            my @args         = @$_;
            my $modification = shift @args;
            my $handler      = "HANDLE_$modification";
            $me->$handler( $caller, undef, @args );
        }
        if ( $cb_after ) {
            $_->( $role, $caller ) for @{ $cb_after->{$role} || [] };
        }
        return;
    }

    # Usage: $me, $caller, @with_args
    sub HANDLE_with {
        my ( $me, $caller ) = ( shift, shift );
        while ( @_ ) {
            my $role = shift;
            my $args = ref($_[0]) ? shift : undef;
            if ( $INC{'Role/Tiny.pm'} and 'Role::Tiny'->is_role( $role ) ) {
                $me->_finalize_application_roletiny( $role, $caller, $args );
            }
            else {