--- JSON-XS/XS.xs 2010/03/17 01:45:43 1.107 +++ JSON-XS/XS.xs 2018/11/15 20:13:03 1.134 @@ -8,6 +8,7 @@ #include #include #include +#include #if defined(__BORLANDC__) || defined(_MSC_VER) # define snprintf _snprintf // C compilers have this in stdio.h @@ -19,6 +20,17 @@ # define UTF8_MAXBYTES 13 #endif +// compatibility with perl <5.18 +#ifndef HvNAMELEN_get +# define HvNAMELEN_get(hv) strlen (HvNAME (hv)) +#endif +#ifndef HvNAMELEN +# define HvNAMELEN(hv) HvNAMELEN_get (hv) +#endif +#ifndef HvNAMEUTF8 +# define HvNAMEUTF8(hv) 0 +#endif + // three extra for rounding, sign, and end of string #define IVUV_MAXCHARS (sizeof (UV) * CHAR_BIT * 28 / 93 + 3) @@ -35,15 +47,18 @@ #define F_CONV_BLESSED 0x00000800UL #define F_RELAXED 0x00001000UL #define F_ALLOW_UNKNOWN 0x00002000UL +#define F_ALLOW_TAGS 0x00004000UL #define F_HOOK 0x00080000UL // some hooks exist, so slow-path processing #define F_PRETTY F_INDENT | F_SPACE_BEFORE | F_SPACE_AFTER -#define INIT_SIZE 32 // initial scalar size to be allocated +#define INIT_SIZE 64 // initial scalar size to be allocated #define INDENT_STEP 3 // spaces per indentation level #define SHORT_STRING_LEN 16384 // special-case strings of up to this size +#define DECODE_WANTS_OCTETS(json) ((json)->flags & F_UTF8) + #define SB do { #define SE } while (0) @@ -65,15 +80,21 @@ #define ERR_NESTING_EXCEEDED "json text or perl structure exceeds maximum nesting level (max_depth set too low?)" #ifdef USE_ITHREADS -# define JSON_SLOW 1 -# define JSON_STASH (json_stash ? json_stash : gv_stashpv ("JSON::XS", 1)) +# define JSON_STASH (expect_true (json_stash) ? json_stash : gv_stashpv ("JSON::XS", 1)) +# define BOOL_STASH (expect_true (bool_stash) ? bool_stash : gv_stashpv ("Types::Serialiser::Boolean", 1)) +# define GET_BOOL(value) (expect_true (bool_ ## value) ? bool_ ## value : get_bool ("Types::Serialiser::" # value)) #else -# define JSON_SLOW 0 # define JSON_STASH json_stash +# define BOOL_STASH bool_stash +# define GET_BOOL(value) bool_ ## value #endif -static HV *json_stash, *json_boolean_stash; // JSON::XS:: -static SV *json_true, *json_false; +// the amount of HEs to allocate on the stack, when sorting keys +#define STACK_HES 64 + +static HV *json_stash, *bool_stash; // JSON::XS::, Types::Serialiser::Boolean:: +static SV *bool_false, *bool_true; +static SV *sv_json; enum { INCR_M_WS = 0, // initial whitespace skipping, must be 0 @@ -99,6 +120,8 @@ STRLEN incr_pos; // the current offset into the text int incr_nest; // {[]}-nesting level unsigned char incr_mode; + + SV *v_false, *v_true; } JSON; INLINE void @@ -137,7 +160,32 @@ } } -// decode an utf-8 character and return it, or (UV)-1 in +/* adds two STRLENs together, slow, and with paranoia */ +STRLEN +strlen_sum (STRLEN l1, STRLEN l2) +{ + size_t sum = l1 + l2; + + if (sum < (size_t)l2 || sum != (size_t)(STRLEN)sum) + croak ("JSON::XS: string size overflow"); + + return sum; +} + +/* similar to SvGROW, but somewhat safer and guarantees exponential realloc strategy */ +static char * +json_sv_grow (SV *sv, size_t len1, size_t len2) +{ + len1 = strlen_sum (len1, len2); + len1 = strlen_sum (len1, len1 >> 1); + + if (len1 > 4096 - 24) + len1 = (len1 | 4095) - 24; + + return SvGROW (sv, len1); +} + +// decode a utf-8 character and return it, or (UV)-1 in // case of an error. // we special-case "safe" characters from U+80 .. U+7FF, // but use the very good perl function to parse anything else. @@ -260,6 +308,7 @@ // this relies greatly on the quality of the pow () // implementation of the platform, but a good // implementation is hard to beat. + // (IEEE 754 conformant ones are required to be exact) if (postdp) *expo -= eaccum; *accum += uaccum * Perl_pow (10., *expo); *expo += eaccum; @@ -283,6 +332,49 @@ return neg ? -accum : accum; } + +// target of scalar reference is bool? -1 == nope, 0 == false, 1 == true +static int +ref_bool_type (SV *sv) +{ + svtype svt = SvTYPE (sv); + + if (svt < SVt_PVAV) + { + STRLEN len = 0; + char *pv = svt ? SvPV (sv, len) : 0; + + if (len == 1) + if (*pv == '1') + return 1; + else if (*pv == '0') + return 0; + } + + return -1; +} + +// returns whether scalar is not a reference in the sense of allow_nonref +static int +json_nonref (SV *scalar) +{ + if (!SvROK (scalar)) + return 1; + + scalar = SvRV (scalar); + + if (SvTYPE (scalar) >= SVt_PVMG) + { + if (SvSTASH (scalar) == bool_stash) + return 1; + + if (!SvOBJECT (scalar) && ref_bool_type (scalar) >= 0) + return 1; + } + + return 0; +} + ///////////////////////////////////////////////////////////////////////////// // encoder @@ -300,12 +392,12 @@ INLINE void need (enc_t *enc, STRLEN len) { - if (expect_false (enc->cur + len >= enc->end)) + if (expect_false ((uintptr_t)(enc->end - enc->cur) < len)) { STRLEN cur = enc->cur - (char *)SvPVX (enc->sv); - SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1); - enc->cur = SvPVX (enc->sv) + cur; - enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1; + char *buf = json_sv_grow (enc->sv, cur, len); + enc->cur = buf + cur; + enc->end = buf + SvLEN (enc->sv) - 1; } } @@ -331,13 +423,13 @@ { if (expect_false (ch == '"')) // but with slow exceptions { - need (enc, len += 1); + need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = '"'; } else if (expect_false (ch == '\\')) { - need (enc, len += 1); + need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = '\\'; } @@ -350,11 +442,11 @@ { switch (ch) { - case '\010': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'b'; ++str; break; - case '\011': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 't'; ++str; break; - case '\012': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'n'; ++str; break; - case '\014': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'f'; ++str; break; - case '\015': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'r'; ++str; break; + case '\010': need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = 'b'; ++str; break; + case '\011': need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = 't'; ++str; break; + case '\012': need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = 'n'; ++str; break; + case '\014': need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = 'f'; ++str; break; + case '\015': need (enc, len + 1); *enc->cur++ = '\\'; *enc->cur++ = 'r'; ++str; break; default: { @@ -380,7 +472,7 @@ if (uch >= 0x110000UL) croak ("out of range codepoint (0x%lx) encountered, unrepresentable in JSON", (unsigned long)uch); - need (enc, len += 11); + need (enc, len + 11); sprintf (enc->cur, "\\u%04x\\u%04x", (int)((uch - 0x10000) / 0x400 + 0xD800), (int)((uch - 0x10000) % 0x400 + 0xDC00)); @@ -388,7 +480,7 @@ } else { - need (enc, len += 5); + need (enc, len + 5); *enc->cur++ = '\\'; *enc->cur++ = 'u'; *enc->cur++ = PL_hexdigit [ uch >> 12 ]; @@ -406,7 +498,7 @@ } else if (is_utf8) { - need (enc, len += clen); + need (enc, len + clen); do { *enc->cur++ = *str++; @@ -415,7 +507,7 @@ } else { - need (enc, len += UTF8_MAXBYTES - 1); // never more than 11 bytes needed + need (enc, len + UTF8_MAXBYTES - 1); // never more than 11 bytes needed enc->cur = encode_utf8 (enc->cur, uch); ++str; } @@ -479,7 +571,7 @@ croak (ERR_NESTING_EXCEEDED); encode_ch (enc, '['); - + if (len >= 0) { encode_nl (enc); ++enc->indent; @@ -501,7 +593,7 @@ encode_nl (enc); --enc->indent; encode_indent (enc); } - + encode_ch (enc, ']'); } @@ -515,7 +607,7 @@ SV *sv = HeSVKEY (he); STRLEN len; char *str; - + SvGETMAGIC (sv); str = SvPV (sv, len); @@ -591,11 +683,15 @@ if (count) { int i, fast = 1; -#if defined(__BORLANDC__) || defined(_MSC_VER) - HE **hes = _alloca (count * sizeof (HE)); -#else - HE *hes [count]; // if your compiler dies here, you need to enable C99 mode -#endif + HE *hes_stack [STACK_HES]; + HE **hes = hes_stack; + + // allocate larger arrays on the heap + if (count > STACK_HES) + { + SV *sv = sv_2mortal (NEWSV (0, count * sizeof (*hes))); + hes = (HE **)SvPVX (sv); + } i = 0; while ((he = hv_iternext (hv))) @@ -674,71 +770,95 @@ encode_rv (enc_t *enc, SV *sv) { svtype svt; + GV *method; SvGETMAGIC (sv); svt = SvTYPE (sv); if (expect_false (SvOBJECT (sv))) { - HV *stash = !JSON_SLOW || json_boolean_stash - ? json_boolean_stash - : gv_stashpv ("JSON::XS::Boolean", 1); + HV *stash = SvSTASH (sv); - if (SvSTASH (sv) == stash) + if (stash == bool_stash) { - if (SvIV (sv)) - encode_str (enc, "true", 4, 0); - else - encode_str (enc, "false", 5, 0); + if (SvIV (sv)) encode_str (enc, "true" , 4, 0); + else encode_str (enc, "false", 5, 0); } - else + else if ((enc->json.flags & F_ALLOW_TAGS) && (method = gv_fetchmethod_autoload (stash, "FREEZE", 0))) { -#if 0 - if (0 && sv_derived_from (rv, "JSON::Literal")) - { - // not yet - } -#endif - if (enc->json.flags & F_CONV_BLESSED) + int count; + dSP; + + ENTER; SAVETMPS; + PUSHMARK (SP); + EXTEND (SP, 2); + // we re-bless the reference to get overload and other niceties right + PUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash)); + PUSHs (sv_json); + + PUTBACK; + count = call_sv ((SV *)GvCV (method), G_ARRAY); + SPAGAIN; + + // catch this surprisingly common error + if (SvROK (TOPs) && SvRV (TOPs) == sv) + croak ("%s::FREEZE method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv))); + + encode_ch (enc, '('); + encode_ch (enc, '"'); + encode_str (enc, HvNAME (stash), HvNAMELEN (stash), HvNAMEUTF8 (stash)); + encode_ch (enc, '"'); + encode_ch (enc, ')'); + encode_ch (enc, '['); + + if (count) { - // we re-bless the reference to get overload and other niceties right - GV *to_json = gv_fetchmethod_autoload (SvSTASH (sv), "TO_JSON", 0); + int i; - if (to_json) + for (i = 0; i < count - 1; ++i) { - dSP; + encode_sv (enc, SP[i + 1 - count]); + encode_ch (enc, ','); + } + + encode_sv (enc, TOPs); + SP -= count; + } - ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), SvSTASH (sv))); + encode_ch (enc, ']'); - // calling with G_SCALAR ensures that we always get a 1 return value - PUTBACK; - call_sv ((SV *)GvCV (to_json), G_SCALAR); - SPAGAIN; + FREETMPS; LEAVE; + } + else if ((enc->json.flags & F_CONV_BLESSED) && (method = gv_fetchmethod_autoload (stash, "TO_JSON", 0))) + { + dSP; - // catch this surprisingly common error - if (SvROK (TOPs) && SvRV (TOPs) == sv) - croak ("%s::TO_JSON method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv))); + ENTER; SAVETMPS; + PUSHMARK (SP); + // we re-bless the reference to get overload and other niceties right + XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash)); + + // calling with G_SCALAR ensures that we always get a 1 return value + PUTBACK; + call_sv ((SV *)GvCV (method), G_SCALAR); + SPAGAIN; + + // catch this surprisingly common error + if (SvROK (TOPs) && SvRV (TOPs) == sv) + croak ("%s::TO_JSON method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv))); - sv = POPs; - PUTBACK; + sv = POPs; + PUTBACK; - encode_sv (enc, sv); + encode_sv (enc, sv); - FREETMPS; LEAVE; - } - else if (enc->json.flags & F_ALLOW_BLESSED) - encode_str (enc, "null", 4, 0); - else - croak ("encountered object '%s', but neither allow_blessed enabled nor TO_JSON method available on it", - SvPV_nolen (sv_2mortal (newRV_inc (sv)))); - } - else if (enc->json.flags & F_ALLOW_BLESSED) - encode_str (enc, "null", 4, 0); - else - croak ("encountered object '%s', but neither allow_blessed nor convert_blessed settings are enabled", - SvPV_nolen (sv_2mortal (newRV_inc (sv)))); + FREETMPS; LEAVE; } + else if (enc->json.flags & F_ALLOW_BLESSED) + encode_str (enc, "null", 4, 0); + else + croak ("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)", + SvPV_nolen (sv_2mortal (newRV_inc (sv)))); } else if (svt == SVt_PVHV) encode_hv (enc, (HV *)sv); @@ -746,12 +866,11 @@ encode_av (enc, (AV *)sv); else if (svt < SVt_PVAV) { - STRLEN len = 0; - char *pv = svt ? SvPV (sv, len) : 0; + int bool_type = ref_bool_type (sv); - if (len == 1 && *pv == '1') + if (bool_type == 1) encode_str (enc, "true", 4, 0); - else if (len == 1 && *pv == '0') + else if (bool_type == 0) encode_str (enc, "false", 5, 0); else if (enc->json.flags & F_ALLOW_UNKNOWN) encode_str (enc, "null", 4, 0); @@ -824,7 +943,7 @@ { // large integer, use the (rather slow) snprintf way. need (enc, IVUV_MAXCHARS); - enc->cur += + enc->cur += SvIsUV(sv) ? snprintf (enc->cur, IVUV_MAXCHARS, "%"UVuf, (UV)SvUVX (sv)) : snprintf (enc->cur, IVUV_MAXCHARS, "%"IVdf, (IV)SvIVX (sv)); @@ -835,8 +954,8 @@ else if (!SvOK (sv) || enc->json.flags & F_ALLOW_UNKNOWN) encode_str (enc, "null", 4, 0); else - croak ("encountered perl type (%s,0x%x) that JSON cannot handle, you might want to report this", - SvPV_nolen (sv), SvFLAGS (sv)); + croak ("encountered perl type (%s,0x%x) that JSON cannot handle, check your input data", + SvPV_nolen (sv), (unsigned int)SvFLAGS (sv)); } static SV * @@ -844,7 +963,7 @@ { enc_t enc; - if (!(json->flags & F_ALLOW_NONREF) && !SvROK (scalar)) + if (!(json->flags & F_ALLOW_NONREF) && json_nonref (scalar)) croak ("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)"); enc.json = *json; @@ -1061,6 +1180,8 @@ utf8 = 1; } + else if (ch == '\t' && dec->json.flags & F_RELAXED) + *cur++ = ch; else { --dec_cur; @@ -1080,8 +1201,8 @@ { STRLEN cur = SvCUR (sv); - if (SvLEN (sv) <= cur + len) - SvGROW (sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1); + if (SvLEN (sv) - cur <= len) + json_sv_grow (sv, cur, len); memcpy (SvPVX (sv) + SvCUR (sv), buf, len); SvCUR_set (sv, SvCUR (sv) + len); @@ -1258,7 +1379,7 @@ ++dec->cur; break; } - + if (*dec->cur != ',') ERR (", or ] expected while parsing array"); @@ -1392,7 +1513,7 @@ he = hv_iternext (hv); hv_iterinit (hv); - // the next line creates a mortal sv each time its called. + // the next line creates a mortal sv each time it's called. // might want to optimise this for common cases. cb = hv_fetch_ent (dec->json.cb_sk_object, hv_iterkeysv (he), 0, 0); @@ -1401,7 +1522,8 @@ dSP; int count; - ENTER; SAVETMPS; PUSHMARK (SP); + ENTER; SAVETMPS; + PUSHMARK (SP); XPUSHs (HeVAL (he)); sv_2mortal (sv); @@ -1413,6 +1535,8 @@ FREETMPS; LEAVE; return sv; } + else if (count) + croak ("filter_json_single_key_object callbacks must not return more than one scalar"); SvREFCNT_inc (sv); FREETMPS; LEAVE; @@ -1424,7 +1548,8 @@ dSP; int count; - ENTER; SAVETMPS; PUSHMARK (SP); + ENTER; SAVETMPS; + PUSHMARK (SP); XPUSHs (sv_2mortal (sv)); PUTBACK; count = call_sv (dec->json.cb_object, G_ARRAY); SPAGAIN; @@ -1435,6 +1560,8 @@ FREETMPS; LEAVE; return sv; } + else if (count) + croak ("filter_json_object callbacks must not return more than one scalar"); SvREFCNT_inc (sv); FREETMPS; LEAVE; @@ -1450,46 +1577,132 @@ } static SV * +decode_tag (dec_t *dec) +{ + SV *tag = 0; + SV *val = 0; + + if (!(dec->json.flags & F_ALLOW_TAGS)) + ERR ("malformed JSON string, neither array, object, number, string or atom"); + + ++dec->cur; + + decode_ws (dec); + + tag = decode_sv (dec); + if (!tag) + goto fail; + + if (!SvPOK (tag)) + ERR ("malformed JSON string, (tag) must be a string"); + + decode_ws (dec); + + if (*dec->cur != ')') + ERR (") expected after tag"); + + ++dec->cur; + + decode_ws (dec); + + val = decode_sv (dec); + if (!val) + goto fail; + + if (!SvROK (val) || SvTYPE (SvRV (val)) != SVt_PVAV) + ERR ("malformed JSON string, tag value must be an array"); + + { + AV *av = (AV *)SvRV (val); + int i, len = av_len (av) + 1; + HV *stash = gv_stashsv (tag, 0); + SV *sv; + + if (!stash) + ERR ("cannot decode perl-object (package does not exist)"); + + GV *method = gv_fetchmethod_autoload (stash, "THAW", 0); + + if (!method) + ERR ("cannot decode perl-object (package does not have a THAW method)"); + + dSP; + + ENTER; SAVETMPS; + PUSHMARK (SP); + EXTEND (SP, len + 2); + // we re-bless the reference to get overload and other niceties right + PUSHs (tag); + PUSHs (sv_json); + + for (i = 0; i < len; ++i) + PUSHs (*av_fetch (av, i, 1)); + + PUTBACK; + call_sv ((SV *)GvCV (method), G_SCALAR); + SPAGAIN; + + SvREFCNT_dec (tag); + SvREFCNT_dec (val); + sv = SvREFCNT_inc (POPs); + + PUTBACK; + + FREETMPS; LEAVE; + + return sv; + } + +fail: + SvREFCNT_dec (tag); + SvREFCNT_dec (val); + return 0; +} + +static SV * decode_sv (dec_t *dec) { // the beauty of JSON: you need exactly one character lookahead // to parse everything. switch (*dec->cur) { - case '"': ++dec->cur; return decode_str (dec); - case '[': ++dec->cur; return decode_av (dec); + case '"': ++dec->cur; return decode_str (dec); + case '[': ++dec->cur; return decode_av (dec); case '{': ++dec->cur; return decode_hv (dec); + case '(': return decode_tag (dec); case '-': case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': return decode_num (dec); - case 't': - if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "true", 4)) + case 'f': + if (dec->end - dec->cur >= 5 && !memcmp (dec->cur, "false", 5)) { - dec->cur += 4; -#if JSON_SLOW - json_true = get_bool ("JSON::XS::true"); -#endif - return newSVsv (json_true); + dec->cur += 5; + + if (expect_false (!dec->json.v_false)) + dec->json.v_false = GET_BOOL (false); + + return newSVsv (dec->json.v_false); } else - ERR ("'true' expected"); + ERR ("'false' expected"); break; - case 'f': - if (dec->end - dec->cur >= 5 && !memcmp (dec->cur, "false", 5)) + case 't': + if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "true", 4)) { - dec->cur += 5; -#if JSON_SLOW - json_false = get_bool ("JSON::XS::false"); -#endif - return newSVsv (json_false); + dec->cur += 4; + + if (expect_false (!dec->json.v_true)) + dec->json.v_true = GET_BOOL (true); + + return newSVsv (dec->json.v_true); } else - ERR ("'false' expected"); + ERR ("'true' expected"); break; @@ -1505,7 +1718,7 @@ break; default: - ERR ("malformed JSON string, neither array, object, number, string or atom"); + ERR ("malformed JSON string, neither tag, array, object, number, string or atom"); break; } @@ -1514,16 +1727,21 @@ } static SV * -decode_json (SV *string, JSON *json, char **offset_return) +decode_json (SV *string, JSON *json, STRLEN *offset_return) { dec_t dec; SV *sv; /* work around bugs in 5.10 where manipulating magic values - * will perl ignore the magic in subsequent accesses + * makes perl ignore the magic in subsequent accesses. + * also make a copy of non-PV values, to get them into a clean + * state (SvPV should do that, but it's buggy, see below). + * + * SvIsCOW_shared_hash works around a bug in perl (possibly 5.16), + * as reported by Reini Urban. */ /*SvGETMAGIC (string);*/ - if (SvMAGICAL (string)) + if (SvMAGICAL (string) || !SvPOK (string) || SvIsCOW_shared_hash (string)) string = sv_2mortal (newSVsv (string)); SvUPGRADE (string, SVt_PV); @@ -1550,7 +1768,7 @@ (unsigned long)SvCUR (string), (unsigned long)json->max_size); } - if (json->flags & F_UTF8) + if (DECODE_WANTS_OCTETS (json)) sv_utf8_downgrade (string, 0); else sv_utf8_upgrade (string); @@ -1572,9 +1790,8 @@ sv = decode_sv (&dec); if (offset_return) - *offset_return = dec.cur; - - if (!(offset_return || !sv)) + *offset_return = dec.cur - SvPVX (string); + else if (sv) { // check for trailing garbage decode_ws (&dec); @@ -1602,13 +1819,13 @@ croak ("%s, at character offset %d (before \"%s\")", dec.err, - ptr_to_index (string, dec.cur), + (int)ptr_to_index (string, dec.cur), dec.cur != dec.end ? SvPV_nolen (uni) : "(end of string)"); } sv = sv_2mortal (sv); - if (!(dec.json.flags & F_ALLOW_NONREF) && !SvROK (sv)) + if (!(dec.json.flags & F_ALLOW_NONREF) && json_nonref (sv)) croak ("JSON text must be an object or array (but found number, string, true, false or null, use allow_nonref to allow this)"); return sv; @@ -1740,6 +1957,7 @@ case '[': case '{': + case '(': if (++self->incr_nest > self->max_depth) croak (ERR_NESTING_EXCEEDED); break; @@ -1750,6 +1968,10 @@ goto interrupt; break; + case ')': + --self->incr_nest; + break; + case '#': self->incr_mode = INCR_M_C1; goto incr_m_c; @@ -1783,11 +2005,13 @@ : i >= 'A' && i <= 'F' ? i - 'A' + 10 : -1; - json_stash = gv_stashpv ("JSON::XS" , 1); - json_boolean_stash = gv_stashpv ("JSON::XS::Boolean", 1); + json_stash = gv_stashpv ("JSON::XS" , 1); + bool_stash = gv_stashpv ("Types::Serialiser::Boolean", 1); + bool_false = get_bool ("Types::Serialiser::false"); + bool_true = get_bool ("Types::Serialiser::true"); - json_true = get_bool ("JSON::XS::true"); - json_false = get_bool ("JSON::XS::false"); + sv_json = newSVpv ("JSON", 0); + SvREADONLY_on (sv_json); CvNODEBUG_on (get_cv ("JSON::XS::incr_text", 0)); /* the debugger completely breaks lvalue subs */ } @@ -1796,13 +2020,18 @@ void CLONE (...) CODE: - json_stash = 0; - json_boolean_stash = 0; + // as long as these writes are atomic, the race should not matter + // as existing threads either already use 0, or use the old value, + // which is sitll correct for the initial thread. + json_stash = 0; + bool_stash = 0; + bool_false = 0; + bool_true = 0; void new (char *klass) PPCODE: { - SV *pv = NEWSV (0, sizeof (JSON)); + SV *pv = NEWSV (0, sizeof (JSON)); SvPOK_only (pv); json_init ((JSON *)SvPVX (pv)); XPUSHs (sv_2mortal (sv_bless ( @@ -1811,6 +2040,21 @@ ))); } +void boolean_values (JSON *self, SV *v_false = 0, SV *v_true = 0) + PPCODE: + self->v_false = newSVsv (v_false); + self->v_true = newSVsv (v_true); + XPUSHs (ST (0)); + +void get_boolean_values (JSON *self) + PPCODE: + if (self->v_false && self->v_true) + { + EXTEND (SP, 2); + PUSHs (self->v_false); + PUSHs (self->v_true); + } + void ascii (JSON *self, int enable = 1) ALIAS: ascii = F_ASCII @@ -1827,6 +2071,7 @@ convert_blessed = F_CONV_BLESSED relaxed = F_RELAXED allow_unknown = F_ALLOW_UNKNOWN + allow_tags = F_ALLOW_TAGS PPCODE: { if (enable) @@ -1852,6 +2097,7 @@ get_convert_blessed = F_CONV_BLESSED get_relaxed = F_RELAXED get_allow_unknown = F_ALLOW_UNKNOWN + get_allow_tags = F_ALLOW_TAGS PPCODE: XPUSHs (boolSV (self->flags & ix)); @@ -1889,7 +2135,7 @@ void filter_json_single_key_object (JSON *self, SV *key, SV *cb = &PL_sv_undef) PPCODE: { - if (!self->cb_sk_object) + if (!self->cb_sk_object) self->cb_sk_object = newHV (); if (SvOK (cb)) @@ -1910,19 +2156,23 @@ void encode (JSON *self, SV *scalar) PPCODE: - XPUSHs (encode_json (scalar, self)); + PUTBACK; scalar = encode_json (scalar, self); SPAGAIN; + XPUSHs (scalar); void decode (JSON *self, SV *jsonstr) PPCODE: - XPUSHs (decode_json (jsonstr, self, 0)); + PUTBACK; jsonstr = decode_json (jsonstr, self, 0); SPAGAIN; + XPUSHs (jsonstr); void decode_prefix (JSON *self, SV *jsonstr) PPCODE: { - char *offset; + SV *sv; + STRLEN offset; + PUTBACK; sv = decode_json (jsonstr, self, &offset); SPAGAIN; EXTEND (SP, 2); - PUSHs (decode_json (jsonstr, self, &offset)); - PUSHs (sv_2mortal (newSVuv (ptr_to_index (jsonstr, offset)))); + PUSHs (sv); + PUSHs (sv_2mortal (newSVuv (ptr_to_index (jsonstr, SvPV_nolen (jsonstr) + offset)))); } void incr_parse (JSON *self, SV *jsonstr = 0) @@ -1931,31 +2181,43 @@ if (!self->incr_text) self->incr_text = newSVpvn ("", 0); + /* if utf8-ness doesn't match the decoder, need to upgrade/downgrade */ + if (!DECODE_WANTS_OCTETS (self) == !SvUTF8 (self->incr_text)) + if (DECODE_WANTS_OCTETS (self)) + { + if (self->incr_pos) + self->incr_pos = utf8_length ((U8 *)SvPVX (self->incr_text), + (U8 *)SvPVX (self->incr_text) + self->incr_pos); + + sv_utf8_downgrade (self->incr_text, 0); + } + else + { + sv_utf8_upgrade (self->incr_text); + + if (self->incr_pos) + self->incr_pos = utf8_hop ((U8 *)SvPVX (self->incr_text), self->incr_pos) + - (U8 *)SvPVX (self->incr_text); + } + // append data, if any if (jsonstr) { - if (SvUTF8 (jsonstr)) - { - if (!SvUTF8 (self->incr_text)) - { - /* utf-8-ness differs, need to upgrade */ - sv_utf8_upgrade (self->incr_text); - - if (self->incr_pos) - self->incr_pos = utf8_hop ((U8 *)SvPVX (self->incr_text), self->incr_pos) - - (U8 *)SvPVX (self->incr_text); - } - } - else if (SvUTF8 (self->incr_text)) - sv_utf8_upgrade (jsonstr); + /* make sure both strings have same encoding */ + if (SvUTF8 (jsonstr) != SvUTF8 (self->incr_text)) + if (SvUTF8 (jsonstr)) + sv_utf8_downgrade (jsonstr, 0); + else + sv_utf8_upgrade (jsonstr); + /* and then just blindly append */ { STRLEN len; const char *str = SvPV (jsonstr, len); STRLEN cur = SvCUR (self->incr_text); - if (SvLEN (self->incr_text) <= cur + len) - SvGROW (self->incr_text, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1); + if (SvLEN (self->incr_text) - cur <= len) + json_sv_grow (self->incr_text, cur, len); Move (str, SvEND (self->incr_text), len, char); SvCUR_set (self->incr_text, SvCUR (self->incr_text) + len); @@ -1966,7 +2228,8 @@ if (GIMME_V != G_VOID) do { - char *offset; + SV *sv; + STRLEN offset; if (!INCR_DONE (self)) { @@ -1977,16 +2240,26 @@ (unsigned long)self->incr_pos, (unsigned long)self->max_size); if (!INCR_DONE (self)) - break; + { + // as an optimisation, do not accumulate white space in the incr buffer + if (self->incr_mode == INCR_M_WS && self->incr_pos) + { + self->incr_pos = 0; + SvCUR_set (self->incr_text, 0); + } + + break; + } } - XPUSHs (decode_json (self->incr_text, self, &offset)); + PUTBACK; sv = decode_json (self->incr_text, self, &offset); SPAGAIN; + XPUSHs (sv); - self->incr_pos -= offset - SvPVX (self->incr_text); + self->incr_pos -= offset; self->incr_nest = 0; self->incr_mode = 0; - sv_chop (self->incr_text, offset); + sv_chop (self->incr_text, SvPVX (self->incr_text) + offset); } while (GIMME_V == G_ARRAY); } @@ -2027,6 +2300,8 @@ void DESTROY (JSON *self) CODE: + SvREFCNT_dec (self->v_false); + SvREFCNT_dec (self->v_true); SvREFCNT_dec (self->cb_sk_object); SvREFCNT_dec (self->cb_object); SvREFCNT_dec (self->incr_text); @@ -2034,26 +2309,22 @@ PROTOTYPES: ENABLE void encode_json (SV *scalar) - ALIAS: - to_json_ = 0 - encode_json = F_UTF8 PPCODE: { JSON json; json_init (&json); - json.flags |= ix; - XPUSHs (encode_json (scalar, &json)); + json.flags |= F_UTF8; + PUTBACK; scalar = encode_json (scalar, &json); SPAGAIN; + XPUSHs (scalar); } void decode_json (SV *jsonstr) - ALIAS: - from_json_ = 0 - decode_json = F_UTF8 PPCODE: { JSON json; json_init (&json); - json.flags |= ix; - XPUSHs (decode_json (jsonstr, &json, 0)); + json.flags |= F_UTF8; + PUTBACK; jsonstr = decode_json (jsonstr, &json, 0); SPAGAIN; + XPUSHs (jsonstr); }