File Coverage

blib/lib/JSV/Validator.pm
Criterion Covered Total %
statement 66 67 98.5
branch 3 4 75.0
condition 2 2 100.0
subroutine 22 23 95.6
pod 6 7 85.7
total 99 103 96.1


line stmt bran cond sub pod time code
1             package JSV::Validator;
2              
3 47     47   93153 use strict;
  47         65  
  47         1395  
4 47     47   153 use warnings;
  47         40  
  47         1567  
5              
6             use Class::Accessor::Lite (
7 47         263 new => 0,
8             rw => [qw/
9             reference
10             environment
11             environment_keywords
12             enable_format
13             enable_history
14             throw_error
15             throw_immediate
16             formats
17             /]
18 47     47   18814 );
  47         35767  
19 47     47   20855 use Clone qw(clone);
  47         85989  
  47         2357  
20 47     47   3775 use JSON;
  47         44298  
  47         179  
21 47     47   17285 use JSV::Keyword qw(:constants);
  47         71  
  47         4896  
22 47     47   14418 use JSV::Reference;
  47         80  
  47         1157  
23 47     47   15317 use JSV::Context;
  47         85  
  47         1067  
24 47     47   20847 use Module::Pluggable::Object;
  47         328200  
  47         30095  
25              
26             our $VERSION = "0.08";
27              
28             my %supported_environments = (
29             draft4 => "Draft4"
30             );
31             my %environment_keywords = ();
32              
33             sub load_environments {
34 47     47 0 93 my ($class, @environments) = @_;
35              
36 47         101 for my $environment (@environments) {
37 47 50       149 next unless (exists $supported_environments{$environment});
38             my $finder = Module::Pluggable::Object->new(
39 47         405 search_path => ["JSV::Keyword::" . $supported_environments{$environment}],
40             require => 1,
41             );
42              
43 47         519 $environment_keywords{$environment} = {
44             INSTANCE_TYPE_NUMERIC() => [],
45             INSTANCE_TYPE_STRING() => [],
46             INSTANCE_TYPE_ARRAY() => [],
47             INSTANCE_TYPE_OBJECT() => [],
48             INSTANCE_TYPE_ANY() => [],
49             };
50             my @keywords =
51 47         169 sort { $a->keyword_priority <=> $b->keyword_priority }
  2820         571783  
52             $finder->plugins;
53              
54 47         162 for my $keyword (@keywords) {
55 1128         1416 my $type = $keyword->instance_type;
56 1128         678 push(@{$environment_keywords{$environment}{$type}}, $keyword);
  1128         2404  
57             }
58             }
59             }
60              
61             sub new {
62 62     62 1 25840 my $class = shift;
63 62         145 my %args = @_;
64             %args = (
65             environment => 'draft4',
66             enable_format => 1,
67             enable_history => 0,
68             reference => JSV::Reference->new,
69             formats => +{
70             'date' => sub {
71 6     6   32 ($_[0] =~ /\A\d{4}-\d{2}-\d{2}\z/);
72             },
73             'date-time' => sub {
74             # RFC3339
75 10     10   39 ($_[0] =~ /\A\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}(\.\d+)?(Z|[+-]\d{2}:\d{2})/);
76             },
77             uri => sub {
78 2     2   513 require Data::Validate::URI;
79 2         36033 Data::Validate::URI::is_uri($_[0]);
80             },
81             email => sub {
82 4     4   722 require Email::Valid::Loose;
83 4         75967 Email::Valid::Loose->address($_[0]);
84             },
85             ipv4 => sub {
86 10     10   44 require Data::Validate::IP;
87 10         24 Data::Validate::IP::is_ipv4($_[0]);
88             },
89             ipv6 => sub {
90 8     8   40 require Data::Validate::IP;
91 8         18 Data::Validate::IP::is_ipv6($_[0]);
92             },
93             hostname => sub {
94 8     8   35 require Data::Validate::Domain;
95 8         21 Data::Validate::Domain::is_domain($_[0]);
96             },
97             },
98 62         350 %args,
99             );
100              
101             ### RECOMMENDED: you should do to preloading environment before calling constructor
102 62 100       244 unless (exists $environment_keywords{$args{environment}}) {
103 47         166 $class->load_environments($args{environment});
104             }
105              
106             bless {
107 62         539 environment_keywords => \%environment_keywords,
108             %args,
109             } => $class;
110             }
111              
112             sub validate {
113 768     768 1 16846 my ($self, $schema, $instance, $opts) = @_;
114              
115 768   100     1966 $opts ||= +{};
116 768         2245 %$opts = (
117             loose_type => 0,
118             %$opts,
119             );
120              
121             my $context = JSV::Context->new(
122             keywords => +{
123             INSTANCE_TYPE_ANY() => $self->instance_type_keywords(INSTANCE_TYPE_ANY),
124             INSTANCE_TYPE_NUMERIC() => $self->instance_type_keywords(INSTANCE_TYPE_NUMERIC),
125             INSTANCE_TYPE_STRING() => $self->instance_type_keywords(INSTANCE_TYPE_STRING),
126             INSTANCE_TYPE_ARRAY() => $self->instance_type_keywords(INSTANCE_TYPE_ARRAY),
127             INSTANCE_TYPE_OBJECT() => $self->instance_type_keywords(INSTANCE_TYPE_OBJECT),
128             },
129             reference => $self->reference,
130             environment => $self->environment,
131             original_schema => $schema,
132             throw_error => $self->throw_error,
133             throw_immediate => $self->throw_immediate,
134             enable_history => $self->enable_history,
135             enable_format => $self->enable_format,
136             formats => $self->formats,
137             history => [],
138             errors => [],
139             current_pointer => "",
140             current_schema_pointer => "",
141             schema_pointer_history => [],
142             json => JSON->new->allow_nonref,
143             loose_type => $opts->{loose_type},
144 768         1559 );
145              
146 768         21987 return $context->validate($schema, $instance);
147             }
148              
149             sub instance_type_keywords {
150 3840     3840 1 13496 my ($self, $instance_type) = @_;
151 3840         5180 return $self->environment_keywords->{$self->environment}{$instance_type};
152             }
153              
154             sub register_schema {
155 4     4 1 6507 shift->reference->register_schema(@_);
156             }
157              
158             sub unregister_schema {
159 0     0 1 0 shift->reference->unregister_schema(@_);
160             }
161              
162             sub register_format {
163 2     2 1 12 my ($self, $format, $format_validator) = @_;
164 2         6 shift->formats->{$format} = $format_validator;
165             }
166              
167             1;
168              
169             __END__