File Coverage

blib/lib/JSON/Validator/Joi.pm
Criterion Covered Total %
statement 111 112 99.1
branch 54 62 87.1
condition 8 11 72.7
subroutine 40 40 100.0
pod 24 24 100.0
total 237 249 95.1


line stmt bran cond sub pod time code
1             package JSON::Validator::Joi;
2 49     49   348 use Mojo::Base -base;
  49         99  
  49         315  
3              
4 49     49   28875 use JSON::Validator::Util 'uniq';
  49         155  
  49         3494  
5 49     49   364 use Mojo::JSON qw(false true);
  49         106  
  49         2597  
6 49     49   344 use Mojo::Util;
  49         110  
  49         1647  
7 49     49   30256 use Storable 'dclone';
  49         152999  
  49         100692  
8              
9             # Avoid "Subroutine redefined" warnings
10             require JSON::Validator;
11              
12             has enum => sub { +[] };
13             has [qw(format max min multiple_of regex)] => undef;
14             has type => 'object';
15              
16             for my $attr (qw(required strict unique)) {
17             Mojo::Util::monkey_patch(__PACKAGE__,
18 9   50 9   97 $attr => sub { $_[0]->{$attr} = $_[1] // 1; $_[0]; });
  9     9   31  
        9      
19             }
20              
21 1     1 1 8 sub alphanum { shift->_type('string')->regex('^\w*$') }
22 1     1 1 7 sub boolean { shift->type('boolean') }
23              
24             sub compile {
25 42     42 1 57 my $self = shift;
26 42         60 my $merged = {};
27              
28 42 100       81 for (ref $self->type eq 'ARRAY' ? @{$self->type} : $self->type) {
  1         7  
29 43         331 my $method = "_compile_$_";
30 43         106 my $compiled = $self->$method;
31 43         197 @$merged{keys %$compiled} = values %$compiled;
32             }
33              
34 42         158 return $merged;
35             }
36              
37 1     1 1 3 sub date_time { shift->_type('string')->format('date-time') }
38 3     3 1 19 sub email { shift->_type('string')->format('email') }
39              
40             sub extend {
41 6     6 1 2558 my ($self, $by) = @_;
42 6 100       18 die "Cannot extend joi '@{[$self->type]}' by '@{[$by->type]}'"
  1         16  
  1         10  
43             unless $self->type eq $by->type;
44              
45 5         178 my $clone = shift->new(dclone($self));
46              
47 5         63 for my $key (keys %$by) {
48 11         22 my $ref = ref $by->{$key};
49 11 100 100     47 $clone->{$key} = $by->{$key} unless $ref eq 'ARRAY' or $ref eq 'HASH';
50             }
51              
52 5 100       16 if ($self->type eq 'array') {
    100          
53 2 100       39 $clone->{items} = dclone($by->{items}) if $by->{items};
54             }
55             elsif ($self->type eq 'object') {
56 1         3 $clone->{required} = [uniq @{$clone->{required}}, @{$by->{required}}]
  1         14  
57 2 100       23 if ref $by->{required} eq 'ARRAY';
58             $clone->{properties}{$_} = dclone($by->{properties}{$_})
59 2 50       4 for keys %{$by->{properties} || {}};
  2         40  
60             }
61              
62 5         30 return $clone;
63             }
64              
65 5     5 1 41 sub array { shift->type('array') }
66 14     14 1 91 sub integer { shift->type('integer') }
67 1     1 1 8 sub iso_date { shift->date_time }
68 3     3 1 20 sub items { $_[0]->{items} = $_[1]; $_[0] }
  3         14  
69 1     1 1 7 sub length { shift->min($_[0])->max($_[0]) }
70 1     1 1 7 sub lowercase { shift->_type('string')->regex('^\p{Lowercase}*$') }
71 1     1 1 8 sub negative { shift->_type('number')->max(0) }
72 4     4 1 24 sub number { shift->type('number') }
73 6     6 1 52 sub object { shift->type('object') }
74 1     1 1 15 sub pattern { shift->regex(@_) }
75 1     1 1 7 sub positive { shift->number->min(0) }
76              
77             sub props {
78 8     8 1 48 my $self = shift->type('object');
79 8 50       78 my %properties = ref $_[0] ? %{$_[0]} : @_;
  0         0  
80              
81 8         32 while (my ($name, $property) = each %properties) {
82 28 100       56 push @{$self->{required}}, $name if $property->{required};
  7         17  
83 28         58 $self->{properties}{$name} = $property->compile;
84             }
85              
86 8         41 return $self;
87             }
88              
89 11     11 1 66 sub string { shift->type('string') }
90 1     1 1 7 sub token { shift->_type('string')->regex('^[a-zA-Z0-9_]+$') }
91 1     1 1 7 sub uppercase { shift->_type('string')->regex('^\p{Uppercase}*$') }
92 1     1 1 6 sub uri { shift->_type('string')->format('uri') }
93              
94             sub validate {
95 2     2 1 5 my ($self, $data) = @_;
96 2         8 state $jv
97             = JSON::Validator->new->coerce({booleans => 1, numbers => 1, strings => 1});
98 2         7 return $jv->validate($data, $self->compile);
99             }
100              
101             sub _compile_array {
102 3     3   5 my $self = shift;
103 3         6 my $json = {type => $self->type};
104              
105 3 100       30 $json->{additionalItems} = false if $self->{strict};
106 3 100       13 $json->{items} = $self->{items} if $self->{items};
107 3 100       9 $json->{maxItems} = $self->{max} if defined $self->{max};
108 3 100       8 $json->{minItems} = $self->{min} if defined $self->{min};
109 3 50       8 $json->{uniqueItems} = true if $self->{unique};
110              
111 3         5 return $json;
112             }
113              
114 1     1   3 sub _compile_boolean { +{type => 'boolean'} }
115              
116 11     11   19 sub _compile_integer { shift->_compile_number }
117              
118 1     1   7 sub _compile_null { {type => shift->type} }
119              
120             sub _compile_number {
121 14     14   35 my $self = shift;
122 14         27 my $json = {type => $self->type};
123              
124 14 100 66     77 $json->{enum} = $self->{enum} if defined $self->{enum} and @{$self->{enum}};
  1         5  
125 14 100       30 $json->{maximum} = $self->{max} if defined $self->{max};
126 14 100       32 $json->{minimum} = $self->{min} if defined $self->{min};
127 14 50       25 $json->{multipleOf} = $self->{multiple_of} if defined $self->{multiple_of};
128              
129 14         24 return $json;
130             }
131              
132             sub _compile_object {
133 6     6   7 my $self = shift;
134 6         13 my $json = {type => $self->type};
135              
136 6 100       35 $json->{additionalProperties} = false if $self->{strict};
137 6 50       19 $json->{maxProperties} = $self->{max} if defined $self->{max};
138 6 50       14 $json->{minProperties} = $self->{min} if defined $self->{min};
139 6 50       25 $json->{patternProperties} = $self->{regex} if $self->{regex};
140             $json->{properties} = $self->{properties}
141 6 50       19 if ref $self->{properties} eq 'HASH';
142 6 100       15 $json->{required} = $self->{required} if ref $self->{required} eq 'ARRAY';
143              
144 6         11 return $json;
145             }
146              
147             sub _compile_string {
148 18     18   22 my $self = shift;
149 18         35 my $json = {type => $self->type};
150              
151 18 100 66     92 $json->{enum} = $self->{enum} if defined $self->{enum} and @{$self->{enum}};
  1         5  
152 18 100       39 $json->{format} = $self->{format} if defined $self->{format};
153 18 100       34 $json->{maxLength} = $self->{max} if defined $self->{max};
154 18 100       37 $json->{minLength} = $self->{min} if defined $self->{min};
155 18 100       35 $json->{pattern} = $self->{regex} if defined $self->{regex};
156              
157 18         25 return $json;
158             }
159              
160             sub _type {
161 10 100   10   26 $_[0]->{type} = $_[1] unless $_[0]->{type};
162 10         28 return $_[0];
163             }
164              
165 12     12 1 341 sub TO_JSON { shift->compile }
166              
167             1;
168              
169             =encoding utf8
170              
171             =head1 NAME
172              
173             JSON::Validator::Joi - Joi validation sugar for JSON::Validator
174              
175             =head1 SYNOPSIS
176              
177             use JSON::Validator "joi";
178              
179             my @errors = joi(
180             {
181             name => "Jan Henning",
182             age => 34,
183             email => "jhthorsen@cpan.org",
184             },
185             joi->object->props(
186             age => joi->integer->min(0)->max(200),
187             email => joi->regex(".@.")->required,
188             name => joi->string->min(1),
189             )
190             );
191              
192             die "@errors" if @errors;
193              
194             =head1 DESCRIPTION
195              
196             L is an elegant DSL schema-builder. The main purpose is
197             to build a L for L, but
198             it can also validate data directly with sane defaults.
199              
200             =head1 ATTRIBUTES
201              
202             =head2 enum
203              
204             my $joi = $joi->enum(["foo", "bar"]);
205             my $array_ref = $joi->enum;
206              
207             Defines a list of enum values for L, L and L.
208              
209             =head2 format
210              
211             my $joi = $joi->format("email");
212             my $str = $joi->format;
213              
214             Used to set the format of the L.
215             See also L, L and L.
216              
217             =head2 max
218              
219             my $joi = $joi->max(10);
220             my $int = $joi->max;
221              
222             =over 2
223              
224             =item * array
225              
226             Defines the max number of items in the array.
227              
228             =item * integer, number
229              
230             Defined the max value.
231              
232             =item * object
233              
234             Defines the max number of items in the object.
235              
236             =item * string
237              
238             Defines how long the string can be.
239              
240             =back
241              
242             =head2 min
243              
244             my $joi = $joi->min(10);
245             my $int = $joi->min;
246              
247             =over 2
248              
249             =item * array
250              
251             Defines the minimum number of items in the array.
252              
253             =item * integer, number
254              
255             Defined the minimum value.
256              
257             =item * object
258              
259             Defines the minimum number of items in the object.
260              
261             =item * string
262              
263             Defines how short the string can be.
264              
265             =back
266              
267             =head2 multiple_of
268              
269             my $joi = $joi->multiple_of(3);
270             my $int = $joi->multiple_of;
271              
272             Used by L and L to define what the number must be a multiple
273             of.
274              
275             =head2 regex
276              
277             my $joi = $joi->regex("^\w+$");
278             my $str = $joi->regex;
279              
280             Defines a pattern that L will be validated against.
281              
282             =head2 type
283              
284             my $joi = $joi->type("string");
285             my $joi = $joi->type([qw(null integer)]);
286             my $any = $joi->type;
287              
288             Sets the required type. This attribute is set by the convenience methods
289             L, L, L and L, but can be set manually if
290             you need to check against a list of type.
291              
292             =head1 METHODS
293              
294             =head2 TO_JSON
295              
296             Alias for L.
297              
298             =head2 alphanum
299              
300             my $joi = $joi->alphanum;
301              
302             Sets L to "^\w*$".
303              
304             =head2 array
305              
306             my $joi = $joi->array;
307              
308             Sets L to "array".
309              
310             =head2 boolean
311              
312             my $joi = $joi->boolean;
313              
314             Sets L to "boolean".
315              
316             =head2 compile
317              
318             my $hash_ref = $joi->compile;
319              
320             Will convert this object into a JSON-Schema data structure that
321             L understands.
322              
323             =head2 date_time
324              
325             my $joi = $joi->date_time;
326              
327             Sets L to L.
328              
329             =head2 email
330              
331             my $joi = $joi->email;
332              
333             Sets L to L.
334              
335             =head2 extend
336              
337             my $new_joi = $joi->extend($other_joi_object);
338              
339             Will extend C<$joi> with the definitions in C<$other_joi_object> and return a
340             new object.
341              
342             =head2 iso_date
343              
344             Alias for L.
345              
346             =head2 integer
347              
348             my $joi = $joi->integer;
349              
350             Sets L to "integer".
351              
352             =head2 items
353              
354             my $joi = $joi->items($joi);
355             my $joi = $joi->items([$joi, ...]);
356              
357             Defines a list of items for the L type.
358              
359             =head2 length
360              
361             my $joi = $joi->length(10);
362              
363             Sets both L and L to the number provided.
364              
365             =head2 lowercase
366              
367             my $joi = $joi->lowercase;
368              
369             Will set L to only match lower case strings.
370              
371             =head2 negative
372              
373             my $joi = $joi->negative;
374              
375             Sets L to C<0>.
376              
377             =head2 number
378              
379             my $joi = $joi->number;
380              
381             Sets L to "number".
382              
383             =head2 object
384              
385             my $joi = $joi->object;
386              
387             Sets L to "object".
388              
389             =head2 pattern
390              
391             Alias for L.
392              
393             =head2 positive
394              
395             my $joi = $joi->positive;
396              
397             Sets L to C<0>.
398              
399             =head2 props
400              
401             my $joi = $joi->props(name => JSON::Validator::Joi->new->string, ...);
402              
403             Used to define properties for an L type. Each key is the name of the
404             parameter and the values must be a L object.
405              
406             =head2 required
407              
408             my $joi = $joi->required;
409              
410             Marks the current property as required.
411              
412             =head2 strict
413              
414             my $joi = $joi->strict;
415              
416             Sets L and L to not allow any more items/keys than what is defined.
417              
418             =head2 string
419              
420             my $joi = $joi->string;
421              
422             Sets L to "string".
423              
424             =head2 token
425              
426             my $joi = $joi->token;
427              
428             Sets L to C<^[a-zA-Z0-9_]+$>.
429              
430             =head2 validate
431              
432             my @errors = $joi->validate($data);
433              
434             Used to validate C<$data> using L. Returns a list of
435             L objects on invalid
436             input.
437              
438             =head2 unique
439              
440             my $joi = $joi->unique;
441              
442             Used to force the L to only contain unique items.
443              
444             =head2 uppercase
445              
446             my $joi = $joi->uppercase;
447              
448             Will set L to only match upper case strings.
449              
450             =head2 uri
451              
452             my $joi = $joi->uri;
453              
454             Sets L to L.
455              
456             =head1 SEE ALSO
457              
458             L
459              
460             L.
461              
462             =cut