File Coverage

XS.xs
Criterion Covered Total %
statement 1474 1664 88.5
branch 1179 1792 65.7
condition n/a
subroutine n/a
pod n/a
total 2653 3456 76.7


line stmt bran cond sub pod time code
1             #define PERL_NO_GET_CONTEXT
2             #include "EXTERN.h"
3             #include "perl.h"
4             #include "XSUB.h"
5             #define NEED_load_module
6             #define NEED_newCONSTSUB
7             #define NEED_vload_module
8             #define NEED_vnewSVpvf
9             #define NEED_warner
10             #define NEED_grok_number
11             #define NEED_grok_numeric_radix
12             #define NEED_newRV_noinc
13             #define NEED_sv_2pv_flags
14             #include "ppport.h"
15              
16             #include
17             #include
18             #include
19             #include
20             #include
21             #include
22              
23             #if defined(__BORLANDC__) || defined(_MSC_VER)
24             # define snprintf _snprintf // C compilers have this in stdio.h
25             #endif
26              
27             #ifndef PERL_UNUSED_RESULT
28             # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
29             # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
30             # else
31             # define PERL_UNUSED_RESULT(v) ((void)(v))
32             # endif
33             #endif
34              
35             #if defined(_AIX) && (!defined(HAS_LONG_DOUBLE) || AIX_WORKAROUND)
36             #define HAVE_NO_POWL
37             #endif
38              
39             /* Freebsd 10: It has powl, but it is too bad. strtold is good. RT #101265 */
40             #if defined(__FreeBSD__) && defined(__clang__) && defined(USE_LONG_DOUBLE)
41             #define HAVE_BAD_POWL
42             #endif
43              
44             #if PERL_VERSION < 22 && defined(HAS_SETLOCALE)
45             #define NEED_NUMERIC_LOCALE_C
46             #ifdef I_XLOCALE
47             #include
48             #endif
49             #endif
50              
51             /* FIXME: still a refcount error */
52             #define HAVE_DECODE_BOM
53             #define UTF8BOM "\357\273\277" /* EF BB BF */
54             /* UTF16/32BOM is deprecated, RFC 8259 */
55             #define UTF16BOM "\377\376" /* FF FE or +UFEFF */
56             #define UTF16BOM_BE "\376\377" /* FE FF */
57             #define UTF32BOM "\377\376\000\000" /* FF FE 00 00 or +UFEFF */
58             #define UTF32BOM_BE "\000\000\376\377" /* 00 00 FE FF */
59              
60             /* mingw with USE_LONG_DOUBLE (and implied USE_MINGW_ANSI_STDIO) do use the
61             non-msvcrt inf/nan stringification in sprintf(). */
62             #if defined(WIN32) && !defined(__USE_MINGW_ANSI_STDIO) && !defined(USE_LONG_DOUBLE)
63             /* new ucrtd.dll runtime? We do not probe the runtime or variants in the Makefile.PL yet. */
64             #define STR_INF "inf"
65             #define STR_INF2 "inf.0"
66             #define STR_NAN "nan"
67             #define STR_QNAN "nan(ind)"
68             /* old standard msvcrt.dll */
69             #define STR_INF3 "1.#INF"
70             #define STR_INF4 "1.#INF.0"
71             #define STR_NAN2 "1.#IND"
72             #define STR_QNAN2 "1.#QNAN"
73             #define HAVE_QNAN
74             #elif defined(sun) || defined(__sun)
75             #define STR_INF "Infinity"
76             #define STR_NAN "NaN"
77             #elif defined(__hpux)
78             #define STR_INF "++"
79             #define STR_NAN "-?"
80             #define HAVE_NEG_NAN
81             #define STR_NEG_INF "---"
82             #define STR_NEG_NAN "?"
83             #else
84             #define STR_INF "inf"
85             #define STR_NAN "nan"
86             #endif
87              
88             /* modfl() segfaults for -Duselongdouble && 64-bit mingw64 && mingw
89             runtime version 4.0 [perl #125924] */
90             #if defined(USE_LONG_DOUBLE) && defined(__MINGW64__) \
91             && __MINGW64_VERSION_MAJOR == 4 && __MINGW64_VERSION_MINOR == 0
92             #undef HAS_MODFL
93             #undef Perl_modf
94             #define Perl_modf(nv, ip) mingw_modfl(nv, ip)
95             long double
96             mingw_modfl(long double x, long double *ip)
97             {
98             *ip = truncl(x);
99             return (x == *ip ? copysignl(0.0L, x) : x - *ip);
100             }
101             #endif
102              
103             #if defined(_AIX)
104             #define HAVE_QNAN
105             #undef STR_QNAN
106             #define STR_QNAN "NANQ"
107             #endif
108              
109             /* some old perls do not have this, try to make it work, no */
110             /* guarantees, though. if it breaks, you get to keep the pieces. */
111             #ifndef UTF8_MAXBYTES
112             # define UTF8_MAXBYTES 13
113             #endif
114              
115             /* 5.6: */
116             #ifndef IS_NUMBER_IN_UV
117             #define IS_NUMBER_IN_UV 0x01 /* number within UV range (maybe not
118             int). value returned in pointed-
119             to UV */
120             #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
121             #define IS_NUMBER_NOT_INT 0x04 /* saw . or E notation */
122             #define IS_NUMBER_NEG 0x08 /* leading minus sign */
123             #define IS_NUMBER_INFINITY 0x10 /* this is big */
124             #define IS_NUMBER_NAN 0x20 /* this is not */
125             #endif
126             #ifndef UNI_DISPLAY_QQ
127             #define UNI_DISPLAY_ISPRINT 0x0001
128             #define UNI_DISPLAY_BACKSLASH 0x0002
129             #define UNI_DISPLAY_QQ (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
130             #define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH)
131             #endif
132             /* with 5.6 hek can only be non-utf8 */
133             #ifndef HeKUTF8
134             #define HeKUTF8(he) 0
135             #endif
136             #ifndef GV_NOADD_NOINIT
137             #define GV_NOADD_NOINIT 0
138             #endif
139             /* since 5.8.1 */
140             #ifndef SvIsCOW_shared_hash
141             #define SvIsCOW_shared_hash(pv) 0
142             #endif
143             /* 5.8.1 has a broken assert_not_ROK */
144             #if PERL_VERSION == 8 && PERL_SUBVERSION == 1
145             # undef assert_not_ROK
146             # if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
147             # define assert_not_ROK(sv) ({assert(!SvROK(sv) || !SvRV(sv));}),
148             # else
149             # define assert_not_ROK(sv)
150             # endif
151             #endif
152             /* compatibility with perl <5.14 */
153             #ifndef SvTRUE_nomg
154             #define SvTRUE_nomg SvTRUE
155             #endif
156             #ifndef SvNV_nomg
157             #define SvNV_nomg SvNV
158             #endif
159             #ifndef PERL_UNICODE_MAX
160             #define PERL_UNICODE_MAX 0x10FFFF
161             #endif
162             #ifndef HvNAMELEN_get
163             # define HvNAMELEN_get(hv) strlen (HvNAME (hv))
164             #endif
165             #ifndef HvNAMELEN
166             # define HvNAMELEN(hv) HvNAMELEN_get (hv)
167             #endif
168             #ifndef HvNAMEUTF8
169             # define HvNAMEUTF8(hv) 0
170             #endif
171             /* since 5.14 check use warnings 'nonchar' */
172             #ifdef WARN_NONCHAR
173             #define WARNER_NONCHAR(hi) \
174             Perl_ck_warner_d(aTHX_ packWARN(WARN_NONCHAR), \
175             "Unicode non-character U+%04" UVXf " is not " \
176             "recommended for open interchange", hi)
177             /* before check use warnings 'utf8' */
178             #elif PERL_VERSION > 10
179             #define WARNER_NONCHAR(hi) \
180             Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), \
181             "Unicode non-character U+%04" UVXf " is illegal " \
182             "for interchange", hi)
183             #else
184             #define WARNER_NONCHAR(hi) \
185             Perl_warner(aTHX_ packWARN(WARN_UTF8), \
186             "Unicode non-character U+%04lX is illegal", (unsigned long)hi)
187             #endif
188              
189             /* since 5.16 */
190             #ifndef GV_NO_SVGMAGIC
191             #define GV_NO_SVGMAGIC 0
192             #endif
193             /* since 5.18 */
194             #ifndef SvREFCNT_dec_NN
195             #define SvREFCNT_dec_NN(sv) SvREFCNT_dec(sv)
196             #endif
197             /* from cperl */
198             #ifndef strEQc
199             /* the buffer ends with \0, includes comparison of the \0.
200             better than strEQ as it uses memcmp, word-wise comparison. */
201             # define strEQc(s, c) memEQ(s, ("" c ""), sizeof(c))
202             #endif
203             #ifndef memEQc
204             /* excluding the final \0, so the string s may continue */
205             # define memEQc(s, c) memEQ(s, ("" c ""), sizeof(c)-1)
206             #endif
207             #ifndef He_IS_SVKEY
208             # define He_IS_SVKEY(he) HeKLEN (he) == HEf_SVKEY
209             #endif
210              
211             /* av_len has 2 different possible types */
212             #ifndef HVMAX_T
213             # if PERL_VERSION >= 20
214             # define HVMAX_T SSize_t
215             # else
216             # define HVMAX_T I32
217             # endif
218             #endif
219             /* and riter 3 */
220             #ifndef RITER_T
221             # ifdef USE_CPERL
222             # if PERL_VERSION >= 25
223             # define RITER_T U32
224             # else
225             # define RITER_T SSize_t
226             # endif
227             # else
228             # define RITER_T I32
229             # endif
230             #endif
231              
232             /* types */
233             #define JSON_TYPE_SCALAR 0x0000
234             #define JSON_TYPE_BOOL 0x0001
235             #define JSON_TYPE_INT 0x0002
236             #define JSON_TYPE_FLOAT 0x0003
237             #define JSON_TYPE_STRING 0x0004
238              
239             /* flags */
240             #define JSON_TYPE_CAN_BE_NULL 0x0100
241              
242             /* null type */
243             #define JSON_TYPE_NULL JSON_TYPE_CAN_BE_NULL
244              
245             /* classes */
246             #define JSON_TYPE_CLASS "Cpanel::JSON::XS::Type"
247             #define JSON_TYPE_ARRAYOF_CLASS "Cpanel::JSON::XS::Type::ArrayOf"
248             #define JSON_TYPE_HASHOF_CLASS "Cpanel::JSON::XS::Type::HashOf"
249             #define JSON_TYPE_ANYOF_CLASS "Cpanel::JSON::XS::Type::AnyOf"
250              
251             #define JSON_TYPE_ANYOF_SCALAR_INDEX 0
252             #define JSON_TYPE_ANYOF_ARRAY_INDEX 1
253             #define JSON_TYPE_ANYOF_HASH_INDEX 2
254              
255             /* three extra for rounding, sign, and end of string */
256             #define IVUV_MAXCHARS (sizeof (UV) * CHAR_BIT * 28 / 93 + 3)
257              
258             #define F_ASCII 0x00000001UL
259             #define F_LATIN1 0x00000002UL
260             #define F_UTF8 0x00000004UL
261             #define F_INDENT 0x00000008UL
262             #define F_CANONICAL 0x00000010UL
263             #define F_SPACE_BEFORE 0x00000020UL
264             #define F_SPACE_AFTER 0x00000040UL
265             #define F_ALLOW_NONREF 0x00000100UL
266             #define F_SHRINK 0x00000200UL
267             #define F_ALLOW_BLESSED 0x00000400UL
268             #define F_CONV_BLESSED 0x00000800UL
269             #define F_RELAXED 0x00001000UL
270             #define F_ALLOW_UNKNOWN 0x00002000UL
271             #define F_ALLOW_TAGS 0x00004000UL
272             #define F_BINARY 0x00008000UL
273             #define F_ALLOW_BAREKEY 0x00010000UL
274             #define F_ALLOW_SQUOTE 0x00020000UL
275             #define F_ALLOW_BIGNUM 0x00040000UL
276             #define F_ESCAPE_SLASH 0x00080000UL
277             #define F_SORT_BY 0x00100000UL
278             #define F_ALLOW_STRINGIFY 0x00200000UL
279             #define F_UNBLESSED_BOOL 0x00400000UL
280             #define F_ALLOW_DUPKEYS 0x00800000UL
281             #define F_REQUIRE_TYPES 0x01000000UL
282             #define F_HOOK 0x80000000UL /* some hooks exist, so slow-path processing */
283              
284             #define F_PRETTY F_INDENT | F_SPACE_BEFORE | F_SPACE_AFTER
285             #define SET_RELAXED (F_RELAXED | F_ALLOW_BAREKEY | F_ALLOW_SQUOTE | F_ALLOW_DUPKEYS)
286              
287             #define INIT_SIZE 32 /* initial scalar size to be allocated */
288             #define INDENT_STEP 3 /* default spaces per indentation level */
289              
290             #define SHORT_STRING_LEN 16384 /* special-case strings of up to this size */
291              
292             #define DECODE_WANTS_OCTETS(json) ((json)->flags & F_UTF8)
293              
294             #define SB do {
295             #define SE } while (0)
296              
297             #if __GNUC__ >= 3
298             # define _expect(expr,value) __builtin_expect ((expr), (value))
299             # define INLINE static inline
300             #else
301             # define _expect(expr,value) (expr)
302             # define INLINE static
303             #endif
304             #ifndef LIKELY
305             #define LIKELY(expr) _expect ((long)(expr) != 0, 1)
306             #define UNLIKELY(expr) _expect ((long)(expr) != 0, 0)
307             #endif
308              
309             #define IN_RANGE_INC(type,val,beg,end) \
310             ((unsigned type)((unsigned type)(val) - (unsigned type)(beg)) \
311             <= (unsigned type)((unsigned type)(end) - (unsigned type)(beg)))
312              
313             #define ERR_NESTING_EXCEEDED "json text or perl structure exceeds maximum nesting level (max_depth set too low?)"
314              
315             # define JSON_STASH MY_CXT.json_stash
316              
317             #define MY_CXT_KEY "Cpanel::JSON::XS::_guts"
318              
319             typedef struct {
320             HV *json_stash; /* Cpanel::JSON::XS:: */
321             HV *json_boolean_stash; /* JSON::PP::Boolean:: */
322             HV *jsonold_boolean_stash; /* JSON::XS::Boolean:: if empty will be (HV*)1 */
323             HV *mojo_boolean_stash; /* Mojo::JSON::_Bool:: if empty will be (HV*)1 */
324             SV *json_true, *json_false;
325             SV *sv_json;
326             } my_cxt_t;
327              
328             /* the amount of HEs to allocate on the stack, when sorting keys */
329             #define STACK_HES 64
330              
331             START_MY_CXT
332              
333             INLINE SV * get_bool (pTHX_ const char *name);
334              
335             enum {
336             INCR_M_WS = 0, /* initial whitespace skipping, must be 0 */
337             INCR_M_STR, /* inside string */
338             INCR_M_BS, /* inside backslash */
339             INCR_M_C0, /* inside comment in initial whitespace sequence */
340             INCR_M_C1, /* inside comment in other places */
341             INCR_M_JSON /* outside anything, count nesting */
342             };
343              
344             #define INCR_DONE(json) ((json)->incr_nest <= 0 && (json)->incr_mode == INCR_M_JSON)
345              
346             typedef struct {
347             U32 flags;
348             U32 max_depth;
349             U32 indent_length; /* how much padding to use when indenting */
350             STRLEN max_size;
351              
352             SV *cb_object;
353             HV *cb_sk_object;
354             SV *cb_sort_by;
355              
356             /* for the incremental parser */
357             SV *incr_text; /* the source text so far */
358             STRLEN incr_pos; /* the current offset into the text */
359             int incr_nest; /* {[]}-nesting level */
360             unsigned char incr_mode;
361             unsigned char infnan_mode;
362             } JSON;
363              
364             INLINE void
365 644           json_init (JSON *json)
366             {
367 644           Zero (json, 1, JSON);
368 644           json->max_depth = 512;
369 644           json->indent_length = INDENT_STEP;
370 644           }
371              
372             /* dTHX/threads TODO*/
373             /* END dtor call not needed, all of these *s refcnts are owned by the stash
374             treem not C code */
375             static void
376 57           init_MY_CXT(pTHX_ my_cxt_t * cxt)
377             {
378 57           cxt->json_stash = gv_stashpvn ("Cpanel::JSON::XS", sizeof("Cpanel::JSON::XS")-1, 1);
379 57           cxt->json_boolean_stash = gv_stashpvn ("JSON::PP::Boolean", sizeof("JSON::PP::Boolean")-1, 1);
380 57           cxt->jsonold_boolean_stash = gv_stashpvn ("JSON::XS::Boolean", sizeof("JSON::XS::Boolean")-1, 0);
381 57           cxt->mojo_boolean_stash = gv_stashpvn ("Mojo::JSON::_Bool", sizeof("Mojo::JSON::_Bool")-1, 0);
382 57 50         if ( !cxt->mojo_boolean_stash )
383 57           cxt->mojo_boolean_stash = (HV*)1; /* invalid ptr to compare against, better than a NULL stash */
384 57 50         if ( !cxt->jsonold_boolean_stash )
385 57           cxt->jsonold_boolean_stash = (HV*)1;
386              
387 57           cxt->json_true = get_bool (aTHX_ "Cpanel::JSON::XS::true");
388 57           cxt->json_false = get_bool (aTHX_ "Cpanel::JSON::XS::false");
389              
390 57           cxt->sv_json = newSVpv ("JSON", 0);
391 57           SvREADONLY_on (cxt->sv_json);
392 57           }
393              
394              
395             /*/////////////////////////////////////////////////////////////////////////// */
396             /* utility functions */
397              
398             /* Unpacks the 2 boolean objects from the global references */
399             INLINE SV *
400 114           get_bool (pTHX_ const char *name)
401             {
402             dMY_CXT;
403             #if PERL_VERSION > 7
404 114           SV *sv = get_sv (name, 1);
405             #else
406             SV *sv = GvSV(gv_fetchpv(name, 1, SVt_PV));
407             #endif
408 114           SV* rv = SvRV(sv);
409 114 50         if (!SvOBJECT(sv) || !SvSTASH(sv)) {
    0          
410 114           SvREADONLY_off (sv);
411 114           SvREADONLY_off (rv);
412 114           (void)sv_bless(sv, MY_CXT.json_boolean_stash); /* bless the ref */
413             }
414 114           SvREADONLY_on (rv);
415 114           SvREADONLY_on (sv);
416 114           return sv;
417             }
418              
419             INLINE void
420 200           shrink (pTHX_ SV *sv)
421             {
422             /* ignore errors */
423 200           (void)sv_utf8_downgrade (sv, 1);
424              
425 200 50         if (SvLEN (sv) > SvCUR (sv) + 1)
426             {
427             #ifdef SvPV_shrink_to_cur
428 200           SvPV_shrink_to_cur (sv);
429             #elif defined (SvPV_renew)
430             SvPV_renew (sv, SvCUR (sv) + 1);
431             #endif
432             }
433 200           }
434              
435             /* decode an utf-8 character and return it, or (UV)-1 in */
436             /* case of an error. */
437             /* we special-case "safe" characters from U+80 .. U+7FF, */
438             /* but use the very good perl function to parse anything else. */
439             /* note that we never call this function for a ascii codepoints */
440             INLINE UV
441 2791           decode_utf8 (pTHX_ unsigned char *s, STRLEN len, int relaxed, STRLEN *clen)
442             {
443 2791 50         if (LIKELY(len >= 2
    100          
    100          
    100          
444             && IN_RANGE_INC (char, s[0], 0xc2, 0xdf)
445             && IN_RANGE_INC (char, s[1], 0x80, 0xbf)))
446             {
447 1306           *clen = 2;
448 1306           return ((s[0] & 0x1f) << 6) | (s[1] & 0x3f);
449             }
450             else {
451             /* Since perl 5.14 we can disallow illegal unicode above U+10FFFF.
452             Before we could only warn with warnings 'utf8'.
453             We accept only valid unicode, unless we are in the relaxed mode. */
454             #if PERL_VERSION > 12
455 1485 100         UV c = utf8n_to_uvuni (s, len, clen,
456             UTF8_CHECK_ONLY | (relaxed ? 0 : UTF8_DISALLOW_SUPER));
457             #elif PERL_VERSION >= 8
458             UV c = utf8n_to_uvuni (s, len, clen, UTF8_CHECK_ONLY);
459             #endif
460             #if PERL_VERSION >= 8 && PERL_VERSION <= 12
461             if (c > PERL_UNICODE_MAX && !relaxed)
462             *clen = -1;
463             #endif
464             #if PERL_VERSION >= 8
465 1485           return c;
466             #else
467             /* 5.6 does not detect certain ill-formed sequences, esp. overflows,
468             which are security relevant. so we add code to detect these. */
469             UV c = utf8_to_uv(s, len, clen, UTF8_CHECK_ONLY);
470             if (!relaxed) {
471             if (!c || c > PERL_UNICODE_MAX)
472             *clen = -1;
473             /* need to check manually for some overflows. 5.6 unicode bug */
474             else if (len >= 2
475             && IN_RANGE_INC (char, s[0], 0xc0, 0xfe)
476             && !IN_RANGE_INC (char, s[0], 0xc2, 0xdf)) {
477             U8 *s0, *send;
478             UV uv = *s;
479             UV expectlen = UTF8SKIP(s);
480              
481             #define UTF_CONTINUATION_MASK ((U8) ((1U << 6) - 1))
482             #define UTF_ACCUMULATION_OVERFLOW_MASK \
483             (((UV) UTF_CONTINUATION_MASK) << ((sizeof(UV) * 8) - 6))
484              
485             s0 = s;
486             /*printf ("maybe overlong <%.*s> %d/%d %x %x\n", len, s, c,
487             *clen, s[0], s[1]);*/
488             if (*clen > 4) {
489             *clen = -1;
490             return c;
491             }
492             send = (U8*) s0 + ((expectlen <= len) ? len : len);
493             for (s = s0 + 1; s < send; s++) {
494             if (LIKELY(UTF8_IS_CONTINUATION(*s))) {
495             if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
496             /*printf ("overflow\n");*/
497             *clen = -1;
498             return c;
499             }
500             uv = UTF8_ACCUMULATE(uv, *s);
501             }
502             else {
503             /*printf ("unexpected non continuation\n");*/
504             *clen = -1;
505             return c;
506             }
507             }
508             }
509             }
510             return c;
511             #endif
512             }
513             }
514              
515             /* Likewise for encoding, also never called for ascii codepoints. */
516             /* This function takes advantage of this fact, although current gcc's */
517             /* seem to optimise the check for >= 0x80 away anyways. */
518             INLINE unsigned char *
519 1335           encode_utf8 (unsigned char *s, UV ch)
520             {
521 1335 50         if (UNLIKELY(ch < 0x000080))
522 0           *s++ = ch;
523 1335 100         else if (LIKELY(ch < 0x000800))
524 736           *s++ = 0xc0 | ( ch >> 6),
525 736           *s++ = 0x80 | ( ch & 0x3f);
526 599 100         else if (ch < 0x010000)
527 267           *s++ = 0xe0 | ( ch >> 12),
528 267           *s++ = 0x80 | ((ch >> 6) & 0x3f),
529 267           *s++ = 0x80 | ( ch & 0x3f);
530 332 50         else if (ch < 0x110000)
531 332           *s++ = 0xf0 | ( ch >> 18),
532 332           *s++ = 0x80 | ((ch >> 12) & 0x3f),
533 332           *s++ = 0x80 | ((ch >> 6) & 0x3f),
534 332           *s++ = 0x80 | ( ch & 0x3f);
535              
536 1335           return s;
537             }
538              
539             /* convert offset to character index, sv must be string */
540             static STRLEN
541 353           ptr_to_index (pTHX_ SV *sv, const STRLEN offset)
542             {
543 353           return SvUTF8 (sv)
544 50           ? (STRLEN)utf8_distance ((U8*)(SvPVX(sv)+offset), (U8*)SvPVX (sv))
545 403 100         : offset;
546             }
547              
548             /*/////////////////////////////////////////////////////////////////////////// */
549             /* fp hell */
550              
551             #ifdef HAVE_NO_POWL
552             /* Ulisse Monari: this is a patch for AIX 5.3, perl 5.8.8 without HAS_LONG_DOUBLE
553             There Perl_pow maps to pow(...) - NOT TO powl(...), core dumps at Perl_pow(...)
554              
555             Base code is from http://bytes.com/topic/c/answers/748317-replacement-pow-function
556             This is my change to fs_pow that goes into libc/libm for calling fmod/exp/log.
557             NEED TO MODIFY Makefile, after perl Makefile.PL by adding "-lm" onto the LDDLFLAGS line */
558             static double fs_powEx(double x, double y)
559             {
560             double p = 0;
561              
562             if (0 > x && fmod(y, 1) == 0) {
563             if (fmod(y, 2) == 0) {
564             p = exp(log(-x) * y);
565             } else {
566             p = -exp(log(-x) * y);
567             }
568             } else {
569             if (x != 0 || 0 >= y) {
570             p = exp(log( x) * y);
571             }
572             }
573             return p;
574             }
575             #endif
576              
577             /* scan a group of digits, and a trailing exponent */
578             static void
579 130           json_atof_scan1 (const char *s, NV *accum, int *expo, int postdp, int maxdepth)
580             {
581 130           UV uaccum = 0;
582 130           int eaccum = 0;
583              
584             #if defined(HAVE_BAD_POWL)
585             *accum = strtold(s, NULL);
586             #else
587             /* if we recurse too deep, skip all remaining digits */
588             /* to avoid a stack overflow attack */
589 130 50         if (UNLIKELY(--maxdepth <= 0))
590 0 0         while (((U8)*s - '0') < 10)
591 0           ++s;
592              
593             for (;;)
594             {
595 470           U8 dig = (U8)*s - '0';
596              
597 470 100         if (UNLIKELY(dig >= 10))
598             {
599 130 100         if (dig == (U8)((U8)'.' - (U8)'0'))
600             {
601 52           ++s;
602 52           json_atof_scan1 (s, accum, expo, 1, maxdepth);
603             }
604 78 100         else if ((dig | ' ') == 'e' - '0')
605             {
606 44           int exp2 = 0;
607 44           int neg = 0;
608              
609 44           ++s;
610              
611 44 100         if (*s == '-')
612             {
613 10           ++s;
614 10           neg = 1;
615             }
616 34 100         else if (*s == '+')
617 16           ++s;
618              
619 265 100         while ((dig = (U8)*s - '0') < 10)
620 221           exp2 = exp2 * 10 + *s++ - '0';
621              
622 44 100         *expo += neg ? -exp2 : exp2;
623             }
624              
625 130           break;
626             }
627              
628 340           ++s;
629              
630 340           uaccum = uaccum * 10 + dig;
631 340           ++eaccum;
632              
633             /* if we have too many digits, then recurse for more */
634             /* we actually do this for rather few digits */
635 340 50         if (uaccum >= (UV_MAX - 9) / 10)
636             {
637 0 0         if (postdp) *expo -= eaccum;
638 0           json_atof_scan1 (s, accum, expo, postdp, maxdepth);
639 0 0         if (postdp) *expo += eaccum;
640              
641 0           break;
642             }
643 340           }
644              
645             /* this relies greatly on the quality of the pow () */
646             /* implementation of the platform, but a good */
647             /* implementation is hard to beat. */
648             /* (IEEE 754 conformant ones are required to be exact) */
649 130 100         if (postdp) *expo -= eaccum;
650             #ifdef HAVE_NO_POWL
651             /* powf() unfortunately is not accurate enough */
652             *accum += uaccum * fs_powEx(10., *expo );
653             #else
654 130           *accum += uaccum * Perl_pow (10., *expo);
655             #endif
656 130           *expo += eaccum;
657             #endif
658 130           }
659              
660             static NV
661 78           json_atof (const char *s)
662             {
663 78           NV accum = 0.;
664 78           int expo = 0;
665 78           int neg = 0;
666              
667 78 100         if (*s == '-')
668             {
669 17           ++s;
670 17           neg = 1;
671             }
672              
673             /* a recursion depth of ten gives us >>500 bits */
674 78           json_atof_scan1 (s, &accum, &expo, 0, 10);
675              
676 78 100         return neg ? -accum : accum;
677             }
678              
679              
680             /* target of scalar reference is bool? -1 == nope, 0 == false, 1 == true */
681             static int
682 1844           ref_bool_type (pTHX_ SV *sv)
683             {
684 1844           svtype svt = SvTYPE (sv);
685              
686 1844 100         if (svt < SVt_PVAV)
687             {
688 27           STRLEN len = 0;
689 27 100         char *pv = svt ? SvPV_nomg (sv, len) : 0;
    100          
690              
691 27 100         if (len == 1) {
692 9 100         if (*pv == '1')
693 8           return 1;
694 4 100         else if (*pv == '0')
695 22           return 0;
696             }
697              
698             }
699              
700 1836           return -1;
701             }
702              
703             /* returns whether scalar is not a reference in the sense of allow_nonref */
704             static int
705 1838           json_nonref (pTHX_ SV *scalar)
706             {
707 1838 100         if (!SvROK (scalar))
708 7           return 1;
709              
710 1831           scalar = SvRV (scalar);
711              
712 1831 100         if (!SvOBJECT (scalar) && ref_bool_type (aTHX_ scalar) >= 0)
    50          
713 0           return 1;
714              
715 1831 100         if (SvOBJECT (scalar)) {
716             dMY_CXT;
717 14           HV *bstash = MY_CXT.json_boolean_stash;
718 14           HV *oldstash = MY_CXT.jsonold_boolean_stash;
719 14           HV *mstash = MY_CXT.mojo_boolean_stash;
720 14           HV *stash = SvSTASH (scalar);
721              
722 14 100         if (stash == bstash || stash == mstash || stash == oldstash)
    50          
    50          
723 2           return 1;
724             }
725            
726 1829           return 0;
727             }
728              
729             /*/////////////////////////////////////////////////////////////////////////// */
730             /* encoder */
731              
732             /* structure used for encoding JSON */
733             typedef struct
734             {
735             char *cur; /* SvPVX (sv) + current output position */
736             char *end; /* SvEND (sv) */
737             SV *sv; /* result scalar */
738             JSON json;
739             U32 indent; /* indentation level */
740             UV limit; /* escape character values >= this value when encoding */
741             } enc_t;
742              
743             INLINE void
744 60527           need (pTHX_ enc_t *enc, STRLEN len)
745             {
746             #if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION >= 1)
747             DEBUG_v(Perl_deb(aTHX_ "need enc: %p %p %4ld, want: %lu\n", enc->cur, enc->end,
748             (long)(enc->end - enc->cur), (unsigned long)len));
749             #endif
750             assert(enc->cur <= enc->end);
751 60527 100         if (UNLIKELY(enc->cur + len >= enc->end))
752             {
753 3095           STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
754 3095 50         SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
    100          
755 3095           enc->cur = SvPVX (enc->sv) + cur;
756 3095           enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
757             }
758 60527           }
759              
760             INLINE void
761 9077           encode_ch (pTHX_ enc_t *enc, char ch)
762             {
763 9077           need (aTHX_ enc, 1);
764 9077           *enc->cur++ = ch;
765 9077           }
766              
767             static void
768 2337           encode_str (pTHX_ enc_t *enc, char *str, STRLEN len, int is_utf8)
769             {
770 2337           char *end = str + len;
771              
772             #if PERL_VERSION < 8
773             /* perl5.6 encodes to utf8 automatically, reverse it */
774             if (is_utf8 && (enc->json.flags & F_BINARY))
775             {
776             str = (char *)utf8_to_bytes((U8*)str, &len);
777             if (!str)
778             croak ("illegal unicode character in binary string", str);
779             end = str + len;
780             }
781             #endif
782 2337           need (aTHX_ enc, len);
783              
784 50315 100         while (str < end)
785             {
786 47978           unsigned char ch = *(unsigned char *)str;
787             #if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION >= 1)
788             DEBUG_v(Perl_deb(aTHX_ "str enc: %p %p %4ld, want: %lu\n", enc->cur, enc->end,
789             (long)(enc->end - enc->cur), (long unsigned)len));
790             #endif
791 47978 100         if (LIKELY(ch >= 0x20 && ch < 0x80)) /* most common case */
    100          
792             {
793             assert(enc->cur <= enc->end);
794 39728 100         if (UNLIKELY(ch == '"')) /* but with slow exceptions */
795             {
796 225           need (aTHX_ enc, 2);
797 225           *enc->cur++ = '\\';
798 225           *enc->cur++ = '"';
799 225           ++len;
800             }
801 39503 100         else if (UNLIKELY(ch == '\\'))
802             {
803 414           need (aTHX_ enc, 2);
804 414           *enc->cur++ = '\\';
805 414           *enc->cur++ = '\\';
806 414           ++len;
807             }
808 39089 100         else if (UNLIKELY(ch == '/' && (enc->json.flags & F_ESCAPE_SLASH)))
    100          
809             {
810 1           need (aTHX_ enc, 2);
811 1           *enc->cur++ = '\\';
812 1           *enc->cur++ = '/';
813 1           ++len;
814             }
815             else {
816 39088           need (aTHX_ enc, 1);
817 39088           *enc->cur++ = ch;
818             }
819              
820 39728           ++str;
821             }
822             else
823             {
824             assert(enc->cur <= enc->end);
825 8250           switch (ch)
826             {
827 81           case '\010': need (aTHX_ enc, 2);
828 81           *enc->cur++ = '\\'; *enc->cur++ = 'b'; ++len; ++str; break;
829 79           case '\011': need (aTHX_ enc, 2);
830 79           *enc->cur++ = '\\'; *enc->cur++ = 't'; ++len; ++str; break;
831 274           case '\012': need (aTHX_ enc, 2);
832 274           *enc->cur++ = '\\'; *enc->cur++ = 'n'; ++len; ++str; break;
833 65           case '\014': need (aTHX_ enc, 2);
834 65           *enc->cur++ = '\\'; *enc->cur++ = 'f'; ++len; ++str; break;
835 61           case '\015': need (aTHX_ enc, 2);
836 61           *enc->cur++ = '\\'; *enc->cur++ = 'r'; ++len; ++str; break;
837              
838             default:
839             {
840             STRLEN clen;
841             UV uch;
842              
843 7690 100         if (is_utf8 && !(enc->json.flags & F_BINARY))
    100          
844             {
845 1620           uch = decode_utf8 (aTHX_ (unsigned char *)str, end - str,
846 1620           enc->json.flags & F_RELAXED, &clen);
847 1620 50         if (clen == (STRLEN)-1)
848 0           croak ("malformed or illegal unicode character in string [%.11s], cannot convert to JSON", str);
849             }
850             else
851             {
852 6070           uch = ch;
853 6070           clen = 1;
854             }
855              
856 7690 100         if (uch < 0x80/*0x20*/ || uch >= enc->limit)
    100          
857             {
858 6525 100         if (enc->json.flags & F_BINARY)
859             {
860             /* MB cannot arrive here */
861 5015           need (aTHX_ enc, 4);
862 5015           *enc->cur++ = '\\';
863 5015           *enc->cur++ = 'x';
864 5015           *enc->cur++ = PL_hexdigit [(uch >> 4) & 15];
865 5015           *enc->cur++ = PL_hexdigit [ uch & 15];
866 5015           len += 3;
867             }
868 1510 100         else if (uch >= 0x10000UL)
869             {
870 320 50         if (uch >= 0x110000UL)
871 0           croak ("out of range codepoint (0x%lx) encountered, unrepresentable in JSON", (unsigned long)uch);
872              
873 320           need (aTHX_ enc, 12);
874 640           sprintf (enc->cur, "\\u%04x\\u%04x",
875 320           (int)((uch - 0x10000) / 0x400 + 0xD800),
876             (int)((uch - 0x10000) % 0x400 + 0xDC00));
877 320           enc->cur += 12;
878 320           len += 11;
879             }
880             else
881             {
882 1190           need (aTHX_ enc, 6);
883 1190           *enc->cur++ = '\\';
884 1190           *enc->cur++ = 'u';
885 1190           *enc->cur++ = PL_hexdigit [ uch >> 12 ];
886 1190           *enc->cur++ = PL_hexdigit [(uch >> 8) & 15];
887 1190           *enc->cur++ = PL_hexdigit [(uch >> 4) & 15];
888 1190           *enc->cur++ = PL_hexdigit [ uch & 15];
889 1190           len += 5;
890             }
891              
892 6525           str += clen;
893             }
894 1165 100         else if (enc->json.flags & F_LATIN1)
895             {
896 8           need (aTHX_ enc, 1);
897 8           *enc->cur++ = uch;
898 8           str += clen;
899             }
900 1157 50         else if (enc->json.flags & F_BINARY)
901             {
902 0           need (aTHX_ enc, 1);
903 0           *enc->cur++ = uch;
904 0           str += clen;
905             }
906 1157 100         else if (is_utf8)
907             {
908 915           need (aTHX_ enc, clen);
909 915           len += clen;
910             do
911             {
912 2766           *enc->cur++ = *str++;
913             }
914 2766 100         while (--clen);
915             }
916             else
917             { /* never more than 11 bytes needed */
918 242           need (aTHX_ enc, UTF8_MAXBYTES);
919 242           enc->cur = (char*)encode_utf8 ((U8*)enc->cur, uch);
920 242           ++str;
921 7690           len += UTF8_MAXBYTES - 1;
922             }
923             }
924             }
925             }
926              
927 47978           --len;
928             }
929 2337           }
930              
931             INLINE void
932 215           encode_const_str (pTHX_ enc_t *enc, const char *str, STRLEN len, int is_utf8)
933             {
934 215           encode_str (aTHX_ enc, (char *)str, len, is_utf8);
935 215           }
936              
937             INLINE void
938 3720           encode_indent (pTHX_ enc_t *enc)
939             {
940 3720 100         if (enc->json.flags & F_INDENT)
941             {
942 32           int spaces = enc->indent * enc->json.indent_length;
943              
944 32           need (aTHX_ enc, spaces);
945 32           memset (enc->cur, ' ', spaces);
946 32           enc->cur += spaces;
947             }
948 3720           }
949              
950             INLINE void
951 14           encode_space (pTHX_ enc_t *enc)
952             {
953 14           encode_ch (aTHX_ enc, ' ');
954 14           }
955              
956             INLINE void
957 3769           encode_nl (pTHX_ enc_t *enc)
958             {
959 3769 100         if (enc->json.flags & F_INDENT)
960             {
961 40           encode_ch (aTHX_ enc, '\n');
962             }
963 3769           }
964              
965             INLINE void
966 1208           encode_comma (pTHX_ enc_t *enc)
967             {
968 1208           encode_ch (aTHX_ enc, ',');
969              
970 1208 100         if (enc->json.flags & F_INDENT)
971 8           encode_nl (aTHX_ enc);
972 1200 50         else if (enc->json.flags & F_SPACE_AFTER)
973 0           encode_space (aTHX_ enc);
974 1208           }
975              
976             static void encode_sv (pTHX_ enc_t *enc, SV *sv, SV *typesv);
977              
978             static void
979 896           encode_av (pTHX_ enc_t *enc, AV *av, SV *typesv)
980             {
981 896           AV *typeav = NULL;
982 896           HVMAX_T i, len = av_len (av);
983              
984 896 100         if (enc->indent >= enc->json.max_depth)
985 1           croak (ERR_NESTING_EXCEEDED);
986              
987 895 50         SvGETMAGIC (typesv);
    0          
988              
989 895 100         if (UNLIKELY (SvOK (typesv)))
    50          
    50          
    50          
990             {
991 22 50         if (SvROK (typesv) &&
    100          
992 16 100         SvOBJECT (SvRV (typesv)) &&
993 16           SvTYPE (SvRV (typesv)) == SVt_PVAV)
994             {
995 11           HV *stash = SvSTASH (SvRV (typesv));
996 11 50         char *name = LIKELY (!!stash) ? HvNAME (stash) : NULL;
    50          
    50          
    50          
    0          
    50          
    50          
997 11 50         if (LIKELY (name && strEQ (name, JSON_TYPE_ANYOF_CLASS)))
    50          
998             {
999 11           AV *type_any = (AV *)SvRV (typesv);
1000 11           SV **typesv_ref = av_fetch (type_any, JSON_TYPE_ANYOF_ARRAY_INDEX, 0);
1001 11 50         if (UNLIKELY (!typesv_ref))
1002 0 0         croak ("incorrectly constructed anyof type (%s, 0x%x) was specified for '%s'",
    0          
1003 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1004 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))));
1005 11           typesv = *typesv_ref;
1006 11 50         SvGETMAGIC (typesv);
    0          
1007 11 50         if (!SvOK (typesv))
    0          
    0          
1008 0 0         croak ("no array alternative in anyof was specified for '%s'",
1009 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))));
1010             }
1011             }
1012              
1013 22 50         if (UNLIKELY (!SvROK (typesv)))
1014 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1015 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1016 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))));
1017              
1018 22 100         if (!SvOBJECT (SvRV (typesv)) && SvTYPE (SvRV (typesv)) == SVt_PVAV)
    50          
