Acme-Mitey-Cards

 view release on metacpan or  search on metacpan

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

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 );

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

};

# 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 }

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

        }
        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 {
                $role->__FINALIZE_APPLICATION__( $caller, $args );
            }
        }
        return;
    }
}

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

	}

	sub get_message {
		sprintf '%s did not pass type constraint "%s"',
			defined( $_[1] ) ? $_[1] : 'Undef',
			$_[0]{name};
	}

	sub validate {
		$_[0]{check}->( $_[1] )
			? undef
			: $_[0]->get_message( $_[1] );
	}

	sub assert_valid {
		$_[0]{check}->( $_[1] )
			? 1
			: Carp::croak( $_[0]->get_message( $_[1] ) );
	}

	sub assert_return {

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

}

# Tied
{
	my $type;
	sub Tied () {
		$type ||= bless( { check => \&is_Tied, name => "Tied", library => "Types::Standard", library_name => "Tied" }, "Acme::Mitey::Cards::Types::TypeConstraint" );
	}

	sub is_Tied ($) {
		(do {  use Scalar::Util (); (!!ref($_[0])) and !!tied(Scalar::Util::reftype($_[0]) eq 'HASH' ? %{$_[0]} : Scalar::Util::reftype($_[0]) eq 'ARRAY' ? @{$_[0]} : Scalar::Util::reftype($_[0]) =~ /^(SCALAR|REF)$/ ? ${$_[0]} : undef) })
	}

	sub assert_Tied ($) {
		(do {  use Scalar::Util (); (!!ref($_[0])) and !!tied(Scalar::Util::reftype($_[0]) eq 'HASH' ? %{$_[0]} : Scalar::Util::reftype($_[0]) eq 'ARRAY' ? @{$_[0]} : Scalar::Util::reftype($_[0]) =~ /^(SCALAR|REF)$/ ? ${$_[0]} : undef) }) ? $_[0] : Tied->g...
	}

	$EXPORT_TAGS{"Tied"} = [ qw( Tied is_Tied assert_Tied ) ];
	push @EXPORT_OK, @{ $EXPORT_TAGS{"Tied"} };
	push @{ $EXPORT_TAGS{"types"} },  "Tied";
	push @{ $EXPORT_TAGS{"is"} },     "is_Tied";
	push @{ $EXPORT_TAGS{"assert"} }, "assert_Tied";

}

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

To import all of these functions:

  use Acme::Mitey::Cards::Types qw( :Value );

=head1 TYPE CONSTRAINT METHODS

For any type constraint B<Foo> the following methods are available:

 Foo->check( $value )         # boolean
 Foo->get_message( $value )   # error message, even if $value is ok 
 Foo->validate( $value )      # error message, or undef if ok
 Foo->assert_valid( $value )  # returns true, dies if error
 Foo->assert_return( $value ) # returns $value, or dies if error
 Foo->to_TypeTiny             # promotes the object to Type::Tiny

Objects overload stringification to return their name and overload
coderefification to call C<assert_return>.

The objects as-is can be used in L<Moo> or L<Mite> C<isa> options.

 has myattr => (