File Coverage

blib/lib/JSON/Schema/Shorthand.pm
Criterion Covered Total %
statement 44 44 100.0
branch 20 20 100.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 72 72 100.0


line stmt bran cond sub pod time code
1             package JSON::Schema::Shorthand;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: Alternative, condensed format for JSON Schemas
4             $JSON::Schema::Shorthand::VERSION = '0.0.2';
5 1     1   31500 use strict;
  1         1  
  1         23  
6 1     1   3 use warnings;
  1         1  
  1         24  
7              
8 1     1   8 use 5.20.0;
  1         2  
9              
10 1     1   393 use experimental 'postderef';
  1         2286  
  1         4  
11              
12 1     1   555 use parent 'Exporter::Tiny';
  1         226  
  1         4  
13              
14             our @EXPORT = ( 'js_shorthand' );
15              
16 1     1   3014 use Clone qw/ clone /;
  1         1884  
  1         406  
17              
18             sub js_shorthand {
19 22     22 1 27383 my $object = clone( shift );
20              
21 22 100       54 unless( ref $object ) {
22 10 100       38 $object = { ( ( '#' eq substr $object, 0, 1 ) ? '$ref' : 'type' ) => $object };
23             }
24              
25 22 100       43 if ( my $array = delete $object->{array} ) {
26 2         4 $object->{type} = 'array';
27             $object->{items} = ref $array eq 'ARRAY'
28 2 100       10 ? [ map { js_shorthand($_) } @$array ]
  1         3  
29             : js_shorthand( $array )
30             ;
31             }
32              
33 22 100       35 if( my $props = delete $object->{object} ) {
34 2         4 $object->{type} = 'object';
35 2         3 $object->{properties} = $props;
36             }
37              
38             # foo => { bar => $schema }
39 22         26 for my $keyword ( qw/ definitions properties / ) {
40 44 100       68 next unless $object->{$keyword};
41 4         6 $_ = js_shorthand($_) for values %{ $object->{$keyword} };
  4         15  
42             }
43              
44             # foo => [ @schemas ]
45 22         24 for my $keyword ( qw/ anyOf allOf oneOf / ) {
46 66 100       90 next unless $object->{$keyword};
47             $object->{$keyword} = [
48 3         5 map { js_shorthand($_) } $object->{$keyword}->@*
  3         7  
49             ];
50             }
51              
52             # foo => $schemas
53 22         20 for my $keyword ( qw/ not / ) {
54 22 100       33 next unless $object->{$keyword};
55 1         4 $object->{$keyword} = js_shorthand($object->{$keyword});
56             }
57              
58             # required attribute
59 22 100       34 if ( $object->{properties} ) {
60             my @required = grep {
61             delete $object->{properties}{$_}{required}
62 3         9 } keys $object->{properties}->%*;
  3         31  
63              
64             $object->{required} = [
65 3 100       13 eval { $object->{required}->@* },
  1         10  
66             @required
67             ] if @required;
68             }
69              
70 22         52 return $object;
71             }
72              
73             1;
74              
75             __END__