ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/JSON-XS/XS.xs
Revision: 1.27
Committed: Mon Apr 9 05:09:57 2007 UTC (17 years, 1 month ago) by root
Branch: MAIN
CVS Tags: rel-1_11
Changes since 1.26: +2 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #include "EXTERN.h"
2     #include "perl.h"
3     #include "XSUB.h"
4    
5     #include "assert.h"
6     #include "string.h"
7     #include "stdlib.h"
8 root 1.26 #include "stdio.h"
9    
10     #if defined(__BORLANDC__) || defined(_MSC_VER)
11     # define snprintf _snprintf // C compilers have this in stdio.h
12     #endif
13 root 1.1
14 root 1.18 #define F_ASCII 0x00000001UL
15     #define F_UTF8 0x00000002UL
16     #define F_INDENT 0x00000004UL
17     #define F_CANONICAL 0x00000008UL
18     #define F_SPACE_BEFORE 0x00000010UL
19     #define F_SPACE_AFTER 0x00000020UL
20     #define F_ALLOW_NONREF 0x00000080UL
21     #define F_SHRINK 0x00000100UL
22     #define F_MAXDEPTH 0xf8000000UL
23     #define S_MAXDEPTH 27
24    
25     #define DEC_DEPTH(flags) (1UL << ((flags & F_MAXDEPTH) >> S_MAXDEPTH))
26    
27     // F_SELFCONVERT? <=> to_json/toJson
28     // F_BLESSED? <=> { $__class__$ => }
29 root 1.16
30 root 1.2 #define F_PRETTY F_INDENT | F_SPACE_BEFORE | F_SPACE_AFTER
31 root 1.24 #define F_DEFAULT (9UL << S_MAXDEPTH)
32 root 1.1
33     #define INIT_SIZE 32 // initial scalar size to be allocated
34 root 1.12 #define INDENT_STEP 3 // spaces per indentation level
35    
36     #define UTF8_MAX_LEN 11 // for perls UTF-X: max. number of octets per character
37 root 1.14 #define SHORT_STRING_LEN 512 // special-case strings of up to this size
38 root 1.1
39     #define SB do {
40     #define SE } while (0)
41    
42 root 1.12 static HV *json_stash; // JSON::XS::
43 root 1.1
44 root 1.12 /////////////////////////////////////////////////////////////////////////////
45     // utility functions
46 root 1.1
47     static UV *
48     SvJSON (SV *sv)
49     {
50     if (!(SvROK (sv) && SvOBJECT (SvRV (sv)) && SvSTASH (SvRV (sv)) == json_stash))
51     croak ("object is not of type JSON::XS");
52    
53     return &SvUVX (SvRV (sv));
54     }
55    
56 root 1.7 static void
57     shrink (SV *sv)
58     {
59     sv_utf8_downgrade (sv, 1);
60 root 1.12 if (SvLEN (sv) > SvCUR (sv) + 1)
61     {
62 root 1.7 #ifdef SvPV_shrink_to_cur
63 root 1.12 SvPV_shrink_to_cur (sv);
64     #elif defined (SvPV_renew)
65     SvPV_renew (sv, SvCUR (sv) + 1);
66 root 1.7 #endif
67 root 1.12 }
68 root 1.7 }
69    
70 root 1.13 // decode an utf-8 character and return it, or (UV)-1 in
71     // case of an error.
72     // we special-case "safe" characters from U+80 .. U+7FF,
73     // but use the very good perl function to parse anything else.
74     // note that we never call this function for a ascii codepoints
75     static UV
76     decode_utf8 (unsigned char *s, STRLEN len, STRLEN *clen)
77     {
78     if (s[0] > 0xdf || s[0] < 0xc2)
79     return utf8n_to_uvuni (s, len, clen, UTF8_CHECK_ONLY);
80     else if (len > 1 && s[1] >= 0x80 && s[1] <= 0xbf)
81     {
82     *clen = 2;
83     return ((s[0] & 0x1f) << 6) | (s[1] & 0x3f);
84     }
85     else
86 root 1.23 {
87     *clen = (STRLEN)-1;
88     return (UV)-1;
89     }
90 root 1.13 }
91    
92 root 1.1 /////////////////////////////////////////////////////////////////////////////
93 root 1.12 // encoder
94    
95     // structure used for encoding JSON
96     typedef struct
97     {
98     char *cur; // SvPVX (sv) + current output position
99     char *end; // SvEND (sv)
100     SV *sv; // result scalar
101 root 1.18 U32 flags; // F_*
102     U32 indent; // indentation level
103     U32 maxdepth; // max. indentation/recursion level
104 root 1.12 } enc_t;
105 root 1.1
106     static void
107     need (enc_t *enc, STRLEN len)
108     {
109     if (enc->cur + len >= enc->end)
110     {
111     STRLEN cur = enc->cur - SvPVX (enc->sv);
112     SvGROW (enc->sv, cur + len + 1);
113     enc->cur = SvPVX (enc->sv) + cur;
114 root 1.27 enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
115 root 1.1 }
116     }
117    
118     static void
119     encode_ch (enc_t *enc, char ch)
120     {
121     need (enc, 1);
122     *enc->cur++ = ch;
123     }
124    
125     static void
126     encode_str (enc_t *enc, char *str, STRLEN len, int is_utf8)
127     {
128     char *end = str + len;
129    
130 root 1.4 need (enc, len);
131    
132 root 1.1 while (str < end)
133     {
134     unsigned char ch = *(unsigned char *)str;
135 root 1.4
136 root 1.6 if (ch >= 0x20 && ch < 0x80) // most common case
137 root 1.4 {
138 root 1.6 if (ch == '"') // but with slow exceptions
139     {
140     need (enc, len += 1);
141     *enc->cur++ = '\\';
142     *enc->cur++ = '"';
143     }
144     else if (ch == '\\')
145     {
146     need (enc, len += 1);
147     *enc->cur++ = '\\';
148     *enc->cur++ = '\\';
149     }
150     else
151     *enc->cur++ = ch;
152    
153 root 1.4 ++str;
154 root 1.1 }
155     else
156     {
157 root 1.6 switch (ch)
158 root 1.1 {
159 root 1.6 case '\010': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'b'; ++str; break;
160     case '\011': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 't'; ++str; break;
161     case '\012': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'n'; ++str; break;
162     case '\014': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'f'; ++str; break;
163     case '\015': need (enc, len += 1); *enc->cur++ = '\\'; *enc->cur++ = 'r'; ++str; break;
164 root 1.1
165 root 1.6 default:
166 root 1.1 {
167 root 1.6 STRLEN clen;
168     UV uch;
169    
170     if (is_utf8)
171     {
172 root 1.13 //uch = utf8n_to_uvuni (str, end - str, &clen, UTF8_CHECK_ONLY);
173     uch = decode_utf8 (str, end - str, &clen);
174 root 1.6 if (clen == (STRLEN)-1)
175 root 1.9 croak ("malformed or illegal unicode character in string [%.11s], cannot convert to JSON", str);
176 root 1.6 }
177     else
178     {
179     uch = ch;
180     clen = 1;
181     }
182    
183 root 1.9 if (uch > 0x10FFFFUL)
184     croak ("out of range codepoint (0x%lx) encountered, unrepresentable in JSON", (unsigned long)uch);
185    
186 root 1.6 if (uch < 0x80 || enc->flags & F_ASCII)
187     {
188     if (uch > 0xFFFFUL)
189     {
190     need (enc, len += 11);
191     sprintf (enc->cur, "\\u%04x\\u%04x",
192 root 1.10 (int)((uch - 0x10000) / 0x400 + 0xD800),
193     (int)((uch - 0x10000) % 0x400 + 0xDC00));
194 root 1.6 enc->cur += 12;
195     }
196     else
197     {
198     static char hexdigit [16] = "0123456789abcdef";
199     need (enc, len += 5);
200     *enc->cur++ = '\\';
201     *enc->cur++ = 'u';
202     *enc->cur++ = hexdigit [ uch >> 12 ];
203     *enc->cur++ = hexdigit [(uch >> 8) & 15];
204     *enc->cur++ = hexdigit [(uch >> 4) & 15];
205     *enc->cur++ = hexdigit [(uch >> 0) & 15];
206     }
207 root 1.4
208 root 1.6 str += clen;
209     }
210     else if (is_utf8)
211     {
212     need (enc, len += clen);
213     do
214     {
215     *enc->cur++ = *str++;
216     }
217     while (--clen);
218     }
219     else
220     {
221 root 1.12 need (enc, len += UTF8_MAX_LEN - 1); // never more than 11 bytes needed
222 root 1.6 enc->cur = uvuni_to_utf8_flags (enc->cur, uch, 0);
223     ++str;
224     }
225 root 1.5 }
226 root 1.4 }
227 root 1.1 }
228    
229     --len;
230     }
231     }
232    
233 root 1.12 static void
234     encode_indent (enc_t *enc)
235     {
236     if (enc->flags & F_INDENT)
237     {
238     int spaces = enc->indent * INDENT_STEP;
239    
240     need (enc, spaces);
241     memset (enc->cur, ' ', spaces);
242     enc->cur += spaces;
243     }
244     }
245    
246     static void
247     encode_space (enc_t *enc)
248     {
249     need (enc, 1);
250     encode_ch (enc, ' ');
251     }
252    
253     static void
254     encode_nl (enc_t *enc)
255     {
256     if (enc->flags & F_INDENT)
257     {
258     need (enc, 1);
259     encode_ch (enc, '\n');
260     }
261     }
262    
263     static void
264     encode_comma (enc_t *enc)
265     {
266     encode_ch (enc, ',');
267 root 1.1
268 root 1.12 if (enc->flags & F_INDENT)
269     encode_nl (enc);
270     else if (enc->flags & F_SPACE_AFTER)
271     encode_space (enc);
272     }
273 root 1.1
274     static void encode_sv (enc_t *enc, SV *sv);
275    
276     static void
277     encode_av (enc_t *enc, AV *av)
278     {
279     int i, len = av_len (av);
280    
281 root 1.21 if (enc->indent >= enc->maxdepth)
282     croak ("data structure too deep (hit recursion limit)");
283    
284 root 1.12 encode_ch (enc, '['); encode_nl (enc);
285 root 1.1 ++enc->indent;
286    
287     for (i = 0; i <= len; ++i)
288     {
289 root 1.12 encode_indent (enc);
290 root 1.1 encode_sv (enc, *av_fetch (av, i, 0));
291    
292     if (i < len)
293 root 1.12 encode_comma (enc);
294 root 1.1 }
295    
296 root 1.12 encode_nl (enc);
297 root 1.1
298     --enc->indent;
299 root 1.12 encode_indent (enc); encode_ch (enc, ']');
300 root 1.1 }
301    
302     static void
303     encode_he (enc_t *enc, HE *he)
304     {
305     encode_ch (enc, '"');
306    
307     if (HeKLEN (he) == HEf_SVKEY)
308     {
309     SV *sv = HeSVKEY (he);
310     STRLEN len;
311 root 1.4 char *str;
312    
313     SvGETMAGIC (sv);
314     str = SvPV (sv, len);
315 root 1.1
316     encode_str (enc, str, len, SvUTF8 (sv));
317     }
318     else
319     encode_str (enc, HeKEY (he), HeKLEN (he), HeKUTF8 (he));
320    
321     encode_ch (enc, '"');
322    
323 root 1.12 if (enc->flags & F_SPACE_BEFORE) encode_space (enc);
324 root 1.1 encode_ch (enc, ':');
325 root 1.12 if (enc->flags & F_SPACE_AFTER ) encode_space (enc);
326 root 1.1 encode_sv (enc, HeVAL (he));
327     }
328    
329     // compare hash entries, used when all keys are bytestrings
330     static int
331     he_cmp_fast (const void *a_, const void *b_)
332     {
333     int cmp;
334    
335     HE *a = *(HE **)a_;
336     HE *b = *(HE **)b_;
337    
338     STRLEN la = HeKLEN (a);
339     STRLEN lb = HeKLEN (b);
340    
341 root 1.11 if (!(cmp = memcmp (HeKEY (a), HeKEY (b), la < lb ? la : lb)))
342     cmp = la - lb;
343 root 1.1
344     return cmp;
345     }
346    
347     // compare hash entries, used when some keys are sv's or utf-x
348     static int
349     he_cmp_slow (const void *a, const void *b)
350     {
351     return sv_cmp (HeSVKEY_force (*(HE **)a), HeSVKEY_force (*(HE **)b));
352     }
353    
354     static void
355     encode_hv (enc_t *enc, HV *hv)
356     {
357     int count, i;
358    
359 root 1.21 if (enc->indent >= enc->maxdepth)
360     croak ("data structure too deep (hit recursion limit)");
361    
362 root 1.12 encode_ch (enc, '{'); encode_nl (enc); ++enc->indent;
363 root 1.1
364     if ((count = hv_iterinit (hv)))
365     {
366     // for canonical output we have to sort by keys first
367     // actually, this is mostly due to the stupid so-called
368     // security workaround added somewhere in 5.8.x.
369     // that randomises hash orderings
370     if (enc->flags & F_CANONICAL)
371     {
372 root 1.12 HE *he, *hes [count]; // if your compiler dies here, you need to enable C99 mode
373 root 1.1 int fast = 1;
374    
375     i = 0;
376     while ((he = hv_iternext (hv)))
377     {
378     hes [i++] = he;
379     if (HeKLEN (he) < 0 || HeKUTF8 (he))
380     fast = 0;
381     }
382    
383     assert (i == count);
384    
385     if (fast)
386     qsort (hes, count, sizeof (HE *), he_cmp_fast);
387     else
388     {
389 root 1.8 // hack to forcefully disable "use bytes"
390     COP cop = *PL_curcop;
391 root 1.1 cop.op_private = 0;
392 root 1.8
393     ENTER;
394     SAVETMPS;
395    
396     SAVEVPTR (PL_curcop);
397 root 1.1 PL_curcop = &cop;
398    
399     qsort (hes, count, sizeof (HE *), he_cmp_slow);
400 root 1.8
401 root 1.1 FREETMPS;
402 root 1.8 LEAVE;
403 root 1.1 }
404    
405     for (i = 0; i < count; ++i)
406     {
407 root 1.12 encode_indent (enc);
408 root 1.1 encode_he (enc, hes [i]);
409    
410     if (i < count - 1)
411 root 1.12 encode_comma (enc);
412 root 1.1 }
413    
414 root 1.12 encode_nl (enc);
415 root 1.1 }
416     else
417     {
418     HE *he = hv_iternext (hv);
419    
420     for (;;)
421     {
422 root 1.12 encode_indent (enc);
423 root 1.1 encode_he (enc, he);
424    
425     if (!(he = hv_iternext (hv)))
426     break;
427    
428 root 1.12 encode_comma (enc);
429 root 1.1 }
430    
431 root 1.12 encode_nl (enc);
432 root 1.1 }
433     }
434    
435 root 1.12 --enc->indent; encode_indent (enc); encode_ch (enc, '}');
436 root 1.1 }
437    
438 root 1.21 // encode objects, arrays and special \0=false and \1=true values.
439     static void
440     encode_rv (enc_t *enc, SV *sv)
441     {
442 root 1.25 svtype svt;
443    
444 root 1.21 SvGETMAGIC (sv);
445 root 1.25 svt = SvTYPE (sv);
446 root 1.21
447     if (svt == SVt_PVHV)
448     encode_hv (enc, (HV *)sv);
449     else if (svt == SVt_PVAV)
450     encode_av (enc, (AV *)sv);
451     else if (svt < SVt_PVAV)
452     {
453     if (SvNIOK (sv) && SvIV (sv) == 0)
454     encode_str (enc, "false", 5, 0);
455     else if (SvNIOK (sv) && SvIV (sv) == 1)
456     encode_str (enc, "true", 4, 0);
457     else
458     croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
459     SvPV_nolen (sv_2mortal (newRV_inc (sv))));
460     }
461     else
462     croak ("encountered %s, but JSON can only represent references to arrays or hashes",
463     SvPV_nolen (sv_2mortal (newRV_inc (sv))));
464     }
465    
466 root 1.1 static void
467     encode_sv (enc_t *enc, SV *sv)
468     {
469 root 1.4 SvGETMAGIC (sv);
470    
471 root 1.1 if (SvPOKp (sv))
472     {
473     STRLEN len;
474     char *str = SvPV (sv, len);
475     encode_ch (enc, '"');
476     encode_str (enc, str, len, SvUTF8 (sv));
477     encode_ch (enc, '"');
478     }
479     else if (SvNOKp (sv))
480     {
481     need (enc, NV_DIG + 32);
482     Gconvert (SvNVX (sv), NV_DIG, 0, enc->cur);
483     enc->cur += strlen (enc->cur);
484     }
485     else if (SvIOKp (sv))
486     {
487     need (enc, 64);
488     enc->cur +=
489     SvIsUV(sv)
490     ? snprintf (enc->cur, 64, "%"UVuf, (UV)SvUVX (sv))
491     : snprintf (enc->cur, 64, "%"IVdf, (IV)SvIVX (sv));
492     }
493     else if (SvROK (sv))
494 root 1.21 encode_rv (enc, SvRV (sv));
495 root 1.1 else if (!SvOK (sv))
496     encode_str (enc, "null", 4, 0);
497     else
498 root 1.9 croak ("encountered perl type (%s,0x%x) that JSON cannot handle, you might want to report this",
499     SvPV_nolen (sv), SvFLAGS (sv));
500 root 1.1 }
501    
502     static SV *
503 root 1.18 encode_json (SV *scalar, U32 flags)
504 root 1.1 {
505 root 1.25 enc_t enc;
506    
507 root 1.3 if (!(flags & F_ALLOW_NONREF) && !SvROK (scalar))
508 root 1.9 croak ("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)");
509 root 1.3
510 root 1.12 enc.flags = flags;
511     enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
512     enc.cur = SvPVX (enc.sv);
513     enc.end = SvEND (enc.sv);
514     enc.indent = 0;
515 root 1.18 enc.maxdepth = DEC_DEPTH (flags);
516 root 1.1
517     SvPOK_only (enc.sv);
518     encode_sv (&enc, scalar);
519    
520     if (!(flags & (F_ASCII | F_UTF8)))
521     SvUTF8_on (enc.sv);
522    
523     SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
524 root 1.27 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
525 root 1.6
526     if (enc.flags & F_SHRINK)
527 root 1.7 shrink (enc.sv);
528    
529 root 1.1 return enc.sv;
530     }
531    
532     /////////////////////////////////////////////////////////////////////////////
533 root 1.12 // decoder
534 root 1.1
535 root 1.12 // structure used for decoding JSON
536     typedef struct
537     {
538     char *cur; // current parser pointer
539     char *end; // end of input string
540     const char *err; // parse error, if != 0
541 root 1.18 U32 flags; // F_*
542     U32 depth; // recursion depth
543     U32 maxdepth; // recursion depth limit
544 root 1.12 } dec_t;
545    
546     static void
547     decode_ws (dec_t *dec)
548     {
549     for (;;)
550     {
551     char ch = *dec->cur;
552    
553     if (ch > 0x20
554     || (ch != 0x20 && ch != 0x0a && ch != 0x0d && ch != 0x09))
555     break;
556    
557     ++dec->cur;
558 root 1.1 }
559 root 1.12 }
560 root 1.1
561     #define ERR(reason) SB dec->err = reason; goto fail; SE
562 root 1.18
563 root 1.1 #define EXPECT_CH(ch) SB \
564     if (*dec->cur != ch) \
565     ERR (# ch " expected"); \
566     ++dec->cur; \
567     SE
568    
569 root 1.18 #define DEC_INC_DEPTH if (++dec->depth > dec->maxdepth) ERR ("json datastructure exceeds maximum nesting level (set a higher max_depth)")
570     #define DEC_DEC_DEPTH --dec->depth
571    
572 root 1.1 static SV *decode_sv (dec_t *dec);
573    
574     static signed char decode_hexdigit[256];
575    
576     static UV
577     decode_4hex (dec_t *dec)
578     {
579     signed char d1, d2, d3, d4;
580 root 1.12 unsigned char *cur = (unsigned char *)dec->cur;
581 root 1.1
582 root 1.12 d1 = decode_hexdigit [cur [0]]; if (d1 < 0) ERR ("four hexadecimal digits expected");
583     d2 = decode_hexdigit [cur [1]]; if (d2 < 0) ERR ("four hexadecimal digits expected");
584     d3 = decode_hexdigit [cur [2]]; if (d3 < 0) ERR ("four hexadecimal digits expected");
585     d4 = decode_hexdigit [cur [3]]; if (d4 < 0) ERR ("four hexadecimal digits expected");
586 root 1.1
587     dec->cur += 4;
588    
589     return ((UV)d1) << 12
590     | ((UV)d2) << 8
591     | ((UV)d3) << 4
592     | ((UV)d4);
593    
594     fail:
595     return (UV)-1;
596     }
597    
598     static SV *
599     decode_str (dec_t *dec)
600     {
601 root 1.12 SV *sv = 0;
602 root 1.1 int utf8 = 0;
603    
604 root 1.12 do
605 root 1.1 {
606 root 1.12 char buf [SHORT_STRING_LEN + UTF8_MAX_LEN];
607     char *cur = buf;
608 root 1.1
609 root 1.12 do
610 root 1.1 {
611 root 1.12 unsigned char ch = *(unsigned char *)dec->cur++;
612    
613     if (ch == '"')
614     {
615     --dec->cur;
616     break;
617     }
618     else if (ch == '\\')
619 root 1.1 {
620 root 1.12 switch (*dec->cur)
621 root 1.1 {
622 root 1.12 case '\\':
623     case '/':
624     case '"': *cur++ = *dec->cur++; break;
625    
626     case 'b': ++dec->cur; *cur++ = '\010'; break;
627     case 't': ++dec->cur; *cur++ = '\011'; break;
628     case 'n': ++dec->cur; *cur++ = '\012'; break;
629     case 'f': ++dec->cur; *cur++ = '\014'; break;
630     case 'r': ++dec->cur; *cur++ = '\015'; break;
631 root 1.1
632 root 1.12 case 'u':
633 root 1.1 {
634 root 1.12 UV lo, hi;
635     ++dec->cur;
636 root 1.1
637 root 1.12 hi = decode_4hex (dec);
638     if (hi == (UV)-1)
639     goto fail;
640 root 1.1
641 root 1.12 // possibly a surrogate pair
642     if (hi >= 0xd800)
643     if (hi < 0xdc00)
644     {
645     if (dec->cur [0] != '\\' || dec->cur [1] != 'u')
646     ERR ("missing low surrogate character in surrogate pair");
647    
648     dec->cur += 2;
649    
650     lo = decode_4hex (dec);
651     if (lo == (UV)-1)
652     goto fail;
653    
654     if (lo < 0xdc00 || lo >= 0xe000)
655     ERR ("surrogate pair expected");
656    
657     hi = (hi - 0xD800) * 0x400 + (lo - 0xDC00) + 0x10000;
658     }
659     else if (hi < 0xe000)
660     ERR ("missing high surrogate character in surrogate pair");
661 root 1.1
662 root 1.12 if (hi >= 0x80)
663     {
664     utf8 = 1;
665 root 1.1
666 root 1.12 cur = (char *)uvuni_to_utf8_flags (cur, hi, 0);
667     }
668     else
669     *cur++ = hi;
670 root 1.1 }
671 root 1.12 break;
672    
673     default:
674     --dec->cur;
675     ERR ("illegal backslash escape sequence in string");
676     }
677     }
678     else if (ch >= 0x20 && ch <= 0x7f)
679     *cur++ = ch;
680     else if (ch >= 0x80)
681     {
682 root 1.25 STRLEN clen;
683     UV uch;
684    
685 root 1.12 --dec->cur;
686 root 1.1
687 root 1.25 uch = decode_utf8 (dec->cur, dec->end - dec->cur, &clen);
688 root 1.12 if (clen == (STRLEN)-1)
689     ERR ("malformed UTF-8 character in JSON string");
690 root 1.1
691 root 1.12 do
692 root 1.23 *cur++ = *dec->cur++;
693 root 1.12 while (--clen);
694 root 1.5
695 root 1.12 utf8 = 1;
696 root 1.1 }
697 root 1.12 else
698 root 1.23 {
699     --dec->cur;
700 root 1.12
701 root 1.23 if (!ch)
702 root 1.24 ERR ("unexpected end of string while parsing JSON string");
703 root 1.23 else
704 root 1.24 ERR ("invalid character encountered while parsing JSON string");
705 root 1.23 }
706 root 1.1 }
707 root 1.12 while (cur < buf + SHORT_STRING_LEN);
708 root 1.1
709 root 1.25 {
710     STRLEN len = cur - buf;
711 root 1.5
712 root 1.25 if (sv)
713     {
714     SvGROW (sv, SvCUR (sv) + len + 1);
715     memcpy (SvPVX (sv) + SvCUR (sv), buf, len);
716     SvCUR_set (sv, SvCUR (sv) + len);
717     }
718     else
719     sv = newSVpvn (buf, len);
720     }
721 root 1.1 }
722 root 1.12 while (*dec->cur != '"');
723 root 1.1
724     ++dec->cur;
725    
726 root 1.12 if (sv)
727     {
728     SvPOK_only (sv);
729     *SvEND (sv) = 0;
730 root 1.4
731 root 1.12 if (utf8)
732     SvUTF8_on (sv);
733     }
734     else
735     sv = newSVpvn ("", 0);
736 root 1.6
737 root 1.1 return sv;
738    
739     fail:
740     return 0;
741     }
742    
743     static SV *
744     decode_num (dec_t *dec)
745     {
746     int is_nv = 0;
747     char *start = dec->cur;
748    
749     // [minus]
750     if (*dec->cur == '-')
751     ++dec->cur;
752    
753     if (*dec->cur == '0')
754     {
755     ++dec->cur;
756     if (*dec->cur >= '0' && *dec->cur <= '9')
757     ERR ("malformed number (leading zero must not be followed by another digit)");
758     }
759 root 1.5 else if (*dec->cur < '0' || *dec->cur > '9')
760     ERR ("malformed number (no digits after initial minus)");
761     else
762     do
763     {
764     ++dec->cur;
765     }
766     while (*dec->cur >= '0' && *dec->cur <= '9');
767 root 1.1
768     // [frac]
769     if (*dec->cur == '.')
770     {
771 root 1.5 ++dec->cur;
772    
773     if (*dec->cur < '0' || *dec->cur > '9')
774     ERR ("malformed number (no digits after decimal point)");
775 root 1.1
776     do
777     {
778     ++dec->cur;
779     }
780     while (*dec->cur >= '0' && *dec->cur <= '9');
781 root 1.5
782     is_nv = 1;
783 root 1.1 }
784    
785     // [exp]
786     if (*dec->cur == 'e' || *dec->cur == 'E')
787     {
788 root 1.5 ++dec->cur;
789 root 1.1
790     if (*dec->cur == '-' || *dec->cur == '+')
791     ++dec->cur;
792    
793 root 1.5 if (*dec->cur < '0' || *dec->cur > '9')
794     ERR ("malformed number (no digits after exp sign)");
795    
796     do
797     {
798     ++dec->cur;
799     }
800     while (*dec->cur >= '0' && *dec->cur <= '9');
801    
802     is_nv = 1;
803 root 1.1 }
804    
805     if (!is_nv)
806     {
807     UV uv;
808     int numtype = grok_number (start, dec->cur - start, &uv);
809     if (numtype & IS_NUMBER_IN_UV)
810     if (numtype & IS_NUMBER_NEG)
811     {
812     if (uv < (UV)IV_MIN)
813     return newSViv (-(IV)uv);
814     }
815     else
816     return newSVuv (uv);
817     }
818    
819     return newSVnv (Atof (start));
820    
821     fail:
822     return 0;
823     }
824    
825     static SV *
826     decode_av (dec_t *dec)
827     {
828     AV *av = newAV ();
829    
830 root 1.18 DEC_INC_DEPTH;
831 root 1.12 decode_ws (dec);
832 root 1.18
833 root 1.5 if (*dec->cur == ']')
834     ++dec->cur;
835     else
836     for (;;)
837     {
838     SV *value;
839 root 1.1
840 root 1.5 value = decode_sv (dec);
841     if (!value)
842     goto fail;
843 root 1.1
844 root 1.5 av_push (av, value);
845 root 1.1
846 root 1.12 decode_ws (dec);
847 root 1.1
848 root 1.5 if (*dec->cur == ']')
849     {
850     ++dec->cur;
851     break;
852     }
853    
854     if (*dec->cur != ',')
855     ERR (", or ] expected while parsing array");
856 root 1.1
857 root 1.5 ++dec->cur;
858     }
859 root 1.1
860 root 1.18 DEC_DEC_DEPTH;
861 root 1.1 return newRV_noinc ((SV *)av);
862    
863     fail:
864     SvREFCNT_dec (av);
865 root 1.18 DEC_DEC_DEPTH;
866 root 1.1 return 0;
867     }
868    
869     static SV *
870     decode_hv (dec_t *dec)
871     {
872     HV *hv = newHV ();
873    
874 root 1.18 DEC_INC_DEPTH;
875 root 1.12 decode_ws (dec);
876 root 1.18
877 root 1.5 if (*dec->cur == '}')
878     ++dec->cur;
879     else
880     for (;;)
881     {
882     SV *key, *value;
883 root 1.1
884 root 1.12 decode_ws (dec); EXPECT_CH ('"');
885 root 1.1
886 root 1.5 key = decode_str (dec);
887     if (!key)
888     goto fail;
889 root 1.1
890 root 1.12 decode_ws (dec); EXPECT_CH (':');
891 root 1.1
892 root 1.5 value = decode_sv (dec);
893     if (!value)
894     {
895     SvREFCNT_dec (key);
896     goto fail;
897     }
898 root 1.1
899 root 1.5 hv_store_ent (hv, key, value, 0);
900 root 1.18 SvREFCNT_dec (key);
901 root 1.1
902 root 1.12 decode_ws (dec);
903 root 1.1
904 root 1.5 if (*dec->cur == '}')
905     {
906     ++dec->cur;
907     break;
908     }
909 root 1.1
910 root 1.5 if (*dec->cur != ',')
911     ERR (", or } expected while parsing object/hash");
912 root 1.1
913 root 1.5 ++dec->cur;
914     }
915 root 1.1
916 root 1.18 DEC_DEC_DEPTH;
917 root 1.1 return newRV_noinc ((SV *)hv);
918    
919     fail:
920     SvREFCNT_dec (hv);
921 root 1.18 DEC_DEC_DEPTH;
922 root 1.1 return 0;
923     }
924    
925     static SV *
926     decode_sv (dec_t *dec)
927     {
928 root 1.12 decode_ws (dec);
929 root 1.1 switch (*dec->cur)
930     {
931     case '"': ++dec->cur; return decode_str (dec);
932     case '[': ++dec->cur; return decode_av (dec);
933     case '{': ++dec->cur; return decode_hv (dec);
934    
935     case '-':
936     case '0': case '1': case '2': case '3': case '4':
937     case '5': case '6': case '7': case '8': case '9':
938     return decode_num (dec);
939    
940     case 't':
941     if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "true", 4))
942     {
943     dec->cur += 4;
944     return newSViv (1);
945     }
946     else
947     ERR ("'true' expected");
948    
949     break;
950    
951     case 'f':
952     if (dec->end - dec->cur >= 5 && !memcmp (dec->cur, "false", 5))
953     {
954     dec->cur += 5;
955     return newSViv (0);
956     }
957     else
958     ERR ("'false' expected");
959    
960     break;
961    
962     case 'n':
963     if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "null", 4))
964     {
965     dec->cur += 4;
966 root 1.5 return newSVsv (&PL_sv_undef);
967 root 1.1 }
968     else
969     ERR ("'null' expected");
970    
971     break;
972    
973     default:
974 root 1.24 ERR ("malformed JSON string, neither array, object, number, string or atom");
975 root 1.1 break;
976     }
977    
978     fail:
979     return 0;
980     }
981    
982     static SV *
983 root 1.18 decode_json (SV *string, U32 flags)
984 root 1.1 {
985 root 1.25 dec_t dec;
986 root 1.1 SV *sv;
987    
988 root 1.22 SvUPGRADE (string, SVt_PV);
989    
990 root 1.5 if (flags & F_UTF8)
991     sv_utf8_downgrade (string, 0);
992     else
993 root 1.1 sv_utf8_upgrade (string);
994    
995     SvGROW (string, SvCUR (string) + 1); // should basically be a NOP
996    
997 root 1.18 dec.flags = flags;
998     dec.cur = SvPVX (string);
999     dec.end = SvEND (string);
1000     dec.err = 0;
1001     dec.depth = 0;
1002     dec.maxdepth = DEC_DEPTH (dec.flags);
1003 root 1.1
1004 root 1.20 *dec.end = 0; // this should basically be a nop, too, but make sure its there
1005 root 1.1 sv = decode_sv (&dec);
1006    
1007     if (!sv)
1008     {
1009 root 1.7 IV offset = dec.flags & F_UTF8
1010     ? dec.cur - SvPVX (string)
1011     : utf8_distance (dec.cur, SvPVX (string));
1012 root 1.1 SV *uni = sv_newmortal ();
1013 root 1.8
1014 root 1.5 // horrible hack to silence warning inside pv_uni_display
1015 root 1.8 COP cop = *PL_curcop;
1016 root 1.5 cop.cop_warnings = pWARN_NONE;
1017 root 1.8 ENTER;
1018 root 1.5 SAVEVPTR (PL_curcop);
1019     PL_curcop = &cop;
1020 root 1.8 pv_uni_display (uni, dec.cur, dec.end - dec.cur, 20, UNI_DISPLAY_QQ);
1021     LEAVE;
1022 root 1.1
1023 root 1.23 croak ("%s, at character offset %d [\"%s\"]",
1024 root 1.1 dec.err,
1025     (int)offset,
1026     dec.cur != dec.end ? SvPV_nolen (uni) : "(end of string)");
1027     }
1028    
1029 root 1.3 sv = sv_2mortal (sv);
1030    
1031     if (!(dec.flags & F_ALLOW_NONREF) && !SvROK (sv))
1032 root 1.9 croak ("JSON text must be an object or array (but found number, string, true, false or null, use allow_nonref to allow this)");
1033 root 1.3
1034     return sv;
1035 root 1.1 }
1036    
1037 root 1.12 /////////////////////////////////////////////////////////////////////////////
1038     // XS interface functions
1039    
1040 root 1.1 MODULE = JSON::XS PACKAGE = JSON::XS
1041    
1042     BOOT:
1043     {
1044     int i;
1045    
1046     memset (decode_hexdigit, 0xff, 256);
1047    
1048 root 1.18 for (i = 0; i < 256; ++i)
1049     decode_hexdigit [i] =
1050     i >= '0' && i <= '9' ? i - '0'
1051     : i >= 'a' && i <= 'f' ? i - 'a' + 10
1052     : i >= 'A' && i <= 'F' ? i - 'A' + 10
1053     : -1;
1054 root 1.1
1055     json_stash = gv_stashpv ("JSON::XS", 1);
1056     }
1057    
1058 root 1.4 PROTOTYPES: DISABLE
1059    
1060 root 1.1 SV *new (char *dummy)
1061     CODE:
1062     RETVAL = sv_bless (newRV_noinc (newSVuv (F_DEFAULT)), json_stash);
1063     OUTPUT:
1064     RETVAL
1065    
1066 root 1.6 SV *ascii (SV *self, int enable = 1)
1067 root 1.1 ALIAS:
1068     ascii = F_ASCII
1069     utf8 = F_UTF8
1070     indent = F_INDENT
1071     canonical = F_CANONICAL
1072     space_before = F_SPACE_BEFORE
1073     space_after = F_SPACE_AFTER
1074 root 1.2 pretty = F_PRETTY
1075 root 1.3 allow_nonref = F_ALLOW_NONREF
1076 root 1.6 shrink = F_SHRINK
1077 root 1.1 CODE:
1078     {
1079     UV *uv = SvJSON (self);
1080     if (enable)
1081     *uv |= ix;
1082     else
1083     *uv &= ~ix;
1084    
1085     RETVAL = newSVsv (self);
1086     }
1087     OUTPUT:
1088     RETVAL
1089    
1090 root 1.25 SV *max_depth (SV *self, UV max_depth = 0x80000000UL)
1091 root 1.18 CODE:
1092     {
1093     UV *uv = SvJSON (self);
1094     UV log2 = 0;
1095    
1096     if (max_depth > 0x80000000UL) max_depth = 0x80000000UL;
1097    
1098     while ((1UL << log2) < max_depth)
1099     ++log2;
1100    
1101     *uv = *uv & ~F_MAXDEPTH | (log2 << S_MAXDEPTH);
1102    
1103     RETVAL = newSVsv (self);
1104     }
1105     OUTPUT:
1106     RETVAL
1107    
1108 root 1.1 void encode (SV *self, SV *scalar)
1109     PPCODE:
1110     XPUSHs (encode_json (scalar, *SvJSON (self)));
1111    
1112 root 1.2 void decode (SV *self, SV *jsonstr)
1113 root 1.1 PPCODE:
1114 root 1.2 XPUSHs (decode_json (jsonstr, *SvJSON (self)));
1115    
1116 root 1.4 PROTOTYPES: ENABLE
1117    
1118 root 1.2 void to_json (SV *scalar)
1119 root 1.15 ALIAS:
1120     objToJson = 0
1121 root 1.2 PPCODE:
1122 root 1.18 XPUSHs (encode_json (scalar, F_DEFAULT | F_UTF8));
1123 root 1.2
1124     void from_json (SV *jsonstr)
1125 root 1.15 ALIAS:
1126     jsonToObj = 0
1127 root 1.2 PPCODE:
1128 root 1.18 XPUSHs (decode_json (jsonstr, F_DEFAULT | F_UTF8));
1129 root 1.1