view release on metacpan or  search on metacpan

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

# NOTE: Since the intention is to ship this file with a project, this file
# cannot have any non-core dependencies.
package Acme::Mitey::Cards::Mite;
use 5.008001;
use strict;
use warnings;
no strict 'refs';

if ( $] < 5.009005 ) { require MRO::Compat; }
else                 { require mro;         }

defined ${^GLOBAL_PHASE}
or eval { require Devel::GlobalDestruction; 1 }
or do {
    carp( "WARNING: Devel::GlobalDestruction recommended!" );
    *Devel::GlobalDestruction::in_global_destruction = sub { undef; };
};

# Constants
sub true  () { !!1 }
sub false () { !!0 }
sub ro    () { 'ro' }
sub rw    () { 'rw' }
sub rwp   () { 'rwp' }
sub lazy  () { 'lazy' }
sub bare  () { 'bare' }

# More complicated constants
BEGIN {
    my @bool = ( \&false, \&true );
    *_HAS_AUTOCLEAN = $bool[ 0+!! eval { require namespace::autoclean } ];
    *STRICT         = $bool[ 0+!! ( $ENV{PERL_STRICT} || $ENV{EXTENDED_TESTING} || $ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING} ) ];
};

# Exportable error handlers
sub _error_handler {
    my ( $func, $message, @args ) = @_;
    if ( @args ) {
        require Data::Dumper;
        local $Data::Dumper::Terse  = 1;
        local $Data::Dumper::Indent = 0;
        $message = sprintf $message, map {
            ref($_) ? Data::Dumper::Dumper($_) : defined($_) ? $_ : '(undef)'
        } @args;
    }
    my $next = do { require Carp; \&{"Carp::$func"} };
    @_ = ( $message );
    goto $next;
}

sub carp    { unshift @_, 'carp'   ; goto \&_error_handler }
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;