--- JSON-XS/XS.xs 2011/07/27 15:53:40 1.111 +++ JSON-XS/XS.xs 2014/11/24 18:42:51 1.124 @@ -19,6 +19,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,6 +46,7 @@ #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 @@ -74,8 +86,11 @@ # define JSON_STASH json_stash #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, *types_boolean_stash; // JSON::XS:: +static SV *types_true, *types_false, *sv_json; enum { INCR_M_WS = 0, // initial whitespace skipping, must be 0 @@ -482,7 +497,7 @@ croak (ERR_NESTING_EXCEEDED); encode_ch (enc, '['); - + if (len >= 0) { encode_nl (enc); ++enc->indent; @@ -504,7 +519,7 @@ encode_nl (enc); --enc->indent; encode_indent (enc); } - + encode_ch (enc, ']'); } @@ -518,7 +533,7 @@ SV *sv = HeSVKEY (he); STRLEN len; char *str; - + SvGETMAGIC (sv); str = SvPV (sv, len); @@ -594,11 +609,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))) @@ -677,71 +696,94 @@ 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 *boolean_stash = !JSON_SLOW || types_boolean_stash + ? types_boolean_stash + : gv_stashpv ("Types::Serialiser::Boolean", 1); + HV *stash = SvSTASH (sv); - if (SvSTASH (sv) == stash) + if (stash == boolean_stash) { 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")) + 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, '['); + + while (count) { - // not yet + encode_sv (enc, SP[1 - count--]); + + if (count) + encode_ch (enc, ','); } -#endif - if (enc->json.flags & F_CONV_BLESSED) - { - // we re-bless the reference to get overload and other niceties right - GV *to_json = gv_fetchmethod_autoload (SvSTASH (sv), "TO_JSON", 0); - if (to_json) - { - dSP; + encode_ch (enc, ']'); - ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), SvSTASH (sv))); + PUTBACK; - // 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)); - sv = POPs; - PUTBACK; + // 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))); - encode_sv (enc, sv); + sv = POPs; + PUTBACK; - 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)))); + 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, 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); @@ -827,7 +869,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)); @@ -838,8 +880,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 * @@ -1064,6 +1106,8 @@ utf8 = 1; } + else if (ch == '\t' && dec->json.flags & F_RELAXED) + *cur++ = ch; else { --dec_cur; @@ -1261,7 +1305,7 @@ ++dec->cur; break; } - + if (*dec->cur != ',') ERR (", or ] expected while parsing array"); @@ -1453,15 +1497,98 @@ } 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': @@ -1473,9 +1600,9 @@ { dec->cur += 4; #if JSON_SLOW - json_true = get_bool ("JSON::XS::true"); + types_true = get_bool ("Types::Serialiser::true"); #endif - return newSVsv (json_true); + return newSVsv (types_true); } else ERR ("'true' expected"); @@ -1487,9 +1614,9 @@ { dec->cur += 5; #if JSON_SLOW - json_false = get_bool ("JSON::XS::false"); + types_false = get_bool ("Types::Serialiser::false"); #endif - return newSVsv (json_false); + return newSVsv (types_false); } else ERR ("'false' expected"); @@ -1508,7 +1635,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; } @@ -1523,7 +1650,7 @@ 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). */ @@ -1607,7 +1734,7 @@ 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)"); } @@ -1745,6 +1872,7 @@ case '[': case '{': + case '(': if (++self->incr_nest > self->max_depth) croak (ERR_NESTING_EXCEEDED); break; @@ -1755,6 +1883,10 @@ goto interrupt; break; + case ')': + --self->incr_nest; + break; + case '#': self->incr_mode = INCR_M_C1; goto incr_m_c; @@ -1788,11 +1920,14 @@ : 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); + types_boolean_stash = gv_stashpv ("Types::Serialiser::Boolean", 1); + + types_true = get_bool ("Types::Serialiser::true"); + types_false = get_bool ("Types::Serialiser::false"); - 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 */ } @@ -1801,13 +1936,13 @@ void CLONE (...) CODE: - json_stash = 0; - json_boolean_stash = 0; + json_stash = 0; + types_boolean_stash = 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 ( @@ -1832,6 +1967,7 @@ convert_blessed = F_CONV_BLESSED relaxed = F_RELAXED allow_unknown = F_ALLOW_UNKNOWN + allow_tags = F_ALLOW_TAGS PPCODE: { if (enable) @@ -1857,6 +1993,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)); @@ -1894,7 +2031,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)) @@ -1915,18 +2052,22 @@ 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: { + SV *sv; char *offset; + PUTBACK; sv = decode_json (jsonstr, self, &offset); SPAGAIN; EXTEND (SP, 2); - PUSHs (decode_json (jsonstr, self, &offset)); + PUSHs (sv); PUSHs (sv_2mortal (newSVuv (ptr_to_index (jsonstr, offset)))); } @@ -1983,6 +2124,7 @@ if (GIMME_V != G_VOID) do { + SV *sv; char *offset; if (!INCR_DONE (self)) @@ -1996,14 +2138,18 @@ if (!INCR_DONE (self)) { // as an optimisation, do not accumulate white space in the incr buffer - if (self->incr_mode == INCR_M_WS) - SvCUR_set (self->incr_text, 0); + 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_nest = 0; @@ -2057,26 +2203,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); }