File Coverage

blib/lib/Valiemon/Primitives.pm
Criterion Covered Total %
statement 47 47 100.0
branch 28 30 93.3
condition 47 53 88.6
subroutine 17 17 100.0
pod 0 11 0.0
total 139 158 87.9


line stmt bran cond sub pod time code
1             package Valiemon::Primitives;
2 19     19   92 use strict;
  19         33  
  19         1110  
3 19     19   97 use warnings;
  19         29  
  19         579  
4 19     19   94 use utf8;
  19         27  
  19         93  
5              
6 19     19   596 use Scalar::Util qw(looks_like_number);
  19         31  
  19         2180  
7 19     19   11052 use Types::Serialiser;
  19         87959  
  19         724  
8 19     19   16119 use Test::Deep qw(eq_deeply);
  19         182882  
  19         143  
9              
10             sub new {
11 53     53 0 20988 my ($class, $options) = @_;
12 53   100     615 return bless {
13             options => $options || +{},
14             }, $class;
15             }
16              
17             sub is_object {
18 67     67 0 125 my ($self, $obj) = @_;
19 67 100 100     622 (defined $obj && ref $obj eq 'HASH') ? 1 : 0;
20             }
21              
22             sub is_array {
23 24     24 0 44 my ($self, $obj) = @_;
24 24 100 100     218 (defined $obj && ref $obj eq 'ARRAY') ? 1 : 0;
25             }
26              
27             sub is_string {
28 201     201 0 1058 my ($self, $obj) = @_;
29 201 100 100     1607 (defined $obj && ref $obj eq '') ? 1 : 0; # really?
30             }
31              
32             sub is_number {
33 105     105 0 944 my ($self, $obj) = @_;
34 105 100 100     704 (defined $obj && looks_like_number($obj)) ? 1 : 0;
35             }
36              
37             sub is_integer {
38 81     81 0 934 my ($self, $obj) = @_;
39 81 100 100     1660 (defined $obj && $obj =~ qr/^-?\d+$/) ? 1 : 0; # TODO find more better way
40             }
41              
42             sub is_boolean {
43 130     130 0 219 my ($self, $obj) = @_;
44             return $self->{options}->{use_json_boolean}
45 130 100       434 ? $self->is_boolean_json($obj)
46             : $self->is_boolean_perl($obj)
47             }
48              
49             sub is_boolean_perl { # 1 or 0
50 140     140 0 1030 my ($self, $obj) = @_;
51 140 100 66     1455 (defined $obj && looks_like_number($obj) && ($obj == 1 || $obj == 0)) ? 1 : 0; # TODO invalidate 0.0
52             }
53              
54             sub is_boolean_json {
55 22     22 0 68 my ($self, $obj) = @_;
56 22 100 100     94 return 1 if defined $obj && Types::Serialiser::is_bool($obj);
57 15 50 66     180 return 1 if ref $obj eq 'SCALAR' && looks_like_number($$obj) && ($$obj == 1 || $$obj == 0);
      66        
      66        
58 11         50 return 0;
59             }
60              
61             sub is_null {
62 7     7 0 55 my ($self, $obj) = @_;
63 7 100       42 !defined($obj) ? 1 : 0;
64             }
65              
66             # json schema core: 3.6 JSON value equality
67             sub is_equal {
68 101     101 0 742 my ($self, $a, $b) = @_;
69 101 100 66     263 return 1 if !defined($a) && !defined($b);
70 100 100 100     241 return 1 if $self->is_boolean($a) && $self->is_boolean($b) && $a == $b;
      100        
71 94 100 100     239 return 1 if $self->is_string($a) && $self->is_string($b) && "$a" eq "$b"; # ah
      100        
72 84 50 100     191 return 1 if $self->is_number($a) && $self->is_number($b) && $a == $b;
      66        
73 84 100       253 return 1 if eq_deeply($a, $b); # array & object
74 78         38628 return 0;
75             }
76              
77             1;