File Coverage

blib/lib/Cpanel/JSON/XS/Type.pm
Criterion Covered Total %
statement 65 67 97.0
branch 31 36 86.1
condition 6 6 100.0
subroutine 11 11 100.0
pod 5 5 100.0
total 118 125 94.4


line stmt bran cond sub pod time code
1             package Cpanel::JSON::XS::Type;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Cpanel::JSON::XS::Type - Type support for JSON encode
8              
9             =head1 SYNOPSIS
10              
11             use Cpanel::JSON::XS;
12             use Cpanel::JSON::XS::Type;
13              
14              
15             encode_json([10, "10", 10.25], [JSON_TYPE_INT, JSON_TYPE_INT, JSON_TYPE_STRING]);
16             # '[10,10,"10.25"]'
17              
18             encode_json([10, "10", 10.25], json_type_arrayof(JSON_TYPE_INT));
19             # '[10,10,10]'
20              
21             encode_json(1, JSON_TYPE_BOOL);
22             # 'true'
23              
24             my $perl_struct = { key1 => 1, key2 => "2", key3 => 1 };
25             my $type_spec = { key1 => JSON_TYPE_STRING, key2 => JSON_TYPE_INT, key3 => JSON_TYPE_BOOL };
26             my $json_string = encode_json($perl_struct, $type_spec);
27             # '{"key1":"1","key2":2,"key3":true}'
28              
29             my $perl_struct = { key1 => "value1", key2 => "value2", key3 => 0, key4 => 1, key5 => "string", key6 => "string2" };
30             my $type_spec = json_type_hashof(JSON_TYPE_STRING);
31             my $json_string = encode_json($perl_struct, $type_spec);
32             # '{"key1":"value1","key2":"value2","key3":"0","key4":"1","key5":"string","key6":"string2"}'
33              
34             my $perl_struct = { key1 => { key2 => [ 10, "10", 10.6 ] }, key3 => "10.5" };
35             my $type_spec = { key1 => json_type_anyof(JSON_TYPE_FLOAT, json_type_hashof(json_type_arrayof(JSON_TYPE_INT))), key3 => JSON_TYPE_FLOAT };
36             my $json_string = encode_json($perl_struct, $type_spec);
37             # '{"key1":{"key2":[10,10,10]},"key3":10.5}'
38              
39              
40             my $value = decode_json('false', 1, my $type);
41             # $value is 0 and $type is JSON_TYPE_BOOL
42              
43             my $value = decode_json('0', 1, my $type);
44             # $value is 0 and $type is JSON_TYPE_INT
45              
46             my $value = decode_json('"0"', 1, my $type);
47             # $value is 0 and $type is JSON_TYPE_STRING
48              
49             my $json_string = '{"key1":{"key2":[10,"10",10.6]},"key3":"10.5"}';
50             my $perl_struct = decode_json($json_string, 0, my $type_spec);
51             # $perl_struct is { key1 => { key2 => [ 10, 10, 10.6 ] }, key3 => 10.5 }
52             # $type_spec is { key1 => { key2 => [ JSON_TYPE_INT, JSON_TYPE_STRING, JSON_TYPE_FLOAT ] }, key3 => JSON_TYPE_STRING }
53              
54             =head1 DESCRIPTION
55              
56             This module provides stable JSON type support for the
57             L encoder which doesn't depend on
58             any internal perl scalar flags or characteristics. Also it provides
59             real JSON types for L decoder.
60              
61             In most cases perl structures passed to
62             L come from other functions
63             or from other modules and caller of Cpanel::JSON::XS module does not
64             have control of internals or they are subject of change. So it is not
65             easy to support enforcing types as described in the
66             L section.
67              
68             For services based on JSON contents it is sometimes needed to correctly
69             process and enforce JSON types.
70              
71             The function L takes optional
72             third scalar parameter and fills it with specification of json types.
73              
74             The function L takes a perl
75             structure as its input and optionally also a json type specification in
76             the second parameter.
77              
78             If the specification is not provided (or is undef) internal perl
79             scalar flags are used for the resulting JSON type. The internal flags
80             can be changed by perl itself, but also by external modules. Which
81             means that types in resulting JSON string aren't stable. Specially it
82             does not work reliable for dual vars and scalars which were used in
83             both numeric and string operations. See L
84             scalars|Cpanel::JSON::XS/simple scalars>.
85              
86             To enforce that specification is always provided use C.
87             In this case when C is called without second argument (or is
88             undef) then it croaks. It applies recursively for all sub-structures.
89              
90             =head2 JSON type specification for scalars:
91              
92             =over 4
93              
94             =item JSON_TYPE_BOOL
95              
96             It enforces JSON boolean in resulting JSON, i.e. either C or
97             C. For determining whether the scalar passed to the encoder
98             is true, standard perl boolean logic is used.
99              
100             =item JSON_TYPE_INT
101              
102             It enforces JSON number without fraction part in the resulting JSON.
103             Equivalent of perl function L is used for conversion.
104              
105             =item JSON_TYPE_FLOAT
106              
107             It enforces JSON number with fraction part in the resulting JSON.
108             Equivalent of perl operation C<+0> is used for conversion.
109              
110             =item JSON_TYPE_STRING
111              
112             It enforces JSON string type in the resulting JSON.
113              
114             =item JSON_TYPE_NULL
115              
116             It represents JSON C value. Makes sense only when passing
117             perl's C value.
118              
119             =back
120              
121             For each type, there also exists a type with the suffix C<_OR_NULL>
122             which encodes perl's C into JSON C. Without type with
123             suffix C<_OR_NULL> perl's C is converted to specific type
124             according to above rules.
125              
126             =head2 JSON type specification for arrays:
127              
128             =over 4
129              
130             =item [...]
131              
132             The array must contain the same number of elements as in the perl
133             array passed for encoding. Each element of the array describes the
134             JSON type which is enforced for the corresponding element of the
135             perl array.
136              
137             =item json_type_arrayof
138              
139             This function takes a JSON type specification as its argument which
140             is enforced for every element of the passed perl array.
141              
142             =back
143              
144             =head2 JSON type specification for hashes:
145              
146             =over 4
147              
148             =item {...}
149              
150             Each hash value for corresponding key describes the JSON type
151             specification for values of passed perl hash structure. Keys in hash
152             which are not present in passed perl hash structure are simple
153             ignored and not used.
154              
155             =item json_type_hashof
156              
157             This function takes a JSON type specification as its argument which
158             is enforced for every value of passed perl hash structure.
159              
160             =back
161              
162             =head2 JSON type specification for alternatives:
163              
164             =over 4
165              
166             =item json_type_anyof
167              
168             This function takes a list of JSON type alternative specifications
169             (maximally one scalar, one array, and one hash) as its input and the
170             JSON encoder chooses one that matches.
171              
172             =item json_type_null_or_anyof
173              
174             Like L|/json_type_anyof>, but scalar can be only
175             perl's C.
176              
177             =item json_type_weaken
178              
179             This function can be used as an argument for L,
180             L or L functions to create weak
181             references suitable for complicated recursive structures. It depends
182             on L module.
183             See following example:
184              
185             my $struct = {
186             type => JSON_TYPE_STRING,
187             array => json_type_arrayof(JSON_TYPE_INT),
188             };
189             $struct->{recursive} = json_type_anyof(
190             json_type_weaken($struct),
191             json_type_arrayof(JSON_TYPE_STRING),
192             );
193              
194             =back
195              
196             =head1 AUTHOR
197              
198             Pali Epali@cpan.orgE
199              
200             =head1 COPYRIGHT & LICENSE
201              
202             Copyright (c) 2017, GoodData Corporation. All rights reserved.
203              
204             This module is available under the same licences as perl, the Artistic
205             license and the GPL.
206              
207             =cut
208              
209 2     2   938 use strict;
  2         4  
  2         51  
