File Coverage

blib/lib/JSON/Create/PP.pm
Criterion Covered Total %
statement 336 372 90.3
branch 148 172 86.0
condition 16 18 88.8
subroutine 56 58 96.5
pod 0 49 0.0
total 556 669 83.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             JSON::Create::PP - Pure-Perl version of JSON::Create
4              
5             =head1 DESCRIPTION
6              
7             This is a backup module for JSON::Create. JSON::Create is written
8             using Perl XS, but JSON::Create::PP offers the same functionality
9             without the XS.
10              
11             =head1 DEPENDENCIES
12              
13             =over
14              
15             =item L
16              
17             =item L
18              
19             This uses Carp to report errors.
20              
21             =item L
22              
23             Scalar::Util is used to distinguish strings from numbers, detect
24             objects, and break encapsulation.
25              
26             =item L
27              
28             This is used to handle conversion to and from character strings.
29              
30             =back
31              
32             =head1 BUGS
33              
34             Printing of floating point numbers cannot be made to work exactly like
35             the XS version.
36              
37             =cut
38              
39             package JSON::Create::PP;
40 24     24   12347 use parent Exporter;
  24         8624  
  24         140  
41             our @EXPORT_OK = qw/create_json create_json_strict json_escape/;
42             our %EXPORT_TAGS = (all => \@EXPORT_OK);
43 24     24   2098 use warnings;
  24         51  
  24         753  
44 24     24   124 use strict;
  24         46  
  24         402  
45 24     24   779 use utf8;
  24         58  
  24         169  
46 24     24   603 use Carp qw/croak carp confess cluck/;
  24         46  
  24         1742  
47 24     24   157 use Scalar::Util qw/looks_like_number blessed reftype/;
  24         65  
  24         1310  
48 24     24   12457 use Unicode::UTF8 qw/decode_utf8 valid_utf8 encode_utf8/;
  24         12972  
  24         1728  
49 24     24   177 use B;
  24         49  
  24         103886  
