File Coverage

blib/lib/Type/Tiny/NumEqu.pm

Criterion	Covered	Total	%
statement	45	49	91.8
branch	16	24	66.6
condition	1	3	33.3
subroutine	13	16	81.2
pod	6	6	100.0
total	81	98	82.6

package Type::Tiny::NumEqu;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.02";

use parent qw( Type::Tiny );

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

sub new {
    my $class = shift;

    my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;

    _croak "NumEqu type constraints cannot have a parent constraint passed to the constructor"
        if exists $opts{parent};

    _croak "NumEqu type constraints cannot have a constraint coderef passed to the constructor"
        if exists $opts{constraint};

    _croak "NumEqu type constraints cannot have a inlining coderef passed to the constructor"
        if exists $opts{inlined};

    _croak "Need to supply value" unless exists $opts{value};

    if (defined $opts{value}) {
        use warnings FATAL => 'numeric';
        eval {
            $opts{value} = $opts{value} + 0; # numify
        };
        if ($@) {
            _croak sprintf("`%s` is not number. NumEqu value must be number.", $opts{value});
        }
    }

    return $class->SUPER::new( %opts );
}

sub value { $_[0]{value} }

sub _build_display_name {
    my $self = shift;

    defined $self->value
        ? sprintf( "NumEqu[%s]", $self->value )
        : "NumEqu[Undef]";
}

sub has_parent {
    !!0;
}

sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }

sub _build_constraint {
    my $self = shift;

    if (defined $self->value) {
        return sub {
            defined $_ && $_ == $self->value;
        };
    }
    else {
        return sub {
            !defined $_;
        };
    }
}

sub can_be_inlined {
    !!1;
}

sub inline_check {
    my $self = shift;

    my $value = $self->value;

    my $code;
    if (defined $value) {
        $code = "(defined($_[0]) && $_[0] == $value)";
    }
    else {
        $code = "!defined($_[0])";
    }

    return "do { $Type::Tiny::SafePackage $code }"
        if $Type::Tiny::AvoidCallbacks; ## no critic (Variables::ProhibitPackageVars)
    return $code;
}

1;
__END__