210 2     2   9 use warnings;
  2         4  
  2         169  
211              
212             BEGIN {
213 2 50   2   7 if (eval { require Scalar::Util }) {
  2         13  
214 2         202 Scalar::Util->import('weaken');
215             } else {
216 0         0 *weaken = sub($) { die 'Scalar::Util is required for weaken' };
  0         0  
217             }
218             }
219              
220             # This exports needed XS constants to perl
221 2     2   12 use Cpanel::JSON::XS ();
  2         3  
  2         36  
222              
223 2     2   7 use Exporter;
  2         4  
  2         208  
224             our @ISA = qw(Exporter);
225             our @EXPORT = our @EXPORT_OK = qw(
226             json_type_arrayof
227             json_type_hashof
228             json_type_anyof
229             json_type_null_or_anyof
230             json_type_weaken
231             JSON_TYPE_NULL
232             JSON_TYPE_BOOL
233             JSON_TYPE_INT
234             JSON_TYPE_FLOAT
235             JSON_TYPE_STRING
236             JSON_TYPE_BOOL_OR_NULL
237             JSON_TYPE_INT_OR_NULL
238             JSON_TYPE_FLOAT_OR_NULL
239             JSON_TYPE_STRING_OR_NULL
240             JSON_TYPE_ARRAYOF_CLASS
241             JSON_TYPE_HASHOF_CLASS
242             JSON_TYPE_ANYOF_CLASS
243             );
244              
245 2     2   12 use constant JSON_TYPE_WEAKEN_CLASS => 'Cpanel::JSON::XS::Type::Weaken';
  2         3  
  2         1423  