50              
51             our $VERSION = '0.35';
52              
53             sub create_json
54             {
55 61     61 0 112585 my ($input, %options) = @_;
56 61         210 my $jc = bless {
57             output => '',
58             };
59 61         248 $jc->{_strict} = !! $options{strict};
60 61         153 $jc->{_indent} = !! $options{indent};
61 61         133 $jc->{_sort} = !! $options{sort};
62 61 100       182 if ($jc->{_indent}) {
63 2         5 $jc->{depth} = 0;
64             }
65 61         202 my $error = create_json_recursively ($jc, $input);
66 61 100       142 if ($error) {
67 8         35 $jc->user_error ($error);
68 8         71 delete $jc->{output};
69 8         67 return undef;
70             }
71 53         369 return $jc->{output};
72             }
73              
74             sub create_json_strict
75             {
76 23     23 0 46128 my ($input, %options) = @_;
77 23         79 $options{strict} = 1;
78 23         85 return create_json ($input, %options);
79             }
80              
81             # http://stackoverflow.com/questions/1185822/how-do-i-create-or-test-for-nan-or-infinity-in-perl#1185828
82              
83             sub isinf {
84 206     206 0 482 $_[0]==9**9**9;
85             }
86              
87             sub isneginf {
88 203     203 0 543 $_[0]==-9**9**9;
89             }
90              
91             sub isnan {
92 209     209 0 734 return ! defined( $_[0] <=> 9**9**9 );
93             }
94              
95             sub isfloat
96             {
97 200     200 0 316 my ($num) = @_;
98              
99 200 100       449 if ($num != int ($num)) {
100             # It's clearly a floating point number
101 79         171 return 1;
102             }
103              
104             # To get the same result as the XS version we have to poke around
105             # with the following. I cannot actually see what to do in the XS
106             # so that I get the same printed numbers as Perl, it seems like
107             # Perl is really monkeying around with NVs so as to print them
108             # like integers when it can do so sensibly, and it doesn't make
109             # the "I'm gonna monkey with this NV" information available to the
110             # Perl programmer.
111              
112 121         315 my $r = B::svref_2object (\$num);
113 121   33     528 my $isfloat = $r->isa("B::NV") || $r->isa("B::PVNV");
114 121         300 return $isfloat;
115             }
116              
117             # Built in booleans. The nasty PL_sv_(yes|no) stuff comes from
118             # JSON::Parse. The JSON::Create::Bool is from our own nice module.
119              
120             sub isbool
121             {
122 372     372 0 583 my ($input, $ref) = @_;
123 372         1183 my $poo = B::svref_2object ($ref);
124 372 100       917 if (ref $poo eq 'B::SPECIAL') {
125             # Leave the following commented-out code as reference for what
126             # the magic numbers mean.
127              
128             # if ($B::specialsv_name[$$poo] eq '&PL_sv_yes') {
129 4 100       23 if ($$poo == 2) {
    50          
130 2         6 return 'true';
131             }
132             # elsif ($B::specialsv_name[$$poo] eq '&PL_sv_no') {
133             elsif ($$poo == 3) {
134 2         6 return 'false';
135             }
136             }
137 368         722 return undef;
138             }
139              
140             sub json_escape
141             {
142 329     329 0 534 my ($input) = @_;
143 329         890 $input =~ s/("|\\)/\\$1/g;
144 329         629 $input =~ s/\x08/\\b/g;
145 329         474 $input =~ s/\f/\\f/g;
146 329         445 $input =~ s/\n/\\n/g;
147 329         446 $input =~ s/\r/\\r/g;
148 329         473 $input =~ s/\t/\\t/g;
149 329         542 $input =~ s/([\x00-\x1f])/sprintf ("\\u%04x", ord ($1))/ge;
  4         28  
150 329         631 return $input;
151             }
152              
153             sub escape_all_unicode
154             {
155 6     6 0 13 my ($jc, $input) = @_;
156 6         12 my $format = "\\u%04x";
157 6 100       13 if ($jc->{_unicode_upper}) {
158 1         3 $format = "\\u%04X";
159             }
160 6         29 $input =~ s/([\x{007f}-\x{ffff}])/sprintf ($format, ord ($1))/ge;
  12         51  
161             # Convert U+10000 to U+10FFFF into surrogate pairs
162 6         29 $input =~ s/([\x{10000}-\x{10ffff}])/
163 9         58 sprintf ($format, 0xD800 | (((ord ($1)-0x10000) >>10) & 0x3ff)) .
164             sprintf ($format, 0xDC00 | ((ord ($1)) & 0x3ff))
165             /gex;
166 6         18 return $input;
167             }
168              
169             sub stringify
170             {
171 333     333 0 625 my ($jc, $input) = @_;
172 333 100       823 if (! utf8::is_utf8 ($input)) {
173 242 100 100     729 if ($input =~ /[\x{80}-\x{FF}]/ && $jc->{_strict}) {
174 3         9 return "Non-ASCII byte in non-utf8 string";
175             }
176 239 100       693 if (! valid_utf8 ($input)) {
177 2 100       7 if ($jc->{_replace_bad_utf8}) {
178             # Discard the warnings from Unicode::UTF8.
179 1     2   10 local $SIG{__WARN__} = sub {};
180 1         15 $input = decode_utf8 ($input);
181             }
182             else {
183 1         4 return 'Invalid UTF-8';
184             }
185             }
186             }
187 329         575 $input = json_escape ($input);
188 329 100       755 if ($jc->{_escape_slash}) {
189 2         8 $input =~ s!/!\\/!g;
190             }
191 329 100       615 if (! $jc->{_no_javascript_safe}) {
192 327         660 $input =~ s/\x{2028}/\\u2028/g;
193 327         557 $input =~ s/\x{2029}/\\u2029/g;
194             }
195 329 100       622 if ($jc->{_unicode_escape_all}) {
196 6         16 $input = $jc->escape_all_unicode ($input);
197             }
198 329         732 $jc->{output} .= "\"$input\"";
199 329         546 return undef;
200             }
201              
202             sub validate_user_json
203             {
204 2     2 0 5 my ($jc, $json) = @_;
205 2         4 eval {
206 2         26 JSON::Parse::assert_valid_json ($json);
207             };
208 2 100       7 if ($@) {
209 1         6 return "JSON::Parse::assert_valid_json failed for '$json': $@";
210             }
211 1         14 return undef;
212             }
213              
214             sub call_to_json
215             {
216 11     11 0 25 my ($jc, $cv, $r) = @_;
217 11 50       33 if (ref $cv ne 'CODE') {
218 0         0 confess "Not code";
219             }
220 11         18 my $json = &{$cv} ($r);
  11         32  
221 11 100       183 if (! defined $json) {
222 3         10 return 'undefined value from user routine';
223             }
224 8 100       25 if ($jc->{_validate}) {
225 2         8 my $error = $jc->validate_user_json ($json);
226 2 100       8 if ($error) {
227 1         4 return $error;
228             }
229             }
230 7         18 $jc->{output} .= $json;
231 7         16 return undef;
232             }
233              
234             # This handles a non-finite floating point number, which is either
235             # nan, inf, or -inf. The return value is undefined if successful, or
236             # the error value if an error occurred.
237              
238             sub handle_non_finite
239             {
240 9     9 0 21 my ($jc, $input, $type) = @_;
241 9         17 my $handler = $jc->{_non_finite_handler};
242 9 100       20 if ($handler) {
243 3         4 my $output = &{$handler} ($type);
  3         12  
244 3 50       14 if (! $output) {
245 0         0 return "Empty output from non-finite handler";
246             }
247 3         6 $jc->{output} .= $output;
248 3         8 return undef;
249             }
250 6 100       22 if ($jc->{_strict}) {
251 3         9 return "non-finite number";
252             }
253 3         11 $jc->{output} .= "\"$type\"";
254 3         10 return undef;
255             }
256              
257             sub handle_number
258             {
259 209     209 0 360 my ($jc, $input) = @_;
260             # Perl thinks that nan, inf, etc. look like numbers.
261 209 100       331 if (isnan ($input)) {
    100          
    100          
    50          
262 3         9 return $jc->handle_non_finite ($input, 'nan');
263             }
264             elsif (isinf ($input)) {
265 3         9 return $jc->handle_non_finite ($input, 'inf');
266             }
267             elsif (isneginf ($input)) {
268 3         9 return $jc->handle_non_finite ($input, '-inf');
269             }
270             elsif (isfloat ($input)) {
271             # Default format
272 200 100       351 if ($jc->{_fformat}) {
273             # Override. Validation is in
274             # JSON::Create::set_fformat.
275 57         237 $jc->{output} .= sprintf ($jc->{_fformat}, $input);
276             }
277             else {
278 143         847 $jc->{output} .= sprintf ("%.*g", 10, $input);
279             }
280             }
281             else {
282             # integer or looks like integer.
283 0         0 $jc->{output} .= $input;
284             }
285 200         428 return undef;
286             }
287              
288             sub newline_indent
289             {
290 117     117 0 168 my ($jc) = @_;
291 117         290 $jc->{output} .= "\n" . "\t" x $jc->{depth};
292             }
293              
294             sub openB
295             {
296 113     113 0 224 my ($jc, $b) = @_;
297 113         280 $jc->{output} .= $b;
298 113 100       292 if ($jc->{_indent}) {
299 23         42 $jc->{depth}++;
300 23         49 $jc->newline_indent ();
301             }
302             }
303              
304             sub closeB
305             {
306 103     103 0 230 my ($jc, $b) = @_;
307 103 100       259 if ($jc->{_indent}) {
308 23         34 $jc->{depth}--;
309 23         43 $jc->newline_indent ();
310             }
311 103         194 $jc->{output} .= $b;
312 103 100       255 if ($jc->{_indent}) {
313 23 100       62 if ($jc->{depth} == 0) {
314 6         13 $jc->{output} .= "\n";
315             }
316             }
317             }
318              
319             sub comma
320             {
321 262     262 0 400 my ($jc) = @_;
322 262         430 $jc->{output} .= ',';
323 262 100       586 if ($jc->{_indent}) {
324 71         128 $jc->newline_indent ();
325             }
326             }
327              
328             sub array
329             {
330 33     33 0 71 my ($jc, $input) = @_;
331 33         91 $jc->openB ('[');
332 33         53 my $i = 0;
333 33         74 for my $k (@$input) {
334 163 100       340 if ($i != 0) {
335 130         214 $jc->comma ();
336             }
337 163         221 $i++;
338 163         318 my $error = create_json_recursively ($jc, $k, \$k);
339 163 100       337 if ($error) {
340 1         2 return $error;
341             }
342             }
343 32         100 $jc->closeB (']');
344 32         52 return undef;
345             }
346              
347             sub object
348             {
349 80     80 0 230 my ($jc, $input) = @_;
350 80         259 $jc->openB ('{');
351 80         272 my @keys = keys %$input;
352 80 100       206 if ($jc->{_sort}) {
353 17 100       37 if ($jc->{cmp}) {
354 2         12 @keys = sort {&{$jc->{cmp}} ($a, $b)} @keys;
  10         46  
  10         17  
355             }
356             else {
357 15         55 @keys = sort @keys;
358             }
359             }
360 80         141 my $i = 0;
361 80         189 for my $k (@keys) {
362 211 100       434 if ($i != 0) {
363 132         256 $jc->comma ();
364             }
365 211         298 $i++;
366 211         271 my $error;
367 211         409 $error = stringify ($jc, $k);
368 211 100       482 if ($error) {
369 2         8 return $error;
370             }
371 209         335 $jc->{output} .= ':';
372 209         581 $error = create_json_recursively ($jc, $input->{$k}, \$input->{$k});
373 209 100       496 if ($error) {
374 7         18 return $error;
375             }
376             }
377 71         231 $jc->closeB ('}');
378 71         160 return undef;
379             }
380             sub newline_for_top
381             {
382 342     342 0 553 my ($jc) = @_;
383 342 100 100     974 if ($jc->{_indent} && $jc->{depth} == 0) {
384 1         2 $jc->{output} .= "\n";
385             }
386             }
387              
388             sub create_json_recursively
389             {
390 488     488 0 903 my ($jc, $input, $input_ref) = @_;
391 488 100       951 if ($input_ref) {
392 372         711 my $bool = isbool ($input, $input_ref);
393 372 100       728 if ($bool) {
394 4         6 $jc->{output} .= $bool;
395 4         11 $jc->newline_for_top ();
396 4         11 return undef;
397             }
398             }
399 484 100       925 if (! defined $input) {
400 8         21 $jc->{output} .= 'null';
401 8         28 $jc->newline_for_top ();
402 8         19 return undef;
403             }
404 476         782 my $ref = ref ($input);
405 476 100       931 if ($ref eq 'JSON::Create::Bool') {
406 4 100       16 if ($$input) {
407 2         6 $jc->{output} .= 'true';
408             }
409             else {
410 2         6 $jc->{output} .= 'false';
411             }
412 4         15 $jc->newline_for_top ();
413 4         11 return undef;
414             }
415 472 100 100     597 if (! keys %{$jc->{_handlers}} && ! $jc->{_obj_handler}) {
  472         2047  
416 442         687 my $origref = $ref;
417             # Break encapsulation if the user has not supplied handlers.
418 442         969 $ref = reftype ($input);
419 442 100 100     1046 if ($ref && $jc->{_strict}) {
420 29 100       81 if ($ref ne $origref) {
421 1         5 return "Object cannot be serialized to JSON: $origref";
422             }
423             }
424             }
425 471 100       883 if ($ref) {
426 140 100       367 if ($ref eq 'HASH') {
    100          
    100          
427 80         260 my $error = $jc->object ($input);
428 80 100       254 if ($error) {
429 9         22 return $error;
430             }
431             }
432             elsif ($ref eq 'ARRAY') {
433 33         110 my $error = $jc->array ($input);
434 33 100       74 if ($error) {
435 1         2 return $error;
436             }
437             }
438             elsif ($ref eq 'SCALAR') {
439 6 100       18 if ($jc->{_strict}) {
440 2         7 return "Input's type cannot be serialized to JSON";
441             }
442 4         31 my $error = $jc->create_json_recursively ($$input);
443 4 50       13 if ($error) {
444 0         0 return $error;
445             }
446             }
447             else {
448 21 100       80 if (blessed ($input)) {
449 18 100       38 if ($jc->{_obj_handler}) {
450 1         4 my $error = call_to_json ($jc, $jc->{_obj_handler}, $input);
451 1 50       3 if ($error) {
452 1         4 return $error;
453             }
454             }
455             else {
456 17         30 my $handler = $jc->{_handlers}{$ref};
457 17 50       35 if ($handler) {
458 17 100       49 if ($handler eq 'bool') {
    50          
459 9 100       52 if ($$input) {
460 6         17 $jc->{output} .= 'true';
461             }
462             else {
463 3         6 $jc->{output} .= 'false';
464             }
465             }
466             elsif (ref ($handler) eq 'CODE') {
467 8         25 my $error = $jc->call_to_json ($handler, $input);
468 8 100       25 if ($error) {
469 2         7 return $error;
470             }
471             }
472             else {
473 0         0 confess "Unknown handler type " . ref ($handler);
474             }
475             }
476             else {
477 0         0 return "$ref cannot be serialized.\n";
478             }
479             }
480             }
481             else {
482 3 100       8 if ($jc->{_type_handler}) {
483 2         8 my $error = call_to_json ($jc, $jc->{_type_handler}, $input);
484 2 100       7 if ($error) {
485 1         5 return $error;
486             }
487             }
488             else {
489 1         4 return "$ref cannot be serialized.\n";
490             }
491             }
492             }
493             }
494             else {
495 331         431 my $error;
496 331 100 100     1476 if (looks_like_number ($input) && $input !~ /^0[^.]/) {
497 209         449 $error = $jc->handle_number ($input);
498             }
499             else {
500 122         263 $error = stringify ($jc, $input);
501             }
502 331 100       702 if ($error) {
503 5         14 return $error;
504             }
505 326         678 $jc->newline_for_top ();
506             }
507 449         757 return undef;
508             }
509              
510             sub user_error
511             {
512 15     15 0 44 my ($jc, $error) = @_;
513 15 100       59 if ($jc->{_fatal_errors}) {
514 2         20 die $error;
515             }
516             else {
517 13         198 warn $error;
518             }
519             }
520              
521             sub new
522             {
523 24     24 0 106 return bless {
524             _handlers => {},
525             };
526             }
527              
528             sub strict
529             {
530 2     2 0 13 my ($jc, $onoff) = @_;
531 2         11 $jc->{_strict} = !! $onoff;
532             }
533              
534             sub get_handlers
535             {
536 8     8 0 22 my ($jc) = @_;
537 8         23 return $jc->{_handlers};
538             }
539              
540             sub non_finite_handler
541             {
542 1     1 0 15 my ($jc, $handler) = @_;
543 1         3 $jc->{_non_finite_handler} = $handler;
544 1         2 return undef;
545             }
546              
547             sub bool
548             {
549 4     4 0 900 my ($jc, @list) = @_;
550 4         10 my $handlers = $jc->get_handlers ();
551 4         11 for my $k (@list) {
552 4         16 $handlers->{$k} = 'bool';
553             }
554             }
555              
556             sub cmp
557             {
558 1     1 0 8 my ($jc, $cmp) = @_;
559 1         4 $jc->{cmp} = $cmp;
560             }
561              
562             sub escape_slash
563             {
564 2     2 0 3192 my ($jc, $onoff) = @_;
565 2         7 $jc->{_escape_slash} = !! $onoff;
566             }
567              
568             sub fatal_errors
569             {
570 4     4 0 953 my ($jc, $onoff) = @_;
571 4         14 $jc->{_fatal_errors} = !! $onoff;
572             }
573              
574             sub indent
575             {
576 5     5 0 24 my ($jc, $onoff) = @_;
577 5         43 $jc->{_indent} = !! $onoff;
578             }
579              
580             sub no_javascript_safe
581             {
582 2     2 0 1101 my ($jc, $onoff) = @_;
583 2         6 $jc->{_no_javascript_safe} = !! $onoff;
584             }
585              
586             sub obj
587             {
588 4     4 0 1038 my ($jc, %things) = @_;
589 4         14 my $handlers = $jc->get_handlers ();
590 4         13 for my $k (keys %things) {
591 5         16 $handlers->{$k} = $things{$k};
592             }
593             }
594              
595             sub obj_handler
596             {
597 1     1 0 9 my ($jc, $handler) = @_;
598 1         36 $jc->{_obj_handler} = $handler;
599             }
600              
601             sub replace_bad_utf8
602             {
603 1     1 0 304 my ($jc, $onoff) = @_;
604 1         4 $jc->{_replace_bad_utf8} = !! $onoff;
605             }
606              
607             sub run
608             {
609 0     0 0 0 goto &create;
610             }
611              
612             sub create
613             {
614 51     51 0 14310 my ($jc, $input) = @_;
615 51         136 $jc->{output} = '';
616 51         146 my $error = create_json_recursively ($jc, $input);
617 51 100       191 if ($error) {
618 7         42 $jc->user_error ($error);
619 5         41 delete $jc->{output};
620 5         15 return undef;
621             }
622 44 100       122 if ($jc->{_downgrade_utf8}) {
623 1         5 $jc->{output} = encode_utf8 ($jc->{output});
624             }
625 44         156 return $jc->{output};
626             }
627              
628             sub set_fformat
629             {
630 4     4 0 1064 my ($jc, $fformat) = @_;
631 4         10 JSON::Create::set_fformat ($jc, $fformat);
632             }
633              
634             sub set_fformat_unsafe
635             {
636 4     4 0 9 my ($jc, $fformat) = @_;
637 4 100       9 if ($fformat) {
638 2         12 $jc->{_fformat} = $fformat;
639             }
640             else {
641 2         7 delete $jc->{_fformat};
642             }
643             }
644              
645             sub set_validate
646             {
647 1     1 0 4 my ($jc, $onoff) = @_;
648 1         61 $jc->{_validate} = !! $onoff;
649             }
650              
651             sub JSON::Create::PP::sort
652             {
653 4     4 0 22 my ($jc, $onoff) = @_;
654 4         25 $jc->{_sort} = !! $onoff;
655             }
656              
657             sub downgrade_utf8
658             {
659 2     2 0 338 my ($jc, $onoff) = @_;
660 2         11 $jc->{_downgrade_utf8} = !! $onoff;
661             }
662              
663             sub set
664             {
665 25     25 0 83 my ($jc, %args) = @_;
666 25         114 for my $k (keys %args) {
667 4         8 my $value = $args{$k};
668              
669             # Options are in alphabetical order
670              
671 4 50       14 if ($k eq 'bool') {
672 0         0 $jc->bool (@$value);
673 0         0 next;
674             }
675 4 50       57 if ($k eq 'cmp') {
676 0         0 $jc->cmp ($value);
677 0         0 next;
678             }
679 4 50       12 if ($k eq 'downgrade_utf8') {
680 0         0 $jc->downgrade_utf8 ($value);
681 0         0 next;
682             }
683 4 50       10 if ($k eq 'escape_slash') {
684 0         0 $jc->escape_slash ($value);
685 0         0 next;
686             }
687 4 50       9 if ($k eq 'fatal_errors') {
688 0         0 $jc->fatal_errors ($value);
689 0         0 next;
690             }
691 4 100       11 if ($k eq 'indent') {
692 2         13 $jc->indent ($value);
693 2         7 next;
694             }
695 2 50       7 if ($k eq 'no_javascript_safe') {
696 0         0 $jc->no_javascript_safe ($value);
697 0         0 next;
698             }
699 2 50       6 if ($k eq 'non_finite_handler') {
700 0         0 $jc->non_finite_handler ($value);
701 0         0 next;
702             }
703 2 50       7 if ($k eq 'obj_handler') {
704 0         0 $jc->obj_handler ($value);
705 0         0 next;
706             }
707 2 50       7 if ($k eq 'replace_bad_utf8') {
708 0         0 $jc->replace_bad_utf8 ($value);
709 0         0 next;
710             }
711 2 50       6 if ($k eq 'sort') {
712 2         9 $jc->sort ($value);
713 2         5 next;
714             }
715 0 0       0 if ($k eq 'strict') {
716 0         0 $jc->strict ($value);
717 0         0 next;
718             }
719 0 0       0 if ($k eq 'unicode_upper') {
720 0         0 $jc->unicode_upper ($value);
721 0         0 next;
722             }
723 0 0       0 if ($k eq 'validate') {
724 0         0 $jc->validate ($value);
725 0         0 next;
726             }
727 0         0 warn "Unknown option '$k'";
728             }
729             }
730              
731             sub type_handler
732             {
733 2     2 0 12 my ($jc, $handler) = @_;
734 2         11 $jc->{_type_handler} = $handler;
735             }
736              
737             sub unicode_escape_all
738             {
739 3     3 0 560 my ($jc, $onoff) = @_;
740 3         11 $jc->{_unicode_escape_all} = !! $onoff;
741             }
742              
743             sub unicode_upper
744             {
745 3     3 0 570 my ($jc, $onoff) = @_;
746 3         9 $jc->{_unicode_upper} = !! $onoff;
747             }
748              
749             sub validate
750             {
751 1     1 0 1306 return JSON::Create::validate (@_);
752             }
753              
754             sub write_json
755             {
756             # Parent module function is pure perl.
757 0     0 0   JSON::Create::write_json (@_);
758             }
759              
760             1;