File Coverage

blib/lib/MooX/MouseTypeConstraints.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	9	10	90.0
condition	1	3	33.3
subroutine	13	13	100.0
pod			n/a
total	64	67	95.5

package MooX::MouseTypeConstraints;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.01";

use B::Hooks::EndOfScope;
use Mouse::Util::TypeConstraints ();

sub import {
    my $class = shift;
    my $target = caller;

    on_scope_end {
        my $has = $target->can('has')
            or die q|Moo's internal DSL keyword `has` is not found. (perhaps you forgot to load "Moo"?)|;
        my $code = sub {
            my ($name, %args) = @_;
            if (exists $args{isa} && !ref $args{isa}) {
                my $type = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($args{isa});
                $args{isa} = _generate_isa($type);
            }
            @_ = ($name, %args);
            goto $has;
        };

        my $glob = "${target}::has";
        {
            no strict qw/refs/;
            no warnings qw/prototype redefine/;
            *{$glob} = $code;
        };
    };
}

sub _generate_isa {
    my $type = shift;
    if ($type->has_coercion) {
        return sub {
            die $type->get_message(@_) unless $type->check($type->coerce(@_));
        };
    } else {
        return sub {
            die $type->get_message(@_) unless $type->check(@_);
        };
    }
}

1;
__END__