File Coverage

json-create-perl.c
Criterion Covered Total %
statement 608 690 88.1
branch 446 1752 25.4
condition n/a
subroutine n/a
pod n/a
total 1054 2442 43.1


line stmt bran cond sub pod time code
1             /*
2             This is the main part of JSON::Create.
3              
4             It's kept in a separate file but #included into the main file,
5             Create.xs.
6             */
7              
8             #ifdef __GNUC__
9             #define INLINE inline
10             #else
11             #define INLINE
12             #endif /* __GNUC__ */
13              
14             /* These are return statuses for the types of failures which can
15             occur. */
16              
17             typedef enum {
18             json_create_ok,
19              
20             /* The following set of exceptions indicate something went wrong
21             in JSON::Create's code, in other words bugs. */
22              
23             /* An error from the unicode.c library. */
24             json_create_unicode_error,
25             /* A printed number turned out to be longer than MARGIN bytes. */
26             json_create_number_too_long,
27             /* Unknown type of floating point number. */
28             json_create_unknown_floating_point,
29             /* Bad format for floating point. */
30             json_create_bad_floating_format,
31              
32             /* The following set of exceptions indicate bad input, in other
33             words these are user-generated exceptions. */
34              
35             /* Badly-formatted UTF-8. */
36             json_create_unicode_bad_utf8,
37             /* Unknown Perl svtype within the structure. */
38             json_create_unknown_type,
39             /* User's routine returned invalid stuff. */
40             json_create_invalid_user_json,
41             /* User gave us an undefined value from a user subroutine. */
42             json_create_undefined_return_value,
43             /* Rejected non-ASCII, non-character string in strict mode. */
44             json_create_non_ascii_byte,
45             /* Rejected scalar reference in strict mode. */
46             json_create_scalar_reference,
47             /* Rejected non-finite number in strict mode. */
48             json_create_non_finite_number,
49             }
50             json_create_status_t;
51              
52             #define BUFSIZE 0x4000
53              
54             /* MARGIN is the size of the "spillover" area where we can print
55             numbers or Unicode UTF-8 whole characters (runes) into the buffer
56             without having to check the printed length after each byte. */
57              
58             #define MARGIN 0x40
59              
60             #define INDENT
61              
62             typedef struct json_create {
63             /* The length of the input string. */
64             int length;
65             unsigned char * buffer;
66             /* Place to write the buffer to. */
67             SV * output;
68             /* Format for floating point numbers. */
69             char * fformat;
70             /* Memory leak counter. */
71             int n_mallocs;
72             /* Handlers for objects and booleans. If there are no handlers,
73             this is zero (a NULL pointer). */
74             HV * handlers;
75             /* User reference handler. */
76             SV * type_handler;
77             /* User obj handler. */
78             SV * obj_handler;
79             /* User non-finite-float handler, what to do with "inf", "nan"
80             type numbers. */
81             SV * non_finite_handler;
82             /* User's sorter for entries. */
83             SV * cmp;
84             #ifdef INDENT
85             /* Indentation depth (no. of tabs). */
86             unsigned int depth;
87             #endif /* def INDENT */
88              
89             /* One-bit flags. */
90              
91             /* Do any of the SVs have a Unicode flag? */
92             unsigned int unicode : 1;
93             /* Should we convert / into \/? */
94             unsigned int escape_slash : 1;
95             /* Should Unicode be upper case? */
96             unsigned int unicode_upper : 1;
97             /* Should we escape all non-ascii? */
98             unsigned int unicode_escape_all : 1;
99             /* Should we validate user-defined JSON? */
100             unsigned int validate : 1;
101             /* Do not escape U+2028 and U+2029. */
102             unsigned int no_javascript_safe : 1;
103             /* Make errors fatal. */
104             unsigned int fatal_errors : 1;
105             /* Replace bad UTF-8 with the "replacement character". */
106             unsigned int replace_bad_utf8 : 1;
107             /* Never upgrade the output to "utf8". */
108             unsigned int downgrade_utf8 : 1;
109             /* Output may contain invalid UTF-8. */
110             unsigned int utf8_dangerous : 1;
111             /* Strict mode, reject lots of things. */
112             unsigned int strict : 1;
113             #ifdef INDENT
114             /* Add whitespace to output to make it human-readable. */
115             unsigned int indent : 1;
116             /* Sort the keys of objects. */
117             unsigned int sort : 1;
118             #endif /* INDENT */
119             }
120             json_create_t;
121              
122             /* Check the length of the buffer, and if we don't have more than
123             MARGIN bytes left to write into, then we put "jc->buffer" into the
124             Perl scalar "jc->output" via "json_create_buffer_fill". We always
125             want to be at least MARGIN bytes from the end of "jc->buffer" after
126             every write operation, so that we always have room to put a number
127             or a UTF-8 "rune" in the buffer without checking the length
128             excessively. */
129              
130             #define CHECKLENGTH \
131             if (jc->length >= BUFSIZE - MARGIN) { \
132             CALL (json_create_buffer_fill (jc)); \
133             }
134              
135             /* Debug the internal handling of types. */
136              
137             //#define JCDEBUGTYPES
138             #ifdef JCDEBUGTYPES
139             #define MSG(format, args...) \
140             fprintf (stderr, "%s:%d: ", __FILE__, __LINE__);\
141             fprintf (stderr, format, ## args);\
142             fprintf (stderr, "\n");
143             #else
144             #define MSG(format, args...)
145             #endif /* def JCDEBUGTYPES */
146              
147             /* Print an error to stderr. */
148              
149             static int
150 0           json_create_error_handler_default (const char * file, int line_number, const char * msg, ...)
151             {
152             int printed;
153             va_list vargs;
154 0           va_start (vargs, msg);
155 0           printed = 0;
156 0           printed += fprintf (stderr, "%s:%d: ", file, line_number);
157 0           printed += vfprintf (stderr, msg, vargs);
158 0           printed += fprintf (stderr, "\n");
159 0           va_end (vargs);
160 0           return printed;
161             }
162              
163             static int (* json_create_error_handler) (const char * file, int line_number, const char * msg, ...) = json_create_error_handler_default;
164              
165             #define JCEH json_create_error_handler
166              
167             #define HANDLE_STATUS(x,status) { \
168             switch (status) { \
169             /* These exceptions indicate a user error. */ \
170             case json_create_unknown_type: \
171             case json_create_unicode_bad_utf8: \
172             case json_create_invalid_user_json: \
173             case json_create_undefined_return_value: \
174             case json_create_non_ascii_byte: \
175             case json_create_scalar_reference: \
176             case json_create_non_finite_number: \
177             break; \
178             \
179             /* All other exceptions are our bugs. */ \
180             default: \
181             if (JCEH) { \
182             (*JCEH) (__FILE__, __LINE__, \
183             "call to %s failed with status %d", \
184             #x, status); \
185             } \
186             } \
187             }
188              
189             #define CALL(x) { \
190             json_create_status_t status; \
191             status = x; \
192             if (status != json_create_ok) { \
193             HANDLE_STATUS (x,status); \
194             return status; \
195             } \
196             }
197              
198             static void
199 15           json_create_user_message (json_create_t * jc, json_create_status_t status, const char * format, ...)
200             {
201             va_list a;
202             /* Check the status. */
203 15           va_start (a, format);
204 15 100         if (jc->fatal_errors) {
205 2           vcroak (format, & a);
206             }
207             else {
208 13           vwarn (format, & a);
209             }
210 13           }
211              
212             /* Everything else in this file is ordered from callee at the top to
213             caller at the bottom, but because of the recursion as we look at
214             JSON values within arrays or hashes, we need to forward-declare
215             "json_create_recursively". */
216              
217             static json_create_status_t
218             json_create_recursively (json_create_t * jc, SV * input);
219              
220             /* Copy the jc buffer into its SV. */
221              
222             static INLINE json_create_status_t
223 97           json_create_buffer_fill (json_create_t * jc)
224             {
225             /* There is nothing to put in the output. */
226 97 50         if (jc->length == 0) {
227 0 0         if (jc->output == 0) {
228             /* And there was not anything before either. */
229 0           jc->output = & PL_sv_undef;
230             }
231             /* Either way, we don't need to do anything more. */
232 0           return json_create_ok;
233             }
234 97 50         if (! jc->output) {
235 97           jc->output = newSVpvn ((char *) jc->buffer, (STRLEN) jc->length);
236             }
237             else {
238 0           sv_catpvn (jc->output, (char *) jc->buffer, (STRLEN) jc->length);
239             }
240             /* "Empty" the buffer, we don't bother cleaning out the old
241             values, so "jc->length" is our only clue as to the clean/dirty
242             state of the buffer. */
243 97           jc->length = 0;
244 97           return json_create_ok;
245             }
246              
247             /* Add one character to the end of jc. */
248              
249             static INLINE json_create_status_t
250 2471           add_char (json_create_t * jc, unsigned char c)
251             {
252 2471           jc->buffer[jc->length] = c;
253 2471           jc->length++;
254             /* The size we have to use before we write the buffer out. */
255 2471 50         CHECKLENGTH;
    0          
    0          
    0          
256 2471           return json_create_ok;
257             }
258              
259             /* Add a nul-terminated string to "jc", up to the nul byte. This
260             should not be used unless it's strictly necessary, prefer to use
261             "add_str_len" instead. Basically, don't use this. This is not
262             intended to be Unicode-safe, it is only to be used for strings
263             which we know do not need to be checked for Unicode validity (for
264             example sprintf'd numbers or something). */
265              
266             static INLINE json_create_status_t
267             add_str (json_create_t * jc, const char * s)
268             {
269             int i;
270             for (i = 0; s[i]; i++) {
271             unsigned char c;
272             c = (unsigned char) s[i];
273             CALL (add_char (jc, c));
274             }
275             return json_create_ok;
276             }
277              
278             /* Add a string "s" with length "slen" to "jc". This does not test for
279             nul bytes, but just copies "slen" bytes of the string. This is not
280             intended to be Unicode-safe, it is only to be used for strings we
281             know do not need to be checked for Unicode validity. */
282              
283             static INLINE json_create_status_t
284 158           add_str_len (json_create_t * jc, const char * s, unsigned int slen)
285             {
286             int i;
287             /* We know that (BUFSIZE - jc->length) is always bigger than
288             MARGIN going into this, but the compiler doesn't. Hopefully,
289             the compiler optimizes the following "if" statement away to a
290             true value for almost all cases when this is inlined and slen
291             is known to be smaller than MARGIN. */
292 158 50         if (slen < MARGIN || slen < BUFSIZE - jc->length) {
    0          
293 783 100         for (i = 0; i < slen; i++) {
294 625           jc->buffer[jc->length + i] = s[i];
295             }
296 158           jc->length += slen;
297 158 50         CHECKLENGTH;
    0          
    0          
    0          
298             }
299             else {
300             /* A very long string which may overflow the buffer, so use
301             checking routines. */
302 0 0         for (i = 0; i < slen; i++) {
303 0 0         CALL (add_char (jc, (unsigned char) s[i]));
    0          
    0          
304             }
305             }
306 158           return json_create_ok;
307             }
308              
309             #ifdef INDENT
310              
311 117           static json_create_status_t newline_indent(json_create_t * jc)
312             {
313             int d;
314 117 50         CALL (add_char (jc, '\n'));
    0          
    0          
315 305 100         for (d = 0; d < jc->depth; d++) {
316 188 50         CALL (add_char (jc, '\t')); \
    0          
    0          
317             }
318 117           return json_create_ok;
319             }
320              
321             static INLINE json_create_status_t
322 0           add_str_len_indent (json_create_t * jc, const char * s, unsigned int slen)
323             {
324             int i;
325              
326 0 0         for (i = 0; i < slen; i++) {
327             unsigned char c;
328 0           c = (unsigned char) s[i];
329 0 0         if (c == '\n') {
330 0 0         if (i < slen - 1) {
331 0 0         CALL (newline_indent (jc));
    0          
    0          
332             }
333             // else just discard it, final newline
334             }
335             else {
336 0 0         CALL (add_char (jc, c));
    0          
    0          
337             }
338             }
339 0           return json_create_ok;
340             }
341              
342             #endif /* def INDENT */
343              
344             /* "Add a string" macro, this just saves cut and pasting a string and
345             typing "strlen" over and over again. For ASCII values only, not
346             Unicode safe. */
347              
348             #define ADD(x) CALL (add_str_len (jc, x, strlen (x)));
349              
350             static const char *uc_hex = "0123456789ABCDEF";
351             static const char *lc_hex = "0123456789abcdef";
352              
353             static INLINE json_create_status_t
354 42           add_one_u (json_create_t * jc, unsigned int u)
355             {
356             char * spillover;
357             const char * hex;
358 42           hex = lc_hex;
359 42 100         if (jc->unicode_upper) {
360 6           hex = uc_hex;
361             }
362 42           spillover = (char *) (jc->buffer) + jc->length;
363 42           spillover[0] = '\\';
364 42           spillover[1] = 'u';
365             // Method poached from https://metacpan.org/source/CHANSEN/Unicode-UTF8-0.60/UTF8.xs#L196
366 42           spillover[5] = hex[u & 0xf];
367 42           u >>= 4;
368 42           spillover[4] = hex[u & 0xf];
369 42           u >>= 4;
370 42           spillover[3] = hex[u & 0xf];
371 42           u >>= 4;
372 42           spillover[2] = hex[u & 0xf];
373 42           jc->length += 6;
374 42 50         CHECKLENGTH;
    0          
    0          
    0          
375 42           return json_create_ok;
376             }
377              
378             /* Add a "\u3000" or surrogate pair if necessary. */
379              
380             static INLINE json_create_status_t
381 21           add_u (json_create_t * jc, unsigned int u)
382             {
383 21 100         if (u > 0xffff) {
384             int hi;
385             int lo;
386 9           int status = unicode_to_surrogates (u, & hi, & lo);
387 9 50         if (status != UNICODE_OK) {
388 0 0         if (JCEH) {
389 0           (*JCEH) (__FILE__, __LINE__,
390             "Error %d making surrogate pairs from %X",
391             status, u);
392             }
393 0           return json_create_unicode_error;
394             }
395 9 50         CALL (add_one_u (jc, hi));
    0          
    0          
396             /* Backtrace fallthrough. */
397 9           return add_one_u (jc, lo);
398             }
399             else {
400             /* Backtrace fallthrough. */
401 12           return add_one_u (jc, u);
402             }
403             }
404              
405             #define BADUTF8 \
406             if (jc->replace_bad_utf8) { \
407             /* We have to switch on Unicode otherwise the replacement */ \
408             /* characters don't work as intended. */ \
409             jc->unicode = 1; \
410             /* This is �, U+FFFD, as UTF-8 bytes. */ \
411             CALL (add_str_len (jc, "\xEF\xBF\xBD", 3)); \
412             } \
413             else { \
414             json_create_user_message (jc, json_create_unicode_bad_utf8, \
415             "Invalid UTF-8"); \
416             return json_create_unicode_bad_utf8; \
417             }
418              
419             /* Jump table. Doing it this way is not the fastest possible way, but
420             it's also very difficult for a compiler to mess this
421             up. Theoretically, it would be faster to make a jump table by the
422             compiler from the switch statement, but some compilers sometimes
423             cannot do that. */
424              
425             /* In this enum, I use three letters as a compromise between
426             readability and formatting. The control character names are from
427             "man ascii" with an X tagged on the end. */
428              
429             typedef enum {
430             CTL, // control char, escape to \u
431             BSX, // backslash b
432             HTX, // Tab character
433             NLX, // backslash n, new line
434             NPX, // backslash f
435             CRX, // backslash r
436             ASC, // Non-special ASCII
437             QUO, // double quote
438             BSL, // backslash
439             FSL, // forward slash, "/"
440             BAD, // Invalid UTF-8 value.
441             UT2, // UTF-8, two bytes
442             UT3, // UTF-8, three bytes
443             UT4, // UTF-8, four bytes
444             }
445             jump_t;
446              
447             static jump_t jump[0x100] = {
448             CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,BSX,HTX,NLX,CTL,NPX,CRX,CTL,CTL,
449             CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,CTL,
450             ASC,ASC,QUO,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,FSL,
451             ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,
452             ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,
453             ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,BSL,ASC,ASC,ASC,
454             ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,
455             ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,ASC,
456             BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,
457             BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,
458             BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,
459             BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,
460             BAD,BAD,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,
461             UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,UT2,
462             UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,UT3,
463             UT4,UT4,UT4,UT4,UT4,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,BAD,
464             };
465              
466             /* Need this twice, once within the ASCII handler and once within the
467             Unicode handler. */
468              
469             #define ASCII \
470             case CTL: \
471             CALL (add_one_u (jc, (unsigned int) c)); \
472             i++; \
473             break; \
474             \
475             case BSX: \
476             ADD ("\\b"); \
477             i++; \
478             break; \
479             \
480             case HTX: \
481             ADD ("\\t"); \
482             i++; \
483             break; \
484             \
485             case NLX: \
486             ADD ("\\n"); \
487             i++; \
488             break; \
489             \
490             case NPX: \
491             ADD ("\\f"); \
492             i++; \
493             break; \
494             \
495             case CRX: \
496             ADD ("\\r"); \
497             i++; \
498             break; \
499             \
500             case ASC: \
501             CALL (add_char (jc, c)); \
502             i++; \
503             break; \
504             \
505             case QUO: \
506             ADD ("\\\""); \
507             i++; \
508             break; \
509             \
510             case FSL: \
511             if (jc->escape_slash) { \
512             ADD ("\\/"); \
513             } \
514             else { \
515             CALL (add_char (jc, c)); \
516             } \
517             i++; \
518             break; \
519             \
520             case BSL: \
521             ADD ("\\\\"); \
522             i++; \
523             break;
524              
525              
526             static INLINE json_create_status_t
527 62           json_create_add_ascii_key_len (json_create_t * jc, const unsigned char * key, STRLEN keylen)
528             {
529             int i;
530              
531 62 50         CALL (add_char (jc, '"'));
    0          
    0          
532 168 100         for (i = 0; i < keylen; ) {
533             unsigned char c;
534              
535 109           c = key[i];
536 109           switch (jump[c]) {
537              
538 106 50         ASCII;
    0          
    0          
    0          
    0          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
539              
540             default:
541 3           json_create_user_message (jc, json_create_non_ascii_byte,
542             "Non-ASCII byte in non-utf8 string: %X",
543 3           key[i]);
544 2           return json_create_non_ascii_byte;
545             }
546             }
547 59 50         CALL (add_char (jc, '"'));
    0          
    0          
548 59           return json_create_ok;
549             }
550              
551              
552             /* Add a string to the buffer with quotes around it and escapes for
553             the escapables. */
554              
555             static INLINE json_create_status_t
556 271           json_create_add_key_len (json_create_t * jc, const unsigned char * key, STRLEN keylen)
557             {
558             int i;
559              
560 271 50         CALL (add_char (jc, '"'));
    0          
    0          
561 1129 100         for (i = 0; i < keylen; ) {
562             unsigned char c, d, e, f;
563 859           c = key[i];
564              
565 859           switch (jump[c]) {
566              
567 722 50         ASCII;
    0          
    0          
    0          
    0          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    100          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
568              
569             case BAD:
570 3 100         BADUTF8;
    50          
    0          
    0          
571 2           i++;
572 2           break;
573              
574             case UT2:
575 5           d = key[i + 1];
576 5 50         if (d < 0x80 || d > 0xBF) {
    50          
577 0 0         BADUTF8;
    0          
    0          
    0          
578 0           i++;
579 0           break;
580             }
581 5 100         if (jc->unicode_escape_all) {
582             unsigned int u;
583 8           u = (c & 0x1F)<<6
584 4           | (d & 0x3F);
585 4 50         CALL (add_u (jc, u));
    0          
    0          
586             }
587             else {
588 1 50         CALL (add_str_len (jc, (const char *) key + i, 2));
    0          
    0          
589             }
590             // Increment i
591 5           i += 2;
592 5           break;
593              
594             case UT3:
595 66           d = key[i + 1];
596 66           e = key[i + 2];
597 66 50         if (d < 0x80 || d > 0xBF ||
    50          
    50          
598 66 50         e < 0x80 || e > 0xBF) {
599 0 0         BADUTF8;
    0          
    0          
    0          
600 0           i++;
601 0           break;
602             }
603 66 100         if (! jc->no_javascript_safe &&
    100          
604 10 100         c == 0xe2 && d == 0x80 &&
    100          
605 4 50         (e == 0xa8 || e == 0xa9)) {
606 8 50         CALL (add_one_u (jc, 0x2028 + e - 0xa8));
    0          
    0          
607             }
608             else {
609 58 100         if (jc->unicode_escape_all) {
610             unsigned int u;
611 16           u = (c & 0x0F)<<12
612 8           | (d & 0x3F)<<6
613 8           | (e & 0x3F);
614 8 50         CALL (add_u (jc, u));
    0          
    0          
615             }
616             else {
617 50 50         CALL (add_str_len (jc, (const char *) key + i, 3));
    0          
    0          
618             }
619             }
620             // Increment i
621 66           i += 3;
622 66           break;
623              
624             case UT4:
625 63           d = key[i + 1];
626 63           e = key[i + 2];
627 63           f = key[i + 3];
628 63 50         if (
629             // These byte values are copied from
630             // https://github.com/htacg/tidy-html5/blob/768ad46968b43e29167f4d1394a451b8c6f40b7d/src/utf8.c
631              
632             // 0x40000 - 0xfffff
633 63 50         (c < 0xf4 &&
634 63 50         (d < 0x80 || d > 0xBF ||
    50          
635 63 50         e < 0x80 || e > 0xBF ||
    50          
636 63 50         f < 0x80 || f > 0xBF))
637 63 50         ||
638             // 0x100000 - 0x10ffff
639 0 0         (c == 0xf4 &&
640 0 0         (d < 0x80 || d > 0x8F ||
    0          
641 0 0         e < 0x80 || e > 0xBF ||
    0          
642 0 0         f < 0x80 || f > 0xBF))
643             ) {
644 0 0         BADUTF8;
    0          
    0          
    0          
645 0           i++;
646 0           break;
647             }
648 63 100         if (jc->unicode_escape_all) {
649             unsigned int u;
650             const unsigned char * input;
651 9           input = key + i;
652 18           u = (c & 0x07) << 18
653 9           | (d & 0x3F) << 12
654 9           | (e & 0x3F) << 6
655 9           | (f & 0x3F);
656 9           add_u (jc, u);
657             }
658             else {
659 54 50         CALL (add_str_len (jc, (const char *) key + i, 4));
    0          
    0          
660             }
661             // Increment i
662 63           i += 4;
663 63           break;
664             }
665             }
666 270 50         CALL (add_char (jc, '"'));
    0          
    0          
667 270           return json_create_ok;
668             }
669              
670             static INLINE json_create_status_t
671 122           json_create_add_string (json_create_t * jc, SV * input)
672             {
673             char * istring;
674             STRLEN ilength;
675              
676 122 50         istring = SvPV (input, ilength);
677 122 100         if (SvUTF8 (input)) {
678             /* "jc->unicode" is true if Perl says that anything in the
679             whole of the input to "json_create" is a "SvUTF8"
680             scalar. We have to force everything in the whole output to
681             Unicode. */
682 54           jc->unicode = 1;
683             }
684 68 100         else if (jc->strict) {
685             /* Backtrace fall through, remember to check the caller's line. */
686 17           return json_create_add_ascii_key_len (jc, (unsigned char *) istring,
687             (STRLEN) ilength);
688             }
689             /* Backtrace fall through, remember to check the caller's line. */
690 121           return json_create_add_key_len (jc, (unsigned char *) istring,
691             (STRLEN) ilength);
692             }
693              
694             /* Extract the remainder of x when divided by ten and then turn it
695             into the equivalent ASCII digit. '0' in ASCII is 0x30, and (x)%10
696             is guaranteed not to have any of the high bits set. */
697              
698             #define DIGIT(x) (((x)%10)|0x30)
699              
700             static INLINE json_create_status_t
701 107           json_create_add_integer (json_create_t * jc, SV * sv)
702             {
703             long int iv;
704             int ivlen;
705             char * spillover;
706              
707 107 50         iv = SvIV (sv);
708 107           ivlen = 0;
709              
710             /* Pointer arithmetic. */
711              
712 107           spillover = ((char *) jc->buffer) + jc->length;
713              
714             /* Souped-up integer printing for small integers. The following is
715             all just souped up versions of snprintf ("%d", iv);. */
716              
717 107 100         if (iv < 0) {
718 10           spillover[ivlen] = '-';
719 10           ivlen++;
720 10           iv = -iv;
721             }
722 107 100         if (iv < 10) {
723             /* iv has exactly one digit. The first digit may be zero. */
724 42           spillover[ivlen] = DIGIT (iv);
725 42           ivlen++;
726             }
727 65 100         else if (iv < 100) {
728             /* iv has exactly two digits. The first digit is not zero. */
729 9           spillover[ivlen] = DIGIT (iv/10);
730 9           ivlen++;
731 9           spillover[ivlen] = DIGIT (iv);
732 9           ivlen++;
733             }
734 56 100         else if (iv < 1000) {
735             /* iv has exactly three digits. The first digit is not
736             zero. */
737 8           spillover[ivlen] = DIGIT (iv/100);
738 8           ivlen++;
739 8           spillover[ivlen] = DIGIT (iv/10);
740 8           ivlen++;
741 8           spillover[ivlen] = DIGIT (iv);
742 8           ivlen++;
743             }
744 48 100         else if (iv < 10000) {
745             /* etc. */
746 8           spillover[ivlen] = DIGIT (iv/1000);
747 8           ivlen++;
748 8           spillover[ivlen] = DIGIT (iv/100);
749 8           ivlen++;
750 8           spillover[ivlen] = DIGIT (iv/10);
751 8           ivlen++;
752 8           spillover[ivlen] = DIGIT (iv);
753 8           ivlen++;
754             }
755 40 100         else if (iv < 100000) {
756 6           spillover[ivlen] = DIGIT (iv/10000);
757 6           ivlen++;
758 6           spillover[ivlen] = DIGIT (iv/1000);
759 6           ivlen++;
760 6           spillover[ivlen] = DIGIT (iv/100);
761 6           ivlen++;
762 6           spillover[ivlen] = DIGIT (iv/10);
763 6           ivlen++;
764 6           spillover[ivlen] = DIGIT (iv);
765 6           ivlen++;
766             }
767 34 100         else if (iv < 1000000) {
768 6           spillover[ivlen] = DIGIT (iv/100000);
769 6           ivlen++;
770 6           spillover[ivlen] = DIGIT (iv/10000);
771 6           ivlen++;
772 6           spillover[ivlen] = DIGIT (iv/1000);
773 6           ivlen++;
774 6           spillover[ivlen] = DIGIT (iv/100);
775 6           ivlen++;
776 6           spillover[ivlen] = DIGIT (iv/10);
777 6           ivlen++;
778 6           spillover[ivlen] = DIGIT (iv);
779 6           ivlen++;
780             }
781 28 100         else if (iv < 10000000) {
782 12           spillover[ivlen] = DIGIT (iv/1000000);
783 12           ivlen++;
784 12           spillover[ivlen] = DIGIT (iv/100000);
785 12           ivlen++;
786 12           spillover[ivlen] = DIGIT (iv/10000);
787 12           ivlen++;
788 12           spillover[ivlen] = DIGIT (iv/1000);
789 12           ivlen++;
790 12           spillover[ivlen] = DIGIT (iv/100);
791 12           ivlen++;
792 12           spillover[ivlen] = DIGIT (iv/10);
793 12           ivlen++;
794 12           spillover[ivlen] = DIGIT (iv);
795 12           ivlen++;
796             }
797 16 100         else if (iv < 100000000) {
798 6           spillover[ivlen] = DIGIT (iv/10000000);
799 6           ivlen++;
800 6           spillover[ivlen] = DIGIT (iv/1000000);
801 6           ivlen++;
802 6           spillover[ivlen] = DIGIT (iv/100000);
803 6           ivlen++;
804 6           spillover[ivlen] = DIGIT (iv/10000);
805 6           ivlen++;
806 6           spillover[ivlen] = DIGIT (iv/1000);
807 6           ivlen++;
808 6           spillover[ivlen] = DIGIT (iv/100);
809 6           ivlen++;
810 6           spillover[ivlen] = DIGIT (iv/10);
811 6           ivlen++;
812 6           spillover[ivlen] = DIGIT (iv);
813 6           ivlen++;
814             }
815 10 100         else if (iv < 1000000000) {
816 8           spillover[ivlen] = DIGIT (iv/100000000);
817 8           ivlen++;
818 8           spillover[ivlen] = DIGIT (iv/10000000);
819 8           ivlen++;
820 8           spillover[ivlen] = DIGIT (iv/1000000);
821 8           ivlen++;
822 8           spillover[ivlen] = DIGIT (iv/100000);
823 8           ivlen++;
824 8           spillover[ivlen] = DIGIT (iv/10000);
825 8           ivlen++;
826 8           spillover[ivlen] = DIGIT (iv/1000);
827 8           ivlen++;
828 8           spillover[ivlen] = DIGIT (iv/100);
829 8           ivlen++;
830 8           spillover[ivlen] = DIGIT (iv/10);
831 8           ivlen++;
832 8           spillover[ivlen] = DIGIT (iv);
833 8           ivlen++;
834             }
835             else {
836             /* The number is one billion (1000,000,000) or more, so we're
837             just going to print it into "jc->buffer" with snprintf. */
838 2           ivlen += snprintf (spillover + ivlen, MARGIN - ivlen, "%ld", iv);
839 2 50         if (ivlen >= MARGIN) {
840 0 0         if (JCEH) {
841 0 0         (*JCEH) (__FILE__, __LINE__,
842             "A printed integer number %ld was "
843             "longer than MARGIN=%d bytes",
844 0           SvIV (sv), MARGIN);
845             }
846 0           return json_create_number_too_long;
847             }
848             }
849 107           jc->length += ivlen;
850 107 50         CHECKLENGTH;
    0          
    0          
    0          
851 107           return json_create_ok;
852             }
853              
854             #define UNKNOWN_TYPE_FAIL(t) \
855             if (JCEH) { \
856             (*JCEH) (__FILE__, __LINE__, \
857             "Unknown Perl type %d", t); \
858             } \
859             return json_create_unknown_type
860              
861             //#define DEBUGOBJ
862              
863             static json_create_status_t
864 2           json_create_validate_user_json (json_create_t * jc, SV * json)
865             {
866             SV * error;
867 2           dSP;
868 2           ENTER;
869 2           SAVETMPS;
870 2 50         PUSHMARK (SP);
871 2 50         XPUSHs (sv_2mortal (newSVsv (json)));
872 2           PUTBACK;
873 2           call_pv ("JSON::Parse::assert_valid_json",
874             G_EVAL|G_DISCARD);
875 2 50         FREETMPS;
876 2           LEAVE;
877 2           error = get_sv ("@", 0);
878 2 50         if (! error) {
879 0           return json_create_ok;
880             }
881 2 50         if (SvOK (error) && SvCUR (error) > 0) {
    0          
    0          
    100          
882 1 50         json_create_user_message (jc, json_create_invalid_user_json,
    50          
883             "JSON::Parse::assert_valid_json failed for '%s': %s",
884 2           SvPV_nolen (json), SvPV_nolen (error));
885 1           return json_create_invalid_user_json;
886             }
887 1           return json_create_ok;
888             }
889              
890             static json_create_status_t
891 14           json_create_call_to_json (json_create_t * jc, SV * cv, SV * r)
892             {
893             SV * json;
894             char * jsonc;
895             STRLEN jsonl;
896             // https://metacpan.org/source/AMBS/Math-GSL-0.35/swig/gsl_typemaps.i#L438
897 14           dSP;
898            
899 14           ENTER;
900 14           SAVETMPS;
901            
902 14 50         PUSHMARK (SP);
903             //https://metacpan.org/source/AMBS/Math-GSL-0.35/swig/gsl_typemaps.i#L482
904 14 50         XPUSHs (sv_2mortal (newRV (r)));
905 14           PUTBACK;
906 14           call_sv (cv, 0);
907 14           json = POPs;
908 14           SvREFCNT_inc (json);
909 14 50         FREETMPS;
910 14           LEAVE;
911              
912 14 100         if (! SvOK (json)) {
    50          
    50          
913             /* User returned an undefined value. */
914 3           SvREFCNT_dec (json);
915 3           json_create_user_message (jc, json_create_undefined_return_value,
916             "Undefined value from user routine");
917 3           return json_create_undefined_return_value;
918             }
919 11 50         if (SvUTF8 (json)) {
920             /* We have to force everything in the whole output to
921             Unicode. */
922 0           jc->unicode = 1;
923             }
924 11 50         jsonc = SvPV (json, jsonl);
925 11 100         if (jc->validate) {
926 2 100         CALL (json_create_validate_user_json (jc, json));
    50          
    0          
927             }
928             else {
929             /* This string may contain invalid UTF-8. */
930 9           jc->utf8_dangerous = 1;
931             }
932             #ifdef INDENT
933 10 50         if (jc->indent) {
934 0 0         CALL (add_str_len_indent (jc, jsonc, jsonl));
    0          
    0          
935             }
936             else {
937             #endif
938 10 50         CALL (add_str_len (jc, jsonc, jsonl));
    0          
    0          
939             #ifdef INDENT
940             }
941             #endif
942 10           SvREFCNT_dec (json);
943 14           return json_create_ok;
944             }
945              
946             static INLINE json_create_status_t
947 102           json_create_add_float (json_create_t * jc, SV * sv)
948             {
949             double fv;
950             STRLEN fvlen;
951 102 50         fv = SvNV (sv);
952 102 100         if (isfinite (fv)) {
953 93 100         if (jc->fformat) {
954 57           fvlen = snprintf ((char *) jc->buffer + jc->length, MARGIN, jc->fformat, fv);
955             }
956             else {
957 36           fvlen = snprintf ((char *) jc->buffer + jc->length, MARGIN,
958             "%g", fv);
959             }
960 93 50         if (fvlen >= MARGIN) {
961 0           return json_create_number_too_long;
962             }
963 93           jc->length += fvlen;
964 93 50         CHECKLENGTH;
    0          
    0          
    0          
965             }
966             else {
967 9 100         if (jc->non_finite_handler) {
968 3 50         CALL (json_create_call_to_json (jc, jc->non_finite_handler, sv));
    0          
    0          
969             }
970             else {
971 6 100         if (jc->strict) {
972 3           json_create_user_message (jc, json_create_non_finite_number,
973             "Non-finite number in input");
974 3           return json_create_non_finite_number;
975             }
976 3 100         if (isnan (fv)) {
977 1 50         ADD ("\"nan\"");
    0          
    0          
978             }
979 2 50         else if (isinf (fv)) {
980 2 100         if (fv < 0.0) {
981 1 50         ADD ("\"-inf\"");
    0          
    0          
982             }
983             else {
984 2 50         ADD ("\"inf\"");
    0          
    0          
985             }
986             }
987             else {
988 0           return json_create_unknown_floating_point;
989             }
990             }
991             }
992 99           return json_create_ok;
993             }
994              
995             static INLINE json_create_status_t
996 3           json_create_add_magic (json_create_t * jc, SV * r)
997             {
998             /* There are some edge cases with blessed references
999             containing numbers which we need to handle correctly. */
1000 3 100         if (SvIOK (r)) {
1001 1 50         CALL (json_create_add_integer (jc, r));
    0          
    0          
1002             }
1003 2 50         else if (SvNOK (r)) {
1004 0 0         CALL (json_create_add_float (jc, r));
    0          
    0          
1005             }
1006             else {
1007 2 50         CALL (json_create_add_string (jc, r));
    0          
    0          
1008             }
1009 3           return json_create_ok;
1010             }
1011              
1012             /* Add a number which is already stringified. This bypasses snprintf
1013             and just copies the Perl string straight into the buffer. */
1014              
1015             static INLINE json_create_status_t
1016             json_create_add_stringified (json_create_t * jc, SV *r)
1017             {
1018             /* Stringified number. */
1019             char * s;
1020             /* Length of "r". */
1021             STRLEN rlen;
1022             int i;
1023             int notdigits = 0;
1024              
1025             s = SvPV (r, rlen);
1026            
1027             /* Somehow or another it's possible to arrive here with a
1028             non-digit string, precisely this happened with the "script"
1029             value returned by Unicode::UCD::charinfo, which had the value
1030             "Common" and was an SVt_PVIV. */
1031             for (i = 0; i < rlen; i++) {
1032             char c = s[i];
1033             if (!isdigit (c) && c != '.' && c != '-' && c != 'e' && c != 'E') {
1034             notdigits = 1;
1035             }
1036             }
1037             /* If the stringified number has leading zeros, don't skip those,
1038             but put the string in quotes. It can happen that something like
1039             a Huffman code has leading zeros and should be treated as a
1040             string, yet Perl also thinks it is a number. */
1041             if (s[0] == '0' && rlen > 1 && isdigit (s[1])) {
1042             notdigits = 1;
1043             }
1044              
1045             if (notdigits) {
1046             CALL (add_char (jc, '"'));
1047             CALL (add_str_len (jc, s, (unsigned int) rlen));
1048             CALL (add_char (jc, '"'));
1049             return json_create_ok;
1050             }
1051             /* This doesn't backtrace correctly, but the calling routine
1052             should print out that it was calling "add_stringified", so as
1053             long as we're careful not to ignore the caller line, it
1054             shouldn't matter. */
1055             return add_str_len (jc, s, (unsigned int) rlen);
1056             }
1057              
1058             #ifdef INDENT
1059             #define DINC if (jc->indent) { jc->depth++; }
1060             #define DDEC if (jc->indent) { jc->depth--; }
1061             #endif /* def INDENT */
1062              
1063             /* Add a comma where necessary. This is shared between objects and
1064             arrays. */
1065              
1066             #ifdef INDENT
1067             #define COMMA \
1068             if (i > 0) { \
1069             CALL (add_char (jc, ',')); \
1070             if (jc->indent) { \
1071             CALL (newline_indent (jc)); \
1072             } \
1073             }
1074             #else /* INDENT */
1075             #define COMMA \
1076             if (i > 0) { \
1077             CALL (add_char (jc, ',')); \
1078             }
1079             #endif /* INDENT */
1080              
1081             static INLINE json_create_status_t
1082 112           add_open (json_create_t * jc, unsigned char c)
1083             {
1084 112 50         CALL (add_char (jc, c));
    0          
    0          
1085             #ifdef INDENT
1086 112 100         if (jc->indent) {
1087 23 50         DINC;
1088 23 50         CALL (newline_indent (jc)); \
    0          
    0          
1089             }
1090             #endif /* INDENT */
1091 112           return json_create_ok;
1092             }
1093              
1094             static INLINE json_create_status_t
1095 102           add_close (json_create_t * jc, unsigned char c)
1096             {
1097             #ifdef INDENT
1098 102 100         if (jc->indent) {
1099 23 50         DDEC;
1100 23 50         CALL (newline_indent (jc)); \
    0          
    0          
1101             }
1102             #endif /* def INDENT */
1103 102 50         CALL (add_char (jc, c));
    0          
    0          
1104             #ifdef INDENT
1105 102 100         if (jc->indent) {
1106             /* Add a new line after the final brace, otherwise we have no
1107             newline on the final line of output. */
1108 23 100         if (jc->depth == 0) {
1109 6 50         CALL (add_char (jc, '\n'));
    0          
    0          
1110             }
1111             }
1112             #endif /* def INDENT */
1113 102           return json_create_ok;
1114             }
1115              
1116             //#define JCDEBUGTYPES
1117              
1118             static int
1119 10           json_create_user_compare (void * thunk, const void * va, const void * vb)
1120             {
1121 10           dSP;
1122             SV * sa;
1123             SV * sb;
1124             json_create_t * jc;
1125             int n;
1126             int c;
1127              
1128 10           sa = *(SV **) va;
1129 10           sb = *(SV **) vb;
1130 10           jc = (json_create_t *) thunk;
1131              
1132 10           ENTER;
1133 10           SAVETMPS;
1134 10 50         PUSHMARK(SP);
1135 10 50         EXTEND(SP, 2);
1136 10 50         XPUSHs(sv_2mortal (newSVsv (sa)));
1137 10 50         XPUSHs(sv_2mortal (newSVsv (sb)));
1138 10           PUTBACK;
1139 10           n = call_sv (jc->cmp, G_SCALAR);
1140 10 50         if (n != 1) {
1141 0           croak ("Wrong number of return values %d from comparison function",
1142             n);
1143             }
1144 10           SPAGAIN;
1145 10 50         c = POPi;
1146 10           PUTBACK;
1147 10 50         FREETMPS;
1148 10           LEAVE;
1149 10           return c;
1150             }
1151              
1152             static INLINE json_create_status_t
1153 17           json_create_add_object_sorted (json_create_t * jc, HV * input_hv)
1154             {
1155             I32 n_keys;
1156             int i;
1157             SV ** keys;
1158              
1159 17           n_keys = hv_iterinit (input_hv);
1160 17 50         if (n_keys == 0) {
1161 0 0         CALL (add_str_len (jc, "{}", strlen ("{}")));
    0          
    0          
1162 0           return json_create_ok;
1163             }
1164 17 50         CALL (add_open (jc, '{'));
    0          
    0          
1165 17 50         Newxz (keys, n_keys, SV *);
1166 17           jc->n_mallocs++;
1167 87 100         for (i = 0; i < n_keys; i++) {
1168             HE * he;
1169 70           he = hv_iternext (input_hv);
1170 70           keys[i] = hv_iterkeysv (he);
1171 70 50         if (HeUTF8 (he)) {
    100          
1172 33           jc->unicode = 1;
1173             }
1174             }
1175              
1176 17 100         if (jc->cmp) {
1177 2           json_create_qsort_r (keys, n_keys, sizeof (SV **), jc,
1178             json_create_user_compare);
1179             }
1180             else {
1181 15           sortsv_flags (keys, (size_t) n_keys, Perl_sv_cmp, /* flags */ 0);
1182             }
1183              
1184 87 100         for (i = 0; i < n_keys; i++) {
1185             SV * key_sv;
1186             char * key;
1187             STRLEN keylen;
1188             HE * he;
1189              
1190 70 100         COMMA;
    50          
    0          
    0          
    50          
    50          
    0          
    0          
1191 70           key_sv = keys[i];
1192 70 50         key = SvPV (key_sv, keylen);
1193 70 50         CALL (json_create_add_key_len (jc, (const unsigned char *) key,
    0          
    0          
1194             keylen));
1195 70           he = hv_fetch_ent (input_hv, key_sv, 0, 0);
1196 70 50         if (! he) {
1197 0           croak ("%s:%d: invalid sv_ptr for '%s' at offset %d",
1198             __FILE__, __LINE__, key, i);
1199             }
1200 70 50         CALL (add_char (jc, ':'));
    0          
    0          
1201 70 50         CALL (json_create_recursively (jc, HeVAL(he)));
    0          
    0          
1202             }
1203 17           Safefree (keys);
1204 17           jc->n_mallocs--;
1205              
1206 17 50         CALL (add_close (jc, '}'));
    0          
    0          
1207              
1208 17           return json_create_ok;
1209             }
1210              
1211             /* Given a reference to a hash in "input_hv", recursively process it
1212             into JSON. "object" here means "JSON object", not "Perl object". */
1213              
1214             static INLINE json_create_status_t
1215 80           json_create_add_object (json_create_t * jc, HV * input_hv)
1216             {
1217             I32 n_keys;
1218             int i;
1219             SV * value;
1220             char * key;
1221             /* I32 is correct, not STRLEN; see hv.c. */
1222             I32 keylen;
1223             #ifdef INDENT
1224 80 100         if (jc->sort) {
1225 17           return json_create_add_object_sorted (jc, input_hv);
1226             }
1227             #endif /* INDENT */
1228 63           n_keys = hv_iterinit (input_hv);
1229 63 100         if (n_keys == 0) {
1230 1 50         CALL (add_str_len (jc, "{}", strlen ("{}")));
    0          
    0          
1231 1           return json_create_ok;
1232             }
1233 62 50         CALL (add_open (jc, '{'));
    0          
    0          
1234 194 100         for (i = 0; i < n_keys; i++) {
1235             HE * he;
1236              
1237             /* Get the information from the hash. */
1238             /* The following is necessary because "hv_iternextsv" doesn't
1239             tell us whether the key is "SvUTF8" or not. */
1240 141           he = hv_iternext (input_hv);
1241 141           key = hv_iterkey (he, & keylen);
1242 141           value = hv_iterval (input_hv, he);
1243              
1244             /* Write the information into the buffer. */
1245              
1246 141 100         COMMA;
    50          
    0          
    0          
    100          
    50          
    0          
    0          
1247 141 50         if (HeUTF8 (he)) {
    100          
1248 4           jc->unicode = 1;
1249 4 50         CALL (json_create_add_key_len (jc, (const unsigned char *) key,
    0          
    0          
1250             (STRLEN) keylen));
1251             }
1252 137 100         else if (jc->strict) {
1253 45 100         CALL (json_create_add_ascii_key_len (jc, (unsigned char *) key,
    50          
    0          
1254             (STRLEN) keylen));
1255             }
1256             else {
1257 92 50         CALL (json_create_add_key_len (jc, (const unsigned char *) key,
    0          
    0          
1258             (STRLEN) keylen));
1259             }
1260 139 50         CALL (add_char (jc, ':'));
    0          
    0          
1261             MSG ("Creating value of hash");
1262 139 100         CALL (json_create_recursively (jc, value));
    50          
    0          
1263             }
1264 53 50         CALL (add_close (jc, '}'));
    0          
    0          
1265 80           return json_create_ok;
1266             }
1267              
1268             /* Given an array reference in "av", recursively process it into
1269             JSON. */
1270              
1271             static INLINE json_create_status_t
1272 33           json_create_add_array (json_create_t * jc, AV * av)
1273             {
1274             I32 n_keys;
1275             int i;
1276             SV * value;
1277             SV ** avv;
1278              
1279             MSG ("Adding first char [");
1280 33 50         CALL (add_open (jc, '['));
    0          
    0          
1281 33           n_keys = av_len (av) + 1;
1282             MSG ("n_keys = %ld", n_keys);
1283              
1284             /* This deals correctly with empty arrays, since av_len is -1 if
1285             the array is empty, so we do not test for a valid n_keys value
1286             before entering the loop. */
1287 195 100         for (i = 0; i < n_keys; i++) {
1288             MSG ("i = %d", i);
1289 163 100         COMMA;
    50          
    0          
    0          
    100          
    50          
    0          
    0          
1290              
1291 163           avv = av_fetch (av, i, 0 /* don't delete the array value */);
1292 163 50         if (avv) {
1293 163           value = * avv;
1294             }
1295             else {
1296             MSG ("null value returned by av_fetch");
1297 0           value = & PL_sv_undef;
1298             }
1299 163 100         CALL (json_create_recursively (jc, value));
    50          
    0          
1300             }
1301             MSG ("Adding last char ]");
1302 32 50         CALL (add_close (jc, ']'));
    0          
    0          
1303 32           return json_create_ok;
1304             }
1305              
1306              
1307             static INLINE json_create_status_t
1308 5           json_create_handle_unknown_type (json_create_t * jc, SV * r)
1309             {
1310 5 100         if (jc->type_handler) {
1311 2 100         CALL (json_create_call_to_json (jc, jc->type_handler, r));
    50          
    0          
1312 1           return json_create_ok;
1313             }
1314 3           json_create_user_message (jc, json_create_unknown_type,
1315             "Input's type cannot be serialized to JSON");
1316 3           return json_create_unknown_type;
1317             }
1318              
1319             #define STRICT_NO_SCALAR \
1320             if (jc->strict) { \
1321             goto handle_type; \
1322             }
1323              
1324             static INLINE json_create_status_t
1325 122           json_create_handle_ref (json_create_t * jc, SV * r)
1326             {
1327             svtype t;
1328 122           t = SvTYPE (r);
1329             MSG ("Type is %d", t);
1330 122           switch (t) {
1331             case SVt_PVAV:
1332             MSG("Array");
1333 33 100         CALL (json_create_add_array (jc, (AV *) r));
    50          
    0          
1334 32           break;
1335              
1336             case SVt_PVHV:
1337             MSG("Hash");
1338 80 100         CALL (json_create_add_object (jc, (HV *) r));
    50          
    0          
1339 71           break;
1340              
1341             case SVt_NV:
1342             case SVt_PVNV:
1343             MSG("NV/PVNV");
1344 0 0         STRICT_NO_SCALAR;
1345 0 0         CALL (json_create_add_float (jc, r));
    0          
    0          
1346 0           break;
1347              
1348             case SVt_IV:
1349             case SVt_PVIV:
1350             MSG("IV/PVIV");
1351 2 100         STRICT_NO_SCALAR;
1352 1 50         CALL (json_create_add_integer (jc, r));
    0          
    0          
1353 1           break;
1354              
1355             case SVt_PV:
1356             MSG("PV");
1357 2 100         STRICT_NO_SCALAR;
1358 1 50         CALL (json_create_add_string (jc, r));
    0          
    0          
1359 1           break;
1360              
1361             case SVt_PVMG:
1362             MSG("PVMG");
1363 2 50         STRICT_NO_SCALAR;
1364 2 50         CALL (json_create_add_magic (jc, r));
    0          
    0          
1365 2           break;
1366              
1367             default:
1368             handle_type:
1369 5 100         CALL (json_create_handle_unknown_type (jc, r));
    50          
    0          
1370             }
1371 108           return json_create_ok;
1372             }
1373              
1374             /* In strict mode, if no object handlers exist, then we reject the
1375             object. */
1376              
1377             #define REJECT_OBJECT(objtype) \
1378             json_create_user_message (jc, json_create_unknown_type, \
1379             "Object cannot be " \
1380             "serialized to JSON: %s", \
1381             objtype); \
1382             return json_create_unknown_type;
1383              
1384              
1385             static INLINE json_create_status_t
1386 17           json_create_handle_object (json_create_t * jc, SV * r,
1387             const char * objtype, I32 olen)
1388             {
1389             SV ** sv_ptr;
1390             #ifdef DEBUGOBJ
1391             fprintf (stderr, "Have found an object of type %s.\n", objtype);
1392             #endif
1393 17           sv_ptr = hv_fetch (jc->handlers, objtype, olen, 0);
1394 17 50         if (sv_ptr) {
1395             char * pv;
1396             STRLEN pvlen;
1397 17 100         pv = SvPV (*sv_ptr, pvlen);
1398             #ifdef DEBUGOBJ
1399             fprintf (stderr, "Have found a handler %s for %s.\n", pv, objtype);
1400             #endif
1401 17 100         if (pvlen == strlen ("bool") &&
    50          
1402 9           strncmp (pv, "bool", 4) == 0) {
1403 18 50         if (SvTRUE (r)) {
    50          
    0          
    100          
    50          
    50          
    100          
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    100          
    50          
    0          
    100          
    0          
1404 8 50         ADD ("true");
    0          
    0          
1405             }
1406             else {
1407 3 50         ADD ("false");
    0          
    0          
1408             }
1409             }
1410 8 50         else if (SvROK (*sv_ptr)) {
1411             SV * what;
1412 8           what = SvRV (*sv_ptr);
1413 8 50         switch (SvTYPE (what)) {
1414             case SVt_PVCV:
1415 8 100         CALL (json_create_call_to_json (jc, what, r));
    50          
    0          
1416 6           break;
1417             default:
1418             /* Weird handler, not a code reference. */
1419 6           goto nothandled;
1420             }
1421             }
1422             else {
1423             /* It's an object, it's in our handlers, but we don't
1424             have any code to deal with it, so we'll print an
1425             error and then stringify it. */
1426 0 0         if (JCEH) {
1427 15           (*JCEH) (__FILE__, __LINE__, "Unhandled handler %s.\n",
1428             pv);
1429 0           goto nothandled;
1430             }
1431             }
1432             }
1433             else {
1434             #ifdef DEBUGOBJ
1435             /* Leaving this debugging code here since this is liable
1436             to change a lot. */
1437             I32 hvnum;
1438             SV * s;
1439             char * key;
1440             I32 retlen;
1441             fprintf (stderr, "Nothing in handlers for %s.\n", objtype);
1442             hvnum = hv_iterinit (jc->handlers);
1443              
1444             fprintf (stderr, "There are %ld keys in handlers.\n", hvnum);
1445             while (1) {
1446             s = hv_iternextsv (jc->handlers, & key, & retlen);
1447             if (! s) {
1448             break;
1449             }
1450             fprintf (stderr, "%s: %s\n", key, SvPV_nolen (s));
1451             }
1452             #endif /* 0 */
1453             nothandled:
1454 0 0         if (jc->strict) {
1455 0           REJECT_OBJECT(objtype);
1456             }
1457 0 0         CALL (json_create_handle_ref (jc, r));
    0          
    0          
1458             }
1459 15           return json_create_ok;
1460             }
1461              
1462             #define JCBOOL "JSON::Create::Bool"
1463              
1464             static json_create_status_t
1465 145           json_create_refobj (json_create_t * jc, SV * input)
1466             {
1467             SV * r;
1468 145           r = SvRV (input);
1469              
1470             MSG("A reference");
1471             /* We have a reference, so decide what to do with it. */
1472 145 100         if (sv_isobject (input)) {
1473             const char * objtype;
1474             I32 olen;
1475 28           objtype = sv_reftype (r, 1);
1476 28           olen = (I32) strlen (objtype);
1477 28 100         if (olen == strlen (JCBOOL) &&
    100          
1478 7           strncmp (objtype, JCBOOL, strlen (JCBOOL)) == 0) {
1479 4 50         if (SvTRUE (r)) {
    50          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    100          
    50          
    0          
    100          
    0          
1480 2 50         ADD("true");
    0          
    0          
1481             }
1482             else {
1483 2 50         ADD("false");
    0          
    0          
1484             }
1485 4           return json_create_ok;
1486             }
1487 24 100         if (jc->obj_handler) {
1488 1 50         CALL (json_create_call_to_json (jc, jc->obj_handler, r));
    50          
    0          
1489 0           return json_create_ok;
1490             }
1491 23 100         if (jc->handlers) {
1492 17 100         CALL (json_create_handle_object (jc, r, objtype, olen));
    50          
    0          
1493 15           return json_create_ok;
1494             }
1495 6 100         if (jc->strict) {
1496 1           REJECT_OBJECT (objtype);
1497             return json_create_ok;
1498             }
1499             }
1500              
1501             MSG ("create handle references");
1502              
1503 122 100         CALL (json_create_handle_ref (jc, r));
    50          
    0          
1504 108           return json_create_ok;
1505             }
1506              
1507             #ifdef INDENT
1508             #define TOP_NEWLINE \
1509             if (jc->indent && jc->depth == 0) {\
1510             MSG ("Top-level non-object non-array with indent, adding newline");\
1511             CALL (add_char (jc, '\n'));\
1512             }
1513             #else
1514             #define TOP_NEWLINE
1515             #endif /* INDENT */
1516              
1517             static json_create_status_t
1518 327           json_create_not_ref (json_create_t * jc, SV * r)
1519             {
1520             svtype t;
1521              
1522             MSG("Not a reference.");
1523              
1524 327           t = SvTYPE (r);
1525 327           switch (t) {
1526              
1527             case SVt_NULL:
1528 0 0         ADD ("null");
    0          
    0          
1529 0           break;
1530              
1531             case SVt_PVMG:
1532             MSG ("SVt_PVMG %s", SvPV_nolen (r));
1533 1 50         CALL (json_create_add_magic (jc, r));
    0          
    0          
1534 1           break;
1535              
1536             case SVt_PV:
1537             MSG ("SVt_PV %s", SvPV_nolen (r));
1538 119 50         CALL (json_create_add_string (jc, r));
    0          
    0          
1539 117           break;
1540              
1541             case SVt_IV:
1542             MSG ("SVt_IV %ld\n", SvIV (r));
1543 101 50         CALL (json_create_add_integer (jc, r));
    0          
    0          
1544 101           break;
1545              
1546             case SVt_NV:
1547             MSG ("SVt_NV %g", SvNV (r));
1548 95 100         CALL (json_create_add_float (jc, r));
    50          
    0          
1549 92           break;
1550              
1551             case SVt_PVNV:
1552 10 50         if (SvNIOK (r)) {
1553 10 100         if (SvNOK (r)) {
1554             MSG ("SVt_PVNV with double %s/%g", SvPV_nolen (r), SvNV (r));
1555              
1556             /* We need to handle non-finite numbers without using
1557             Perl's stringified forms, because we need to put quotes
1558             around them, whereas Perl will just print 'nan' the
1559             same way it will print '0.01'. 'nan' is not valid JSON,
1560             so we have to convert to '"nan"'. */
1561 7 50         CALL (json_create_add_float (jc, r));
    0          
    0          
1562             }
1563 3 50         else if (SvIOK (r)) {
1564             MSG ("SVt_PVNV with integer %s/%g", SvPV_nolen (r), SvNV (r));
1565              
1566             /* We need to handle non-finite numbers without using
1567             Perl's stringified forms, because we need to put quotes
1568             around them, whereas Perl will just print 'nan' the
1569             same way it will print '0.01'. 'nan' is not valid JSON,
1570             so we have to convert to '"nan"'. */
1571 3 50         CALL (json_create_add_integer (jc, r));
    0          
    0          
1572             }
1573             else {
1574             /* I'm not sure if this will be reached. */
1575             MSG ("SVt_PVNV without valid NV/IV %s", SvPV_nolen (r));
1576 10 0         CALL (json_create_add_string (jc, r));
    0          
    0          
1577             }
1578             }
1579             else {
1580             MSG ("SVt_PVNV without valid NV/IV %s", SvPV_nolen (r));
1581 0 0         CALL (json_create_add_string (jc, r));
    0          
    0          
1582             }
1583 10           break;
1584              
1585             case SVt_PVIV:
1586             /* Add numbers with a string version using the strings
1587             which Perl contains. */
1588 1 50         if (SvIOK (r)) {
1589             MSG ("SVt_PVIV %s/%ld", SvPV_nolen (r), SvIV (r));
1590 1 50         CALL (json_create_add_integer (jc, r));
    0          
    0          
1591             }
1592             else {
1593              
1594             /* This combination of things happens e.g. with the
1595             value returned under "script" by charinfo of
1596             Unicode::UCD. If we don't catch it with SvIOK as
1597             above, we get an error of the form 'Argument
1598             "Latin" isn't numeric in subroutine entry' */
1599             #if 0
1600             fprintf (stderr, "%s:%d: SVt_PVIV without valid IV %s\n",
1601             __FILE__, __LINE__, SvPV_nolen (r));
1602             #endif /* 0 */
1603 0 0         CALL (json_create_add_string (jc, r));
    0          
    0          
1604             }
1605 1           break;
1606            
1607             default:
1608 0 0         CALL (json_create_handle_unknown_type (jc, r));
    0          
    0          
1609             }
1610 322 100         TOP_NEWLINE;
    50          
    0          
    0          
    0          
1611 322           return json_create_ok;
1612             }
1613              
1614             /* This is the core routine, it is called recursively as hash values
1615             and array values containing array or hash references are
1616             handled. */
1617              
1618             static json_create_status_t
1619 484           json_create_recursively (json_create_t * jc, SV * input)
1620             {
1621              
1622             MSG("sv = %p.", input);
1623              
1624 484 100         if (! SvOK (input)) {
    50          
    50          
1625             /* We were told to add an undefined value, so put the literal
1626             'null' (without quotes) at the end of "jc" then return. */
1627             MSG("Adding 'null'");
1628 8 50         ADD ("null");
    0          
    0          
1629 8 100         TOP_NEWLINE;
    50          
    50          
    0          
    0          
1630 8           return json_create_ok;
1631             }
1632             /* JSON::Parse inserts pointers to &PL_sv_yes and no as literal
1633             "true" and "false" markers. */
1634 476 100         if (input == &PL_sv_yes) {
1635             MSG("Adding 'true'");
1636 2 50         ADD ("true");
    0          
    0          
1637 2           return json_create_ok;
1638             }
1639 474 100         if (input == &PL_sv_no) {
1640             MSG("Adding 'false'");
1641 2 50         ADD ("false");
    0          
    0          
1642 2           return json_create_ok;
1643             }
1644 472 100         if (SvROK (input)) {
1645 145 100         CALL (json_create_refobj (jc, input));
    50          
    0          
1646 127           return json_create_ok;
1647             }
1648 327 100         CALL (json_create_not_ref (jc, input));
    50          
    0          
1649 322           return json_create_ok;
1650             }
1651              
1652             /* Master-caller macro. Calls to subsystems from "json_create" cannot
1653             be handled using the CALL macro above, because we need to return a
1654             non-status value from json_create. If things go wrong somewhere, we
1655             return "undef". */
1656              
1657             #define FINALCALL(x) { \
1658             json_create_status_t status; \
1659             status = x; \
1660             if (status != json_create_ok) { \
1661             HANDLE_STATUS (x, status); \
1662             /* Free the memory of "output". */ \
1663             if (jc->output) { \
1664             SvREFCNT_dec (jc->output); \
1665             jc->output = 0; \
1666             } \
1667             /* return undef; */ \
1668             return & PL_sv_undef; \
1669             } \
1670             }
1671              
1672             /* This is the main routine of JSON::Create, where the JSON is
1673             produced from the Perl structure in "input". */
1674              
1675             static INLINE SV *
1676 112           json_create_create (json_create_t * jc, SV * input)
1677             {
1678             unsigned char buffer[BUFSIZE];
1679              
1680             /* Set up all the transient variables for reading. */
1681              
1682 112           jc->buffer = buffer;
1683 112           jc->length = 0;
1684             /* Tell json_create_buffer_fill that it needs to allocate an
1685             SV. */
1686 112           jc->output = 0;
1687             /* Not Unicode. */
1688 112           jc->unicode = 0;
1689              
1690 112 100         FINALCALL (json_create_recursively (jc, input));
    50          
    0          
    50          
1691 97 50         FINALCALL (json_create_buffer_fill (jc));
    0          
    0          
    0          
1692              
1693 97 100         if (jc->unicode && ! jc->downgrade_utf8) {
    100          
1694 23 50         if (jc->utf8_dangerous) {
1695 0 0         if (is_utf8_string ((U8 *) SvPV_nolen (jc->output),
    0          
1696 0           SvCUR (jc->output))) {
1697 0           SvUTF8_on (jc->output);
1698             }
1699             else {
1700 0           json_create_user_message (jc, json_create_unicode_bad_utf8,
1701             "Invalid UTF-8 from user routine");
1702 0           return & PL_sv_undef;
1703             }
1704             }
1705             else {
1706 23           SvUTF8_on (jc->output);
1707             }
1708             }
1709              
1710             /* We didn't allocate any memory except for the SV, all our memory
1711             is on the stack, so there is nothing to free here. */
1712              
1713 110           return jc->output;
1714             }
1715              
1716             /* __ __ _ _ _
1717             | \/ | ___| |_| |__ ___ __| |___
1718             | |\/| |/ _ \ __| '_ \ / _ \ / _` / __|
1719             | | | | __/ |_| | | | (_) | (_| \__ \
1720             |_| |_|\___|\__|_| |_|\___/ \__,_|___/ */
1721            
1722              
1723             static json_create_status_t
1724 24           json_create_new (json_create_t ** jc_ptr)
1725             {
1726             json_create_t * jc;
1727 24           Newxz (jc, 1, json_create_t);
1728 24           jc->n_mallocs = 0;
1729 24           jc->n_mallocs++;
1730 24           jc->fformat = 0;
1731 24           jc->type_handler = 0;
1732 24           jc->handlers = 0;
1733 24           * jc_ptr = jc;
1734 24           return json_create_ok;
1735             }
1736              
1737             static json_create_status_t
1738 28           json_create_free_fformat (json_create_t * jc)
1739             {
1740 28 100         if (jc->fformat) {
1741 2           Safefree (jc->fformat);
1742 2           jc->fformat = 0;
1743 2           jc->n_mallocs--;
1744             }
1745 28           return json_create_ok;
1746             }
1747              
1748             static json_create_status_t
1749 4           json_create_set_fformat (json_create_t * jc, SV * fformat)
1750             {
1751             char * ff;
1752             STRLEN fflen;
1753             int i;
1754              
1755 4 50         CALL (json_create_free_fformat (jc));
    0          
    0          
1756 4 50         if (! SvTRUE (fformat)) {
    50          
    0          
    50          
    0          
    0          
    100          
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    50          
    0          
    50          
    0          
1757 2           jc->fformat = 0;
1758 2           return json_create_ok;
1759             }
1760              
1761 2 50         ff = SvPV (fformat, fflen);
1762 2 50         if (! strchr (ff, '%')) {
1763 0           return json_create_bad_floating_format;
1764             }
1765 2           Newx (jc->fformat, fflen + 1, char);
1766 2           jc->n_mallocs++;
1767 10 100         for (i = 0; i < fflen; i++) {
1768             /* We could also check the format in this loop. */
1769 8           jc->fformat[i] = ff[i];
1770             }
1771 2           jc->fformat[fflen] = '\0';
1772 4           return json_create_ok;
1773             }
1774              
1775             static json_create_status_t
1776 24           json_create_remove_handlers (json_create_t * jc)
1777             {
1778 24 100         if (jc->handlers) {
1779 5           SvREFCNT_dec ((SV *) jc->handlers);
1780 5           jc->handlers = 0;
1781 5           jc->n_mallocs--;
1782             }
1783 24           return json_create_ok;
1784             }
1785              
1786             static json_create_status_t
1787 26           json_create_remove_type_handler (json_create_t * jc)
1788             {
1789 26 100         if (jc->type_handler) {
1790 2           SvREFCNT_dec (jc->type_handler);
1791 2           jc->type_handler = 0;
1792 2           jc->n_mallocs--;
1793             }
1794 26           return json_create_ok;
1795             }
1796              
1797             static json_create_status_t
1798 25           json_create_remove_obj_handler (json_create_t * jc)
1799             {
1800 25 100         if (jc->obj_handler) {
1801 1           SvREFCNT_dec (jc->obj_handler);
1802 1           jc->obj_handler = 0;
1803 1           jc->n_mallocs--;
1804             }
1805 25           return json_create_ok;
1806             }
1807              
1808             static json_create_status_t
1809 25           json_create_remove_non_finite_handler (json_create_t * jc)
1810             {
1811 25 100         if (jc->non_finite_handler) {
1812 1           SvREFCNT_dec (jc->non_finite_handler);
1813 1           jc->non_finite_handler = 0;
1814 1           jc->n_mallocs--;
1815             }
1816 25           return json_create_ok;
1817             }
1818              
1819             static json_create_status_t
1820 25           json_create_remove_cmp (json_create_t * jc)
1821             {
1822 25 100         if (jc->cmp) {
1823 1           SvREFCNT_dec (jc->cmp);
1824 1           jc->cmp = 0;
1825 1           jc->n_mallocs--;
1826             }
1827 25           return json_create_ok;
1828             }
1829              
1830             static json_create_status_t
1831 24           json_create_free (json_create_t * jc)
1832             {
1833 24 50         CALL (json_create_free_fformat (jc));
    0          
    0          
1834 24 50         CALL (json_create_remove_handlers (jc));
    0          
    0          
1835 24 50         CALL (json_create_remove_type_handler (jc));
    0          
    0          
1836 24 50         CALL (json_create_remove_obj_handler (jc));
    0          
    0          
1837 24 50         CALL (json_create_remove_non_finite_handler (jc));
    0          
    0          
1838 24 50         CALL (json_create_remove_cmp (jc));
    0          
    0          
1839              
1840             /* Finished, check we have no leaks before freeing. */
1841              
1842 24           jc->n_mallocs--;
1843 24 50         if (jc->n_mallocs != 0) {
1844 0           fprintf (stderr, "%s:%d: n_mallocs = %d\n",
1845             __FILE__, __LINE__, jc->n_mallocs);
1846             }
1847 24           Safefree (jc);
1848 24           return json_create_ok;
1849             }
1850              
1851             static void
1852 4           bump (json_create_t * jc, SV * h)
1853             {
1854 4           SvREFCNT_inc (h);
1855 4           jc->n_mallocs++;
1856 4           }
1857              
1858             static void
1859 1           set_non_finite_handler (json_create_t * jc, SV * oh)
1860             {
1861 1           jc->non_finite_handler = oh;
1862 1           bump (jc, oh);
1863 1           }
1864              
1865             static void
1866 1           set_object_handler (json_create_t * jc, SV * oh)
1867             {
1868 1           jc->obj_handler = oh;
1869 1           bump (jc, oh);
1870 1           }
1871              
1872             static void
1873 2           set_type_handler (json_create_t * jc, SV * th)
1874             {
1875 2           jc->type_handler = th;
1876 2           bump (jc, th);
1877 2           }
1878              
1879             /* Use the length of the string to eliminate impossible matches before
1880             looking at the string's bytes. */
1881              
1882             #define CMP(x) (strlen(#x) == (size_t) key_len && \
1883             strncmp(#x, key, key_len) == 0)
1884              
1885             #define BOOL(x) \
1886             if (CMP(x)) { \
1887             jc->x = SvTRUE (value) ? 1 : 0; \
1888             return; \
1889             }
1890              
1891             #define HANDLER(x) \
1892             if (CMP(x ## _handler)) { \
1893             set_ ## x ## _handler (jc, value); \
1894             return; \
1895             }
1896              
1897             static void
1898 6           json_create_set (json_create_t * jc, SV * key_sv, SV * value)
1899             {
1900             const char * key;
1901             STRLEN key_len;
1902            
1903 6 50         key = SvPV (key_sv, key_len);
1904              
1905 12 50         BOOL (downgrade_utf8);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1906 6 50         BOOL (escape_slash);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1907 6 50         BOOL (fatal_errors);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1908 6 100         BOOL (indent);
    50          
    50          
    50          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    0          
    0          
    50          
    0          
1909 2 50         BOOL (no_javascript_safe);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1910 2 50         BOOL (replace_bad_utf8);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1911 2 50         BOOL (sort);
    50          
    50          
    50          
    0          
    50          
    0          
    0          
    50          
    0          
    0          
    0          
    0          
    0          
    50          
    50          
    50          
    0          
    0          
    50          
    0          
1912 0 0         BOOL (strict);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1913 0 0         BOOL (unicode_upper);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1914 0 0         BOOL (unicode_escape_all);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1915 0 0         BOOL (validate);
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1916 0 0         HANDLER (non_finite);
    0          
1917 0 0         HANDLER (object);
    0          
1918 0 0         HANDLER (type);
    0          
1919 0           warn ("Unknown option '%s'", key);
1920             }