1019             {
1020 9           typeav = (AV *)SvRV (typesv);
1021 9 50         if (len != av_len (typeav))
1022 0 0         croak ("array '%s' has different number of elements as in specified type '%s'",
    0          
1023 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))),
1024 0           SvPV_nolen (typesv));
1025             }
1026 13 50         else if (SvOBJECT (SvRV (typesv)) &&
    50          
1027 13           SvTYPE (SvRV (typesv)) < SVt_PVAV)
1028 13           {
1029 13           HV *stash = SvSTASH (SvRV (typesv));
1030 13 50         char *name = LIKELY (!!stash) ? HvNAME (stash) : NULL;
    50          
    50          
    50          
    0          
    50          
    50          
1031 13 50         if (LIKELY (name && strEQ (name, JSON_TYPE_ARRAYOF_CLASS)))
    50          
1032 13           typesv = (SV *)SvRV (typesv);
1033             else
1034 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1035 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1036 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))));
1037             }
1038             else
1039 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1040 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1041 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)av))));
1042             }
1043              
1044 895           encode_ch (aTHX_ enc, '[');
1045            
1046 895 100         if (len >= 0)
1047             {
1048 885           encode_nl (aTHX_ enc); ++enc->indent;
1049              
1050 2600 100         for (i = 0; i <= len; ++i)
1051             {
1052 1730           SV **svp = av_fetch (av, i, 0);
1053              
1054 1730 100         if (typeav)
1055             {
1056 23           SV **typerv = av_fetch (typeav, i, 0);
1057 23 50         if (typerv)
1058 23           typesv = *typerv;
1059             }
1060              
1061 1730           encode_indent (aTHX_ enc);
1062              
1063 1730 100         if (svp)
1064 1728           encode_sv (aTHX_ enc, *svp, typesv);
1065             else
1066 2           encode_const_str (aTHX_ enc, "null", 4, 0);
1067              
1068 1715 100         if (i < len)
1069 845           encode_comma (aTHX_ enc);
1070             }
1071              
1072 870           encode_nl (aTHX_ enc); --enc->indent; encode_indent (aTHX_ enc);
1073             }
1074            
1075 880           encode_ch (aTHX_ enc, ']');
1076 880           }
1077              
1078             INLINE void
1079 744           retrieve_hk (pTHX_ HE *he, char **key, I32 *klen)
1080             {
1081             int utf8;
1082              
1083 744 100         if (He_IS_SVKEY(he))
1084             {
1085             STRLEN len;
1086 1 50         SV *sv = HeSVKEY (he);
    50          
1087 1 50         *key = SvPV (sv, len);
1088 1           *klen = (I32)len;
1089 1           utf8 = SvUTF8 (sv);
1090             }
1091             else
1092             {
1093 743           *key = HeKEY (he);
1094 743           *klen = HeKLEN (he);
1095 743           utf8 = HeKUTF8 (he);
1096             }
1097              
1098 744 100         if (utf8) *klen = -(*klen);
1099 744           }
1100              
1101             static void
1102 744           encode_hk (pTHX_ enc_t *enc, char *key, I32 klen)
1103             {
1104 744           encode_ch (aTHX_ enc, '"');
1105 744           encode_str (aTHX_ enc, key, klen < 0 ? -klen : klen, klen < 0);
1106 744           encode_ch (aTHX_ enc, '"');
1107              
1108 744 100         if (enc->json.flags & F_SPACE_BEFORE) encode_space (aTHX_ enc);
1109 744           encode_ch (aTHX_ enc, ':');
1110 744 100         if (enc->json.flags & F_SPACE_AFTER ) encode_space (aTHX_ enc);
1111 744           }
1112              
1113             /* compare hash entries, used when all keys are bytestrings */
1114             static int
1115 312           he_cmp_fast (const void *a_, const void *b_)
1116             {
1117             int cmp;
1118              
1119 312           HE *a = *(HE **)a_;
1120 312           HE *b = *(HE **)b_;
1121              
1122 312           STRLEN la = HeKLEN (a);
1123 312           STRLEN lb = HeKLEN (b);
1124              
1125 312 100         if (!(cmp = memcmp (HeKEY (b), HeKEY (a), lb < la ? lb : la)))
1126 198           cmp = lb - la;
1127              
1128 312           return cmp;
1129             }
1130              
1131             /* compare hash entries, used when some keys are sv's or utf-x */
1132             static int
1133 353           he_cmp_slow (const void *a, const void *b)
1134             {
1135             dTHX;
1136 353 50         return sv_cmp (HeSVKEY_force (*(HE **)b), HeSVKEY_force (*(HE **)a));
    50          
    100          
    50          
    50          
    100          
1137             }
1138              
1139             static void
1140 392           encode_hv (pTHX_ enc_t *enc, HV *hv, SV *typesv)
1141             {
1142 392           HV *typehv = NULL;
1143             HE *he;
1144              
1145 392 100         if (enc->indent >= enc->json.max_depth)
1146 1           croak (ERR_NESTING_EXCEEDED);
1147              
1148 391 50         SvGETMAGIC (typesv);
    0          
1149              
1150 391 100         if (UNLIKELY (SvOK (typesv)))
    50          
    50          
    50          
1151             {
1152 17 50         if (SvROK (typesv) &&
    100          
1153 6 100         SvOBJECT (SvRV (typesv)) &&
1154 6           SvTYPE (SvRV (typesv)) == SVt_PVAV)
1155             {
1156 4           HV *stash = SvSTASH (SvRV (typesv));
1157 4 50         char *name = LIKELY (!!stash) ? HvNAME (stash) : NULL;
    50          
    50          
    50          
    0          
    50          
    50          
1158 4 50         if (LIKELY (name && strEQ (name, JSON_TYPE_ANYOF_CLASS)))
    50          
1159             {
1160 4           AV *type_any = (AV *)SvRV (typesv);
1161 4           SV **typesv_ref = av_fetch (type_any, JSON_TYPE_ANYOF_HASH_INDEX, 0);
1162 4 50         if (UNLIKELY (!typesv_ref))
1163 0 0         croak ("incorrectly constructed anyof type (%s, 0x%x) was specified for '%s'",
    0          
1164 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1165 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)hv))));
1166 4           typesv = *typesv_ref;
1167 4 50         SvGETMAGIC (typesv);
    0          
1168 4 50         if (!SvOK (typesv))
    0          
    0          
1169 0 0         croak ("no hash alternative in anyof was specified for '%s'",
1170 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)hv))));
1171             }
1172             }
1173              
1174 17 50         if (UNLIKELY (!SvROK (typesv)))
1175 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1176 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1177 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)hv))));
1178              
1179 17 100         if (!SvOBJECT (SvRV (typesv)) && SvTYPE (SvRV (typesv)) == SVt_PVHV)
    50          
1180 13           typehv = (HV *)SvRV (typesv);
1181 4 50         else if (SvOBJECT (SvRV (typesv)) &&
    50          
1182 4           SvTYPE (SvRV (typesv)) < SVt_PVAV)
1183 4           {
1184 4           HV *stash = SvSTASH (SvRV (typesv));
1185 4 50         char *name = LIKELY (!!stash) ? HvNAME (stash) : NULL;
    50          
    50          
    50          
    0          
    50          
    50          
1186 4 50         if (LIKELY (name && strEQ (name, JSON_TYPE_HASHOF_CLASS)))
    50          
1187 4           typesv = (SV *)SvRV (typesv);
1188             else
1189 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1190 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1191 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)hv))));
1192             }
1193             else
1194 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1195 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1196 0           SvPV_nolen (sv_2mortal (newRV_inc ((SV *)hv))));
1197             }
1198              
1199              
1200 391           encode_ch (aTHX_ enc, '{');
1201              
1202             /* for canonical output we have to sort by keys first */
1203             /* caused by randomised hash orderings */
1204 391 100         if (enc->json.flags & F_CANONICAL && !SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
    50          
    0          
1205 238           {
1206 239           RITER_T i, count = hv_iterinit (hv);
1207              
1208 239 50         if (SvMAGICAL (hv))
1209             {
1210             /* need to count by iterating. could improve by dynamically building the vector below */
1211             /* but I don't care for the speed of this special case. */
1212             /* note also that we will run into undefined behaviour when the two iterations */
1213             /* do not result in the same count, something I might care for in some later release. */
1214              
1215 0           count = 0;
1216 0 0         while (hv_iternext (hv))
1217 0           ++count;
1218              
1219 0           hv_iterinit (hv);
1220             }
1221              
1222 239 100         if (count)
1223             {
1224 233           int fast = 1;
1225             HE *hes_stack [STACK_HES];
1226 233           HE **hes = hes_stack;
1227              
1228             /* allocate larger arrays on the heap */
1229 233 50         if (count > STACK_HES)
1230             {
1231 0           SV *sv = sv_2mortal (NEWSV (0, count * sizeof (*hes)));
1232 0           hes = (HE **)SvPVX (sv);
1233             }
1234              
1235 233           i = 0;
1236 817 100         while ((he = hv_iternext (hv)))
1237             {
1238 584           hes [i++] = he;
1239 584 50         if (HeKLEN (he) < 0 || HeKUTF8 (he))
    100          
1240 3           fast = 0;
1241             }
1242              
1243             assert (i == count);
1244              
1245 233 100         if (fast)
1246 230           qsort (hes, count, sizeof (HE *), he_cmp_fast);
1247             else
1248             {
1249             /* hack to forcefully disable "use bytes" */
1250 3           COP cop = *PL_curcop;
1251 3           cop.op_private = 0;
1252              
1253 3           ENTER;
1254 3           SAVETMPS;
1255              
1256 3           SAVEVPTR (PL_curcop);
1257 3           PL_curcop = &cop;
1258              
1259 3           qsort (hes, count, sizeof (HE *), he_cmp_slow);
1260              
1261 3 50         FREETMPS;
1262 3           LEAVE;
1263             }
1264              
1265 233           encode_nl (aTHX_ enc); ++enc->indent;
1266              
1267 816 100         while (count--)
1268             {
1269             char *key;
1270             I32 klen;
1271              
1272 584           encode_indent (aTHX_ enc);
1273 584           he = hes [count];
1274 584           retrieve_hk (aTHX_ he, &key, &klen);
1275 584           encode_hk (aTHX_ enc, key, klen);
1276              
1277 584 100         if (UNLIKELY (PTR2ul (typehv)))
1278             {
1279 29           SV **typesv_ref = hv_fetch (typehv, key, klen, 0);
1280 29 50         if (UNLIKELY (!typesv_ref))
1281 0           croak ("no type was specified for hash key '%s'", key);
1282              
1283 29           typesv = *typesv_ref;
1284             }
1285              
1286 584 50         encode_sv (aTHX_ enc, UNLIKELY(SvMAGICAL (hv)) ? hv_iterval (hv, he) : HeVAL (he), typesv);
1287              
1288 583 100         if (count)
1289 583           encode_comma (aTHX_ enc);
1290             }
1291              
1292 232           encode_nl (aTHX_ enc); --enc->indent; encode_indent (aTHX_ enc);
1293             }
1294             }
1295             else
1296             {
1297 152 100         if (hv_iterinit (hv) || SvMAGICAL (hv))
    100          
1298 148 50         if ((he = hv_iternext (hv)))
1299             {
1300 148           encode_nl (aTHX_ enc); ++enc->indent;
1301              
1302             for (;;)
1303             {
1304             char *key;
1305             I32 klen;
1306              
1307 160           encode_indent (aTHX_ enc);
1308 160           retrieve_hk (aTHX_ he, &key, &klen);
1309 160           encode_hk (aTHX_ enc, key, klen);
1310              
1311 160 50         if (UNLIKELY (PTR2ul (typehv)))
1312             {
1313 0           SV **typesv_ref = hv_fetch (typehv, key, klen, 0);
1314 0 0         if (UNLIKELY (!typesv_ref))
1315 0           croak ("no type was specified for hash key '%s'", key);
1316              
1317 0           typesv = *typesv_ref;
1318             }
1319              
1320 160 100         encode_sv (aTHX_ enc, UNLIKELY(SvMAGICAL (hv)) ? hv_iterval (hv, he) : HeVAL (he), typesv);
1321              
1322 156 100         if (!(he = hv_iternext (hv)))
1323 144           break;
1324              
1325 12           encode_comma (aTHX_ enc);
1326 12           }
1327              
1328 144           encode_nl (aTHX_ enc); --enc->indent; encode_indent (aTHX_ enc);
1329             }
1330             }
1331              
1332 386           encode_ch (aTHX_ enc, '}');
1333 386           }
1334              
1335             /* implement convert_blessed, sv is already unref'ed here */
1336             static void
1337 11           encode_stringify(pTHX_ enc_t *enc, SV *sv, int isref)
1338             {
1339 11           char *str = NULL;
1340             STRLEN len;
1341 11           SV *pv = NULL;
1342 11           svtype type = SvTYPE(sv);
1343             #if PERL_VERSION <= 8
1344             MAGIC *mg;
1345             #endif
1346              
1347             /* SvAMAGIC without the ref */
1348             #if PERL_VERSION > 17
1349             #define MyAMG(sv) (SvOBJECT(sv) && HvAMAGIC(SvSTASH(sv)))
1350             #else
1351             #if PERL_VERSION > 8
1352             #define MyAMG(sv) (SvOBJECT(sv) && (SvFLAGS(sv) & SVf_AMAGIC))
1353             #else
1354             #define MyAMG(sv) (SvOBJECT(sv) && ((SvFLAGS(sv) & SVf_AMAGIC) \
1355             || ((mg = mg_find((SV*)SvSTASH(sv), PERL_MAGIC_overload_table)) \
1356             && mg->mg_ptr && AMT_AMAGIC((AMT*)mg->mg_ptr))))
1357             #endif
1358             #endif
1359              
1360 11 100         if (isref && SvAMAGIC(sv))
    50          
    50          
    50          
