File Coverage

blib/lib/Data/Rx/CoreType/num.pm
Criterion Covered Total %
statement 33 33 100.0
branch 19 20 95.0
condition 11 14 78.5
subroutine 9 9 100.0
pod 0 3 0.0
total 72 79 91.1


line stmt bran cond sub pod time code
1 1     1   432 use v5.12.0;
  1         3  
2 1     1   5 use warnings;
  1         1  
  1         50  
3             package Data::Rx::CoreType::num 0.200008;
4             # ABSTRACT: the Rx //num type
5              
6 1     1   6 use parent 'Data::Rx::CoreType';
  1         2  
  1         5  
7              
8             sub guts_from_arg {
9 34     34 0 102 my ($class, $arg, $rx, $type) = @_;
10              
11 34 100       175 Carp::croak("unknown arguments to new")
12             unless Data::Rx::Util->_x_subset_keys_y($arg, { range => 1, value => 1});
13              
14 32         93 my $guts = {};
15              
16             $guts->{range_check} = Data::Rx::Util->_make_range_check($arg->{range})
17 32 100       103 if $arg->{range};
18              
19 32 100       92 if (exists $arg->{value}) {
20 4         12 my $val = $arg->{value};
21 4 50 66     41 if (
      66        
22             (! defined $val)
23             or ref $val
24             or ! $class->_value_is_of_type($val)
25             ) {
26 1   50     8 Carp::croak(sprintf(
27             'invalid value (%s) for //%s',
28             $val // 'undef',
29             $class->subname,
30             ));
31             }
32             }
33              
34 31 100       80 $guts->{value} = $arg->{value} if defined $arg->{value};
35              
36 31         84 return $guts;
37             }
38              
39             sub __type_fail {
40 114     114   212 my ($self, $value) = @_;
41 114         608 $self->fail({
42             error => [ qw(type) ],
43             message => "value is not a number",
44             value => $value,
45             });
46             }
47              
48             my $_NUM_RE;
49             BEGIN {
50 1     1   580 $_NUM_RE = qr/
51             \A
52             [-+]?
53             (?:0|[1-9]\d*)
54             (?:\.\d+)?
55             (?:e
56             (?:0|[1-9]\d*)
57             )?
58             \z
59             /ix;
60             }
61              
62             sub _value_is_of_type {
63 289     289   580 my ($self, $value) = @_;
64              
65 289         3066 return $value =~ $_NUM_RE;
66             }
67              
68             sub assert_valid {
69 499     499 0 66976 my ($self, $value) = @_;
70              
71 499 100       1736 $self->__type_fail($value) unless length $value;
72              
73             # XXX: This is insufficiently precise. It's here to keep us from believing
74             # that JSON::XS::Boolean objects, which end up looking like 0 or 1, are
75             # integers. -- rjbs, 2008-07-24
76 485 100       1439 $self->__type_fail($value) if ref $value;
77              
78 286 100       791 $self->__type_fail($value) unless $self->_value_is_of_type($value);
79              
80 197 100 100     717 if ($self->{range_check} && ! $self->{range_check}->($value)) {
81 24         536 $self->fail({
82             error => [ qw(range) ],
83             message => "value is outside allowed range",
84             value => $value,
85             });
86             }
87              
88 173 100 100     677 if (defined($self->{value}) && $value != $self->{value}) {
89 20         127 $self->fail({
90             error => [ qw(value) ],
91             message => "found value is not the required value",
92             value => $value,
93             });
94             }
95              
96 153         425 return 1;
97             }
98              
99 71     71 0 384 sub subname { 'num' }
100              
101             1;
102              
103             __END__