File Coverage

blib/lib/Type/Tiny/NumEqu.pm
Criterion Covered Total %
statement 43 47 91.4
branch 16 24 66.6
condition 1 3 33.3
subroutine 12 15 80.0
pod 6 6 100.0
total 78 95 82.1


line stmt bran cond sub pod time code
1             package Type::Tiny::NumEqu;
2 2     2   15 use strict;
  2         3  
  2         78  
3 2     2   11 use warnings;
  2         3  
  2         155  
4              
5             our $VERSION = "0.03";
6              
7 2     2   14 use parent qw( Type::Tiny );
  2         3  
  2         11  
8              
9 1     1   9 sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
  1         9  
10              
11             sub new {
12 5     5 1 17 my $class = shift;
13              
14 5 50       39 my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
  0         0  
15              
16             _croak "NumEqu type constraints cannot have a parent constraint passed to the constructor"
17 5 50       29 if exists $opts{parent};
18              
19             _croak "NumEqu type constraints cannot have a constraint coderef passed to the constructor"
20 5 50       22 if exists $opts{constraint};
21              
22             _croak "NumEqu type constraints cannot have a inlining coderef passed to the constructor"
23 5 50       19 if exists $opts{inlined};
24              
25 5 50       21 _croak "Need to supply value" unless exists $opts{value};
26              
27 5 100       19 if (defined $opts{value}) {
28 2     2   576 use warnings FATAL => 'numeric';
  2         4  
  2         1292  
29 3         9 eval {
30 3         37 $opts{value} = $opts{value} + 0; # numify
31             };
32 3 100       18 if ($@) {
33 1         7 _croak sprintf("`%s` is not number. NumEqu value must be number.", $opts{value});
34             }
35             }
36              
37 4         133 return $class->SUPER::new( %opts );
38             }
39              
40 16     16 1 47418 sub value { $_[0]{value} }
41              
42             sub _build_display_name {
43 4     4   73 my $self = shift;
44              
45 4 100       14 defined $self->value
46             ? sprintf( "NumEqu[%s]", $self->value )
47             : "NumEqu[Undef]";
48             }
49              
50             sub has_parent {
51 0     0 1 0 !!0;
52             }
53              
54 4   33 4 1 2860 sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint }
55              
56             sub _build_constraint {
57 4     4   10 my $self = shift;
58              
59 4 100       17 if (defined $self->value) {
60             return sub {
61 0 0   0   0 defined $_ && $_ == $self->value;
62 2         28 };
63             }
64             else {
65             return sub {
66 0     0   0 !defined $_;
67 2         20 };
68             }
69             }
70              
71             sub can_be_inlined {
72 4     4 1 108 !!1;
73             }
74              
75             sub inline_check {
76 4     4 1 20 my $self = shift;
77              
78 4         12 my $value = $self->value;
79              
80 4         11 my $code;
81 4 100       355 if (defined $value) {
82 2         10 $code = "(defined($_[0]) && $_[0] == $value)";
83             }
84             else {
85 2         5 $code = "!defined($_[0])";
86             }
87              
88 4 50       14 return "do { $Type::Tiny::SafePackage $code }"
89             if $Type::Tiny::AvoidCallbacks; ## no critic (Variables::ProhibitPackageVars)
90 4         34 return $code;
91             }
92              
93             1;
94             __END__