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   148631 use strict;
  47         104  
  47         1800  
4 47     47   260 use warnings;
  47         78  
  47         2388  
5              
6             use Class::Accessor::Lite (
7 47         388 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   39065 );
  47         57030  
19 47     47   40380 use Clone qw(clone);
  47         148652  
  47         3428  
20 47     47   6775 use JSON;
  47         73339  
  47         323  
21 47     47   29610 use JSV::Keyword qw(:constants);
  47         123  
  47         6692  
22 47     47   24478 use JSV::Reference;
  47         152  
  47         1892  
23 47     47   26270 use JSV::Context;
  47         201  
  47         1556  
24 47     47   42608 use Module::Pluggable::Object;
  47         558396  
  47         49801  
25              
26             our $VERSION = "0.07";
27              
28             my %supported_environments = (
29             draft4 => "Draft4"
30             );
31             my %environment_keywords = ();
32              
33             sub load_environments {
34 47     47 0 148 my ($class, @environments) = @_;
35              
36 47         152 for my $environment (@environments) {
37 47 50       233 next unless (exists $supported_environments{$environment});
38             my $finder = Module::Pluggable::Object->new(
39 47         604 search_path => ["JSV::Keyword::" . $supported_environments{$environment}],
40             require => 1,
41             );
42              
43 47         748 $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         300 sort { $a->keyword_priority <=> $b->keyword_priority }
  2820         1010787  
52             $finder->plugins;
53              
54 47         284 for my $keyword (@keywords) {
55 1128         2813 my $type = $keyword->instance_type;
56 1128         1298 push(@{$environment_keywords{$environment}{$type}}, $keyword);
  1128         4418  
57             }
58             }
59             }
60              
61             sub new {
62 62     62 1 33736 my $class = shift;
63 62         206 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   55 ($_[0] =~ /\A\d{4}-\d{2}-\d{2}\z/);
72             },
73             'date-time' => sub {
74             # RFC3339
75 10     10   80 ($_[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   1766 require Data::Validate::URI;
79 2         58798 Data::Validate::URI::is_uri($_[0]);
80             },
81             email => sub {
82 4     4   919 require Email::Valid::Loose;
83 4         120194 Email::Valid::Loose->address($_[0]);
84             },
85             ipv4 => sub {
86 10     10   62 require Data::Validate::IP;
87 10         39 Data::Validate::IP::is_ipv4($_[0]);
88             },
89             ipv6 => sub {
90 8     8   62 require Data::Validate::IP;
91 8         35 Data::Validate::IP::is_ipv6($_[0]);
92             },
93             hostname => sub {
94 8     8   63 require Data::Validate::Domain;
95 8         39 Data::Validate::Domain::is_domain($_[0]);
96             },
97             },
98 62         518 %args,
99             );
100              
101             ### RECOMMENDED: you should do to preloading environment before calling constructor
102 62 100       377 unless (exists $environment_keywords{$args{environment}}) {
103 47         251 $class->load_environments($args{environment});
104             }
105              
106             bless {
107 62         841 environment_keywords => \%environment_keywords,
108             %args,
109             } => $class;
110             }
111              
112             sub validate {
113 768     768 1 26047 my ($self, $schema, $instance, $opts) = @_;
114              
115 768   100     3015 $opts ||= +{};
116 768         3548 %$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         2874 );
145              
146 768         40220 return $context->validate($schema, $instance);
147             }
148              
149             sub instance_type_keywords {
150 3840     3840 1 29713 my ($self, $instance_type) = @_;
151 3840         10831 return $self->environment_keywords->{$self->environment}{$instance_type};
152             }
153              
154             sub register_schema {
155 4     4 1 14348 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 20 my ($self, $format, $format_validator) = @_;
164 2         10 shift->formats->{$format} = $format_validator;
165             }
166              
167             1;
168              
169             __END__