246              
247             sub json_type_anyof {
248 86     86 1 44033 my ($scalar, $array, $hash);
249 86         0 my ($scalar_weaken, $array_weaken, $hash_weaken);
250 86         144 foreach (@_) {
251 156         176 my $type = $_;
252 156         227 my $ref = ref($_);
253 156         170 my $weaken;
254 156 100       305 if ($ref eq JSON_TYPE_WEAKEN_CLASS) {
255 1         2 $type = ${$type};
  1         2  
256 1         3 $ref = ref($type);
257 1         2 $weaken = 1;
258             }
259 156 100 100     411 if ($ref eq '') {
    100 100        
    100          
260 77 100       146 die 'Only one scalar type can be specified in anyof' if defined $scalar;
261 76         82 $scalar = $type;
262 76         108 $scalar_weaken = $weaken;
263             } elsif ($ref eq 'ARRAY' or $ref eq JSON_TYPE_ARRAYOF_CLASS) {
264 41 100       85 die 'Only one array type can be specified in anyof' if defined $array;
265 38         46 $array = $type;
266 38         57 $array_weaken = $weaken;
267             } elsif ($ref eq 'HASH' or $ref eq JSON_TYPE_HASHOF_CLASS) {
268 37 100       81 die 'Only one hash type can be specified in anyof' if defined $hash;
269 34         41 $hash = $type;
270 34         48 $hash_weaken = $weaken;
271             } else {
272 1         10 die 'Only scalar, array or hash can be specified in anyof';
273             }
274             }
275 78         131 my $type = [$scalar, $array, $hash];
276 78 50       119 weaken $type->[0] if $scalar_weaken;
277 78 50       123 weaken $type->[1] if $array_weaken;
278 78 100       108 weaken $type->[2] if $hash_weaken;
279 78         567 return bless $type, JSON_TYPE_ANYOF_CLASS;
280             }
281              
282             sub json_type_null_or_anyof {
283 4     4 1 11 foreach (@_) {
284 4 100       21 die 'Scalar cannot be specified in null_or_anyof' if ref($_) eq '';
285             }
286 3         8 return json_type_anyof(JSON_TYPE_CAN_BE_NULL, @_);
287             }
288              
289             sub json_type_arrayof {
290 16 100   16 1 5048 die 'Exactly one type must be specified in arrayof' if scalar @_ != 1;
291 15         20 my $type = $_[0];
292 15 100       31 if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
293 1         1 $type = ${$type};
  1         2  
294 1         4 weaken $type;
295             }
296 15         64 return bless \$type, JSON_TYPE_ARRAYOF_CLASS;
297             }
298              
299             sub json_type_hashof {
300 9 100   9 1 1368 die 'Exactly one type must be specified in hashof' if scalar @_ != 1;
301 8         10 my $type = $_[0];
302 8 100       17 if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
303 1         2 $type = ${$type};
  1         3  
304 1         4 weaken $type;
305             }
306 8         28 return bless \$type, JSON_TYPE_HASHOF_CLASS;
307             }
308              
309             sub json_type_weaken {
310 3 50   3 1 5533 die 'Exactly one type must be specified in weaken' if scalar @_ != 1;
311 3 50       10 die 'Scalar cannot be specfied in weaken' if ref($_[0]) eq '';
312 3         19 return bless \(my $type = $_[0]), JSON_TYPE_WEAKEN_CLASS;
313             }
314              
315             1;