File Coverage

blib/lib/JSV/Validator.pm
Criterion Covered Total %
statement 56 67 83.5
branch 3 4 75.0
condition 2 2 100.0
subroutine 17 23 73.9
pod 0 7 0.0
total 78 103 75.7


line stmt bran cond sub pod time code
1             package JSV::Validator;
2              
3 44     44   62367 use strict;
  44         77  
  44         1432  
4 44     44   203 use warnings;
  44         63  
  44         1950  
5              
6             use Class::Accessor::Lite (
7 44         333 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 44     44   32513 );
  44         45139  
19 44     44   101473 use Clone qw(clone);
  44         239682  
  44         2869  
20 44     44   5507 use JSON;
  44         61198  
  44         263  
21 44     44   24424 use JSV::Keyword qw(:constants);
  44         99  
  44         5761  
22 44     44   19804 use JSV::Reference;
  44         139  
  44         1393  
23 44     44   32343 use JSV::Context;
  44         356  
  44         2425  
24 44     44   37872 use Module::Pluggable::Object;
  44         467237  
  44         39725  
25              
26             our $VERSION = "0.06";
27              
28             my %supported_environments = (
29             draft4 => "Draft4"
30             );
31             my %environment_keywords = ();
32              
33             sub load_environments {
34 44     44 0 130 my ($class, @environments) = @_;
35              
36 44         142 for my $environment (@environments) {
37 44 50       200 next unless (exists $supported_environments{$environment});
38             my $finder = Module::Pluggable::Object->new(
39 44         532 search_path => ["JSV::Keyword::" . $supported_environments{$environment}],
40             require => 1,
41             );
42              
43 44         665 $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 44         261 sort { $a->keyword_priority <=> $b->keyword_priority }
  2640         878992  
52             $finder->plugins;
53              
54 44         232 for my $keyword (@keywords) {
55 1056         2469 my $type = $keyword->instance_type;
56 1056         1105 push(@{$environment_keywords{$environment}{$type}}, $keyword);
  1056         3765  
57             }
58             }
59             }
60              
61             sub new {
62 59     59 0 38445 my $class = shift;
63 59         163 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   38 ($_[0] =~ /\A\d{4}-\d{2}-\d{2}\z/);
72             },
73             'date-time' => sub {
74             # RFC3339
75 4     4   17 ($_[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 0     0   0 require Data::Validate::URI;
79 0         0 Data::Validate::URI::is_uri($_[0]);
80             },
81             email => sub {
82 0     0   0 require Email::Valid::Loose;
83 0         0 Email::Valid::Loose->address($_[0]);
84             },
85             ipv4 => sub {
86 0     0   0 require Data::Validate::IP;
87 0         0 Data::Validate::IP::is_ipv4($_[0]);
88             },
89             ipv6 => sub {
90 0     0   0 require Data::Validate::IP;
91 0         0 Data::Validate::IP::is_ipv6($_[0]);
92             },
93             hostname => sub {
94 0     0   0 require Data::Validate::Domain;
95 0         0 Data::Validate::Domain::is_domain($_[0]);
96             },
97             },
98 59         465 %args,
99             );
100              
101             ### RECOMMENDED: you should do to preloading environment before calling constructor
102 59 100       320 unless (exists $environment_keywords{$args{environment}}) {
103 44         221 $class->load_environments($args{environment});
104             }
105              
106             bless {
107 59         742 environment_keywords => \%environment_keywords,
108             %args,
109             } => $class;
110             }
111              
112             sub validate {
113 728     728 0 16923 my ($self, $schema, $instance, $opts) = @_;
114              
115 728   100     2821 $opts ||= +{};
116 728         3270 %$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 728         2553 );
145              
146 728         35686 return $context->validate($schema, $instance);
147             }
148              
149             sub instance_type_keywords {
150 3640     3640 0 39489 my ($self, $instance_type) = @_;
151 3640         9018 return $self->environment_keywords->{$self->environment}{$instance_type};
152             }
153              
154             sub register_schema {
155 4     4 0 3856082 shift->reference->register_schema(@_);
156             }
157              
158             sub unregister_schema {
159 0     0 0 0 shift->reference->unregister_schema(@_);
160             }
161              
162             sub register_format {
163 2     2 0 16 my ($self, $format, $format_validator) = @_;
164 2         9 shift->formats->{$format} = $format_validator;
165             }
166              
167             1;
168              
169             __END__