1361             ;
1362             /* if no string overload found, check allow_stringify */
1363 2 50         else if (!MyAMG(sv) && !(enc->json.flags & F_ALLOW_STRINGIFY)) {
    50          
    50          
1364 2 50         if (isref && !(enc->json.flags & F_ALLOW_UNKNOWN))
    0          
1365 0 0         croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
1366 0           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1367 2           encode_const_str (aTHX_ enc, "null", 4, 0);
1368 9           return;
1369             }
1370             /* sv_2pv_flags does not accept those types: */
1371 9 50         if (type != SVt_PVAV && type != SVt_PVHV && type != SVt_PVFM) {
    50          
    50          
1372             /* the essential of pp_stringify */
1373             #if PERL_VERSION > 7
1374 9           pv = newSVpvs("");
1375 9           sv_copypv(pv, sv);
1376 9 50         SvSETMAGIC(pv);
1377 9 50         str = SvPVutf8_force(pv, len);
1378             #else
1379             char *s;
1380             if (isref) {
1381             pv = AMG_CALLun(sv,string);
1382             len = SvCUR(pv);
1383             str = SvPVX(pv);
1384             SvREFCNT_inc(pv);
1385             }
1386             else {
1387             pv = newSVpvs("");
1388             s = SvPV(sv,len);
1389             sv_setpvn(pv,s,len);
1390             if (SvUTF8(sv))
1391             SvUTF8_on(pv);
1392             else
1393             SvUTF8_off(pv);
1394             SvSETMAGIC(pv);
1395             str = SvPVutf8_force(pv, len);
1396             }
1397             #endif
1398 9 50         if (!len) {
1399 0           encode_const_str (aTHX_ enc, "null", 4, 0);
1400 0           SvREFCNT_dec(pv);
1401 0           return;
1402             }
1403             } else {
1404             /* manually call all possible magic on AV, HV, FM */
1405 0 0         if (SvGMAGICAL(sv)) mg_get(sv);
1406 0 0         if (MyAMG(sv)) { /* force a RV here */
    0          
1407 0           SV* rv = newRV(SvREFCNT_inc(sv));
1408             #if PERL_VERSION <= 8
1409             HV *stash = SvSTASH(sv);
1410             if (!SvSTASH(rv) || !(SvFLAGS(sv) & SVf_AMAGIC)) {
1411             sv_bless(rv, stash);
1412             Gv_AMupdate(stash);
1413             SvFLAGS(sv) |= SVf_AMAGIC;
1414             }
1415             #endif
1416             #if PERL_VERSION > 13
1417 0           pv = AMG_CALLunary(rv, string_amg);
1418             #else
1419             pv = AMG_CALLun(rv, string);
1420             #endif
1421 0 0         TAINT_IF(pv && SvTAINTED(pv));
    0          
    0          
    0          
1422 0 0         if (pv && SvPOK(pv)) {
    0          
1423 0 0         str = SvPVutf8_force(pv, len);
1424 0           encode_ch (aTHX_ enc, '"');
1425 0           encode_str (aTHX_ enc, str, len, 0);
1426 0           encode_ch (aTHX_ enc, '"');
1427 0           SvREFCNT_dec(rv);
1428 0           return;
1429             }
1430 0           SvREFCNT_dec(rv);
1431             }
1432             }
1433 9 50         if (UNLIKELY(isref == 1 && (enc->json.flags & F_ALLOW_BIGNUM) && str && str[0] == '+')) {
    50          
    50          
    50          
    50          
    50          
1434 0           str++;
1435 0           len--;
1436             }
1437             /* if ALLOW_BIGNUM and Math::Big* and NaN => according to stringify_infnan */
1438 9 50         if (UNLIKELY(
    50          
    50          
    50          
    50          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
1439             (enc->json.flags & F_ALLOW_BIGNUM)
1440             && str
1441             && SvROK(sv)
1442             && (memEQc(str, "NaN") || memEQc(str, "nan") ||
1443             memEQc(str, "inf") || memEQc(str, "-inf"))))
1444             {
1445 7           HV *stash = SvSTASH(SvRV(sv));
1446 7 50         if (stash
1447 7           && ((stash == gv_stashpvn ("Math::BigInt", sizeof("Math::BigInt")-1, 0)) ||
1448 0           (stash == gv_stashpvn ("Math::BigFloat", sizeof("Math::BigFloat")-1, 0))))
1449             {
1450 7 100         if (enc->json.infnan_mode == 0) {
1451 4           encode_const_str (aTHX_ enc, "null", 4, 0);
1452 4 50         if (pv) SvREFCNT_dec(pv);
1453 4           return;
1454 3 50         } else if (enc->json.infnan_mode == 3) {
1455 3 100         if (memEQc(str, "NaN") || memEQc(str, "nan"))
    50          
1456 1           encode_const_str (aTHX_ enc, "nan", 3, 0);
1457 2 100         else if (memEQc(str, "inf"))
1458 1           encode_const_str (aTHX_ enc, "inf", 3, 0);
1459             else
1460 1           encode_const_str (aTHX_ enc, "-inf", 4, 0);
1461 3 50         if (pv) SvREFCNT_dec(pv);
1462 3           return;
1463             }
1464             }
1465             }
1466 2 50         if (!str)
1467 0           encode_const_str (aTHX_ enc, "null", 4, 0);
1468             else {
1469 2 50         if (isref != 1)
1470 0           encode_ch (aTHX_ enc, '"');
1471 2           encode_str (aTHX_ enc, str, len, 0);
1472 2 50         if (isref != 1)
1473 2           encode_ch (aTHX_ enc, '"');
1474             }
1475             #undef MyAMG
1476             }
1477              
1478             INLINE int
1479 63           encode_bool_obj (pTHX_ enc_t *enc, SV *sv, int force_conversion, int as_string)
1480             {
1481             dMY_CXT;
1482              
1483 63           HV *bstash = MY_CXT.json_boolean_stash; /* JSON-XS-3.x interop (Types::Serialiser/JSON::PP::Boolean) */
1484 63           HV *oldstash = MY_CXT.jsonold_boolean_stash; /* JSON-XS-2.x interop (JSON::XS::Boolean) */
1485 63           HV *mstash = MY_CXT.mojo_boolean_stash; /* Mojo::JSON::_Bool interop */
1486 63           HV *stash = SvSTASH (sv);
1487              
1488 63 100         if (stash == bstash || stash == mstash || stash == oldstash)
    50          
    50          
1489             {
1490 35 100         if (as_string)
1491 3           encode_ch (aTHX_ enc, '"');
1492 35 50         if (SvIV_nomg (sv))
    100          
1493 20           encode_const_str (aTHX_ enc, "true", 4, 0);
1494             else
1495 15           encode_const_str (aTHX_ enc, "false", 5, 0);
1496 38 100         if (as_string)
1497 3           encode_ch (aTHX_ enc, '"');
1498             }
1499 28 50         else if (force_conversion && enc->json.flags & F_CONV_BLESSED)
    0          
1500             {
1501 0 0         if (as_string)
1502 0           encode_ch (aTHX_ enc, '"');
1503 0 0         if (SvTRUE_nomg (sv))
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1504 0           encode_const_str (aTHX_ enc, "true", 4, 0);
1505             else
1506 0           encode_const_str (aTHX_ enc, "false", 5, 0);
1507 0 0         if (as_string)
1508 0           encode_ch (aTHX_ enc, '"');
1509             }
1510             else
1511 28           return 0;
1512              
1513 35           return 1;
1514             }
1515              
1516             INLINE int
1517 27           encode_bool_ref (pTHX_ enc_t *enc, SV *sv)
1518             {
1519 27           int bool_type = ref_bool_type (aTHX_ sv);
1520              
1521 27 100         if (bool_type == 1)
1522 5           encode_const_str (aTHX_ enc, "true", 4, 0);
1523 22 100         else if (bool_type == 0)
1524 3           encode_const_str (aTHX_ enc, "false", 5, 0);
1525             else
1526 19           return 0;
1527              
1528 8           return 1;
1529             }
1530              
1531             /* encode objects, arrays and special \0=false and \1=true values
1532             and other representations of booleans: JSON::PP::Boolean, Mojo::JSON::_Bool
1533             */
1534             static void
1535 80           encode_rv (pTHX_ enc_t *enc, SV *rv)
1536             {
1537             svtype svt;
1538             GV *method;
1539 80           SV *sv = SvRV(rv);
1540              
1541 80           svt = SvTYPE (sv);
1542              
1543 80 100         if (UNLIKELY (SvOBJECT (sv)))
1544             {
1545 51 100         if (!encode_bool_obj (aTHX_ enc, sv, 0, 0))
1546             {
1547 28           HV *stash = SvSTASH (sv);
1548 28 100         if ((enc->json.flags & F_ALLOW_TAGS)
1549 7 100         && (method = gv_fetchmethod_autoload (stash, "FREEZE", 0)))
1550 48           {
1551             dMY_CXT;
1552 6           dSP;
1553             int count, items;
1554              
1555 6 50         ENTER; SAVETMPS; SAVESTACK_POS (); PUSHMARK (SP);
    50          
1556 6 50         EXTEND (SP, 2);
1557 6           PUSHs (rv);
1558 6           PUSHs (MY_CXT.sv_json);
1559              
1560 6           PUTBACK;
1561 6           count = call_sv ((SV *)GvCV (method), G_ARRAY);
1562 6           items = count;
1563 6           SPAGAIN;
1564              
1565             /* catch this surprisingly common error */
1566 6 100         if (SvROK (TOPs) && SvRV (TOPs) == sv)
    50          
1567 0 0         croak ("%s::FREEZE method returned same object as was passed instead of a new one",
    0          
1568 0 0         HvNAME (SvSTASH (sv)));
    0          
    0          
    0          
1569              
1570 6           encode_ch (aTHX_ enc, '(');
1571 6           encode_ch (aTHX_ enc, '"');
1572 6 50         encode_str (aTHX_ enc, HvNAME (stash), HvNAMELEN (stash), HvNAMEUTF8 (stash));
    50          
    50          
    0          
    50          
    50          
    50          
    50          
    50          
    50          
    0          
    50          
    50          
    50          
    50          
    50          
    0          
    50          
    50          
1573 6           encode_ch (aTHX_ enc, '"');
1574 6           encode_ch (aTHX_ enc, ')');
1575 6           encode_ch (aTHX_ enc, '[');
1576              
1577 261 100         while (count)
1578             {
1579 255           encode_sv (aTHX_ enc, SP[1 - count--], &PL_sv_undef);
1580 255           SPAGAIN;
1581              
1582 255 100         if (count)
1583 249           encode_ch (aTHX_ enc, ',');
1584             }
1585              
1586 6           encode_ch (aTHX_ enc, ']');
1587              
1588 6           SP -= items;
1589 6           PUTBACK;
1590              
1591 6 50         FREETMPS; LEAVE;
1592             }
1593 22 100         else if ((enc->json.flags & F_CONV_BLESSED)
1594 18 100         && (method = gv_fetchmethod_autoload (stash, "TO_JSON", 0)))
1595 6           {
1596 7           dSP;
1597              
1598 7 50         ENTER; SAVETMPS; PUSHMARK (SP);
1599              
1600 7 50         XPUSHs (rv);
1601              
1602             /* calling with G_SCALAR ensures that we always get a 1 return value */
1603 7           PUTBACK;
1604 7           call_sv ((SV *)GvCV (method), G_SCALAR);
1605 7           SPAGAIN;
1606            
1607             /* catch this surprisingly common error */
1608 7 100         if (SvROK (TOPs) && SvRV (TOPs) == sv)
    100          
1609 1 50         croak ("%s::TO_JSON method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv)));
    50          
    50          
    0          
    50          
    50          
1610              
1611 6           sv = POPs;
1612 6           PUTBACK;
1613              
1614 6           encode_sv (aTHX_ enc, sv, &PL_sv_undef);
1615              
1616 6 50         FREETMPS; LEAVE;
1617             }
1618 15 100         else if ((enc->json.flags & F_ALLOW_BIGNUM)
1619 9 50         && stash
1620 9 100         && ((stash == gv_stashpvn ("Math::BigInt", sizeof("Math::BigInt")-1, 0))
1621 1 50         || (stash == gv_stashpvn ("Math::BigFloat", sizeof("Math::BigFloat")-1, 0))))
1622 9           encode_stringify(aTHX_ enc, rv, 1);
1623 6 100         else if (enc->json.flags & F_CONV_BLESSED)
1624 2           encode_stringify(aTHX_ enc, sv, 0);
1625 4 100         else if (enc->json.flags & F_ALLOW_BLESSED)
1626 2           encode_const_str (aTHX_ enc, "null", 4, 0);
1627             else
1628 4 50         croak ("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)",
1629 4           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1630             }
1631             }
1632 29 100         else if (svt < SVt_PVAV && svt != SVt_PVGV && svt != SVt_PVHV && svt != SVt_PVAV)
    100          
    50          
    50          
1633             {
1634 31 100         if (!encode_bool_ref (aTHX_ enc, sv))
1635             {
1636 19 50         if (enc->json.flags & F_ALLOW_STRINGIFY)
1637 0           encode_stringify(aTHX_ enc, sv, SvROK(sv));
1638 19 100         else if (enc->json.flags & F_ALLOW_UNKNOWN)
1639 7           encode_const_str (aTHX_ enc, "null", 4, 0);
1640             else
1641 24 50         croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
1642 24           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1643             }
1644             }
1645 5 100         else if (enc->json.flags & F_ALLOW_UNKNOWN)
1646 2           encode_const_str (aTHX_ enc, "null", 4, 0);
1647             else
1648 6 50         croak ("encountered %s, but JSON can only represent references to arrays or hashes",
1649 6           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1650 62           }
1651              
1652             static void
1653 107           encode_bool (pTHX_ enc_t *enc, SV *sv)
1654             {
1655             svtype svt;
1656              
1657 107 100         if (!SvROK (sv))
1658             {
1659 95 100         if (UNLIKELY (sv == &PL_sv_yes))
1660 8           encode_const_str (aTHX_ enc, "true", 4, 0);
1661 87 100         else if (UNLIKELY (sv == &PL_sv_no))
1662 6           encode_const_str (aTHX_ enc, "false", 5, 0);
1663 81 100         else if (!SvOK (sv))
    50          
    50          
1664 1           encode_const_str (aTHX_ enc, "false", 5, 0);
1665 80 50         else if (SvTRUE_nomg (sv))
    50          
    0          
    0          
    100          
    50          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    100          
    0          
1666 65           encode_const_str (aTHX_ enc, "true", 4, 0);
1667             else
1668 95           encode_const_str (aTHX_ enc, "false", 5, 0);
1669             }
1670             else
1671             {
1672 12           sv = SvRV (sv);
1673 12           svt = SvTYPE (sv);
1674              
1675 12 100         if (UNLIKELY (SvOBJECT (sv)))
1676             {
1677 9 50         if (!encode_bool_obj (aTHX_ enc, sv, 1, 0))
1678 0 0         croak ("encountered object '%s', but convert_blessed is not enabled",
1679 0           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1680             }
1681 3 50         else if (svt < SVt_PVAV && svt != SVt_PVGV)
    50          
1682             {
1683 3 50         if (!encode_bool_ref (aTHX_ enc, sv))
1684 0 0         croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
1685 0           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1686             }
1687             else
1688 0 0         croak ("encountered %s, but does not represent boolean",
1689 0           SvPV_nolen (sv_2mortal (newRV_inc (sv))));
1690             }
1691 107           }
1692              
1693             static void
1694 31           sv_to_ivuv (pTHX_ SV *sv, int *is_neg, IV *iv, UV *uv)
1695             {
1696 31 50         *iv = SvIV_nomg (sv);
1697 31           *uv = (UV)(*iv);
1698             /* SvIV and SvUV may modify SvIsUV flag */
1699 31           *is_neg = !SvIsUV (sv);
1700 31 100         if (!*is_neg)
1701             {
1702 9 50         *uv = SvUV_nomg (sv);
1703 9           *iv = (IV)(*uv);
1704             }
1705 31           }
1706              
1707             static void
1708 4010           encode_sv (pTHX_ enc_t *enc, SV *sv, SV *typesv)
1709             {
1710 4010           IV type = 0;
1711 4010           int can_be_null = 0;
1712 4010           int process_ref = 0;
1713 4010           int force_conversion = 0;
1714              
1715 4010 100         SvGETMAGIC (sv);
    50          
1716              
1717 4010 100         if (UNLIKELY (!(SvOK (typesv)) && (enc->json.flags & F_REQUIRE_TYPES)))
    50          
    50          
    50          
    100          
    100          
1718 8 50         croak ("type for '%s' was not specified", SvPV_nolen (sv));
1719              
1720 4002 100         if (SvROK (sv) && !SvOBJECT (SvRV (sv)))
    100          
1721             {
1722 1320           svtype svt = SvTYPE (SvRV (sv));
1723 1320 100         if (svt == SVt_PVHV)
1724             {
1725 392           encode_hv (aTHX_ enc, (HV *)SvRV (sv), typesv);
1726 386           return;
1727             }
1728 928 100         else if (svt == SVt_PVAV)
1729             {
1730 896           encode_av (aTHX_ enc, (AV *)SvRV (sv), typesv);
1731 880           return;
1732             }
1733             }
1734              
1735 2714 50         SvGETMAGIC (typesv);
    0          
1736              
1737 2714 100         if (UNLIKELY (SvOK (typesv)))
    50          
    50          
    50          
1738             {
1739 322 100         if (!SvIOKp (typesv))
1740             {
1741 83 50         if (SvROK (typesv) &&
    50          
1742 83 50         SvOBJECT (SvRV (typesv)) &&
1743 83           SvTYPE (SvRV (typesv)) == SVt_PVAV)
1744 83           {
1745 83           HV *stash = SvSTASH (SvRV (typesv));
1746 83 50         char *name = LIKELY (!!stash) ? HvNAME (stash) : NULL;
    50          
    50          
    50          
    0          
    50          
    50          
1747 83 50         if (LIKELY (name && strEQ (name, JSON_TYPE_ANYOF_CLASS)))
    50          
1748 83           {
1749 83           AV *type_any = (AV *)SvRV (typesv);
1750 83           SV **typesv_ref = av_fetch (type_any, JSON_TYPE_ANYOF_SCALAR_INDEX, 0);
1751 83 50         if (UNLIKELY (!typesv_ref))
1752 0 0         croak ("incorrectly constructed anyof type (%s, 0x%x) was specified for '%s'",
    0          
1753 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1754 0           SvPV_nolen (sv));
1755 83           typesv = *typesv_ref;
1756 83 50         SvGETMAGIC (typesv);
    0          
1757 83 50         if (!SvIOKp (typesv))
1758 0 0         croak ("no scalar alternative in anyof was specified for '%s'", SvPV_nolen (sv));
1759             }
1760             else
1761 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1762 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1763 0           SvPV_nolen (sv));
1764             }
1765             else
1766 0 0         croak ("encountered type (%s, 0x%x) was specified for '%s'",
    0          
1767 0           SvPV_nolen (typesv), (unsigned int)SvFLAGS (typesv),
1768 0           SvPV_nolen (sv));
1769             }
1770 322           type = SvIVX (typesv);
1771             }
1772              
1773 2714 100         if (UNLIKELY (type))
1774             {
1775 320           force_conversion = 1;
1776 320           can_be_null = (type & JSON_TYPE_CAN_BE_NULL);
1777 320           type &= ~JSON_TYPE_CAN_BE_NULL;
1778             }
1779             else
1780             {
1781 2394 100         if (UNLIKELY (sv == &PL_sv_yes || sv == &PL_sv_no)) type = JSON_TYPE_BOOL;
    100          
1782 2386 100         else if (SvNOKp (sv)) type = JSON_TYPE_FLOAT;
1783 2308 100         else if (SvIOKp (sv)) type = JSON_TYPE_INT;
1784 1436 100         else if (SvPOKp (sv)) type = JSON_TYPE_STRING;
1785 122 100         else if (SvROK (sv)) process_ref = 1;
1786 42 50         else if (!SvOK (sv)) can_be_null = 1;
    50          
    50          
1787             }
1788              
1789 2714 100         if (can_be_null && !SvOK (sv))
    100          
    50          
    50          
1790 55           encode_const_str (aTHX_ enc, "null", 4, 0);
1791 2659 100         else if (type == JSON_TYPE_BOOL)
1792 107           encode_bool (aTHX_ enc, sv);
1793 2552 100         else if (type == JSON_TYPE_FLOAT)
1794             {
1795             char *savecur, *saveend;
1796 117           char inf_or_nan = 0;
1797             #ifdef NEED_NUMERIC_LOCALE_C
1798             # ifdef HAS_USELOCALE
1799             locale_t oldloc = (locale_t)0;
1800             locale_t newloc;
1801             # endif
1802             bool loc_changed = FALSE;
1803             char *locale = NULL;
1804             #endif
1805 117 100         NV nv = SvNOKp (sv) ? SvNVX (sv) : SvNV_nomg (sv);
    50          
1806             /* trust that perl will do the right thing w.r.t. JSON syntax. */
1807 117           need (aTHX_ enc, NV_DIG + 32);
1808 117           savecur = enc->cur;
1809 117           saveend = enc->end;
1810              
1811             #if defined(HAVE_ISINF) && defined(HAVE_ISNAN)
1812             /* With no stringify_infnan we can skip the conversion, returning null. */
1813             if (enc->json.infnan_mode == 0) {
1814             # if defined(USE_QUADMATH) && defined(HAVE_ISINFL) && defined(HAVE_ISNANL)
1815             if (UNLIKELY(isinfl(nv) || isnanl(nv)))
1816             # else
1817             if (UNLIKELY(isinf(nv) || isnan(nv)))
1818             # endif
1819             {
1820             goto is_inf_or_nan;
1821             }
1822             }
1823             #endif
1824             /* locale insensitive sprintf radix #96 */
1825             #ifdef NEED_NUMERIC_LOCALE_C
1826             locale = setlocale(LC_NUMERIC, NULL);
1827             if (!locale || strNE(locale, "C")) {
1828             loc_changed = TRUE;
1829             # ifdef HAS_USELOCALE
1830             /* thread-safe variant for children not changing the global state */
1831             oldloc = uselocale((locale_t)0);
1832             if (oldloc == LC_GLOBAL_LOCALE)
1833             newloc = newlocale(LC_NUMERIC_MASK, "C", (locale_t)0);
1834             else
1835             newloc = newlocale(LC_NUMERIC_MASK, "C", oldloc);
1836             uselocale(newloc);
1837             # else
1838             setlocale(LC_NUMERIC, "C");
1839             # endif
1840             }
1841             #endif
1842              
1843             #ifdef USE_QUADMATH
1844             quadmath_snprintf(enc->cur, enc->end - enc->cur, "%.*Qg", (int)NV_DIG, nv);
1845             #else
1846 117           PERL_UNUSED_RESULT(Gconvert (nv, NV_DIG, 0, enc->cur));
1847             #endif
1848              
1849             #ifdef NEED_NUMERIC_LOCALE_C
1850             if (loc_changed) {
1851             # ifdef HAS_USELOCALE
1852             (void)uselocale(oldloc);
1853             if (newloc)
1854             freelocale(newloc);
1855             # else
1856             (void)setlocale(LC_NUMERIC, locale);
1857             # endif
1858             }
1859             #endif
1860              
1861             #ifdef STR_INF4
1862             if (UNLIKELY(strEQc(enc->cur, STR_INF)
1863             || strEQc(enc->cur, STR_INF2)
1864             || strEQc(enc->cur, STR_INF3)
1865             || strEQc(enc->cur, STR_INF4)))
1866             #elif defined(STR_INF2)
1867             if (UNLIKELY(strEQc(enc->cur, STR_INF)
1868             || strEQc(enc->cur, STR_INF2)))
1869             #else
1870 117 100         if (UNLIKELY(strEQc(enc->cur, STR_INF)))
1871             #endif
1872 4           inf_or_nan = 1;
1873             #if defined(__hpux)
1874             else if (UNLIKELY(strEQc(enc->cur, STR_NEG_INF)))
1875             inf_or_nan = 2;
1876             else if (UNLIKELY(strEQc(enc->cur, STR_NEG_NAN)))
1877             inf_or_nan = 3;
1878             #endif
1879             else if
1880             #ifdef HAVE_QNAN
1881             # ifdef STR_QNAN2
1882             (UNLIKELY(strEQc(enc->cur, STR_NAN)
1883             || strEQc(enc->cur, STR_QNAN)
1884             || strEQc(enc->cur, STR_NAN2)
1885             || strEQc(enc->cur, STR_QNAN2)))
1886             # else
1887             (UNLIKELY(strEQc(enc->cur, STR_NAN)
1888             || strEQc(enc->cur, STR_QNAN)))
1889             # endif
1890             #else
1891 113 100         (UNLIKELY(strEQc(enc->cur, STR_NAN)))
1892             #endif
1893 4           inf_or_nan = 3;
1894 109 100         else if (*enc->cur == '-') {
1895             #ifdef STR_INF4
1896             if (UNLIKELY(strEQc(enc->cur+1, STR_INF)
1897             || strEQc(enc->cur+1, STR_INF2)
1898             || strEQc(enc->cur+1, STR_INF3)
1899             || strEQc(enc->cur+1, STR_INF4)))
1900             #elif defined(STR_INF2)
1901             if (UNLIKELY(strEQc(enc->cur+1, STR_INF)
1902             || strEQc(enc->cur+1, STR_INF2)))
1903             #else
1904 20 100         if (UNLIKELY(strEQc(enc->cur+1, STR_INF)))
1905             #endif
1906 4           inf_or_nan = 2;
1907             else if
1908             #ifdef HAVE_QNAN
1909             # ifdef STR_QNAN2
1910             (UNLIKELY(strEQc(enc->cur+1, STR_NAN)
1911             || strEQc(enc->cur+1, STR_QNAN)
1912             || strEQc(enc->cur+1, STR_NAN2)
1913             || strEQc(enc->cur+1, STR_QNAN2)))
1914             # else
1915             (UNLIKELY(strEQc(enc->cur+1, STR_NAN)
1916             || strEQc(enc->cur+1, STR_QNAN)))
1917             # endif
1918             #else
1919 16 100         (UNLIKELY(strEQc(enc->cur+1, STR_NAN)))
1920             #endif
1921 8           inf_or_nan = 3;
1922             }
1923 117 100         if (UNLIKELY(inf_or_nan)) {
1924             #if defined(HAVE_ISINF) && defined(HAVE_ISNAN)
1925             is_inf_or_nan:
1926             #endif
1927 20 100         if (enc->json.infnan_mode == 0) {
1928 5           strncpy(enc->cur, "null\0", 5);
1929             }
1930 15 100         else if (enc->json.infnan_mode == 1) {
1931 5           const int l = strlen(enc->cur);
1932 5           memmove(enc->cur+1, enc->cur, l);
1933 5           *enc->cur = '"';
1934 5           *(enc->cur + l+1) = '"';
1935 5           *(enc->cur + l+2) = 0;
1936             }
1937 10 100         else if (enc->json.infnan_mode == 3) {
1938 5 100         if (inf_or_nan == 1)
1939 1           strncpy(enc->cur, "\"inf\"\0", 6);
1940 4 100         else if (inf_or_nan == 2)
1941 1           strncpy(enc->cur, "\"-inf\"\0", 7);
1942 3 50         else if (inf_or_nan == 3)
1943 5           strncpy(enc->cur, "\"nan\"\0", 6);
1944             }
1945 5 50         else if (enc->json.infnan_mode != 2) {
1946 0           croak ("invalid stringify_infnan mode %c. Must be 0, 1, 2 or 3",
1947 0           enc->json.infnan_mode);
1948             }
1949             }
1950 120 100         if (!force_conversion && SvPOKp (sv) && !strEQ(enc->cur, SvPVX (sv))) {
    100          
    100          
1951 3           char *str = SvPVX (sv);
1952 3           STRLEN len = SvCUR (sv);
1953 3           enc->cur = savecur;
1954 3           enc->end = saveend;
1955 3           encode_ch (aTHX_ enc, '"');
1956 3           encode_str (aTHX_ enc, str, len, SvUTF8 (sv));
1957 3           encode_ch (aTHX_ enc, '"');
1958 3           *enc->cur = 0;
1959             }
1960             else {
1961             NV intpart;
1962 170 100         if (!( inf_or_nan || (SvNOKp(sv) && Perl_modf(SvNVX(sv), &intpart)) || (!force_conversion && SvIOK(sv))
    100          
    100          
    100          
    100          
    50          
1963 63 100         || strchr(enc->cur,'e') || strchr(enc->cur,'E')
1964             #if PERL_VERSION < 10
1965             /* !!1 with 5.8 */
1966             || (SvPOKp(sv) && strEQc(SvPVX(sv), "1")
1967             && SvNVX(sv) == 1.0) /* yes */
1968             #endif
1969             ) )
1970             {
1971 56           char *tempend = enc->cur + strlen(enc->cur);
1972 56           strncpy(tempend, ".0\0", 3);
1973             }
1974 117           enc->cur += strlen (enc->cur);
1975             }
1976             }
1977 2435 100         else if (type == JSON_TYPE_INT)
1978             {
1979             char *savecur, *saveend;
1980             /* we assume we can always read an IV as a UV and vice versa */
1981             /* we assume two's complement */
1982             /* we assume no aliasing issues in the union */
1983 986           UV uv = 0;
1984 986           IV iv = 0;
1985 986           int is_neg = 0;
1986 986 100         if (SvIOKp (sv))
1987             {
1988 915           is_neg = !SvIsUV (sv);
1989 915           iv = SvIVX (sv);
1990 915           uv = SvUVX (sv);
1991             }
1992 71 100         else if (SvPOKp (sv))
1993             {
1994 44           int numtype = grok_number (SvPVX (sv), SvCUR (sv), &uv);
1995 44 100         if (numtype & IS_NUMBER_IN_UV)
1996             {
1997 37 100         if (numtype & IS_NUMBER_NEG)
1998             {
1999 5           is_neg = 1;
2000 5 100         if (LIKELY(uv <= (UV)(IV_MAX) + 1))
2001 3           iv = -(IV)uv;
2002             else
2003 2           iv = IV_MIN; /* underflow */
2004 5           uv = (UV)iv;
2005             }
2006             else
2007 37           iv = (IV)uv;
2008             }
2009 7 100         else if (UNLIKELY (numtype & IS_NUMBER_INFINITY))
2010             {
2011 2           is_neg = (numtype & IS_NUMBER_NEG);
2012 2 100         if (is_neg)
2013             {
2014 1           iv = IV_MIN;
2015 1           uv = (UV)iv;
2016             }
2017             else
2018             {
2019 1           uv = UV_MAX;
2020 2           iv = (IV)uv;
2021             }
2022             }
2023 5 100         else if (LIKELY (!(numtype & IS_NUMBER_NAN)))
2024             {
2025 44           sv_to_ivuv (aTHX_ sv, &is_neg, &iv, &uv);
2026             }
2027             }
2028             else
2029             {
2030             #if PERL_VERSION < 8
2031             /* SvIV() and SvUV() in Perl 5.6 does not handle Inf and NaN in NV slot */
2032             # if defined(USE_QUADMATH) && defined(HAVE_ISINFL) && defined(HAVE_ISNANL)
2033             if (SvNOKp (sv) && UNLIKELY (isinfl (SvNVX (sv))))
2034             # else
2035             if (SvNOKp (sv) && UNLIKELY (isinf (SvNVX (sv))))
2036             # endif
2037             {
2038             if (SvNVX (sv) < 0)
2039             {
2040             is_neg = 1;
2041             iv = IV_MIN;
2042             uv = (UV)iv;
2043             }
2044             else
2045             {
2046             uv = UV_MAX;
2047             iv = (IV)uv;
2048             }
2049             }
2050             # if defined(USE_QUADMATH) && defined(HAVE_ISINFL) && defined(HAVE_ISNANL)
2051             else if (!SvNOKp (sv) || LIKELY (!isnanl (SvNVX (sv))))
2052             # else
2053             else if (!SvNOKp (sv) || LIKELY (!isnan (SvNVX (sv))))
2054             # endif
2055             #endif
2056 27           sv_to_ivuv (aTHX_ sv, &is_neg, &iv, &uv);
2057             }
2058 986 100         if (is_neg ? iv <= 59000 && iv >= -59000
    100          
    100          
    100          
2059             : uv <= 59000)
2060             {
2061             /* optimise the "small number case" */
2062             /* code will likely be branchless and use only a single multiplication */
2063             /* works for numbers up to 59074 */
2064 957           I32 i = iv;
2065             U32 u;
2066 957           char digit, nz = 0;
2067              
2068 957           need (aTHX_ enc, 6);
2069 957           savecur = enc->cur;
2070 957           saveend = enc->end;
2071              
2072 957 100         *enc->cur = '-'; enc->cur += i < 0 ? 1 : 0;
2073 957           u = i < 0 ? -i : i;
2074              
2075             /* convert to 4.28 fixed-point representation */
2076 957           u = u * ((0xfffffff + 10000) / 10000); /* 10**5, 5 fractional digits */
2077              
2078             /* now output digit by digit, each time masking out the integer part */
2079             /* and multiplying by 5 while moving the decimal point one to the right, */
2080             /* resulting in a net multiplication by 10. */
2081             /* we always write the digit to memory but conditionally increment */
2082             /* the pointer, to enable the use of conditional move instructions. */
2083 957 50         digit = u >> 28; *enc->cur = digit + '0'; enc->cur += (nz = nz || digit); u = (u & 0xfffffffUL) * 5;
    100          
2084 957 100         digit = u >> 27; *enc->cur = digit + '0'; enc->cur += (nz = nz || digit); u = (u & 0x7ffffffUL) * 5;
    100          
2085 957 100         digit = u >> 26; *enc->cur = digit + '0'; enc->cur += (nz = nz || digit); u = (u & 0x3ffffffUL) * 5;
    100          
2086 957 100         digit = u >> 25; *enc->cur = digit + '0'; enc->cur += (nz = nz || digit); u = (u & 0x1ffffffUL) * 5;
    100          
2087 957           digit = u >> 24; *enc->cur = digit + '0'; enc->cur += 1; /* correctly generate '0' */
2088 957           *enc->cur = 0;
2089             }
2090             else
2091             {
2092             /* large integer, use the (rather slow) snprintf way. */
2093 29           need (aTHX_ enc, IVUV_MAXCHARS);
2094 29           savecur = enc->cur;
2095 29           saveend = enc->end;
2096 29           enc->cur +=
2097 29           !is_neg
2098 16           ? snprintf (enc->cur, IVUV_MAXCHARS, "%" UVuf, uv)
2099 29 100         : snprintf (enc->cur, IVUV_MAXCHARS, "%" IVdf, iv);
2100             }
2101              
2102 986 100         if (!force_conversion && SvPOKp (sv) && !strEQ(savecur, SvPVX (sv))) {
    100          
    100          
2103 1           char *str = SvPVX (sv);
2104 1           STRLEN len = SvCUR (sv);
2105 1           enc->cur = savecur;
2106 1           enc->end = saveend;
2107 1           encode_ch (aTHX_ enc, '"');
2108 1           encode_str (aTHX_ enc, str, len, SvUTF8 (sv));
2109 1           encode_ch (aTHX_ enc, '"');
2110 986           *enc->cur = 0;
2111             }
2112             }
2113 1449 100         else if (type == JSON_TYPE_STRING)
2114             {
2115 1369 50         if (UNLIKELY (sv == &PL_sv_yes))
2116             {
2117 0           encode_ch (aTHX_ enc, '"');
2118 0           encode_const_str (aTHX_ enc, "true", 4, 0);
2119 0           encode_ch (aTHX_ enc, '"');
2120             }
2121 1369 50         else if (UNLIKELY (sv == &PL_sv_no))
2122             {
2123 0           encode_ch (aTHX_ enc, '"');
2124 0           encode_const_str (aTHX_ enc, "false", 5, 0);
2125 0           encode_ch (aTHX_ enc, '"');
2126             }
2127 1369 100         else if (!UNLIKELY (SvROK(sv) && SvOBJECT (SvRV(sv))) || !encode_bool_obj (aTHX_ enc, SvRV(sv), 0, 1))
    50          
    50          
2128             {
2129             char *str;
2130             STRLEN len;
2131 1366 100         if (SvPOKp (sv))
2132             {
2133 1351           str = SvPVX (sv);
2134 1351           len = SvCUR (sv);
2135             }
2136             else
2137             {
2138 15 50         str = SvPV_nomg (sv, len);
2139             }
2140 1366           encode_ch (aTHX_ enc, '"');
2141 1366           encode_str (aTHX_ enc, str, len, SvUTF8 (sv));
2142 1369           encode_ch (aTHX_ enc, '"');
2143             }
2144             }
2145 80 50         else if (process_ref)
2146 80           encode_rv (aTHX_ enc, sv);
2147 0 0         else if (enc->json.flags & F_ALLOW_UNKNOWN)
2148 0           encode_const_str (aTHX_ enc, "null", 4, 0);
2149             else
2150 0 0         croak ("encountered perl type (%s,0x%x) that JSON cannot handle, check your input data",
2151 0           SvPV_nolen (sv), (unsigned int)SvFLAGS (sv));
2152             }
2153              
2154             static SV *
2155 1277           encode_json (pTHX_ SV *scalar, JSON *json, SV *typesv)
2156             {
2157             enc_t enc;
2158              
2159 1277 100         if (!(json->flags & F_ALLOW_NONREF) && json_nonref (aTHX_ scalar))
    50          
2160 0           croak ("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)");
2161              
2162 1277           enc.json = *json;
2163 1277           enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
2164 1277           enc.cur = SvPVX (enc.sv);
2165 1277           enc.end = SvEND (enc.sv);
2166 1277           enc.indent = 0;
2167 2554           enc.limit = enc.json.flags & F_ASCII ? 0x000080UL
2168 2442 100         : enc.json.flags & F_BINARY ? 0x000080UL
2169 2127 100         : enc.json.flags & F_LATIN1 ? 0x000100UL
2170 962 100         : 0x110000UL;
2171              
2172 1277           SvPOK_only (enc.sv);
2173 1277           encode_sv (aTHX_ &enc, scalar, typesv);
2174 1249           encode_nl (aTHX_ &enc);
2175              
2176 1249           SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
2177 1249           *SvEND (enc.sv) = 0; /* many xs functions expect a trailing 0 for text strings */
2178              
2179 1249 100         if (!(enc.json.flags & (F_ASCII | F_LATIN1 | F_BINARY | F_UTF8)))
2180 600           SvUTF8_on (enc.sv);
2181              
2182 1249 100         if (enc.json.flags & F_SHRINK)
2183 200           shrink (aTHX_ enc.sv);
2184              
2185 1249           return enc.sv;
2186             }
2187              
2188             /*/////////////////////////////////////////////////////////////////////////// */
2189             /* decoder */
2190              
2191             /* structure used for decoding JSON */
2192             typedef struct
2193             {
2194             char *cur; /* current parser pointer */
2195             char *end; /* end of input string */
2196             const char *err; /* parse error, if != 0 */
2197             JSON json;
2198             U32 depth; /* recursion depth */
2199             U32 maxdepth; /* recursion depth limit */
2200             } dec_t;
2201              
2202             INLINE void
2203 9           decode_comment (dec_t *dec)
2204             {
2205             /* only '#'-style comments allowed a.t.m. */
2206              
2207 47 50         while (*dec->cur && *dec->cur != 0x0a && *dec->cur != 0x0d)
    100          
    50          
2208 38           ++dec->cur;
2209 9           }
2210              
2211             INLINE void
2212 27790           decode_ws (dec_t *dec)
2213             {
2214             for (;;)
2215             {
2216 63893           char ch = *dec->cur;
2217              
2218 63893 100         if (ch > 0x20)
2219             {
2220 26940 100         if (UNLIKELY(ch == '#'))
2221             {
2222 11 100         if (dec->json.flags & F_RELAXED)
2223 9           decode_comment (dec);
2224             else
2225 2           break;
2226             }
2227             else
2228 26929           break;
2229             }
2230 36953 100         else if (ch != 0x20 && ch != 0x0a && ch != 0x0d && ch != 0x09)
    100          
    50          
    100          
2231 859           break; /* parse error, but let higher level handle it, gives better error messages */
2232              
2233 36103           ++dec->cur;
2234 36103           }
2235 27790           }
2236              
2237             #define ERR(reason) SB dec->err = reason; goto fail; SE
2238              
2239             #define EXPECT_CH(ch) SB \
2240             if (*dec->cur != ch) \
2241             ERR (# ch " expected"); \
2242             ++dec->cur; \
2243             SE
2244              
2245             #define DEC_INC_DEPTH if (++dec->depth > dec->json.max_depth) ERR (ERR_NESTING_EXCEEDED)
2246             #define DEC_DEC_DEPTH --dec->depth
2247              
2248             static SV *decode_sv (pTHX_ dec_t *dec, SV *typesv);
2249              
2250             /* #regen code
2251             my $i;
2252             for ($i = 0; $i < 256; ++$i){
2253             print
2254             " $i >= '0' && $i <= '9' ? $i - '0' : $i >= 'a' && $i <= 'f' ? $i - 'a' + 10
2255             : $i >= 'A' && $i <= 'F' ? $i - 'A' + 10 : -1 ,
2256             ";
2257             }
2258             */
2259             static const signed char decode_hexdigit[256] = {
2260             0 >= '0' && 0 <= '9' ? 0 - '0' : 0 >= 'a' && 0 <= 'f' ? 0 - 'a' + 10
2261             : 0 >= 'A' && 0 <= 'F' ? 0 - 'A' + 10 : -1 ,
2262             1 >= '0' && 1 <= '9' ? 1 - '0' : 1 >= 'a' && 1 <= 'f' ? 1 - 'a' + 10
2263             : 1 >= 'A' && 1 <= 'F' ? 1 - 'A' + 10 : -1 ,
2264             2 >= '0' && 2 <= '9' ? 2 - '0' : 2 >= 'a' && 2 <= 'f' ? 2 - 'a' + 10
2265             : 2 >= 'A' && 2 <= 'F' ? 2 - 'A' + 10 : -1 ,
2266             3 >= '0' && 3 <= '9' ? 3 - '0' : 3 >= 'a' && 3 <= 'f' ? 3 - 'a' + 10
2267             : 3 >= 'A' && 3 <= 'F' ? 3 - 'A' + 10 : -1 ,
2268             4 >= '0' && 4 <= '9' ? 4 - '0' : 4 >= 'a' && 4 <= 'f' ? 4 - 'a' + 10
2269             : 4 >= 'A' && 4 <= 'F' ? 4 - 'A' + 10 : -1 ,
2270             5 >= '0' && 5 <= '9' ? 5 - '0' : 5 >= 'a' && 5 <= 'f' ? 5 - 'a' + 10
2271             : 5 >= 'A' && 5 <= 'F' ? 5 - 'A' + 10 : -1 ,
2272             6 >= '0' && 6 <= '9' ? 6 - '0' : 6 >= 'a' && 6 <= 'f' ? 6 - 'a' + 10
2273             : 6 >= 'A' && 6 <= 'F' ? 6 - 'A' + 10 : -1 ,
2274             7 >= '0' && 7 <= '9' ? 7 - '0' : 7 >= 'a' && 7 <= 'f' ? 7 - 'a' + 10
2275             : 7 >= 'A' && 7 <= 'F' ? 7 - 'A' + 10 : -1 ,
2276             8 >= '0' && 8 <= '9' ? 8 - '0' : 8 >= 'a' && 8 <= 'f' ? 8 - 'a' + 10
2277             : 8 >= 'A' && 8 <= 'F' ? 8 - 'A' + 10 : -1 ,
2278             9 >= '0' && 9 <= '9' ? 9 - '0' : 9 >= 'a' && 9 <= 'f' ? 9 - 'a' + 10
2279             : 9 >= 'A' && 9 <= 'F' ? 9 - 'A' + 10 : -1 ,
2280             10 >= '0' && 10 <= '9' ? 10 - '0' : 10 >= 'a' && 10 <= 'f' ? 10 - 'a' + 10
2281             : 10 >= 'A' && 10 <= 'F' ? 10 - 'A' + 10 : -1 ,
2282             11 >= '0' && 11 <= '9' ? 11 - '0' : 11 >= 'a' && 11 <= 'f' ? 11 - 'a' + 10
2283             : 11 >= 'A' && 11 <= 'F' ? 11 - 'A' + 10 : -1 ,
2284             12 >= '0' && 12 <= '9' ? 12 - '0' : 12 >= 'a' && 12 <= 'f' ? 12 - 'a' + 10
2285             : 12 >= 'A' && 12 <= 'F' ? 12 - 'A' + 10 : -1 ,
2286             13 >= '0' && 13 <= '9' ? 13 - '0' : 13 >= 'a' && 13 <= 'f' ? 13 - 'a' + 10
2287             : 13 >= 'A' && 13 <= 'F' ? 13 - 'A' + 10 : -1 ,
2288             14 >= '0' && 14 <= '9' ? 14 - '0' : 14 >= 'a' && 14 <= 'f' ? 14 - 'a' + 10
2289             : 14 >= 'A' && 14 <= 'F' ? 14 - 'A' + 10 : -1 ,
2290             15 >= '0' && 15 <= '9' ? 15 - '0' : 15 >= 'a' && 15 <= 'f' ? 15 - 'a' + 10
2291             : 15 >= 'A' && 15 <= 'F' ? 15 - 'A' + 10 : -1 ,
2292             16 >= '0' && 16 <= '9' ? 16 - '0' : 16 >= 'a' && 16 <= 'f' ? 16 - 'a' + 10
2293             : 16 >= 'A' && 16 <= 'F' ? 16 - 'A' + 10 : -1 ,
2294             17 >= '0' && 17 <= '9' ? 17 - '0' : 17 >= 'a' && 17 <= 'f' ? 17 - 'a' + 10
2295             : 17 >= 'A' && 17 <= 'F' ? 17 - 'A' + 10 : -1 ,
2296             18 >= '0' && 18 <= '9' ? 18 - '0' : 18 >= 'a' && 18 <= 'f' ? 18 - 'a' + 10
2297             : 18 >= 'A' && 18 <= 'F' ? 18 - 'A' + 10 : -1 ,
2298             19 >= '0' && 19 <= '9' ? 19 - '0' : 19 >= 'a' && 19 <= 'f' ? 19 - 'a' + 10
2299             : 19 >= 'A' && 19 <= 'F' ? 19 - 'A' + 10 : -1 ,
2300             20 >= '0' && 20 <= '9' ? 20 - '0' : 20 >= 'a' && 20 <= 'f' ? 20 - 'a' + 10
2301             : 20 >= 'A' && 20 <= 'F' ? 20 - 'A' + 10 : -1 ,
2302             21 >= '0' && 21 <= '9' ? 21 - '0' : 21 >= 'a' && 21 <= 'f' ? 21 - 'a' + 10
2303             : 21 >= 'A' && 21 <= 'F' ? 21 - 'A' + 10 : -1 ,
2304             22 >= '0' && 22 <= '9' ? 22 - '0' : 22 >= 'a' && 22 <= 'f' ? 22 - 'a' + 10
2305             : 22 >= 'A' && 22 <= 'F' ? 22 - 'A' + 10 : -1 ,
2306             23 >= '0' && 23 <= '9' ? 23 - '0' : 23 >= 'a' && 23 <= 'f' ? 23 - 'a' + 10
2307             : 23 >= 'A' && 23 <= 'F' ? 23 - 'A' + 10 : -1 ,
2308             24 >= '0' && 24 <= '9' ? 24 - '0' : 24 >= 'a' && 24 <= 'f' ? 24 - 'a' + 10
2309             : 24 >= 'A' && 24 <= 'F' ? 24 - 'A' + 10 : -1 ,
2310             25 >= '0' && 25 <= '9' ? 25 - '0' : 25 >= 'a' && 25 <= 'f' ? 25 - 'a' + 10
2311             : 25 >= 'A' && 25 <= 'F' ? 25 - 'A' + 10 : -1 ,
2312             26 >= '0' && 26 <= '9' ? 26 - '0' : 26 >= 'a' && 26 <= 'f' ? 26 - 'a' + 10
2313             : 26 >= 'A' && 26 <= 'F' ? 26 - 'A' + 10 : -1 ,
2314             27 >= '0' && 27 <= '9' ? 27 - '0' : 27 >= 'a' && 27 <= 'f' ? 27 - 'a' + 10
2315             : 27 >= 'A' && 27 <= 'F' ? 27 - 'A' + 10 : -1 ,
2316             28 >= '0' && 28 <= '9' ? 28 - '0' : 28 >= 'a' && 28 <= 'f' ? 28 - 'a' + 10
2317             : 28 >= 'A' && 28 <= 'F' ? 28 - 'A' + 10 : -1 ,
2318             29 >= '0' && 29 <= '9' ? 29 - '0' : 29 >= 'a' && 29 <= 'f' ? 29 - 'a' + 10
2319             : 29 >= 'A' && 29 <= 'F' ? 29 - 'A' + 10 : -1 ,
2320             30 >= '0' && 30 <= '9' ? 30 - '0' : 30 >= 'a' && 30 <= 'f' ? 30 - 'a' + 10
2321             : 30 >= 'A' && 30 <= 'F' ? 30 - 'A' + 10 : -1 ,
2322             31 >= '0' && 31 <= '9' ? 31 - '0' : 31 >= 'a' && 31 <= 'f' ? 31 - 'a' + 10
2323             : 31 >= 'A' && 31 <= 'F' ? 31 - 'A' + 10 : -1 ,
2324             32 >= '0' && 32 <= '9' ? 32 - '0' : 32 >= 'a' && 32 <= 'f' ? 32 - 'a' + 10
2325             : 32 >= 'A' && 32 <= 'F' ? 32 - 'A' + 10 : -1 ,
2326             33 >= '0' && 33 <= '9' ? 33 - '0' : 33 >= 'a' && 33 <= 'f' ? 33 - 'a' + 10
2327             : 33 >= 'A' && 33 <= 'F' ? 33 - 'A' + 10 : -1 ,
2328             34 >= '0' && 34 <= '9' ? 34 - '0' : 34 >= 'a' && 34 <= 'f' ? 34 - 'a' + 10
2329             : 34 >= 'A' && 34 <= 'F' ? 34 - 'A' + 10 : -1 ,
2330             35 >= '0' && 35 <= '9' ? 35 - '0' : 35 >= 'a' && 35 <= 'f' ? 35 - 'a' + 10
2331             : 35 >= 'A' && 35 <= 'F' ? 35 - 'A' + 10 : -1 ,
2332             36 >= '0' && 36 <= '9' ? 36 - '0' : 36 >= 'a' && 36 <= 'f' ? 36 - 'a' + 10
2333             : 36 >= 'A' && 36 <= 'F' ? 36 - 'A' + 10 : -1 ,
2334             37 >= '0' && 37 <= '9' ? 37 - '0' : 37 >= 'a' && 37 <= 'f' ? 37 - 'a' + 10
2335             : 37 >= 'A' && 37 <= 'F' ? 37 - 'A' + 10 : -1 ,
2336             38 >= '0' && 38 <= '9' ? 38 - '0' : 38 >= 'a' && 38 <= 'f' ? 38 - 'a' + 10
2337             : 38 >= 'A' && 38 <= 'F' ? 38 - 'A' + 10 : -1 ,
2338             39 >= '0' && 39 <= '9' ? 39 - '0' : 39 >= 'a' && 39 <= 'f' ? 39 - 'a' + 10
2339             : 39 >= 'A' && 39 <= 'F' ? 39 - 'A' + 10 : -1 ,
2340             40 >= '0' && 40 <= '9' ? 40 - '0' : 40 >= 'a' && 40 <= 'f' ? 40 - 'a' + 10
2341             : 40 >= 'A' && 40 <= 'F' ? 40 - 'A' + 10 : -1 ,
2342             41 >= '0' && 41 <= '9' ? 41 - '0' : 41 >= 'a' && 41 <= 'f' ? 41 - 'a' + 10
2343             : 41 >= 'A' && 41 <= 'F' ? 41 - 'A' + 10 : -1 ,
2344             42 >= '0' && 42 <= '9' ? 42 - '0' : 42 >= 'a' && 42 <= 'f' ? 42 - 'a' + 10
2345             : 42 >= 'A' && 42 <= 'F' ? 42 - 'A' + 10 : -1 ,
2346             43 >= '0' && 43 <= '9' ? 43 - '0' : 43 >= 'a' && 43 <= 'f' ? 43 - 'a' + 10
2347             : 43 >= 'A' && 43 <= 'F' ? 43 - 'A' + 10 : -1 ,
2348             44 >= '0' && 44 <= '9' ? 44 - '0' : 44 >= 'a' && 44 <= 'f' ? 44 - 'a' + 10
2349             : 44 >= 'A' && 44 <= 'F' ? 44 - 'A' + 10 : -1 ,
2350             45 >= '0' && 45 <= '9' ? 45 - '0' : 45 >= 'a' && 45 <= 'f' ? 45 - 'a' + 10
2351             : 45 >= 'A' && 45 <= 'F' ? 45 - 'A' + 10 : -1 ,
2352             46 >= '0' && 46 <= '9' ? 46 - '0' : 46 >= 'a' && 46 <= 'f' ? 46 - 'a' + 10
2353             : 46 >= 'A' && 46 <= 'F' ? 46 - 'A' + 10 : -1 ,
2354             47 >= '0' && 47 <= '9' ? 47 - '0' : 47 >= 'a' && 47 <= 'f' ? 47 - 'a' + 10
2355             : 47 >= 'A' && 47 <= 'F' ? 47 - 'A' + 10 : -1 ,
2356             48 >= '0' && 48 <= '9' ? 48 - '0' : 48 >= 'a' && 48 <= 'f' ? 48 - 'a' + 10
2357             : 48 >= 'A' && 48 <= 'F' ? 48 - 'A' + 10 : -1 ,
2358             49 >= '0' && 49 <= '9' ? 49 - '0' : 49 >= 'a' && 49 <= 'f' ? 49 - 'a' + 10
2359             : 49 >= 'A' && 49 <= 'F' ? 49 - 'A' + 10 : -1 ,
2360             50 >= '0' && 50 <= '9' ? 50 - '0' : 50 >= 'a' && 50 <= 'f' ? 50 - 'a' + 10
2361             : 50 >= 'A' && 50 <= 'F' ? 50 - 'A' + 10 : -1 ,
2362             51 >= '0' && 51 <= '9' ? 51 - '0' : 51 >= 'a' && 51 <= 'f' ? 51 - 'a' + 10
2363             : 51 >= 'A' && 51 <= 'F' ? 51 - 'A' + 10 : -1 ,
2364             52 >= '0' && 52 <= '9' ? 52 - '0' : 52 >= 'a' && 52 <= 'f' ? 52 - 'a' + 10
2365             : 52 >= 'A' && 52 <= 'F' ? 52 - 'A' + 10 : -1 ,
2366             53 >= '0' && 53 <= '9' ? 53 - '0' : 53 >= 'a' && 53 <= 'f' ? 53 - 'a' + 10
2367             : 53 >= 'A' && 53 <= 'F' ? 53 - 'A' + 10 : -1 ,
2368             54 >= '0' && 54 <= '9' ? 54 - '0' : 54 >= 'a' && 54 <= 'f' ? 54 - 'a' + 10
2369             : 54 >= 'A' && 54 <= 'F' ? 54 - 'A' + 10 : -1 ,
2370             55 >= '0' && 55 <= '9' ? 55 - '0' : 55 >= 'a' && 55 <= 'f' ? 55 - 'a' + 10
2371             : 55 >= 'A' && 55 <= 'F' ? 55 - 'A' + 10 : -1 ,
2372             56 >= '0' && 56 <= '9' ? 56 - '0' : 56 >= 'a' && 56 <= 'f' ? 56 - 'a' + 10
2373             : 56 >= 'A' && 56 <= 'F' ? 56 - 'A' + 10 : -1 ,
2374             57 >= '0' && 57 <= '9' ? 57 - '0' : 57 >= 'a' && 57 <= 'f' ? 57 - 'a' + 10
2375             : 57 >= 'A' && 57 <= 'F' ? 57 - 'A' + 10 : -1 ,
2376             58 >= '0' && 58 <= '9' ? 58 - '0' : 58 >= 'a' && 58 <= 'f' ? 58 - 'a' + 10
2377             : 58 >= 'A' && 58 <= 'F' ? 58 - 'A' + 10 : -1 ,
2378             59 >= '0' && 59 <= '9' ? 59 - '0' : 59 >= 'a' && 59 <= 'f' ? 59 - 'a' + 10
2379             : 59 >= 'A' && 59 <= 'F' ? 59 - 'A' + 10 : -1 ,
2380             60 >= '0' && 60 <= '9' ? 60 - '0' : 60 >= 'a' && 60 <= 'f' ? 60 - 'a' + 10
2381             : 60 >= 'A' && 60 <= 'F' ? 60 - 'A' + 10 : -1 ,
2382             61 >= '0' && 61 <= '9' ? 61 - '0' : 61 >= 'a' && 61 <= 'f' ? 61 - 'a' + 10
2383             : 61 >= 'A' && 61 <= 'F' ? 61 - 'A' + 10 : -1 ,
2384             62 >= '0' && 62 <= '9' ? 62 - '0' : 62 >= 'a' && 62 <= 'f' ? 62 - 'a' + 10
2385             : 62 >= 'A' && 62 <= 'F' ? 62 - 'A' + 10 : -1 ,
2386             63 >= '0' && 63 <= '9' ? 63 - '0' : 63 >= 'a' && 63 <= 'f' ? 63 - 'a' + 10
2387             : 63 >= 'A' && 63 <= 'F' ? 63 - 'A' + 10 : -1 ,
2388             64 >= '0' && 64 <= '9' ? 64 - '0' : 64 >= 'a' && 64 <= 'f' ? 64 - 'a' + 10
2389             : 64 >= 'A' && 64 <= 'F' ? 64 - 'A' + 10 : -1 ,
2390             65 >= '0' && 65 <= '9' ? 65 - '0' : 65 >= 'a' && 65 <= 'f' ? 65 - 'a' + 10
2391             : 65 >= 'A' && 65 <= 'F' ? 65 - 'A' + 10 : -1 ,
2392             66 >= '0' && 66 <= '9' ? 66 - '0' : 66 >= 'a' && 66 <= 'f' ? 66 - 'a' + 10
2393             : 66 >= 'A' && 66 <= 'F' ? 66 - 'A' + 10 : -1 ,
2394             67 >= '0' && 67 <= '9' ? 67 - '0' : 67 >= 'a' && 67 <= 'f' ? 67 - 'a' + 10
2395             : 67 >= 'A' && 67 <= 'F' ? 67 - 'A' + 10 : -1 ,
2396             68 >= '0' && 68 <= '9' ? 68 - '0' : 68 >= 'a' && 68 <= 'f' ? 68 - 'a' + 10
2397             : 68 >= 'A' && 68 <= 'F' ? 68 - 'A' + 10 : -1 ,
2398             69 >= '0' && 69 <= '9' ? 69 - '0' : 69 >= 'a' && 69 <= 'f' ? 69 - 'a' + 10
2399             : 69 >= 'A' && 69 <= 'F' ? 69 - 'A' + 10 : -1 ,
2400             70 >= '0' && 70 <= '9' ? 70 - '0' : 70 >= 'a' && 70 <= 'f' ? 70 - 'a' + 10
2401             : 70 >= 'A' && 70 <= 'F' ? 70 - 'A' + 10 : -1 ,
2402             71 >= '0' && 71 <= '9' ? 71 - '0' : 71 >= 'a' && 71 <= 'f' ? 71 - 'a' + 10
2403             : 71 >= 'A' && 71 <= 'F' ? 71 - 'A' + 10 : -1 ,
2404             72 >= '0' && 72 <= '9' ? 72 - '0' : 72 >= 'a' && 72 <= 'f' ? 72 - 'a' + 10
2405             : 72 >= 'A' && 72 <= 'F' ? 72 - 'A' + 10 : -1 ,
2406             73 >= '0' && 73 <= '9' ? 73 - '0' : 73 >= 'a' && 73 <= 'f' ? 73 - 'a' + 10
2407             : 73 >= 'A' && 73 <= 'F' ? 73 - 'A' + 10 : -1 ,
2408             74 >= '0' && 74 <= '9' ? 74 - '0' : 74 >= 'a' && 74 <= 'f' ? 74 - 'a' + 10
2409             : 74 >= 'A' && 74 <= 'F' ? 74 - 'A' + 10 : -1 ,
2410             75 >= '0' && 75 <= '9' ? 75 - '0' : 75 >= 'a' && 75 <= 'f' ? 75 - 'a' + 10
2411             : 75 >= 'A' && 75 <= 'F' ? 75 - 'A' + 10 : -1 ,
2412             76 >= '0' && 76 <= '9' ? 76 - '0' : 76 >= 'a' && 76 <= 'f' ? 76 - 'a' + 10
2413             : 76 >= 'A' && 76 <= 'F' ? 76 - 'A' + 10 : -1 ,
2414             77 >= '0' && 77 <= '9' ? 77 - '0' : 77 >= 'a' && 77 <= 'f' ? 77 - 'a' + 10
2415             : 77 >= 'A' && 77 <= 'F' ? 77 - 'A' + 10 : -1 ,
2416             78 >= '0' && 78 <= '9' ? 78 - '0' : 78 >= 'a' && 78 <= 'f' ? 78 - 'a' + 10
2417             : 78 >= 'A' && 78 <= 'F' ? 78 - 'A' + 10 : -1 ,
2418             79 >= '0' && 79 <= '9' ? 79 - '0' : 79 >= 'a' && 79 <= 'f' ? 79 - 'a' + 10
2419             : 79 >= 'A' && 79 <= 'F' ? 79 - 'A' + 10 : -1 ,
2420             80 >= '0' && 80 <= '9' ? 80 - '0' : 80 >= 'a' && 80 <= 'f' ? 80 - 'a' + 10
2421             : 80 >= 'A' && 80 <= 'F' ? 80 - 'A' + 10 : -1 ,
2422             81 >= '0' && 81 <= '9' ? 81 - '0' : 81 >= 'a' && 81 <= 'f' ? 81 - 'a' + 10
2423             : 81 >= 'A' && 81 <= 'F' ? 81 - 'A' + 10 : -1 ,
2424             82 >= '0' && 82 <= '9' ? 82 - '0' : 82 >= 'a' && 82 <= 'f' ? 82 - 'a' + 10
2425             : 82 >= 'A' && 82 <= 'F' ? 82 - 'A' + 10 : -1 ,
2426             83 >= '0' && 83 <= '9' ? 83 - '0' : 83 >= 'a' && 83 <= 'f' ? 83 - 'a' + 10
2427             : 83 >= 'A' && 83 <= 'F' ? 83 - 'A' + 10 : -1 ,
2428             84 >= '0' && 84 <= '9' ? 84 - '0' : 84 >= 'a' && 84 <= 'f' ? 84 - 'a' + 10
2429             : 84 >= 'A' && 84 <= 'F' ? 84 - 'A' + 10 : -1 ,
2430             85 >= '0' && 85 <= '9' ? 85 - '0' : 85 >= 'a' && 85 <= 'f' ? 85 - 'a' + 10
2431             : 85 >= 'A' && 85 <= 'F' ? 85 - 'A' + 10 : -1 ,
2432             86 >= '0' && 86 <= '9' ? 86 - '0' : 86 >= 'a' && 86 <= 'f' ? 86 - 'a' + 10
2433             : 86 >= 'A' && 86 <= 'F' ? 86 - 'A' + 10 : -1 ,
2434             87 >= '0' && 87 <= '9' ? 87 - '0' : 87 >= 'a' && 87 <= 'f' ? 87 - 'a' + 10
2435             : 87 >= 'A' && 87 <= 'F' ? 87 - 'A' + 10 : -1 ,
2436             88 >= '0' && 88 <= '9' ? 88 - '0' : 88 >= 'a' && 88 <= 'f' ? 88 - 'a' + 10
2437             : 88 >= 'A' && 88 <= 'F' ? 88 - 'A' + 10 : -1 ,
2438             89 >= '0' && 89 <= '9' ? 89 - '0' : 89 >= 'a' && 89 <= 'f' ? 89 - 'a' + 10
2439             : 89 >= 'A' && 89 <= 'F' ? 89 - 'A' + 10 : -1 ,
2440             90 >= '0' && 90 <= '9' ? 90 - '0' : 90 >= 'a' && 90 <= 'f' ? 90 - 'a' + 10
2441             : 90 >= 'A' && 90 <= 'F' ? 90 - 'A' + 10 : -1 ,
2442             91 >= '0' && 91 <= '9' ? 91 - '0' : 91 >= 'a' && 91 <= 'f' ? 91 - 'a' + 10
2443             : 91 >= 'A' && 91 <= 'F' ? 91 - 'A' + 10 : -1 ,
2444             92 >= '0' && 92 <= '9' ? 92 - '0' : 92 >= 'a' && 92 <= 'f' ? 92 - 'a' + 10
2445             : 92 >= 'A' && 92 <= 'F' ? 92 - 'A' + 10 : -1 ,
2446             93 >= '0' && 93 <= '9' ? 93 - '0' : 93 >= 'a' && 93 <= 'f' ? 93 - 'a' + 10
2447             : 93 >= 'A' && 93 <= 'F' ? 93 - 'A' + 10 : -1 ,
2448             94 >= '0' && 94 <= '9' ? 94 - '0' : 94 >= 'a' && 94 <= 'f' ? 94 - 'a' + 10
2449             : 94 >= 'A' && 94 <= 'F' ? 94 - 'A' + 10 : -1 ,
2450             95 >= '0' && 95 <= '9' ? 95 - '0' : 95 >= 'a' && 95 <= 'f' ? 95 - 'a' + 10
2451             : 95 >= 'A' && 95 <= 'F' ? 95 - 'A' + 10 : -1 ,
2452             96 >= '0' && 96 <= '9' ? 96 - '0' : 96 >= 'a' && 96 <= 'f' ? 96 - 'a' + 10
2453             : 96 >= 'A' && 96 <= 'F' ? 96 - 'A' + 10 : -1 ,
2454             97 >= '0' && 97 <= '9' ? 97 - '0' : 97 >= 'a' && 97 <= 'f' ? 97 - 'a' + 10
2455             : 97 >= 'A' && 97 <= 'F' ? 97 - 'A' + 10 : -1 ,
2456             98 >= '0' && 98 <= '9' ? 98 - '0' : 98 >= 'a' && 98 <= 'f' ? 98 - 'a' + 10
2457             : 98 >= 'A' && 98 <= 'F' ? 98 - 'A' + 10 : -1 ,
2458             99 >= '0' && 99 <= '9' ? 99 - '0' : 99 >= 'a' && 99 <= 'f' ? 99 - 'a' + 10
2459             : 99 >= 'A' && 99 <= 'F' ? 99 - 'A' + 10 : -1 ,
2460             100 >= '0' && 100 <= '9' ? 100 - '0' : 100 >= 'a' && 100 <= 'f' ? 100 - 'a' + 10
2461             : 100 >= 'A' && 100 <= 'F' ? 100 - 'A' + 10 : -1 ,
2462             101 >= '0' && 101 <= '9' ? 101 - '0' : 101 >= 'a' && 101 <= 'f' ? 101 - 'a' + 10
2463             : 101 >= 'A' && 101 <= 'F' ? 101 - 'A' + 10 : -1 ,
2464             102 >= '0' && 102 <= '9' ? 102 - '0' : 102 >= 'a' && 102 <= 'f' ? 102 - 'a' + 10
2465             : 102 >= 'A' && 102 <= 'F' ? 102 - 'A' + 10 : -1 ,
2466             103 >= '0' && 103 <= '9' ? 103 - '0' : 103 >= 'a' && 103 <= 'f' ? 103 - 'a' + 10
2467             : 103 >= 'A' && 103 <= 'F' ? 103 - 'A' + 10 : -1 ,
2468             104 >= '0' && 104 <= '9' ? 104 - '0' : 104 >= 'a' && 104 <= 'f' ? 104 - 'a' + 10
2469             : 104 >= 'A' && 104 <= 'F' ? 104 - 'A' + 10 : -1 ,
2470             105 >= '0' && 105 <= '9' ? 105 - '0' : 105 >= 'a' && 105 <= 'f' ? 105 - 'a' + 10
2471             : 105 >= 'A' && 105 <= 'F' ? 105 - 'A' + 10 : -1 ,
2472             106 >= '0' && 106 <= '9' ? 106 - '0' : 106 >= 'a' && 106 <= 'f' ? 106 - 'a' + 10
2473             : 106 >= 'A' && 106 <= 'F' ? 106 - 'A' + 10 : -1 ,
2474             107 >= '0' && 107 <= '9' ? 107 - '0' : 107 >= 'a' && 107 <= 'f' ? 107 - 'a' + 10
2475             : 107 >= 'A' && 107 <= 'F' ? 107 - 'A' + 10 : -1 ,
2476             108 >= '0' && 108 <= '9' ? 108 - '0' : 108 >= 'a' && 108 <= 'f' ? 108 - 'a' + 10
2477             : 108 >= 'A' && 108 <= 'F' ? 108 - 'A' + 10 : -1 ,
2478             109 >= '0' && 109 <= '9' ? 109 - '0' : 109 >= 'a' && 109 <= 'f' ? 109 - 'a' + 10
2479             : 109 >= 'A' && 109 <= 'F' ? 109 - 'A' + 10 : -1 ,
2480             110 >= '0' && 110 <= '9' ? 110 - '0' : 110 >= 'a' && 110 <= 'f' ? 110 - 'a' + 10
2481             : 110 >= 'A' && 110 <= 'F' ? 110 - 'A' + 10 : -1 ,
2482             111 >= '0' && 111 <= '9' ? 111 - '0' : 111 >= 'a' && 111 <= 'f' ? 111 - 'a' + 10
2483             : 111 >= 'A' && 111 <= 'F' ? 111 - 'A' + 10 : -1 ,
2484             112 >= '0' && 112 <= '9' ? 112 - '0' : 112 >= 'a' && 112 <= 'f' ? 112 - 'a' + 10
2485             : 112 >= 'A' && 112 <= 'F' ? 112 - 'A' + 10 : -1 ,
2486             113 >= '0' && 113 <= '9' ? 113 - '0' : 113 >= 'a' && 113 <= 'f' ? 113 - 'a' + 10
2487             : 113 >= 'A' && 113 <= 'F' ? 113 - 'A' + 10 : -1 ,
2488             114 >= '0' && 114 <= '9' ? 114 - '0' : 114 >= 'a' && 114 <= 'f' ? 114 - 'a' + 10
2489             : 114 >= 'A' && 114 <= 'F' ? 114 - 'A' + 10 : -1 ,
2490             115 >= '0' && 115 <= '9' ? 115 - '0' : 115 >= 'a' && 115 <= 'f' ? 115 - 'a' + 10
2491             : 115 >= 'A' && 115 <= 'F' ? 115 - 'A' + 10 : -1 ,
2492             116 >= '0' && 116 <= '9' ? 116 - '0' : 116 >= 'a' && 116 <= 'f' ? 116 - 'a' + 10
2493             : 116 >= 'A' && 116 <= 'F' ? 116 - 'A' + 10 : -1 ,
2494             117 >= '0' && 117 <= '9' ? 117 - '0' : 117 >= 'a' && 117 <= 'f' ? 117 - 'a' + 10
2495             : 117 >= 'A' && 117 <= 'F' ? 117 - 'A' + 10 : -1 ,
2496             118 >= '0' && 118 <= '9' ? 118 - '0' : 118 >= 'a' && 118 <= 'f' ? 118 - 'a' + 10
2497             : 118 >= 'A' && 118 <= 'F' ? 118 - 'A' + 10 : -1 ,
2498             119 >= '0' && 119 <= '9' ? 119 - '0' : 119 >= 'a' && 119 <= 'f' ? 119 - 'a' + 10
2499             : 119 >= 'A' && 119 <= 'F' ? 119 - 'A' + 10 : -1 ,
2500             120 >= '0' && 120 <= '9' ? 120 - '0' : 120 >= 'a' && 120 <= 'f' ? 120 - 'a' + 10
2501             : 120 >= 'A' && 120 <= 'F' ? 120 - 'A' + 10 : -1 ,
2502             121 >= '0' && 121 <= '9' ? 121 - '0' : 121 >= 'a' && 121 <= 'f' ? 121 - 'a' + 10
2503             : 121 >= 'A' && 121 <= 'F' ? 121 - 'A' + 10 : -1 ,
2504             122 >= '0' && 122 <= '9' ? 122 - '0' : 122 >= 'a' && 122 <= 'f' ? 122 - 'a' + 10
2505             : 122 >= 'A' && 122 <= 'F' ? 122 - 'A' + 10 : -1 ,
2506             123 >= '0' && 123 <= '9' ? 123 - '0' : 123 >= 'a' && 123 <= 'f' ? 123 - 'a' + 10
2507             : 123 >= 'A' && 123 <= 'F' ? 123 - 'A' + 10 : -1 ,
2508             124 >= '0' && 124 <= '9' ? 124 - '0' : 124 >= 'a' && 124 <= 'f' ? 124 - 'a' + 10
2509             : 124 >= 'A' && 124 <= 'F' ? 124 - 'A' + 10 : -1 ,
2510             125 >= '0' && 125 <= '9' ? 125 - '0' : 125 >= 'a' && 125 <= 'f' ? 125 - 'a' + 10
2511             : 125 >= 'A' && 125 <= 'F' ? 125 - 'A' + 10 : -1 ,
2512             126 >= '0' && 126 <= '9' ? 126 - '0' : 126 >= 'a' && 126 <= 'f' ? 126 - 'a' + 10
2513             : 126 >= 'A' && 126 <= 'F' ? 126 - 'A' + 10 : -1 ,
2514             127 >= '0' && 127 <= '9' ? 127 - '0' : 127 >= 'a' && 127 <= 'f' ? 127 - 'a' + 10
2515             : 127 >= 'A' && 127 <= 'F' ? 127 - 'A' + 10 : -1 ,
2516             128 >= '0' && 128 <= '9' ? 128 - '0' : 128 >= 'a' && 128 <= 'f' ? 128 - 'a' + 10
2517             : 128 >= 'A' && 128 <= 'F' ? 128 - 'A' + 10 : -1 ,
2518             129 >= '0' && 129 <= '9' ? 129 - '0' : 129 >= 'a' && 129 <= 'f' ? 129 - 'a' + 10
2519             : 129 >= 'A' && 129 <= 'F' ? 129 - 'A' + 10 : -1 ,
2520             130 >= '0' && 130 <= '9' ? 130 - '0' : 130 >= 'a' && 130 <= 'f' ? 130 - 'a' + 10
2521             : 130 >= 'A' && 130 <= 'F' ? 130 - 'A' + 10 : -1 ,
2522             131 >= '0' && 131 <= '9' ? 131 - '0' : 131 >= 'a' && 131 <= 'f' ? 131 - 'a' + 10
2523             : 131 >= 'A' && 131 <= 'F' ? 131 - 'A' + 10 : -1 ,
2524             132 >= '0' && 132 <= '9' ? 132 - '0' : 132 >= 'a' && 132 <= 'f' ? 132 - 'a' + 10
2525             : 132 >= 'A' && 132 <= 'F' ? 132 - 'A' + 10 : -1 ,
2526             133 >= '0' && 133 <= '9' ? 133 - '0' : 133 >= 'a' && 133 <= 'f' ? 133 - 'a' + 10
2527             : 133 >= 'A' && 133 <= 'F' ? 133 - 'A' + 10 : -1 ,
2528             134 >= '0' && 134 <= '9' ? 134 - '0' : 134 >= 'a' && 134 <= 'f' ? 134 - 'a' + 10
2529             : 134 >= 'A' && 134 <= 'F' ? 134 - 'A' + 10 : -1 ,
2530             135 >= '0' && 135 <= '9' ? 135 - '0' : 135 >= 'a' && 135 <= 'f' ? 135 - 'a' + 10
2531             : 135 >= 'A' && 135 <= 'F' ? 135 - 'A' + 10 : -1 ,
2532             136 >= '0' && 136 <= '9' ? 136 - '0' : 136 >= 'a' && 136 <= 'f' ? 136 - 'a' + 10
2533             : 136 >= 'A' && 136 <= 'F' ? 136 - 'A' + 10 : -1 ,
2534             137 >= '0' && 137 <= '9' ? 137 - '0' : 137 >= 'a' && 137 <= 'f' ? 137 - 'a' + 10
2535             : 137 >= 'A' && 137 <= 'F' ? 137 - 'A' + 10 : -1 ,
2536             138 >= '0' && 138 <= '9' ? 138 - '0' : 138 >= 'a' && 138 <= 'f' ? 138 - 'a' + 10
2537             : 138 >= 'A' && 138 <= 'F' ? 138 - 'A' + 10 : -1 ,
2538             139 >= '0' && 139 <= '9' ? 139 - '0' : 139 >= 'a' && 139 <= 'f' ? 139 - 'a' + 10
2539             : 139 >= 'A' && 139 <= 'F' ? 139 - 'A' + 10 : -1 ,
2540             140 >= '0' && 140 <= '9' ? 140 - '0' : 140 >= 'a' && 140 <= 'f' ? 140 - 'a' + 10
2541             : 140 >= 'A' && 140 <= 'F' ? 140 - 'A' + 10 : -1 ,
2542             141 >= '0' && 141 <= '9' ? 141 - '0' : 141 >= 'a' && 141 <= 'f' ? 141 - 'a' + 10
2543             : 141 >= 'A' && 141 <= 'F' ? 141 - 'A' + 10 : -1 ,
2544             142 >= '0' && 142 <= '9' ? 142 - '0' : 142 >= 'a' && 142 <= 'f' ? 142 - 'a' + 10
2545             : 142 >= 'A' && 142 <= 'F' ? 142 - 'A' + 10 : -1 ,
2546             143 >= '0' && 143 <= '9' ? 143 - '0' : 143 >= 'a' && 143 <= 'f' ? 143 - 'a' + 10
2547             : 143 >= 'A' && 143 <= 'F' ? 143 - 'A' + 10 : -1 ,
2548             144 >= '0' && 144 <= '9' ? 144 - '0' : 144 >= 'a' && 144 <= 'f' ? 144 - 'a' + 10
2549             : 144 >= 'A' && 144 <= 'F' ? 144 - 'A' + 10 : -1 ,
2550             145 >= '0' && 145 <= '9' ? 145 - '0' : 145 >= 'a' && 145 <= 'f' ? 145 - 'a' + 10
2551             : 145 >= 'A' && 145 <= 'F' ? 145 - 'A' + 10 : -1 ,
2552             146 >= '0' && 146 <= '9' ? 146 - '0' : 146 >= 'a' && 146 <= 'f' ? 146 - 'a' + 10
2553             : 146 >= 'A' && 146 <= 'F' ? 146 - 'A' + 10 : -1 ,
2554             147 >= '0' && 147 <= '9' ? 147 - '0' : 147 >= 'a' && 147 <= 'f' ? 147 - 'a' + 10
2555             : 147 >= 'A' && 147 <= 'F' ? 147 - 'A' + 10 : -1 ,
2556             148 >= '0' && 148 <= '9' ? 148 - '0' : 148 >= 'a' && 148 <= 'f' ? 148 - 'a' + 10
2557             : 148 >= 'A' && 148 <= 'F' ? 148 - 'A' + 10 : -1 ,
2558             149 >= '0' && 149 <= '9' ? 149 - '0' : 149 >= 'a' && 149 <= 'f' ? 149 - 'a' + 10
2559             : 149 >= 'A' && 149 <= 'F' ? 149 - 'A' + 10 : -1 ,
2560             150 >= '0' && 150 <= '9' ? 150 - '0' : 150 >= 'a' && 150 <= 'f' ? 150 - 'a' + 10
2561             : 150 >= 'A' && 150 <= 'F' ? 150 - 'A' + 10 : -1 ,
2562             151 >= '0' && 151 <= '9' ? 151 - '0' : 151 >= 'a' && 151 <= 'f' ? 151 - 'a' + 10
2563             : 151 >= 'A' && 151 <= 'F' ? 151 - 'A' + 10 : -1 ,
2564             152 >= '0' && 152 <= '9' ? 152 - '0' : 152 >= 'a' && 152 <= 'f' ? 152 - 'a' + 10
2565             : 152 >= 'A' && 152 <= 'F' ? 152 - 'A' + 10 : -1 ,
2566             153 >= '0' && 153 <= '9' ? 153 - '0' : 153 >= 'a' && 153 <= 'f' ? 153 - 'a' + 10
2567             : 153 >= 'A' && 153 <= 'F' ? 153 - 'A' + 10 : -1 ,
2568             154 >= '0' && 154 <= '9' ? 154 - '0' : 154 >= 'a' && 154 <= 'f' ? 154 - 'a' + 10
2569             : 154 >= 'A' && 154 <= 'F' ? 154 - 'A' + 10 : -1 ,
2570             155 >= '0' && 155 <= '9' ? 155 - '0' : 155 >= 'a' && 155 <= 'f' ? 155 - 'a' + 10
2571             : 155 >= 'A' && 155 <= 'F' ? 155 - 'A' + 10 : -1 ,
2572             156 >= '0' && 156 <= '9' ? 156 - '0' : 156 >= 'a' && 156 <= 'f' ? 156 - 'a' + 10
2573             : 156 >= 'A' && 156 <= 'F' ? 156 - 'A' + 10 : -1 ,
2574             157 >= '0' && 157 <= '9' ? 157 - '0' : 157 >= 'a' && 157 <= 'f' ? 157 - 'a' + 10
2575             : 157 >= 'A' && 157 <= 'F' ? 157 - 'A' + 10 : -1 ,
2576             158 >= '0' && 158 <= '9' ? 158 - '0' : 158 >= 'a' && 158 <= 'f' ? 158 - 'a' + 10
2577             : 158 >= 'A' && 158 <= 'F' ? 158 - 'A' + 10 : -1 ,
2578             159 >= '0' && 159 <= '9' ? 159 - '0' : 159 >= 'a' && 159 <= 'f' ? 159 - 'a' + 10
2579             : 159 >= 'A' && 159 <= 'F' ? 159 - 'A' + 10 : -1 ,
2580             160 >= '0' && 160 <= '9' ? 160 - '0' : 160 >= 'a' && 160 <= 'f' ? 160 - 'a' + 10
2581             : 160 >= 'A' && 160 <= 'F' ? 160 - 'A' + 10 : -1 ,
2582             161 >= '0' && 161 <= '9' ? 161 - '0' : 161 >= 'a' && 161 <= 'f' ? 161 - 'a' + 10
2583             : 161 >= 'A' && 161 <= 'F' ? 161 - 'A' + 10 : -1 ,
2584             162 >= '0' && 162 <= '9' ? 162 - '0' : 162 >= 'a' && 162 <= 'f' ? 162 - 'a' + 10
2585             : 162 >= 'A' && 162 <= 'F' ? 162 - 'A' + 10 : -1 ,
2586             163 >= '0' && 163 <= '9' ? 163 - '0' : 163 >= 'a' && 163 <= 'f' ? 163 - 'a' + 10
2587             : 163 >= 'A' && 163 <= 'F' ? 163 - 'A' + 10 : -1 ,
2588             164 >= '0' && 164 <= '9' ? 164 - '0' : 164 >= 'a' && 164 <= 'f' ? 164 - 'a' + 10
2589             : 164 >= 'A' && 164 <= 'F' ? 164 - 'A' + 10 : -1 ,
2590             165 >= '0' && 165 <= '9' ? 165 - '0' : 165 >= 'a' && 165 <= 'f' ? 165 - 'a' + 10
2591             : 165 >= 'A' && 165 <= 'F' ? 165 - 'A' + 10 : -1 ,
2592             166 >= '0' && 166 <= '9' ? 166 - '0' : 166 >= 'a' && 166 <= 'f' ? 166 - 'a' + 10
2593             : 166 >= 'A' && 166 <= 'F' ? 166 - 'A' + 10 : -1 ,
2594             167 >= '0' && 167 <= '9' ? 167 - '0' : 167 >= 'a' && 167 <= 'f' ? 167 - 'a' + 10
2595             : 167 >= 'A' && 167 <= 'F' ? 167 - 'A' + 10 : -1 ,
2596             168 >= '0' && 168 <= '9' ? 168 - '0' : 168 >= 'a' && 168 <= 'f' ? 168 - 'a' + 10
2597             : 168 >= 'A' && 168 <= 'F' ? 168 - 'A' + 10 : -1 ,
2598             169 >= '0' && 169 <= '9' ? 169 - '0' : 169 >= 'a' && 169 <= 'f' ? 169 - 'a' + 10
2599             : 169 >= 'A' && 169 <= 'F' ? 169 - 'A' + 10 : -1 ,
2600             170 >= '0' && 170 <= '9' ? 170 - '0' : 170 >= 'a' && 170 <= 'f' ? 170 - 'a' + 10
2601             : 170 >= 'A' && 170 <= 'F' ? 170 - 'A' + 10 : -1 ,
2602             171 >= '0' && 171 <= '9' ? 171 - '0' : 171 >= 'a' && 171 <= 'f' ? 171 - 'a' + 10
2603             : 171 >= 'A' && 171 <= 'F' ? 171 - 'A' + 10 : -1 ,
2604             172 >= '0' && 172 <= '9' ? 172 - '0' : 172 >= 'a' && 172 <= 'f' ? 172 - 'a' + 10
2605             : 172 >= 'A' && 172 <= 'F' ? 172 - 'A' + 10 : -1 ,
2606             173 >= '0' && 173 <= '9' ? 173 - '0' : 173 >= 'a' && 173 <= 'f' ? 173 - 'a' + 10
2607             : 173 >= 'A' && 173 <= 'F' ? 173 - 'A' + 10 : -1 ,
2608             174 >= '0' && 174 <= '9' ? 174 - '0' : 174 >= 'a' && 174 <= 'f' ? 174 - 'a' + 10
2609             : 174 >= 'A' && 174 <= 'F' ? 174 - 'A' + 10 : -1 ,
2610             175 >= '0' && 175 <= '9' ? 175 - '0' : 175 >= 'a' && 175 <= 'f' ? 175 - 'a' + 10
2611             : 175 >= 'A' && 175 <= 'F' ? 175 - 'A' + 10 : -1 ,
2612             176 >= '0' && 176 <= '9' ? 176 - '0' : 176 >= 'a' && 176 <= 'f' ? 176 - 'a' + 10
2613             : 176 >= 'A' && 176 <= 'F' ? 176 - 'A' + 10 : -1 ,
2614             177 >= '0' && 177 <= '9' ? 177 - '0' : 177 >= 'a' && 177 <= 'f' ? 177 - 'a' + 10
2615             : 177 >= 'A' && 177 <= 'F' ? 177 - 'A' + 10 : -1 ,
2616             178 >= '0' && 178 <= '9' ? 178 - '0' : 178 >= 'a' && 178 <= 'f' ? 178 - 'a' + 10
2617             : 178 >= 'A' && 178 <= 'F' ? 178 - 'A' + 10 : -1 ,
2618             179 >= '0' && 179 <= '9' ? 179 - '0' : 179 >= 'a' && 179 <= 'f' ? 179 - 'a' + 10
2619             : 179 >= 'A' && 179 <= 'F' ? 179 - 'A' + 10 : -1 ,
2620             180 >= '0' && 180 <= '9' ? 180 - '0' : 180 >= 'a' && 180 <= 'f' ? 180 - 'a' + 10
2621             : 180 >= 'A' && 180 <= 'F' ? 180 - 'A' + 10 : -1 ,
2622             181 >= '0' && 181 <= '9' ? 181 - '0' : 181 >= 'a' && 181 <= 'f' ? 181 - 'a' + 10
2623             : 181 >= 'A' && 181 <= 'F' ? 181 - 'A' + 10 : -1 ,
2624             182 >= '0' && 182 <= '9' ? 182 - '0' : 182 >= 'a' && 182 <= 'f' ? 182 - 'a' + 10
2625             : 182 >= 'A' && 182 <= 'F' ? 182 - 'A' + 10 : -1 ,
2626             183 >= '0' && 183 <= '9' ? 183 - '0' : 183 >= 'a' && 183 <= 'f' ? 183 - 'a' + 10
2627             : 183 >= 'A' && 183 <= 'F' ? 183 - 'A' + 10 : -1 ,
2628             184 >= '0' && 184 <= '9' ? 184 - '0' : 184 >= 'a' && 184 <= 'f' ? 184 - 'a' + 10
2629             : 184 >= 'A' && 184 <= 'F' ? 184 - 'A' + 10 : -1 ,
2630             185 >= '0' && 185 <= '9' ? 185 - '0' : 185 >= 'a' && 185 <= 'f' ? 185 - 'a' + 10
2631             : 185 >= 'A' && 185 <= 'F' ? 185 - 'A' + 10 : -1 ,
2632             186 >= '0' && 186 <= '9' ? 186 - '0' : 186 >= 'a' && 186 <= 'f' ? 186 - 'a' + 10
2633             : 186 >= 'A' && 186 <= 'F' ? 186 - 'A' + 10 : -1 ,
2634             187 >= '0' && 187 <= '9' ? 187 - '0' : 187 >= 'a' && 187 <= 'f' ? 187 - 'a' + 10
2635             : 187 >= 'A' && 187 <= 'F' ? 187 - 'A' + 10 : -1 ,
2636             188 >= '0' && 188 <= '9' ? 188 - '0' : 188 >= 'a' && 188 <= 'f' ? 188 - 'a' + 10
2637             : 188 >= 'A' && 188 <= 'F' ? 188 - 'A' + 10 : -1 ,
2638             189 >= '0' && 189 <= '9' ? 189 - '0' : 189 >= 'a' && 189 <= 'f' ? 189 - 'a' + 10
2639             : 189 >= 'A' && 189 <= 'F' ? 189 - 'A' + 10 : -1 ,
2640             190 >= '0' && 190 <= '9' ? 190 - '0' : 190 >= 'a' && 190 <= 'f' ? 190 - 'a' + 10
2641             : 190 >= 'A' && 190 <= 'F' ? 190 - 'A' + 10 : -1 ,
2642             191 >= '0' && 191 <= '9' ? 191 - '0' : 191 >= 'a' && 191 <= 'f' ? 191 - 'a' + 10
2643             : 191 >= 'A' && 191 <= 'F' ? 191 - 'A' + 10 : -1 ,
2644             192 >= '0' && 192 <= '9' ? 192 - '0' : 192 >= 'a' && 192 <= 'f' ? 192 - 'a' + 10
2645             : 192 >= 'A' && 192 <= 'F' ? 192 - 'A' + 10 : -1 ,
2646             193 >= '0' && 193 <= '9' ? 193 - '0' : 193 >= 'a' && 193 <= 'f' ? 193 - 'a' + 10
2647             : 193 >= 'A' && 193 <= 'F' ? 193 - 'A' + 10 : -1 ,
2648             194 >= '0' && 194 <= '9' ? 194 - '0' : 194 >= 'a' && 194 <= 'f' ? 194 - 'a' + 10
2649             : 194 >= 'A' && 194 <= 'F' ? 194 - 'A' + 10 : -1 ,
2650             195 >= '0' && 195 <= '9' ? 195 - '0' : 195 >= 'a' && 195 <= 'f' ? 195 - 'a' + 10
2651             : 195 >= 'A' && 195 <= 'F' ? 195 - 'A' + 10 : -1 ,
2652             196 >= '0' && 196 <= '9' ? 196 - '0' : 196 >= 'a' && 196 <= 'f' ? 196 - 'a' + 10
2653             : 196 >= 'A' && 196 <= 'F' ? 196 - 'A' + 10 : -1 ,
2654             197 >= '0' && 197 <= '9' ? 197 - '0' : 197 >= 'a' && 197 <= 'f' ? 197 - 'a' + 10
2655             : 197 >= 'A' && 197 <= 'F' ? 197 - 'A' + 10 : -1 ,
2656             198 >= '0' && 198 <= '9' ? 198 - '0' : 198 >= 'a' && 198 <= 'f' ? 198 - 'a' + 10
2657             : 198 >= 'A' && 198 <= 'F' ? 198 - 'A' + 10 : -1 ,
2658             199 >= '0' && 199 <= '9' ? 199 - '0' : 199 >= 'a' && 199 <= 'f' ? 199 - 'a' + 10
2659             : 199 >= 'A' && 199 <= 'F' ? 199 - 'A' + 10 : -1 ,
2660             200 >= '0' && 200 <= '9' ? 200 - '0' : 200 >= 'a' && 200 <= 'f' ? 200 - 'a' + 10
2661             : 200 >= 'A' && 200 <= 'F' ? 200 - 'A' + 10 : -1 ,
2662             201 >= '0' && 201 <= '9' ? 201 - '0' : 201 >= 'a' && 201 <= 'f' ? 201 - 'a' + 10
2663             : 201 >= 'A' && 201 <= 'F' ? 201 - 'A' + 10 : -1 ,
2664             202 >= '0' && 202 <= '9' ? 202 - '0' : 202 >= 'a' && 202 <= 'f' ? 202 - 'a' + 10
2665             : 202 >= 'A' && 202 <= 'F' ? 202 - 'A' + 10 : -1 ,
2666             203 >= '0' && 203 <= '9' ? 203 - '0' : 203 >= 'a' && 203 <= 'f' ? 203 - 'a' + 10
2667             : 203 >= 'A' && 203 <= 'F' ? 203 - 'A' + 10 : -1 ,
2668             204 >= '0' && 204 <= '9' ? 204 - '0' : 204 >= 'a' && 204 <= 'f' ? 204 - 'a' + 10
2669             : 204 >= 'A' && 204 <= 'F' ? 204 - 'A' + 10 : -1 ,
2670             205 >= '0' && 205 <= '9' ? 205 - '0' : 205 >= 'a' && 205 <= 'f' ? 205 - 'a' + 10
2671             : 205 >= 'A' && 205 <= 'F' ? 205 - 'A' + 10 : -1 ,
2672             206 >= '0' && 206 <= '9' ? 206 - '0' : 206 >= 'a' && 206 <= 'f' ? 206 - 'a' + 10
2673             : 206 >= 'A' && 206 <= 'F' ? 206 - 'A' + 10 : -1 ,
2674             207 >= '0' && 207 <= '9' ? 207 - '0' : 207 >= 'a' && 207 <= 'f' ? 207 - 'a' + 10
2675             : 207 >= 'A' && 207 <= 'F' ? 207 - 'A' + 10 : -1 ,
2676             208 >= '0' && 208 <= '9' ? 208 - '0' : 208 >= 'a' && 208 <= 'f' ? 208 - 'a' + 10
2677             : 208 >= 'A' && 208 <= 'F' ? 208 - 'A' + 10 : -1 ,
2678             209 >= '0' && 209 <= '9' ? 209 - '0' : 209 >= 'a' && 209 <= 'f' ? 209 - 'a' + 10
2679             : 209 >= 'A' && 209 <= 'F' ? 209 - 'A' + 10 : -1 ,
2680             210 >= '0' && 210 <= '9' ? 210 - '0' : 210 >= 'a' && 210 <= 'f' ? 210 - 'a' + 10
2681             : 210 >= 'A' && 210 <= 'F' ? 210 - 'A' + 10 : -1 ,
2682             211 >= '0' && 211 <= '9' ? 211 - '0' : 211 >= 'a' && 211 <= 'f' ? 211 - 'a' + 10
2683             : 211 >= 'A' && 211 <= 'F' ? 211 - 'A' + 10 : -1 ,
2684             212 >= '0' && 212 <= '9' ? 212 - '0' : 212 >= 'a' && 212 <= 'f' ? 212 - 'a' + 10
2685             : 212 >= 'A' && 212 <= 'F' ? 212 - 'A' + 10 : -1 ,
2686             213 >= '0' && 213 <= '9' ? 213 - '0' : 213 >= 'a' && 213 <= 'f' ? 213 - 'a' + 10
2687             : 213 >= 'A' && 213 <= 'F' ? 213 - 'A' + 10 : -1 ,
2688             214 >= '0' && 214 <= '9' ? 214 - '0' : 214 >= 'a' && 214 <= 'f' ? 214 - 'a' + 10
2689             : 214 >= 'A' && 214 <= 'F' ? 214 - 'A' + 10 : -1 ,
2690             215 >= '0' && 215 <= '9' ? 215 - '0' : 215 >= 'a' && 215 <= 'f' ? 215 - 'a' + 10
2691             : 215 >= 'A' && 215 <= 'F' ? 215 - 'A' + 10 : -1 ,
2692             216 >= '0' && 216 <= '9' ? 216 - '0' : 216 >= 'a' && 216 <= 'f' ? 216 - 'a' + 10
2693             : 216 >= 'A' && 216 <= 'F' ? 216 - 'A' + 10 : -1 ,
2694             217 >= '0' && 217 <= '9' ? 217 - '0' : 217 >= 'a' && 217 <= 'f' ? 217 - 'a' + 10
2695             : 217 >= 'A' && 217 <= 'F' ? 217 - 'A' + 10 : -1 ,
2696             218 >= '0' && 218 <= '9' ? 218 - '0' : 218 >= 'a' && 218 <= 'f' ? 218 - 'a' + 10
2697             : 218 >= 'A' && 218 <= 'F' ? 218 - 'A' + 10 : -1 ,
2698             219 >= '0' && 219 <= '9' ? 219 - '0' : 219 >= 'a' && 219 <= 'f' ? 219 - 'a' + 10
2699             : 219 >= 'A' && 219 <= 'F' ? 219 - 'A' + 10 : -1 ,
2700             220 >= '0' && 220 <= '9' ? 220 - '0' : 220 >= 'a' && 220 <= 'f' ? 220 - 'a' + 10
2701             : 220 >= 'A' && 220 <= 'F' ? 220 - 'A' + 10 : -1 ,
2702             221 >= '0' && 221 <= '9' ? 221 - '0' : 221 >= 'a' && 221 <= 'f' ? 221 - 'a' + 10
2703             : 221 >= 'A' && 221 <= 'F' ? 221 - 'A' + 10 : -1 ,
2704             222 >= '0' && 222 <= '9' ? 222 - '0' : 222 >= 'a' && 222 <= 'f' ? 222 - 'a' + 10
2705             : 222 >= 'A' && 222 <= 'F' ? 222 - 'A' + 10 : -1 ,
2706             223 >= '0' && 223 <= '9' ? 223 - '0' : 223 >= 'a' && 223 <= 'f' ? 223 - 'a' + 10
2707             : 223 >= 'A' && 223 <= 'F' ? 223 - 'A' + 10 : -1 ,
2708             224 >= '0' && 224 <= '9' ? 224 - '0' : 224 >= 'a' && 224 <= 'f' ? 224 - 'a' + 10
2709             : 224 >= 'A' && 224 <= 'F' ? 224 - 'A' + 10 : -1 ,
2710             225 >= '0' && 225 <= '9' ? 225 - '0' : 225 >= 'a' && 225 <= 'f' ? 225 - 'a' + 10
2711             : 225 >= 'A' && 225 <= 'F' ? 225 - 'A' + 10 : -1 ,
2712             226 >= '0' && 226 <= '9' ? 226 - '0' : 226 >= 'a' && 226 <= 'f' ? 226 - 'a' + 10
2713             : 226 >= 'A' && 226 <= 'F' ? 226 - 'A' + 10 : -1 ,
2714             227 >= '0' && 227 <= '9' ? 227 - '0' : 227 >= 'a' && 227 <= 'f' ? 227 - 'a' + 10
2715             : 227 >= 'A' && 227 <= 'F' ? 227 - 'A' + 10 : -1 ,
2716             228 >= '0' && 228 <= '9' ? 228 - '0' : 228 >= 'a' && 228 <= 'f' ? 228 - 'a' + 10
2717             : 228 >= 'A' && 228 <= 'F' ? 228 - 'A' + 10 : -1 ,
2718             229 >= '0' && 229 <= '9' ? 229 - '0' : 229 >= 'a' && 229 <= 'f' ? 229 - 'a' + 10
2719             : 229 >= 'A' && 229 <= 'F' ? 229 - 'A' + 10 : -1 ,
2720             230 >= '0' && 230 <= '9' ? 230 - '0' : 230 >= 'a' && 230 <= 'f' ? 230 - 'a' + 10
2721             : 230 >= 'A' && 230 <= 'F' ? 230 - 'A' + 10 : -1 ,
2722             231 >= '0' && 231 <= '9' ? 231 - '0' : 231 >= 'a' && 231 <= 'f' ? 231 - 'a' + 10
2723             : 231 >= 'A' && 231 <= 'F' ? 231 - 'A' + 10 : -1 ,
2724             232 >= '0' && 232 <= '9' ? 232 - '0' : 232 >= 'a' && 232 <= 'f' ? 232 - 'a' + 10
2725             : 232 >= 'A' && 232 <= 'F' ? 232 - 'A' + 10 : -1 ,
2726             233 >= '0' && 233 <= '9' ? 233 - '0' : 233 >= 'a' && 233 <= 'f' ? 233 - 'a' + 10
2727             : 233 >= 'A' && 233 <= 'F' ? 233 - 'A' + 10 : -1 ,
2728             234 >= '0' && 234 <= '9' ? 234 - '0' : 234 >= 'a' && 234 <= 'f' ? 234 - 'a' + 10
2729             : 234 >= 'A' && 234 <= 'F' ? 234 - 'A' + 10 : -1 ,
2730             235 >= '0' && 235 <= '9' ? 235 - '0' : 235 >= 'a' && 235 <= 'f' ? 235 - 'a' + 10
2731             : 235 >= 'A' && 235 <= 'F' ? 235 - 'A' + 10 : -1 ,
2732             236 >= '0' && 236 <= '9' ? 236 - '0' : 236 >= 'a' && 236 <= 'f' ? 236 - 'a' + 10
2733             : 236 >= 'A' && 236 <= 'F' ? 236 - 'A' + 10 : -1 ,
2734             237 >= '0' && 237 <= '9' ? 237 - '0' : 237 >= 'a' && 237 <= 'f' ? 237 - 'a' + 10
2735             : 237 >= 'A' && 237 <= 'F' ? 237 - 'A' + 10 : -1 ,
2736             238 >= '0' && 238 <= '9' ? 238 - '0' : 238 >= 'a' && 238 <= 'f' ? 238 - 'a' + 10
2737             : 238 >= 'A' && 238 <= 'F' ? 238 - 'A' + 10 : -1 ,
2738             239 >= '0' && 239 <= '9' ? 239 - '0' : 239 >= 'a' && 239 <= 'f' ? 239 - 'a' + 10
2739             : 239 >= 'A' && 239 <= 'F' ? 239 - 'A' + 10 : -1 ,
2740             240 >= '0' && 240 <= '9' ? 240 - '0' : 240 >= 'a' && 240 <= 'f' ? 240 - 'a' + 10
2741             : 240 >= 'A' && 240 <= 'F' ? 240 - 'A' + 10 : -1 ,
2742             241 >= '0' && 241 <= '9' ? 241 - '0' : 241 >= 'a' && 241 <= 'f' ? 241 - 'a' + 10
2743             : 241 >= 'A' && 241 <= 'F' ? 241 - 'A' + 10 : -1 ,
2744             242 >= '0' && 242 <= '9' ? 242 - '0' : 242 >= 'a' && 242 <= 'f' ? 242 - 'a' + 10
2745             : 242 >= 'A' && 242 <= 'F' ? 242 - 'A' + 10 : -1 ,
2746             243 >= '0' && 243 <= '9' ? 243 - '0' : 243 >= 'a' && 243 <= 'f' ? 243 - 'a' + 10
2747             : 243 >= 'A' && 243 <= 'F' ? 243 - 'A' + 10 : -1 ,
2748             244 >= '0' && 244 <= '9' ? 244 - '0' : 244 >= 'a' && 244 <= 'f' ? 244 - 'a' + 10
2749             : 244 >= 'A' && 244 <= 'F' ? 244 - 'A' + 10 : -1 ,
2750             245 >= '0' && 245 <= '9' ? 245 - '0' : 245 >= 'a' && 245 <= 'f' ? 245 - 'a' + 10
2751             : 245 >= 'A' && 245 <= 'F' ? 245 - 'A' + 10 : -1 ,
2752             246 >= '0' && 246 <= '9' ? 246 - '0' : 246 >= 'a' && 246 <= 'f' ? 246 - 'a' + 10
2753             : 246 >= 'A' && 246 <= 'F' ? 246 - 'A' + 10 : -1 ,
2754             247 >= '0' && 247 <= '9' ? 247 - '0' : 247 >= 'a' && 247 <= 'f' ? 247 - 'a' + 10
2755             : 247 >= 'A' && 247 <= 'F' ? 247 - 'A' + 10 : -1 ,
2756             248 >= '0' && 248 <= '9' ? 248 - '0' : 248 >= 'a' && 248 <= 'f' ? 248 - 'a' + 10
2757             : 248 >= 'A' && 248 <= 'F' ? 248 - 'A' + 10 : -1 ,
2758             249 >= '0' && 249 <= '9' ? 249 - '0' : 249 >= 'a' && 249 <= 'f' ? 249 - 'a' + 10
2759             : 249 >= 'A' && 249 <= 'F' ? 249 - 'A' + 10 : -1 ,
2760             250 >= '0' && 250 <= '9' ? 250 - '0' : 250 >= 'a' && 250 <= 'f' ? 250 - 'a' + 10
2761             : 250 >= 'A' && 250 <= 'F' ? 250 - 'A' + 10 : -1 ,
2762             251 >= '0' && 251 <= '9' ? 251 - '0' : 251 >= 'a' && 251 <= 'f' ? 251 - 'a' + 10
2763             : 251 >= 'A' && 251 <= 'F' ? 251 - 'A' + 10 : -1 ,
2764             252 >= '0' && 252 <= '9' ? 252 - '0' : 252 >= 'a' && 252 <= 'f' ? 252 - 'a' + 10
2765             : 252 >= 'A' && 252 <= 'F' ? 252 - 'A' + 10 : -1 ,
2766             253 >= '0' && 253 <= '9' ? 253 - '0' : 253 >= 'a' && 253 <= 'f' ? 253 - 'a' + 10
2767             : 253 >= 'A' && 253 <= 'F' ? 253 - 'A' + 10 : -1 ,
2768             254 >= '0' && 254 <= '9' ? 254 - '0' : 254 >= 'a' && 254 <= 'f' ? 254 - 'a' + 10
2769             : 254 >= 'A' && 254 <= 'F' ? 254 - 'A' + 10 : -1 ,
2770             255 >= '0' && 255 <= '9' ? 255 - '0' : 255 >= 'a' && 255 <= 'f' ? 255 - 'a' + 10
2771             : 255 >= 'A' && 255 <= 'F' ? 255 - 'A' + 10 : -1
2772             };
2773              
2774             static UV
2775 2144           decode_4hex (dec_t *dec)
2776             {
2777             signed char d1, d2, d3, d4;
2778 2144           unsigned char *cur = (unsigned char *)dec->cur;
2779              
2780 2144 100         d1 = decode_hexdigit [cur [0]]; if (UNLIKELY(d1 < 0)) ERR ("exactly four hexadecimal digits expected");
2781 2141 100         d2 = decode_hexdigit [cur [1]]; if (UNLIKELY(d2 < 0)) ERR ("exactly four hexadecimal digits expected");
2782 2139 100         d3 = decode_hexdigit [cur [2]]; if (UNLIKELY(d3 < 0)) ERR ("exactly four hexadecimal digits expected");
2783 2138 100         d4 = decode_hexdigit [cur [3]]; if (UNLIKELY(d4 < 0)) ERR ("exactly four hexadecimal digits expected");
2784              
2785 2137           dec->cur += 4;
2786              
2787 2137           return ((UV)d1) << 12
2788 2137           | ((UV)d2) << 8
2789 2137           | ((UV)d3) << 4
2790 2137           | ((UV)d4);
2791              
2792             fail:
2793 7           return (UV)-1;
2794             }
2795              
2796             static UV
2797 2506           decode_2hex (dec_t *dec)
2798             {
2799             signed char d1, d2;
2800 2506           unsigned char *cur = (unsigned char *)dec->cur;
2801              
2802 2506 50         d1 = decode_hexdigit [cur [0]]; if (UNLIKELY(d1 < 0)) ERR ("exactly two hexadecimal digits expected");
2803 2506 50         d2 = decode_hexdigit [cur [1]]; if (UNLIKELY(d2 < 0)) ERR ("exactly two hexadecimal digits expected");
2804 2506           dec->cur += 2;
2805 2506           return ((UV)d1) << 4
2806 2506           | ((UV)d2);
2807             fail:
2808 0           return (UV)-1;
2809             }
2810              
2811             static UV
2812 0           decode_3oct (dec_t *dec)
2813             {
2814             IV d1, d2, d3;
2815 0           unsigned char *cur = (unsigned char *)dec->cur;
2816              
2817 0 0         d1 = (IV)(cur[0] - '0'); if (d1 < 0 || d1 > 7) ERR ("exactly three octal digits expected");
    0          
2818 0 0         d2 = (IV)(cur[1] - '0'); if (d2 < 0 || d2 > 7) ERR ("exactly three octal digits expected");
    0          
2819 0 0         d3 = (IV)(cur[2] - '0'); if (d3 < 0 || d3 > 7) ERR ("exactly three octal digits expected");
    0          
2820 0           dec->cur += 3;
2821 0           return (d1 * 64) + (d2 * 8) + d3;
2822             fail:
2823 0           return (UV)-1;
2824             }
2825              
2826             static SV *
2827 3915           _decode_str (pTHX_ dec_t *dec, char endstr)
2828             {
2829 3915           SV *sv = 0;
2830 3915           int utf8 = 0;
2831 3915           char *dec_cur = dec->cur;
2832             unsigned char ch;
2833             assert(endstr == 0x27 || endstr == '"');
2834              
2835             do
2836             {
2837             char buf [SHORT_STRING_LEN + UTF8_MAXBYTES];
2838 3916           char *cur = buf;
2839              
2840             do
2841             {
2842 117559           ch = *(unsigned char *)dec_cur++;
2843              
2844 117559 100         if (UNLIKELY(ch == endstr))
2845             {
2846 3793 100         if (ch == 0x27 && !(dec->json.flags & F_ALLOW_SQUOTE)) {
    50          
2847 121           ERR("'\"' expected");
2848             }
2849 3793           --dec_cur;
2850 3793           break;
2851             }
2852 113766 100         else if (UNLIKELY(ch == '\\'))
2853             {
2854 5436           switch (*dec_cur)
2855             {
2856             case '\\':
2857             case '/':
2858 638           case '"': *cur++ = *dec_cur++; break;
2859              
2860 62           case 'b': ++dec_cur; *cur++ = '\010'; break;
2861 60           case 't': ++dec_cur; *cur++ = '\011'; break;
2862 259           case 'n': ++dec_cur; *cur++ = '\012'; break;
2863 50           case 'f': ++dec_cur; *cur++ = '\014'; break;
2864 46           case 'r': ++dec_cur; *cur++ = '\015'; break;
2865              
2866             case 'x':
2867             {
2868             UV c;
2869 2508 100         if (!(dec->json.flags & F_BINARY))
2870 2           ERR ("illegal hex character in non-binary string");
2871 2506           ++dec_cur;
2872 2506           dec->cur = dec_cur;
2873 2506           c = decode_2hex (dec);
2874 2506 50         if (c == (UV)-1)
2875 0           goto fail;
2876 2506           *cur++ = c;
2877 2506           dec_cur += 2;
2878 2506           break;
2879             }
2880             case '0': case '1': case '2': case '3':
2881             case '4': case '5': case '6': case '7':
2882             {
2883             UV c;
2884 1 50         if (!(dec->json.flags & F_BINARY))
2885 1           ERR ("illegal octal character in non-binary string");
2886 0           dec->cur = dec_cur;
2887 0           c = decode_3oct (dec);
2888 0 0         if (c == (UV)-1)
2889 0           goto fail;
2890 0           *cur++ = c;
2891 0           dec_cur += 3;
2892 0           break;
2893             }
2894             case 'u':
2895             {
2896             UV lo, hi;
2897 1802           ++dec_cur;
2898              
2899 1802           dec->cur = dec_cur;
2900 1802           hi = decode_4hex (dec);
2901 1802           dec_cur = dec->cur;
2902 1802 100         if (hi == (UV)-1)
2903 3           goto fail;
2904 1799 50         if (dec->json.flags & F_BINARY)
2905 0           ERR ("illegal unicode character in binary string");
2906              
2907             /* possibly a surrogate pair */
2908 1799 100         if (hi >= 0xd800) {
2909 372 100         if (hi < 0xdc00) {
2910 352 100         if (dec_cur [0] != '\\' || dec_cur [1] != 'u')
    100          
2911 10           ERR ("missing low surrogate character in surrogate pair");
2912              
2913 342           dec_cur += 2;
2914              
2915 342           dec->cur = dec_cur;
2916 342           lo = decode_4hex (dec);
2917 342           dec_cur = dec->cur;
2918 342 100         if (lo == (UV)-1)
2919 4           goto fail;
2920              
2921 338 100         if (lo < 0xdc00 || lo >= 0xe000)
    50          
2922 6           ERR ("surrogate pair expected");
2923              
2924 332           hi = (hi - 0xD800) * 0x400 + (lo - 0xDC00) + 0x10000;
2925 332 100         if (UNLIKELY(
    100          
    50          
    100          
2926             !(dec->json.flags & F_RELAXED)
2927             && (((hi & 0xfffe) == 0xfffe)
2928             || ((hi & 0xffff) == 0xffff)))) {
2929 332           WARNER_NONCHAR(hi);
2930             }
2931             }
2932 20 100         else if (UNLIKELY(hi < 0xe000)) {
2933 9           ERR ("missing high surrogate character in surrogate pair");
2934             }
2935             else
2936              
2937             /* check 66 noncharacters U+FDD0..U+FDEF, U+FFFE, U+FFFF
2938             and U+1FFFE, U+1FFFF, U+2FFFE, U+2FFFF, ... U+10FFFE, U+10FFFF (issue #74)
2939             and warn as in core.
2940             See http://www.unicode.org/versions/corrigendum9.html.
2941              
2942             https://www.rfc-editor.org/errata_search.php?rfc=7159&eid=3984
2943             The WG's consensus was to leave the full range present
2944             in the ABNF and add the interoperability guidance about
2945             values outside the Unicode accepted range.
2946              
2947             http://seriot.ch/parsing_json.html#25 According to the Unicode
2948             standard, illformed subsequences should be replaced by U+FFFD
2949             REPLACEMENT CHARACTER. (See Unicode PR #121: Recommended Practice
2950             for Replacement Characters). Several parsers use replacement
2951             characters, while other keep the escaped form or produce an
2952             non-Unicode character (see Section 5 - Parsing Contents). This
2953             values are not for interchange, only for application internal use.
2954             They are different from private use. Most parsers accept these.
2955             */
2956 11 100         if (UNLIKELY(
    100          
    100          
    100          
    100          
    50          
    100          
    100          
2957             !(dec->json.flags & F_RELAXED)
2958             && ((hi >= 0xfdd0 && hi <= 0xfdef)
2959             || (hi >= 0xfffe && hi <= 0xffff)))) {
2960 4           WARNER_NONCHAR(hi);
2961             }
2962             }
2963 1770 100         if (hi >= 0x80)
2964             {
2965 1093           utf8 = 1;
2966 1093           cur = (char*)encode_utf8 ((U8*)cur, hi);
2967             }
2968             else
2969 677           *cur++ = hi;
2970             }
2971 1770           break;
2972              
2973             default:
2974 10           --dec_cur;
2975 5401           ERR ("illegal backslash escape sequence in string");
2976             }
2977             }
2978 108330 100         else if (LIKELY(ch >= 0x20 && ch < 0x80)) {
    100          
2979 107142           *cur++ = ch;
2980             /* Ending ' already handled above with (ch == endstr) cid #165321 */
2981             }
2982 1188 100         else if (ch >= 0x80)
2983             {
2984             STRLEN clen;
2985              
2986 1171           --dec_cur;
2987              
2988 1171           decode_utf8 (aTHX_ (U8*)dec_cur, dec->end - dec_cur,
2989 1171           dec->json.flags & F_RELAXED, &clen);
2990 1171 100         if (clen == (STRLEN)-1)
2991 60           ERR ("malformed UTF-8 character in JSON string");
2992              
2993             do
2994 2942           *cur++ = *dec_cur++;
2995 2942 100         while (--clen);
2996              
2997 1111           utf8 = 1;
2998             }
2999 17 100         else if (dec->json.flags & F_RELAXED && ch == '\t') {
    50          
3000 1           *cur++ = ch;
3001             } else
3002             {
3003 16           --dec_cur;
3004              
3005 16 100         if (!ch)
3006 9           ERR ("unexpected end of string while parsing JSON string");
3007             else
3008 7           ERR ("invalid character encountered while parsing JSON string");
3009             }
3010             }
3011 113645 100         while (cur < buf + SHORT_STRING_LEN);
3012              
3013             {
3014 3795           STRLEN len = cur - buf;
3015              
3016 3795 100         if (sv)
3017             {
3018 1           STRLEN cur = SvCUR (sv);
3019              
3020 1 50         if (SvLEN (sv) <= cur + len)
3021 1 50         SvGROW (sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
    50          
3022              
3023 1           memcpy (SvPVX (sv) + SvCUR (sv), buf, len);
3024 1           SvCUR_set (sv, SvCUR (sv) + len);
3025             }
3026             else
3027 3794           sv = newSVpvn (buf, len);
3028             }
3029             }
3030 3795 100         while (*dec_cur != endstr);
3031              
3032 3794           ++dec_cur;
3033              
3034 3794 50         if (sv)
3035             {
3036 3794           SvPOK_only (sv);
3037 3794           *SvEND (sv) = 0;
3038              
3039 3794 100         if (utf8)
3040 3794           SvUTF8_on (sv);
3041             }
3042             else
3043 0           sv = newSVpvn ("", 0);
3044              
3045 3794           dec->cur = dec_cur;
3046 3794           return sv;
3047              
3048             fail:
3049 121           dec->cur = dec_cur;
3050 121           return 0;
3051             }
3052              
3053             INLINE SV *
3054 3689           decode_str (pTHX_ dec_t *dec)
3055             {
3056 3689           return _decode_str(aTHX_ dec, '"');
3057             }
3058              
3059             INLINE SV *
3060 3           decode_str_sq (pTHX_ dec_t *dec)
3061             {
3062 3           return _decode_str(aTHX_ dec, 0x27);
3063             }
3064              
3065             static SV *
3066 964           decode_num (pTHX_ dec_t *dec, SV *typesv)
3067             {
3068 964           int is_nv = 0;
3069 964           char *start = dec->cur;
3070              
3071             /* [minus] */
3072 964 100         if (*dec->cur == '-')
3073 57           ++dec->cur;
3074              
3075 964 100         if (*dec->cur == '0')
3076             {
3077 117           ++dec->cur;
3078 117 100         if (*dec->cur >= '0' && *dec->cur <= '9')
    100          
3079 6           ERR ("malformed number (leading zero must not be followed by another digit)");
3080             }
3081 847 100         else if (*dec->cur < '0' || *dec->cur > '9')
    100          
3082 7           ERR ("malformed number (no digits after initial minus)");
3083             else
3084             do
3085             {
3086 1239           ++dec->cur;
3087             }
3088 1239 100         while (*dec->cur >= '0' && *dec->cur <= '9');
    100          
3089              
3090             /* [frac] */
3091 951 100         if (*dec->cur == '.')
3092             {
3093 65           ++dec->cur;
3094              
3095 65 100         if (*dec->cur < '0' || *dec->cur > '9')
    100          
3096 8           ERR ("malformed number (no digits after decimal point)");
3097              
3098             do
3099             {
3100 254           ++dec->cur;
3101             }
3102 254 100         while (*dec->cur >= '0' && *dec->cur <= '9');
    100          
3103              
3104 57           is_nv = 1;
3105             }
3106              
3107             /* [exp] */
3108 943 100         if (*dec->cur == 'e' || *dec->cur == 'E')
    100          
3109             {
3110 61           ++dec->cur;
3111              
3112 61 100         if (*dec->cur == '-' || *dec->cur == '+')
    100          
3113 34           ++dec->cur;
3114              
3115 61 100         if (*dec->cur < '0' || *dec->cur > '9')
    100          
3116 17           ERR ("malformed number (no digits after exp sign)");
3117              
3118             do
3119             {
3120 221           ++dec->cur;
3121             }
3122 221 100         while (*dec->cur >= '0' && *dec->cur <= '9');
    100          
3123              
3124 44           is_nv = 1;
3125             }
3126              
3127 926 100         if (!is_nv)
3128             {
3129 846           int len = dec->cur - start;
3130              
3131 846 100         if (typesv)
3132 7           sv_setiv_mg (typesv, JSON_TYPE_INT);
3133              
3134             /* special case the rather common 1..5-digit-int case */
3135 846 100         if (*start == '-')
3136 28           switch (len)
3137             {
3138 16           case 2: return newSViv (-(IV)( start [1] - '0' * 1));
3139 5           case 3: return newSViv (-(IV)( start [1] * 10 + start [2] - '0' * 11));
3140 3           case 4: return newSViv (-(IV)( start [1] * 100 + start [2] * 10 + start [3] - '0' * 111));
3141 0           case 5: return newSViv (-(IV)( start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 1111));
3142 4           case 6: return newSViv (-(IV)(start [1] * 10000 + start [2] * 1000 + start [3] * 100 + start [4] * 10 + start [5] - '0' * 11111));
3143             }
3144             else
3145 818           switch (len)
3146             {
3147 779           case 1: return newSViv ( start [0] - '0' * 1);
3148 6           case 2: return newSViv ( start [0] * 10 + start [1] - '0' * 11);
3149 7           case 3: return newSViv ( start [0] * 100 + start [1] * 10 + start [2] - '0' * 111);
3150 4           case 4: return newSViv ( start [0] * 1000 + start [1] * 100 + start [2] * 10 + start [3] - '0' * 1111);
3151 10           case 5: return newSViv ( start [0] * 10000 + start [1] * 1000 + start [2] * 100 + start [3] * 10 + start [4] - '0' * 11111);
3152             }
3153              
3154             {
3155             UV uv;
3156 16           int numtype = grok_number (start, len, &uv);
3157 16 100         if (numtype & IS_NUMBER_IN_UV) {
3158 10 100         if (numtype & IS_NUMBER_NEG)
3159             {
3160 2 50         if (uv <= (UV)(IV_MAX) + 1)
3161 10           return newSViv (-(IV)uv);
3162             }
3163             else
3164 8           return newSVuv (uv);
3165             }
3166             }
3167              
3168 6           len -= *start == '-' ? 1 : 0;
3169              
3170             /* does not fit into IV or UV, try NV */
3171 6 50         if ((sizeof (NV) == sizeof (double) && DBL_DIG >= len)
3172             #if defined (LDBL_DIG)
3173             || (sizeof (NV) == sizeof (long double) && LDBL_DIG >= len)
3174             #endif
3175             )
3176             /* fits into NV without loss of precision */
3177 0           return newSVnv (json_atof (start));
3178              
3179 6 100         if (dec->json.flags & F_ALLOW_BIGNUM) {
3180             SV *errsv;
3181 2           SV* pv = newSVpvs("require Math::BigInt && return Math::BigInt->new(\"");
3182 2           sv_catpvn(pv, start, dec->cur - start);
3183 2           sv_catpvs(pv, "\");");
3184 2           eval_sv(pv, G_SCALAR);
3185 2           SvREFCNT_dec(pv);
3186             /* rethrow current error */
3187 2 50         errsv = ERRSV;
3188 2 50         if (SvROK (errsv))
3189 0           croak (NULL);
3190 2 50         else if (SvTRUE (errsv))
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    50          
3191 0           croak ("%" SVf, SVfARG (errsv));
3192             {
3193 2           dSP;
3194 2           SV *retval = SvREFCNT_inc(POPs);
3195 2           PUTBACK;
3196 2           return retval;
3197             }
3198             }
3199              
3200             /* everything else fails, convert it to a string */
3201 4           return newSVpvn (start, dec->cur - start);
3202             }
3203              
3204 80 100         if (typesv)
3205 4           sv_setiv_mg (typesv, JSON_TYPE_FLOAT);
3206              
3207 80 100         if (dec->json.flags & F_ALLOW_BIGNUM) {
3208             SV *errsv;
3209 2           SV* pv = newSVpvs("require Math::BigFloat && return Math::BigFloat->new(\"");
3210 2           sv_catpvn(pv, start, dec->cur - start);
3211 2           sv_catpvs(pv, "\");");
3212 2           eval_sv(pv, G_SCALAR);
3213 2           SvREFCNT_dec(pv);
3214             /* rethrow current error */
3215 2 50         errsv = ERRSV;
3216 2 50         if (SvROK (errsv))
3217 0           croak (NULL);
3218 2 50         else if (SvTRUE (errsv))
    50          
    50          
    0          
    0          
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
    0          
    50          
3219 0           croak ("%" SVf, SVfARG (errsv));
3220             {
3221 2           dSP;
3222 2           SV *retval = SvREFCNT_inc(POPs);
3223 2           PUTBACK;
3224 2           return retval;
3225             }
3226             }
3227              
3228             /* loss of precision here */
3229 78           return newSVnv (json_atof (start));
3230              
3231             fail:
3232 38           return 0;
3233             }
3234              
3235             static SV *
3236 4221           decode_av (pTHX_ dec_t *dec, SV *typesv)
3237             {
3238 4221           AV *av = newAV ();
3239 4221           AV *typeav = NULL;
3240             SV *typerv;
3241              
3242 4221 100         DEC_INC_DEPTH;
3243 4216           decode_ws (dec);
3244              
3245 4216 100         if (typesv)
3246             {
3247 5           typeav = newAV ();
3248 5           typerv = newRV_noinc ((SV *)typeav);
3249 5 50         SvSetMagicSV (typesv, typerv);
    50          
3250             }
3251              
3252 4216 100         if (*dec->cur == ']')
3253 29           ++dec->cur;
3254             else
3255             for (;;)
3256             {
3257             SV *value;
3258 6347           SV *value_typesv = NULL;
3259              
3260 6347 100         if (typesv)
3261             {
3262 13           value_typesv = newSV (0);
3263 13           av_push (typeav, value_typesv);
3264             }
3265              
3266 6347           value = decode_sv (aTHX_ dec, value_typesv);
3267 6347 100         if (!value)
3268 1506           goto fail;
3269              
3270 4841           av_push (av, value);
3271              
3272 4841           decode_ws (dec);
3273              
3274 4841 100         if (*dec->cur == ']')
3275             {
3276 2652           ++dec->cur;
3277 2652           break;
3278             }
3279            
3280 2189 100         if (*dec->cur != ',')
3281 27           ERR (", or ] expected while parsing array");
3282              
3283 2162           ++dec->cur;
3284              
3285 2162           decode_ws (dec);
3286              
3287 2162 100         if (*dec->cur == ']' && dec->json.flags & F_RELAXED)
    100          
3288             {
3289 2           ++dec->cur;
3290 2           break;
3291             }
3292 2160           }
3293              
3294 2683           DEC_DEC_DEPTH;
3295 2683           return newRV_noinc ((SV *)av);
3296              
3297             fail:
3298 1538           SvREFCNT_dec (av);
3299 1538           DEC_DEC_DEPTH;
3300 1538           return 0;
3301             }
3302              
3303             static SV *
3304 2468           decode_hv (pTHX_ dec_t *dec, SV *typesv)
3305             {
3306             SV *sv;
3307 2468           HV *hv = newHV ();
3308 2468           HV *typehv = NULL;
3309             SV *typerv;
3310 2468           int allow_squote = dec->json.flags & F_ALLOW_SQUOTE;
3311 2468           int allow_barekey = dec->json.flags & F_ALLOW_BAREKEY;
3312 2468           int allow_dupkeys = dec->json.flags & F_ALLOW_DUPKEYS;
3313 2468           char endstr = '"';
3314              
3315 2468 50         DEC_INC_DEPTH;
3316 2468           decode_ws (dec);
3317              
3318 2468 100         if (typesv)
3319             {
3320 2           typehv = newHV ();
3321 2           typerv = newRV_noinc ((SV *)typehv);
3322 2 50         SvSetMagicSV (typesv, typerv);
    50          
3323             }
3324              
3325 2468 100         if (*dec->cur == '}')
3326 17           ++dec->cur;
3327             else
3328             for (;;)
3329             {
3330 3794           int is_bare = allow_barekey;
3331              
3332 3794 100         if (UNLIKELY(allow_barekey
    100          
    100          
    50          
3333             && *dec->cur >= 'A' && *dec->cur <= 'z'))
3334             ;
3335 3788 100         else if (UNLIKELY(allow_squote)) {
3336 16 100         if (*dec->cur != '"' && *dec->cur != 0x27) {
    100          
3337 1           ERR ("'\"' or ''' expected");
3338             }
3339 15 100         else if (*dec->cur == 0x27)
3340 4           endstr = 0x27;
3341 15           is_bare=0;
3342 15           ++dec->cur;
3343             } else {
3344 3772 100         EXPECT_CH ('"');
3345 3748           is_bare=0;
3346             }
3347              
3348             /* heuristic: assume that */
3349             /* a) decode_str + hv_store_ent are abysmally slow. */
3350             /* b) most hash keys are short, simple ascii text. */
3351             /* => try to "fast-match" such strings to avoid */
3352             /* the overhead of decode_str + hv_store_ent. */
3353             {
3354             SV *value;
3355 3769           SV *value_typesv = NULL;
3356 3769           char *p = dec->cur;
3357 3769           char *e = p + 24; /* only try up to 24 bytes */
3358              
3359             for (;;)
3360             {
3361             /* the >= 0x80 is false on most architectures */
3362 21345 100         if (!is_bare &&
    100          
3363 21322 100         (p == e || *p < 0x20 || *(U8*)p >= 0x80 || *p == '\\'
    50          
    100          
3364 21115 100         || allow_squote))
3365             {
3366             /* slow path, back up and use decode_str */
3367             /* utf8 hash keys are handled here */
3368 223           SV *key = _decode_str (aTHX_ dec, endstr);
3369 223 100         if (!key)
3370 4           goto fail;
3371              
3372 219 100         if (!allow_dupkeys && UNLIKELY(hv_exists_ent (hv, key, 0))) {
    100          
3373 1           ERR ("Duplicate keys not allowed");
3374             }
3375 218 50         decode_ws (dec); EXPECT_CH (':');
3376 218           decode_ws (dec);
3377              
3378 218 50         if (typesv)
3379             {
3380 0           value_typesv = newSV (0);
3381 0           (void)hv_store_ent (typehv, key, value_typesv, 0);
3382             }
3383              
3384 218           value = decode_sv (aTHX_ dec, value_typesv);
3385 218 100         if (!value)
3386             {
3387 1           SvREFCNT_dec (key);
3388 1           goto fail;
3389             }
3390              
3391 217           (void)hv_store_ent (hv, key, value, 0);
3392 217           SvREFCNT_dec (key);
3393              
3394 217           break;
3395             }
3396 21122 100         else if (*p == endstr
3397 17582 100         || (is_bare &&
    100          
3398 17 100         (*p == ':' || *p == ' ' || *p == 0x0a
    50          
3399 16 50         || *p == 0x0d || *p == 0x09)))
    100          
3400             {
3401             /* fast path, got a simple key */
3402 3546           char *key = dec->cur;
3403 3546           U32 len = p - key;
3404             assert(p >= key && p - key < I32_MAX);
3405             #if PTRSIZE >= 8
3406             /* hv_store can only handle I32 len, which might overflow */
3407             /* perl5 just silently truncates it, cperl panics */
3408 3546 50         if (UNLIKELY(p - key > I32_MAX))
3409 0           ERR ("Hash key too large");
3410             #endif
3411 3546 100         if (!allow_dupkeys && UNLIKELY(hv_exists (hv, key, len))) {
    100          
3412 6           ERR ("Duplicate keys not allowed");
3413             }
3414              
3415 3540           dec->cur = p + 1;
3416 3540 100         decode_ws (dec); if (*p != ':') EXPECT_CH (':');
    100          
3417 3532           decode_ws (dec);
3418              
3419 3532 100         if (typesv)
3420             {
3421 9           value_typesv = newSV (0);
3422 9           hv_store (typehv, key, len, value_typesv, 0);
3423             }
3424              
3425 3532           value = decode_sv (aTHX_ dec, value_typesv);
3426 3532 100         if (!value)
3427 776           goto fail;
3428              
3429             /* Note: not a utf8 hash key */
3430             #if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION >= 9)
3431 2756           hv_common (hv, NULL, key, len, 0,
3432             HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, value, 0);
3433             #else
3434             hv_store (hv, key, len, value, 0);
3435             #endif
3436 2756           break;
3437             }
3438              
3439 17576           ++p;
3440 17576           }
3441             }
3442              
3443 2973           decode_ws (dec);
3444              
3445 2973 100         if (*dec->cur == '}')
3446             {
3447 1624           ++dec->cur;
3448 1624           break;
3449             }
3450              
3451 1349 100         if (*dec->cur != ',')
3452 5           ERR (", or } expected while parsing object/hash");
3453              
3454 1344           ++dec->cur;
3455              
3456 1344           decode_ws (dec);
3457              
3458 1344 100         if (*dec->cur == '}' && dec->json.flags & F_RELAXED)
    100          
3459             {
3460 1           ++dec->cur;
3461 1           break;
3462             }
3463 1343           }
3464              
3465 1642           DEC_DEC_DEPTH;
3466 1642           sv = newRV_noinc ((SV *)hv);
3467              
3468             /* check filter callbacks */
3469 1642 100         if (dec->json.flags & F_HOOK)
3470             {
3471 14 100         if (dec->json.cb_sk_object && HvKEYS (hv) == 1)
    50          
    100          
3472             {
3473 7           HE *cb = NULL, *he;
3474              
3475 7           hv_iterinit (hv);
3476 7           he = hv_iternext (hv);
3477 7           hv_iterinit (hv);
3478              
3479             /* the next line creates a mortal sv each time it's called. */
3480             /* might want to optimise this for common cases. */
3481 7 50         if (LIKELY((long)he))
3482 7           cb = hv_fetch_ent (dec->json.cb_sk_object, hv_iterkeysv (he), 0, 0);
3483              
3484 7 100         if (cb)
3485             {
3486 6           dSP;
3487             I32 count;
3488              
3489 6 50         ENTER; SAVETMPS; SAVESTACK_POS (); PUSHMARK (SP);
    50          
3490 6 50         XPUSHs (HeVAL (he));
3491 6           sv_2mortal (sv);
3492              
3493 6           PUTBACK; count = call_sv (HeVAL (cb), G_ARRAY); SPAGAIN;
3494              
3495 6 100         if (count == 1)
3496             {
3497 4           sv = newSVsv (POPs);
3498 4 50         PUTBACK; FREETMPS; LEAVE;
3499 4           return sv;
3500             }
3501              
3502 2           SvREFCNT_inc (sv);
3503 2           SP -= count;
3504 2 50         PUTBACK; FREETMPS; LEAVE;
3505             }
3506             }
3507              
3508 10 100         if (dec->json.cb_object)
3509             {
3510 8           dSP;
3511             I32 count;
3512              
3513 8 50         ENTER; SAVETMPS; SAVESTACK_POS (); PUSHMARK (SP);
    50          
3514 8 50         XPUSHs (sv_2mortal (sv));
3515              
3516 8           PUTBACK; count = call_sv (dec->json.cb_object, G_ARRAY); SPAGAIN;
3517              
3518 8 100         if (count == 1)
3519             {
3520 3           sv = newSVsv (POPs);
3521 3 50         PUTBACK; FREETMPS; LEAVE;
3522 3           return sv;
3523             }
3524              
3525 5           SvREFCNT_inc (sv);
3526 5           SP -= count;
3527 5 50         PUTBACK; FREETMPS; LEAVE;
3528             }
3529             }
3530              
3531 1635           return sv;
3532              
3533             fail:
3534 826           SvREFCNT_dec (hv);
3535 826           DEC_DEC_DEPTH;
3536 826           return 0;
3537             }
3538              
3539             static SV *
3540 1           decode_tag (pTHX_ dec_t *dec)
3541             {
3542 1           SV *tag = 0;
3543 1           SV *val = 0;
3544              
3545 1 50         if (!(dec->json.flags & F_ALLOW_TAGS))
3546 0           ERR ("malformed JSON string, neither array, object, number, string or atom");
3547              
3548 1           ++dec->cur;
3549              
3550 1           decode_ws (dec);
3551              
3552 1           tag = decode_sv (aTHX_ dec, NULL);
3553 1 50         if (!tag)
3554 0           goto fail;
3555              
3556 1 50         if (!SvPOK (tag))
3557 0           ERR ("malformed JSON string, (tag) must be a string");
3558              
3559 1           decode_ws (dec);
3560              
3561 1 50         if (*dec->cur != ')')
3562 0           ERR (") expected after tag");
3563              
3564 1           ++dec->cur;
3565              
3566 1           decode_ws (dec);
3567              
3568 1           val = decode_sv (aTHX_ dec, NULL);
3569 1 50         if (!val)
3570 0           goto fail;
3571              
3572 1 50         if (!SvROK (val) || SvTYPE (SvRV (val)) != SVt_PVAV)
    50          
3573 0           ERR ("malformed JSON string, tag value must be an array");
3574              
3575             {
3576             dMY_CXT;
3577 1           AV *av = (AV *)SvRV (val);
3578 1           HVMAX_T i, len = av_len (av) + 1;
3579 1           HV *stash = gv_stashsv (tag, 0);
3580             SV *sv;
3581             GV *method;
3582 1           dSP;
3583              
3584 1 50         if (!stash)
3585 0           ERR ("cannot decode perl-object (package does not exist)");
3586              
3587 1           method = gv_fetchmethod_autoload (stash, "THAW", 0);
3588              
3589 1 50         if (!method)
3590 0           ERR ("cannot decode perl-object (package does not have a THAW method)");
3591              
3592 1 50         ENTER; SAVETMPS; SAVESTACK_POS (); PUSHMARK (SP);
    50          
3593 1 50         EXTEND (SP, len + 2);
    50          
3594             /* we re-bless the reference to get overload and other niceties right */
3595 1           PUSHs (tag);
3596 1           PUSHs (MY_CXT.sv_json);
3597              
3598 4 100         for (i = 0; i < len; ++i)
3599 3           PUSHs (*av_fetch (av, i, 1));
3600              
3601 1           PUTBACK;
3602 1           call_sv ((SV *)GvCV (method), G_SCALAR);
3603 1           SPAGAIN;
3604              
3605 1           SvREFCNT_dec (tag);
3606 1           SvREFCNT_dec (val);
3607 1           sv = SvREFCNT_inc (POPs);
3608              
3609 1           PUTBACK;
3610              
3611 1 50         FREETMPS; LEAVE;
3612              
3613 1           return sv;
3614             }
3615              
3616             fail:
3617 0           SvREFCNT_dec (tag);
3618 0           SvREFCNT_dec (val);
3619 0           return 0;
3620             }
3621              
3622             static SV *
3623 11537           decode_sv (pTHX_ dec_t *dec, SV *typesv)
3624             {
3625             /* the beauty of JSON: you need exactly one character lookahead */
3626             /* to parse everything. */
3627 11537           switch (*dec->cur)
3628             {
3629             case '"':
3630 3689           ++dec->cur;
3631 3689 100         if (typesv)
3632 5           sv_setiv_mg (typesv, JSON_TYPE_STRING);
3633 3689           return decode_str (aTHX_ dec);
3634             case 0x27:
3635 6 100         if (dec->json.flags & F_ALLOW_SQUOTE) {
3636 3           ++dec->cur;
3637 3 50         if (typesv)
3638 0           sv_setiv_mg (typesv, JSON_TYPE_STRING);
3639 3           return decode_str_sq (aTHX_ dec);
3640             }
3641 3           ERR ("malformed JSON string, neither tag, array, object, number, string or atom");
3642             break;
3643 4221           case '[': ++dec->cur; return decode_av (aTHX_ dec, typesv);
3644 2468           case '{': ++dec->cur; return decode_hv (aTHX_ dec, typesv);
3645 1           case '(': return decode_tag (aTHX_ dec);
3646              
3647             case '-':
3648             case '0': case '1': case '2': case '3': case '4':
3649             case '5': case '6': case '7': case '8': case '9':
3650 964           return decode_num (aTHX_ dec, typesv);
3651              
3652             case 't':
3653 31 100         if (dec->end - dec->cur >= 4 && memEQc(dec->cur, "true"))
    100          
3654             {
3655             dMY_CXT;
3656 27           dec->cur += 4;
3657 27 100         if (typesv)
3658 5           sv_setiv_mg (typesv, JSON_TYPE_BOOL);
3659 27 100         if (dec->json.flags & F_UNBLESSED_BOOL)
3660 4           return newSVsv (&PL_sv_yes);
3661 23           return newSVsv(MY_CXT.json_true);
3662             }
3663             else
3664 4           ERR ("'true' expected");
3665              
3666             break;
3667              
3668             case 'f':
3669 24 100         if (dec->end - dec->cur >= 5 && memEQc(dec->cur, "false"))
    100          
3670             {
3671             dMY_CXT;
3672 22           dec->cur += 5;
3673 22 100         if (typesv)
3674 5           sv_setiv_mg (typesv, JSON_TYPE_BOOL);
3675 22 100         if (dec->json.flags & F_UNBLESSED_BOOL)
3676 4           return newSVsv (&PL_sv_no);
3677 18           return newSVsv(MY_CXT.json_false);
3678             }
3679             else
3680 2           ERR ("'false' expected");
3681              
3682             break;
3683              
3684             case 'n':
3685 59 100         if (dec->end - dec->cur >= 4 && memEQc(dec->cur, "null"))
    100          
3686             {
3687 56           dec->cur += 4;
3688 56 100         if (typesv)
3689 3           sv_setiv_mg (typesv, JSON_TYPE_NULL);
3690 56           return newSVsv(&PL_sv_undef);
3691             }
3692             else
3693 3           ERR ("'null' expected");
3694              
3695             break;
3696              
3697             default:
3698 74           ERR ("malformed JSON string, neither tag, array, object, number, string or atom");
3699             break;
3700             }
3701              
3702             fail:
3703 86           return 0;
3704             }
3705              
3706             /* decode UTF32-LE/... to UTF-8:
3707             $utf8 = Encode::decode("UTF-32", $string); */
3708             static SV *
3709 8           decode_bom(pTHX_ const char* encoding, SV* string, STRLEN offset)
3710             {
3711 8           dSP;
3712             I32 items;
3713             PERL_UNUSED_ARG(offset);
3714              
3715             #ifndef HAVE_DECODE_BOM
3716             croak ("Cannot handle multibyte BOM yet");
3717             return string;
3718             #else
3719 8           ENTER;
3720             #if PERL_VERSION > 18
3721             /* on older perls (<5.20) this corrupts ax */
3722 8           Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("Encode"),
3723             NULL, NULL, NULL);
3724             #else
3725             if (!get_cvs("Encode::decode", GV_NOADD_NOINIT|GV_NO_SVGMAGIC))
3726             croak("Multibyte BOM needs to use Encode before");
3727             #endif
3728 8           LEAVE;
3729 8           ENTER;
3730 8 50         PUSHMARK(SP);
3731 8 50         XPUSHs(newSVpvn(encoding, strlen(encoding)));
3732 8 50         XPUSHs(string);
3733 8           PUTBACK;
3734             /* Calling Encode::Unicode::decode_xs would be faster, but we'd need the blessed
3735             enc hash from find_encoding() then. e.g. $Encode::Encoding{'UTF-16LE'}
3736             bless {Name=>UTF-16,size=>2,endian=>'',ucs2=>undef}, 'Encode::Unicode';
3737             And currenty we enjoy the simplicity of the BOM offset advance by
3738             endianness autodetection.
3739             */
3740 8           items = call_sv(MUTABLE_SV(get_cvs("Encode::decode",
3741             GV_NOADD_NOINIT|GV_NO_SVGMAGIC)), G_SCALAR);
3742 8           SPAGAIN;
3743 8 50         if (items >= 0 && SvPOK(TOPs)) {
    50          
3744 8           LEAVE;
3745 8           SvUTF8_on(TOPs);
3746 8           return POPs;
3747             } else {
3748 0           LEAVE;
3749 0           return string;
3750             }
3751             #endif
3752             }
3753              
3754             static SV *
3755 1440           decode_json (pTHX_ SV *string, JSON *json, STRLEN *offset_return, SV *typesv)
3756             {
3757             dec_t dec;
3758             SV *sv;
3759 1440           STRLEN len, offset = 0;
3760 1440           int converted = 0;
3761             /*dMY_CXT;*/
3762              
3763             /* work around bugs in 5.10 where manipulating magic values
3764             * makes perl ignore the magic in subsequent accesses.
3765             * also make a copy of non-PV values, to get them into a clean
3766             * state (SvPV should do that, but it's buggy, see below).
3767             * But breaks decode_prefix with offset.
3768             */
3769             /*SvGETMAGIC (string);*/
3770 1440 100         if (SvMAGICAL (string) || !SvPOK (string) || SvIsCOW_shared_hash(string))
    100          
    100          
    100          
3771 117           string = sv_2mortal (newSVsv (string));
3772              
3773 1440 100         SvUPGRADE (string, SVt_PV);
3774              
3775             /* work around a bug in perl 5.10, which causes SvCUR to fail an
3776             * assertion with -DDEBUGGING, although SvCUR is documented to
3777             * return the xpv_cur field which certainly exists after upgrading.
3778             * according to nicholas clark, calling SvPOK fixes this.
3779             * But it doesn't fix it, so try another workaround, call SvPV_nolen
3780             * and hope for the best.
3781             * Damnit, SvPV_nolen still trips over yet another assertion. This
3782             * assertion business is seriously broken, try yet another workaround
3783             * for the broken -DDEBUGGING.
3784             */
3785             {
3786             #ifdef DEBUGGING
3787             len = SvOK (string) ? sv_len (string) : 0;
3788             #else
3789 1440           len = SvCUR (string);
3790             #endif
3791              
3792 1440 100         if (UNLIKELY(len > json->max_size && json->max_size))
    100          
3793 1           croak ("attempted decode of JSON text of %lu bytes size, but max_size is set to %lu",
3794 1           (unsigned long)len, (unsigned long)json->max_size);
3795             }
3796              
3797             /* Detect BOM and possibly convert to UTF-8 and set UTF8 flag.
3798              
3799             https://tools.ietf.org/html/rfc7159#section-8.1
3800             JSON text SHALL be encoded in UTF-8, UTF-16, or UTF-32.
3801             Byte Order Mark - While section 8.1 states "Implementations MUST
3802             NOT add a byte order mark to the beginning of a JSON text",
3803             "implementations (...) MAY ignore the presence of a byte order
3804             mark rather than treating it as an error". */
3805 1439 100         if (UNLIKELY(len > 2 && SvPOK(string) && !json->incr_pos)) {
    50          
    100          
    100          
3806 1122           U8 *s = (U8*)SvPVX (string);
3807 1122 100         if (*s >= 0xEF) {
3808 12 50         if (len >= 3 && memEQc(s, UTF8BOM)) {
    100          
3809 5           converted = 1 + (json->flags & F_UTF8);
3810 5           json->flags |= F_UTF8;
3811 5           offset = 3;
3812 5           SvPV_set(string, SvPVX_mutable (string) + 3);
3813 5           SvCUR_set(string, len - 3);
3814 5           SvUTF8_on(string);
3815             /* omitting the endian name will skip the BOM in the result */
3816 7 50         } else if (len >= 4 && memEQc(s, UTF32BOM)) {
    100          
3817 2           string = decode_bom(aTHX_ "UTF-32", string, 4);
3818 2           converted = 1 + (json->flags & F_UTF8);
3819 2           json->flags |= F_UTF8;
3820 5 100         } else if (memEQc(s, UTF16BOM)) {
3821 2           string = decode_bom(aTHX_ "UTF-16", string, 2);
3822 2           converted = 1 + (json->flags & F_UTF8);
3823 2           json->flags |= F_UTF8;
3824 3 100         } else if (memEQc(s, UTF16BOM_BE)) {
3825 2           string = decode_bom(aTHX_ "UTF-16", string, 2);
3826 2           converted = 1 + (json->flags & F_UTF8);
3827 12           json->flags |= F_UTF8;
3828             }
3829 1110 100         } else if (UNLIKELY(len >= 4 && !*s && memEQc(s, UTF32BOM_BE))) {
    100          
    100          
    50          
3830 2           string = decode_bom(aTHX_ "UTF-32", string, 4);
3831 2           converted = 1 + (json->flags & F_UTF8);
3832 2           json->flags |= F_UTF8;
3833             }
3834             }
3835              
3836 1439 100         if (LIKELY(!converted)) {
3837 1426 100         if (DECODE_WANTS_OCTETS (json))
3838 750           sv_utf8_downgrade (string, 0);
3839             else
3840 676           sv_utf8_upgrade (string);
3841             }
3842              
3843             /* should basically be a NOP but needed for 5.6 with undef */
3844 1438 50         if (!SvPOK(string))
3845 0 0         SvGROW (string, SvCUR (string) + 1);
    0          
3846              
3847 1438           dec.json = *json;
3848 1438           dec.cur = SvPVX (string);
3849 1438           dec.end = SvEND (string);
3850 1438           dec.err = 0;
3851 1438           dec.depth = 0;
3852              
3853 1438 100         if (dec.json.cb_object || dec.json.cb_sk_object)
    100          
3854 14           dec.json.flags |= F_HOOK;
3855              
3856 1438           *dec.end = 0; /* this should basically be a nop, too, but make sure it's there */
3857              
3858 1438           decode_ws (&dec);
3859 1438           sv = decode_sv (aTHX_ &dec, typesv);
3860              
3861 1438 100         if (offset_return) {
3862 283 50         if (dec.cur < SvPVX (string) || dec.cur > SvEND (string))
    50          
3863 0           *offset_return = 0;
3864             else
3865 283           *offset_return = dec.cur - SvPVX (string);
3866             }
3867              
3868 1438 100         if (!(offset_return || !sv))
    100          
3869             {
3870             /* check for trailing garbage */
3871 837           decode_ws (&dec);
3872              
3873 837 100         if ((dec.end - dec.cur) || *dec.cur)
    50          
3874             {
3875 21           dec.err = "garbage after JSON object";
3876 21           SvREFCNT_dec (sv);
3877 21           sv = NULL;
3878             }
3879             }
3880             /* restore old utf8 string with BOM */
3881 1438 100         if (UNLIKELY(offset)) {
3882 5           SvPV_set(string, SvPVX_mutable (string) - offset);
3883 5           SvCUR_set(string, len);
3884             }
3885              
3886 1438 100         if (!sv)
3887             {
3888 343           SV *uni = sv_newmortal ();
3889              
3890             #if PERL_VERSION >= 8
3891             /* horrible hack to silence warning inside pv_uni_display */
3892             /* TODO: Can be omitted with newer perls */
3893 343           COP cop = *PL_curcop;
3894 343           cop.cop_warnings = pWARN_NONE;
3895 343           ENTER;
3896 343           SAVEVPTR (PL_curcop);
3897 343           PL_curcop = &cop;
3898 343           pv_uni_display (uni, (U8*)dec.cur, dec.end - dec.cur, 20, UNI_DISPLAY_QQ);
3899 343           LEAVE;
3900             #endif
3901 992 100         croak ("%s, at character offset %d (before \"%s\")",
3902             dec.err,
3903 343           (int)ptr_to_index (aTHX_ string, dec.cur-SvPVX(string)),
3904 306 50         dec.cur != dec.end ? SvPV_nolen (uni) : "(end of string)");
3905             }
3906              
3907 1095 100         if (!(dec.json.flags & F_ALLOW_NONREF) && json_nonref(aTHX_ sv))
    100          
3908 9           croak ("JSON text must be an object or array (but found number, string, true, false or null, use allow_nonref to allow this)");
3909              
3910 1086 100         if (UNLIKELY(converted && !(converted - 1))) /* with BOM, and UTF8 was not set */
    100          
3911 1           json->flags &= ~F_UTF8;
3912 1086           return sv_2mortal (sv);
3913             }
3914              
3915             /*/////////////////////////////////////////////////////////////////////////// */
3916             /* incremental parser */
3917              
3918             static void
3919 318           incr_parse (JSON *self)
3920             {
3921 318           const char *p = SvPVX (self->incr_text) + self->incr_pos;
3922              
3923             /* the state machine here is a bit convoluted and could be simplified a lot */
3924             /* but this would make it slower, so... */
3925              
3926             for (;;)
3927             {
3928             /*printf ("loop pod %d *p<%c><%s>, mode %d nest %d\n", p - SvPVX (self->incr_text), *p, p, self->incr_mode, self->incr_nest);//D */
3929 327           switch (self->incr_mode)
3930             {
3931             /* only used for initial whitespace skipping */
3932             case INCR_M_WS:
3933             for (;;)
3934             {
3935 556 100         if (*p > 0x20)
3936             {
3937 278 100         if (*p == '#')
3938             {
3939 6           self->incr_mode = INCR_M_C0;
3940 6           goto incr_m_c;
3941             }
3942             else
3943             {
3944 272           self->incr_mode = INCR_M_JSON;
3945 272           goto incr_m_json;
3946             }
3947             }
3948 278 100         else if (!*p)
3949 42           goto interrupt;
3950              
3951 236           ++p;
3952 236           }
3953              
3954             /* skip a single char inside a string (for \\-processing) */
3955             case INCR_M_BS:
3956 0 0         if (!*p)
3957 0           goto interrupt;
3958              
3959 0           ++p;
3960 0           self->incr_mode = INCR_M_STR;
3961 0           goto incr_m_str;
3962              
3963             /* inside #-style comments */
3964             case INCR_M_C0:
3965             case INCR_M_C1:
3966             incr_m_c:
3967             for (;;)
3968             {
3969 45 100         if (*p == '\n')
3970             {
3971 9 100         self->incr_mode = self->incr_mode == INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;
3972 9           break;
3973             }
3974 36 50         else if (!*p)
3975 0           goto interrupt;
3976              
3977 36           ++p;
3978 36           }
3979              
3980 9           break;
3981              
3982             /* inside a string */
3983             case INCR_M_STR:
3984             incr_m_str:
3985             for (;;)
3986             {
3987 2085 100         if (*p == '"')
3988             {
3989 583           ++p;
3990 583           self->incr_mode = INCR_M_JSON;
3991              
3992 583 100         if (!self->incr_nest)
3993 15           goto interrupt;
3994              
3995 568           goto incr_m_json;
3996             }
3997 1502 100         else if (*p == '\\')
3998             {
3999 498           ++p; /* "virtually" consumes character after \ */
4000              
4001 498 50         if (!*p) /* if at end of string we have to switch modes */
4002             {
4003 0           self->incr_mode = INCR_M_BS;
4004 0           goto interrupt;
4005             }
4006             }
4007 1004 100         else if (!*p)
4008 2           goto interrupt;
4009              
4010 1500           ++p;
4011 1500           }
4012              
4013             /* after initial ws, outside string */
4014             case INCR_M_JSON:
4015             incr_m_json:
4016             for (;;)
4017             {
4018 3238           switch (*p++)
4019             {
4020             case 0:
4021 2           --p;
4022 2           goto interrupt;
4023              
4024             case 0x09:
4025             case 0x0a:
4026             case 0x0d:
4027             case 0x20:
4028 682 50         if (!self->incr_nest)
4029             {
4030 0           --p; /* do not eat the whitespace, let the next round do it */
4031 0           goto interrupt;
4032             }
4033 682           break;
4034              
4035             case '"':
4036 583           self->incr_mode = INCR_M_STR;
4037 583           goto incr_m_str;
4038              
4039             case '[':
4040             case '{':
4041             case '(':
4042 358 100         if (++self->incr_nest > (int)self->max_depth)
4043 1           croak (ERR_NESTING_EXCEEDED);
4044 357           break;
4045              
4046             case ']':
4047             case '}':
4048 355 100         if (--self->incr_nest <= 0)
4049 256           goto interrupt;
4050 99           break;
4051              
4052             case ')':
4053 0           --self->incr_nest;
4054 0           break;
4055              
4056             case '#':
4057 3           self->incr_mode = INCR_M_C1;
4058 3           goto incr_m_c;
4059             }
4060 2393           }
4061             }
4062 9           }
4063              
4064             interrupt:
4065 317           self->incr_pos = p - SvPVX (self->incr_text);
4066             /*printf ("interrupt<%.*s>\n", self->incr_pos, SvPVX(self->incr_text));//D */
4067             /*printf ("return pos %d mode %d nest %d\n", self->incr_pos, self->incr_mode, self->incr_nest);//D */
4068 317           }
4069              
4070             /*/////////////////////////////////////////////////////////////////////////// */
4071             /* XS interface functions */
4072              
4073             MODULE = Cpanel::JSON::XS PACKAGE = Cpanel::JSON::XS
4074              
4075             #if PERL_VERSION > 7
4076             # define NODEBUG_ON \
4077             CvNODEBUG_on (get_cv ("Cpanel::JSON::XS::incr_text", 0));
4078             #else
4079             # define NODEBUG_ON
4080             #endif
4081              
4082             BOOT:
4083             {
4084             HV *stash;
4085             MY_CXT_INIT;
4086 57           init_MY_CXT(aTHX_ &MY_CXT);
4087              
4088 57           stash = gv_stashpvs(JSON_TYPE_CLASS, GV_ADD);
4089 57           newCONSTSUB(stash, "JSON_TYPE_BOOL", newSViv(JSON_TYPE_BOOL));
4090 57           newCONSTSUB(stash, "JSON_TYPE_INT", newSViv(JSON_TYPE_INT));
4091 57           newCONSTSUB(stash, "JSON_TYPE_FLOAT", newSViv(JSON_TYPE_FLOAT));
4092 57           newCONSTSUB(stash, "JSON_TYPE_STRING", newSViv(JSON_TYPE_STRING));
4093 57           newCONSTSUB(stash, "JSON_TYPE_NULL", newSViv(JSON_TYPE_NULL));
4094 57           newCONSTSUB(stash, "JSON_TYPE_INT_OR_NULL", newSViv(JSON_TYPE_INT | JSON_TYPE_CAN_BE_NULL));
4095 57           newCONSTSUB(stash, "JSON_TYPE_BOOL_OR_NULL", newSViv(JSON_TYPE_BOOL | JSON_TYPE_CAN_BE_NULL));
4096 57           newCONSTSUB(stash, "JSON_TYPE_FLOAT_OR_NULL", newSViv(JSON_TYPE_FLOAT | JSON_TYPE_CAN_BE_NULL));
4097 57           newCONSTSUB(stash, "JSON_TYPE_STRING_OR_NULL", newSViv(JSON_TYPE_STRING | JSON_TYPE_CAN_BE_NULL));
4098 57           newCONSTSUB(stash, "JSON_TYPE_CAN_BE_NULL", newSViv(JSON_TYPE_CAN_BE_NULL));
4099 57           newCONSTSUB(stash, "JSON_TYPE_ARRAYOF_CLASS", newSVpvs(JSON_TYPE_ARRAYOF_CLASS));
4100 57           newCONSTSUB(stash, "JSON_TYPE_HASHOF_CLASS", newSVpvs(JSON_TYPE_HASHOF_CLASS));
4101 57           newCONSTSUB(stash, "JSON_TYPE_ANYOF_CLASS", newSVpvs(JSON_TYPE_ANYOF_CLASS));
4102              
4103 57           NODEBUG_ON; /* the debugger completely breaks lvalue subs */
4104             }
4105              
4106             PROTOTYPES: DISABLE
4107              
4108              
4109             #_if PERL_IMPLICIT_CONTEXT for embedding, but no ithreads, then CLONE is never
4110             # called
4111              
4112             #ifdef USE_ITHREADS
4113              
4114             void CLONE (...)
4115             PPCODE:
4116             MY_CXT_CLONE; /* possible declaration */
4117             init_MY_CXT(aTHX_ &MY_CXT);
4118             /* skip implicit PUTBACK, returning @_ to caller, more efficient*/
4119             return;
4120              
4121             #endif
4122              
4123             void END(...)
4124             PREINIT:
4125             dMY_CXT;
4126             SV * sv;
4127             PPCODE:
4128 57           sv = MY_CXT.sv_json;
4129 57           MY_CXT.sv_json = NULL;
4130 57           SvREFCNT_dec_NN(sv);
4131             /* skip implicit PUTBACK, returning @_ to caller, more efficient*/
4132 57           return;
4133              
4134             void new (char *klass)
4135             PPCODE:
4136             dMY_CXT;
4137 213           SV *pv = NEWSV (0, sizeof (JSON));
4138 213           SvPOK_only (pv);
4139 213           json_init ((JSON *)SvPVX (pv));
4140 213 50         XPUSHs (sv_2mortal (sv_bless (
    50          
4141             newRV_noinc (pv),
4142             strEQc (klass, "Cpanel::JSON::XS") ? JSON_STASH : gv_stashpv (klass, 1)
4143             )));
4144              
4145             void ascii (JSON *self, int enable = 1)
4146             ALIAS:
4147             ascii = F_ASCII
4148             latin1 = F_LATIN1
4149             binary = F_BINARY
4150             utf8 = F_UTF8
4151             indent = F_INDENT
4152             canonical = F_CANONICAL
4153             space_before = F_SPACE_BEFORE
4154             space_after = F_SPACE_AFTER
4155             pretty = F_PRETTY
4156             allow_nonref = F_ALLOW_NONREF
4157             shrink = F_SHRINK
4158             allow_blessed = F_ALLOW_BLESSED
4159             convert_blessed = F_CONV_BLESSED
4160             relaxed = SET_RELAXED
4161             allow_unknown = F_ALLOW_UNKNOWN
4162             allow_tags = F_ALLOW_TAGS
4163             allow_barekey = F_ALLOW_BAREKEY
4164             allow_singlequote = F_ALLOW_SQUOTE
4165             allow_bignum = F_ALLOW_BIGNUM
4166             escape_slash = F_ESCAPE_SLASH
4167             allow_stringify = F_ALLOW_STRINGIFY
4168             unblessed_bool = F_UNBLESSED_BOOL
4169             allow_dupkeys = F_ALLOW_DUPKEYS
4170             require_types = F_REQUIRE_TYPES
4171             PPCODE:
4172 287 100         if (enable)
4173 273           self->flags |= ix;
4174             else
4175 14           self->flags &= ~ix;
4176 287 50         XPUSHs (ST (0));
4177              
4178             void get_ascii (JSON *self)
4179             ALIAS:
4180             get_ascii = F_ASCII
4181             get_latin1 = F_LATIN1
4182             get_binary = F_BINARY
4183             get_utf8 = F_UTF8
4184             get_indent = F_INDENT
4185             get_canonical = F_CANONICAL
4186             get_space_before = F_SPACE_BEFORE
4187             get_space_after = F_SPACE_AFTER
4188             get_allow_nonref = F_ALLOW_NONREF
4189             get_shrink = F_SHRINK
4190             get_allow_blessed = F_ALLOW_BLESSED
4191             get_convert_blessed = F_CONV_BLESSED
4192             get_relaxed = F_RELAXED
4193             get_allow_unknown = F_ALLOW_UNKNOWN
4194             get_allow_tags = F_ALLOW_TAGS
4195             get_allow_barekey = F_ALLOW_BAREKEY
4196             get_allow_singlequote = F_ALLOW_SQUOTE
4197             get_allow_bignum = F_ALLOW_BIGNUM
4198             get_escape_slash = F_ESCAPE_SLASH
4199             get_allow_stringify = F_ALLOW_STRINGIFY
4200             get_unblessed_bool = F_UNBLESSED_BOOL
4201             get_allow_dupkeys = F_ALLOW_DUPKEYS
4202             get_require_types = F_REQUIRE_TYPES
4203             PPCODE:
4204 0 0         XPUSHs (boolSV (self->flags & ix));
    0          
4205              
4206             void indent_length (JSON *self, int val = INDENT_STEP)
4207             PPCODE:
4208 1 50         if (0 <= val && val <= 15) {
    50          
4209 1           self->indent_length = val;
4210             } else {
4211 0           warn("The acceptable range of indent_length() is 0 to 15.");
4212             }
4213 1 50         XPUSHs (ST (0));
4214              
4215             U32 get_indent_length (JSON *self)
4216             CODE:
4217 0           RETVAL = self->indent_length;
4218             OUTPUT:
4219             RETVAL
4220              
4221             void max_depth (JSON *self, U32 max_depth = 0x80000000UL)
4222             PPCODE:
4223 5           self->max_depth = max_depth;
4224 5 50         XPUSHs (ST (0));
4225              
4226             U32 get_max_depth (JSON *self)
4227             CODE:
4228 0           RETVAL = self->max_depth;
4229             OUTPUT:
4230             RETVAL
4231              
4232             void max_size (JSON *self, U32 max_size = 0)
4233             PPCODE:
4234 3           self->max_size = max_size;
4235 3 50         XPUSHs (ST (0));
4236              
4237             int get_max_size (JSON *self)
4238             CODE:
4239 0           RETVAL = self->max_size;
4240             OUTPUT:
4241             RETVAL
4242              
4243             void stringify_infnan (JSON *self, IV infnan_mode = 1)
4244             PPCODE:
4245 9 50         if (infnan_mode > 3 || infnan_mode < 0) {
    50          
4246 0           croak ("invalid stringify_infnan mode %d. Must be 0, 1, 2 or 3", (int)infnan_mode);
4247             }
4248 9           self->infnan_mode = (unsigned char)infnan_mode;
4249 9 50         XPUSHs (ST (0));
4250            
4251             int get_stringify_infnan (JSON *self)
4252             CODE:
4253 0           RETVAL = (int)self->infnan_mode;
4254             OUTPUT:
4255             RETVAL
4256              
4257             void sort_by (JSON *self, SV* cb = &PL_sv_yes)
4258             PPCODE:
4259             {
4260 3           SvREFCNT_dec (self->cb_sort_by);
4261 3 50         self->cb_sort_by = SvOK (cb) ? newSVsv (cb) : 0;
    0          
    0          
4262 3 50         if (self->cb_sort_by)
4263 3           self->flags |= F_CANONICAL;
4264              
4265 3 50         XPUSHs (ST (0));
4266             }
4267              
4268            
4269             void filter_json_object (JSON *self, SV *cb = &PL_sv_undef)
4270             PPCODE:
4271             {
4272 5           SvREFCNT_dec (self->cb_object);
4273 5 100         self->cb_object = SvOK (cb) ? newSVsv (cb) : 0;
    50          
    50          
4274              
4275 5 50         XPUSHs (ST (0));
4276             }
4277              
4278             void filter_json_single_key_object (JSON *self, SV *key, SV *cb = &PL_sv_undef)
4279             PPCODE:
4280             {
4281 6 100         if (!self->cb_sk_object)
4282 3           self->cb_sk_object = newHV ();
4283              
4284 6 100         if (SvOK (cb))
    50          
    50          
4285 5           (void)hv_store_ent (self->cb_sk_object, key, newSVsv (cb), 0);
4286             else
4287             {
4288 1           (void)hv_delete_ent (self->cb_sk_object, key, G_DISCARD, 0);
4289              
4290 1 50         if (!HvKEYS (self->cb_sk_object))
    50          
4291             {
4292 0           SvREFCNT_dec (self->cb_sk_object);
4293 0           self->cb_sk_object = 0;
4294             }
4295             }
4296              
4297 6 50         XPUSHs (ST (0));
4298             }
4299              
4300             void encode (JSON *self, SV *scalar, SV *typesv = &PL_sv_undef)
4301             PPCODE:
4302 1062           PUTBACK; scalar = encode_json (aTHX_ scalar, self, typesv); SPAGAIN;
4303 1034 50         XPUSHs (scalar);
4304              
4305             void decode (JSON *self, SV *jsonstr, SV *typesv = NULL)
4306             PPCODE:
4307 941           PUTBACK; jsonstr = decode_json (aTHX_ jsonstr, self, 0, typesv); SPAGAIN;
4308 644 50         XPUSHs (jsonstr);
4309              
4310             void decode_prefix (JSON *self, SV *jsonstr, SV *typesv = NULL)
4311             PPCODE:
4312             {
4313             SV *sv;
4314             STRLEN offset;
4315 12           PUTBACK; sv = decode_json (aTHX_ jsonstr, self, &offset, typesv); SPAGAIN;
4316 10 50         EXTEND (SP, 2);
4317 10           PUSHs (sv);
4318 10           PUSHs (sv_2mortal (newSVuv (ptr_to_index (aTHX_ jsonstr, offset))));
4319             }
4320              
4321             void incr_parse (JSON *self, SV *jsonstr = 0)
4322             PPCODE:
4323             {
4324 626 100         if (!self->incr_text)
4325 27           self->incr_text = newSVpvn ("", 0);
4326              
4327             /* if utf8-ness doesn't match the decoder, need to upgrade/downgrade */
4328 626 100         if (!DECODE_WANTS_OCTETS (self) == !SvUTF8 (self->incr_text)) {
4329 27 50         if (DECODE_WANTS_OCTETS (self))
4330             {
4331 0 0         if (self->incr_pos)
4332 0           self->incr_pos = utf8_length ((U8 *)SvPVX (self->incr_text),
4333             (U8 *)SvPVX (self->incr_text) + self->incr_pos);
4334              
4335 0           sv_utf8_downgrade (self->incr_text, 0);
4336             }
4337             else
4338             {
4339 27           sv_utf8_upgrade (self->incr_text);
4340              
4341 27 50         if (self->incr_pos)
4342 0           self->incr_pos = utf8_hop ((U8 *)SvPVX (self->incr_text), self->incr_pos)
4343 0           - (U8 *)SvPVX (self->incr_text);
4344             }
4345             }
4346              
4347             /* append data, if any */
4348 626 100         if (jsonstr)
4349             {
4350             /* make sure both strings have same encoding */
4351 321 100         if (SvUTF8 (jsonstr) != SvUTF8 (self->incr_text)) {
4352 319 50         if (SvUTF8 (jsonstr))
4353 0           sv_utf8_downgrade (jsonstr, 0);
4354             else
4355 319           sv_utf8_upgrade (jsonstr);
4356             }
4357              
4358             /* and then just blindly append */
4359             {
4360             STRLEN len;
4361 321 50         const char *str = SvPV (jsonstr, len);
4362 321           STRLEN cur = SvCUR (self->incr_text);
4363              
4364 321 100         if (SvLEN (self->incr_text) <= cur + len)
4365 147 50         SvGROW (self->incr_text, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
    50          
4366              
4367 321           Move (str, SvEND (self->incr_text), len, char);
4368 321           SvCUR_set (self->incr_text, SvCUR (self->incr_text) + len);
4369 321           *SvEND (self->incr_text) = 0; /* this should basically be a nop, too, but make sure it's there */
4370             }
4371             }
4372              
4373 626 50         if (GIMME_V != G_VOID)
    100          
4374             do
4375             {
4376             SV *sv;
4377             STRLEN offset;
4378             char *endp;
4379              
4380 319 100         if (!INCR_DONE (self))
    100          
4381             {
4382 318           incr_parse (self);
4383              
4384 317 100         if (UNLIKELY(self->incr_pos > self->max_size && self->max_size))
    100          
4385 1           croak ("attempted decode of JSON text of %lu bytes size, but max_size is set to %lu",
4386 1           (unsigned long)self->incr_pos, (unsigned long)self->max_size);
4387              
4388 316 100         if (!INCR_DONE (self))
    100          
4389             {
4390             /* as an optimisation, do not accumulate white space in the incr buffer */
4391 46 100         if (self->incr_mode == INCR_M_WS && self->incr_pos)
    100          
4392             {
4393 4           self->incr_pos = 0;
4394 4           SvCUR_set (self->incr_text, 0);
4395             }
4396              
4397 46           break;
4398             }
4399             }
4400              
4401 271           PUTBACK; sv = decode_json (aTHX_ self->incr_text, self, &offset, NULL); SPAGAIN;
4402 267 50         XPUSHs (sv);
4403              
4404 267           endp = SvPVX(self->incr_text) + offset;
4405 267           self->incr_pos -= offset;
4406 267           self->incr_nest = 0;
4407 267           self->incr_mode = 0;
4408             #if PERL_VERSION > 9
4409 267           sv_chop (self->incr_text, (const char* const)endp);
4410             #else
4411             sv_chop (self->incr_text, (char*)endp);
4412             #endif
4413             }
4414 267 50         while (GIMME_V == G_ARRAY);
    100          
4415             }
4416              
4417             #if PERL_VERSION > 6
4418              
4419             SV *incr_text (JSON *self)
4420             ATTRS: lvalue
4421             PPCODE:
4422             {
4423             PERL_UNUSED_VAR(RETVAL);
4424 290 50         if (UNLIKELY(self->incr_pos))
4425             {
4426             /* We might want to return a copy of the rest.
4427             But incr_parse already chops the start at the end, so this can
4428             only happen on concurrent accesses to incr_parse */
4429 0           croak ("incr_text can not be called when the incremental parser already started parsing");
4430             }
4431 290 100         ST(0) = self->incr_text ? self->incr_text : &PL_sv_undef;
4432 290           XSRETURN(1);
4433             }
4434              
4435             #else
4436              
4437             SV *incr_text (JSON *self)
4438             PPCODE:
4439             {
4440             if (UNLIKELY(self->incr_pos))
4441             croak ("incr_text can not be called when the incremental parser already started parsing");
4442              
4443             ST(0) = self->incr_text ? self->incr_text : &PL_sv_undef;
4444             XSRETURN(1);
4445             }
4446              
4447             #endif
4448              
4449             void incr_skip (JSON *self)
4450             CODE:
4451             {
4452 2 50         if (self->incr_pos)
4453             {
4454 2 50         sv_chop (self->incr_text, SvPV_nolen (self->incr_text) + self->incr_pos);
4455 2           self->incr_pos = 0;
4456 2           self->incr_nest = 0;
4457 2           self->incr_mode = 0;
4458             }
4459             }
4460              
4461             void incr_reset (JSON *self)
4462             CODE:
4463             {
4464 1 50         if (self->incr_text)
4465             {
4466 1           SvREFCNT_dec (self->incr_text);
4467             }
4468 1           self->incr_text = NULL;
4469 1           self->incr_pos = 0;
4470 1           self->incr_nest = 0;
4471 1           self->incr_mode = 0;
4472             }
4473              
4474             void DESTROY (JSON *self)
4475             CODE:
4476 213           SvREFCNT_dec (self->cb_sk_object);
4477 213           SvREFCNT_dec (self->cb_object);
4478 213           SvREFCNT_dec (self->cb_sort_by);
4479 213           SvREFCNT_dec (self->incr_text);
4480              
4481             PROTOTYPES: ENABLE
4482              
4483             void encode_json (SV *scalar, SV *typesv = &PL_sv_undef)
4484             ALIAS:
4485             _to_json = 0
4486             encode_json = F_UTF8
4487             PPCODE:
4488             {
4489             JSON json;
4490 215           json_init (&json);
4491 215           json.flags |= ix;
4492 215           PUTBACK; scalar = encode_json (aTHX_ scalar, &json, typesv); SPAGAIN;
4493 215 50         XPUSHs (scalar);
4494             }
4495              
4496             void decode_json (SV *jsonstr, SV *allow_nonref = NULL, SV *typesv = NULL)
4497             ALIAS:
4498             _from_json = 0
4499             decode_json = F_UTF8
4500             PPCODE:
4501             {
4502             JSON json;
4503 216           json_init (&json);
4504 216           json.flags |= ix;
4505 216 50         if (ix && allow_nonref)
    100          
4506 9           json.flags |= F_ALLOW_NONREF;
4507 216           PUTBACK; jsonstr = decode_json (aTHX_ jsonstr, &json, 0, typesv); SPAGAIN;
4508 165 50         XPUSHs (jsonstr);
4509             }
4510