root/JSON-Syck/trunk/perl_syck.h

Revision 1740 (checked in by miyagawa, 15 years ago)

apply audrey's patch

Line 
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #define NEED_grok_oct
6 #define NEED_grok_hex
7 #define NEED_grok_number
8 #define NEED_grok_numeric_radix
9 #define NEED_newRV_noinc
10 #include "ppport.h"
11 #include "ppport_math.h"
12
13 #undef DEBUG /* maybe defined in perl.h */
14 #include <syck.h>
15
16 #ifdef YAML_IS_JSON
17 #  define PACKAGE_NAME  "JSON::Syck"
18 #  define NULL_LITERAL  "null"
19 #  define SCALAR_NUMBER scalar_none
20 #  define SCALAR_STRING scalar_2quote
21 #  define SCALAR_QUOTED scalar_2quote
22 #  define SEQ_NONE      seq_inline
23 #  define MAP_NONE      map_inline
24 #  define TYPE_IS_NULL(x) ((x == NULL) || (strcmp( x, "str" ) == 0))
25 #  define OBJOF(a)        (a)
26 #else
27 #  define PACKAGE_NAME  "YAML::Syck"
28 #  define NULL_LITERAL  "~"
29 #  define SCALAR_NUMBER scalar_none
30 #  define SCALAR_STRING scalar_none
31 #  define SCALAR_QUOTED scalar_1quote
32 #  define SEQ_NONE      seq_none
33 #  define MAP_NONE      map_none
34 #  define TYPE_IS_NULL(x) (x == NULL)
35 #  define OBJOF(a)        (*tag ? tag : a)
36 #endif
37
38 /*
39 #undef ASSERT
40 #include "Storable.xs"
41 */
42
43 struct emitter_xtra {
44     SV* port;
45     char* tag;
46 };
47
48 SV* perl_syck_lookup_sym( SyckParser *p, SYMID v) {
49     SV *obj = &PL_sv_undef;
50     syck_lookup_sym(p, v, (char **)&obj);
51     return obj;
52 }
53
54 SYMID perl_syck_parser_handler(SyckParser *p, SyckNode *n) {
55     SV *sv;
56     AV *seq;
57     HV *map;
58     long i;
59
60     switch (n->kind) {
61         case syck_str_kind:
62             if (TYPE_IS_NULL(n->type_id)) {
63                 if ((strcmp( n->data.str->ptr, NULL_LITERAL ) == 0)
64                     && (n->data.str->style == scalar_plain)) {
65                     sv = &PL_sv_undef;
66                 } else {
67                     sv = newSVpvn(n->data.str->ptr, n->data.str->len);
68                 }
69             } else if (strcmp( n->type_id, "str" ) == 0 ) {
70                 sv = newSVpvn(n->data.str->ptr, n->data.str->len);
71             } else if (strcmp( n->type_id, "null" ) == 0 ) {
72                 sv = &PL_sv_undef;
73             } else if (strcmp( n->type_id, "bool#yes" ) == 0 ) {
74                 sv = &PL_sv_yes;
75             } else if (strcmp( n->type_id, "bool#no" ) == 0 ) {
76                 sv = &PL_sv_no;
77             } else if (strcmp( n->type_id, "default" ) == 0 ) {
78                 sv = newSVpvn(n->data.str->ptr, n->data.str->len);
79             } else if (strcmp( n->type_id, "float#base60" ) == 0 ) {
80                 char *ptr, *end;
81                 UV sixty = 1;
82                 NV total = 0.0;
83                 syck_str_blow_away_commas( n );
84                 ptr = n->data.str->ptr;
85                 end = n->data.str->ptr + n->data.str->len;
86                 while ( end > ptr )
87                 {
88                     NV bnum = 0;
89                     char *colon = end - 1;
90                     while ( colon >= ptr && *colon != ':' )
91                     {
92                         colon--;
93                     }
94                     if ( *colon == ':' ) *colon = '\0';
95
96                     bnum = strtod( colon + 1, NULL );
97                     total += bnum * sixty;
98                     sixty *= 60;
99                     end = colon;
100                 }
101                 sv = newSVnv(total);
102 #ifdef NV_NAN
103             } else if (strcmp( n->type_id, "float#nan" ) == 0 ) {
104                 sv = newSVnv(NV_NAN);
105 #endif
106 #ifdef NV_INF
107             } else if (strcmp( n->type_id, "float#inf" ) == 0 ) {
108                 sv = newSVnv(NV_INF);
109             } else if (strcmp( n->type_id, "float#neginf" ) == 0 ) {
110                 sv = newSVnv(-NV_INF);
111 #endif
112             } else if (strncmp( n->type_id, "float", 5 ) == 0) {
113                 NV f;
114                 syck_str_blow_away_commas( n );
115                 f = strtod( n->data.str->ptr, NULL );
116                 sv = newSVnv( f );
117             } else if (strcmp( n->type_id, "int#base60" ) == 0 ) {
118                 char *ptr, *end;
119                 UV sixty = 1;
120                 UV total = 0;
121                 syck_str_blow_away_commas( n );
122                 ptr = n->data.str->ptr;
123                 end = n->data.str->ptr + n->data.str->len;
124                 while ( end > ptr )
125                 {
126                     long bnum = 0;
127                     char *colon = end - 1;
128                     while ( colon >= ptr && *colon != ':' )
129                     {
130                         colon--;
131                     }
132                     if ( *colon == ':' ) *colon = '\0';
133
134                     bnum = strtol( colon + 1, NULL, 10 );
135                     total += bnum * sixty;
136                     sixty *= 60;
137                     end = colon;
138                 }
139                 sv = newSVuv(total);
140             } else if (strcmp( n->type_id, "int#hex" ) == 0 ) {
141                 STRLEN len = n->data.str->len;
142                 syck_str_blow_away_commas( n );
143                 sv = newSVuv( grok_hex( n->data.str->ptr, &len, 0, NULL) );
144             } else if (strcmp( n->type_id, "int#oct" ) == 0 ) {
145                 STRLEN len = n->data.str->len;
146                 syck_str_blow_away_commas( n );
147                 sv = newSVuv( grok_oct( n->data.str->ptr, &len, 0, NULL) );
148             } else if (strncmp( n->type_id, "int", 3 ) == 0) {
149                 UV uv = 0;
150                 syck_str_blow_away_commas( n );
151                 grok_number( n->data.str->ptr, n->data.str->len, &uv);
152                 sv = newSVuv(uv);
153             } else {
154                 /* croak("unknown node type: %s", n->type_id); */
155                 sv = newSVpvn(n->data.str->ptr, n->data.str->len);
156             }
157         break;
158
159         case syck_seq_kind:
160             seq = newAV();
161             for (i = 0; i < n->data.list->idx; i++) {
162                 av_push(seq, perl_syck_lookup_sym(p, syck_seq_read(n, i) ));
163             }
164             sv = newRV_noinc((SV*)seq);
165             if (n->type_id) {
166                 sv_bless(sv, gv_stashpv(n->type_id + 6, TRUE));
167             }
168         break;
169
170         case syck_map_kind:
171             map = newHV();
172             for (i = 0; i < n->data.pairs->idx; i++) {
173                 hv_store_ent(
174                     map,
175                     perl_syck_lookup_sym(p, syck_map_read(n, map_key, i) ),
176                     perl_syck_lookup_sym(p, syck_map_read(n, map_value, i) ),
177                     0
178                 );
179             }
180             sv = newRV_noinc((SV*)map);
181             if (n->type_id) {
182                 sv_bless(sv, gv_stashpv(n->type_id + 5, TRUE));
183             }
184         break;
185     }
186     return syck_add_sym(p, (char *)sv);
187 }
188
189 void perl_syck_mark_emitter(SyckEmitter *e) {
190     return;
191 }
192
193 void perl_syck_error_handler(SyckParser *p, char *msg) {
194     croak(form( "%s parser (line %d, column %d): %s",
195         PACKAGE_NAME,
196         p->linect + 1,
197         p->cursor - p->lineptr,
198         msg ));
199 }
200
201 static char* perl_json_preprocess(char *s) {
202     int i;
203     char *out;
204     char ch;
205     bool in_string = 0;
206     bool in_quote  = 0;
207     char *pos;
208     STRLEN len = strlen(s);
209
210     New(2006, out, len*2+1, char);
211     pos = out;
212
213     for (i = 0; i < len; i++) {
214         ch = *(s+i);
215         *pos++ = ch;
216         if (in_quote) {
217             in_quote = !in_quote;
218         }
219         else if (ch == '\"') {
220             in_string = !in_string;
221         }
222         else if ((ch == ':' || ch == ',') && !in_string) {
223             *pos++ = ' ';
224         }
225     }
226
227     *pos = '\0';
228     return out;
229 }
230
231 void perl_json_postprocess(SV *sv) {
232     int i;
233     char ch;
234     bool in_string = 0;
235     bool in_quote  = 0;
236     char *pos;
237     char *s = SvPVX(sv);
238     STRLEN len = sv_len(sv);
239     STRLEN final_len = len;
240
241     pos = s;
242
243     for (i = 0; i < len; i++) {
244         ch = *(s+i);
245         *pos++ = ch;
246         if (in_quote) {
247             in_quote = !in_quote;
248         }
249         else if (ch == '\"') {
250             in_string = !in_string;
251         }
252         else if ((ch == ':' || ch == ',') && !in_string) {
253             i++; /* has to be a space afterwards */
254             final_len--;
255         }
256     }
257     *pos = '\0';
258
259     SvCUR_set(sv, final_len);
260 }
261
262 static SV * Load(char *s) {
263     SYMID v;
264     SyckParser *parser;
265     SV *obj = &PL_sv_undef;
266     SV *implicit = GvSV(gv_fetchpv(form("%s::ImplicitTyping", PACKAGE_NAME), TRUE, SVt_PV));
267
268     /* Don't even bother if the string is empty. */
269     if (*s == '\0') { return &PL_sv_undef; }
270
271 #ifdef YAML_IS_JSON
272     s = perl_json_preprocess(s);
273 #endif
274
275     parser = syck_new_parser();
276     syck_parser_str_auto(parser, s, NULL);
277     syck_parser_handler(parser, perl_syck_parser_handler);
278     syck_parser_error_handler(parser, perl_syck_error_handler);
279     syck_parser_implicit_typing(parser, SvTRUE(implicit));
280     syck_parser_taguri_expansion(parser, 0);
281     v = syck_parse(parser);
282     syck_lookup_sym(parser, v, (char **)&obj);
283     syck_free_parser(parser);
284
285 #ifdef YAML_IS_JSON
286     Safefree(s);
287 #endif
288
289     return obj;
290 }
291
292 void perl_syck_output_handler(SyckEmitter *e, char *str, long len) {
293     struct emitter_xtra *bonus = (struct emitter_xtra *)e->bonus;
294     sv_catpvn_nomg(bonus->port, str, len);
295     e->headless = 1;
296 }
297
298 void perl_syck_emitter_handler(SyckEmitter *e, st_data_t data) {
299     I32  len, i;
300     SV*  sv = (SV*)data;
301     struct emitter_xtra *bonus = (struct emitter_xtra *)e->bonus;
302     char* tag = bonus->tag;
303     char* ref = NULL;
304
305     if (sv == &PL_sv_undef) {
306         return syck_emit_scalar(e, "string", scalar_none, 0, 0, 0, NULL_LITERAL, 1);
307     }
308    
309 #define OBJECT_TAG     "tag:perl:"
310    
311     if (SvMAGICAL(sv)) {
312         mg_get(sv);
313     }
314
315 #ifndef YAML_IS_JSON
316     if (sv_isobject(sv)) {
317         ref = savepv(sv_reftype(SvRV(sv), TRUE));
318         *tag = '\0';
319         strcat(tag, OBJECT_TAG);
320         switch (SvTYPE(SvRV(sv))) {
321             case SVt_PVAV: { strcat(tag, "@"); break; }
322             case SVt_RV:   { strcat(tag, "$"); break; }
323             case SVt_PVCV: { strcat(tag, "code"); break; }
324             case SVt_PVGV: { strcat(tag, "glob"); break; }
325         }
326         strcat(tag, ref);
327     }
328 #endif
329
330     if (SvROK(sv)) {
331         perl_syck_emitter_handler(e, (st_data_t)SvRV(sv));
332         *tag = '\0';
333         return;
334     }
335
336     switch (SvTYPE(sv)) {
337         case SVt_NULL: { return; }
338         case SVt_PVIV:
339         case SVt_PVNV: {
340             if (sv_len(sv) > 0) {
341                 syck_emit_scalar(e, OBJOF("string"), SvNIOK(sv) ? SCALAR_NUMBER : SCALAR_STRING, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
342             }
343             else {
344                 syck_emit_scalar(e, OBJOF("string"), SCALAR_QUOTED, 0, 0, 0, "", 0);
345             }
346             break;
347         }
348         case SVt_IV:
349         case SVt_NV: {
350             if (sv_len(sv) > 0) {
351                 syck_emit_scalar(e, OBJOF("string"), SCALAR_NUMBER, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
352             }
353             else {
354                 syck_emit_scalar(e, OBJOF("string"), SCALAR_QUOTED, 0, 0, 0, "", 0);
355             }
356             break;
357         }
358         case SVt_PV:
359         case SVt_PVMG:
360         case SVt_PVBM:
361         case SVt_PVLV: {
362             if (sv_len(sv) > 0) {
363                 syck_emit_scalar(e, OBJOF("string"), SCALAR_STRING, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
364             }
365             else {
366                 syck_emit_scalar(e, OBJOF("string"), SCALAR_QUOTED, 0, 0, 0, "", 0);
367             }
368             break;
369         }
370         case SVt_RV: {
371             perl_syck_emitter_handler(e, (st_data_t)SvRV(sv));
372             break;
373         }
374         case SVt_PVAV: {
375             syck_emit_seq(e, OBJOF("array"), SEQ_NONE);
376             *tag = '\0';
377             len = av_len((AV*)sv) + 1;
378             for (i = 0; i < len; i++) {
379                 SV** sav = av_fetch((AV*)sv, i, 0);
380                 syck_emit_item( e, (st_data_t)(*sav) );
381             }
382             syck_emit_end(e);
383             return;
384         }
385         case SVt_PVHV: {
386             syck_emit_map(e, OBJOF("hash"), MAP_NONE);
387             *tag = '\0';
388 #ifdef HAS_RESTRICTED_HASHES
389             len = HvTOTALKEYS((HV*)sv);
390 #else
391             len = HvKEYS((HV*)sv);
392 #endif
393             hv_iterinit((HV*)sv);
394             for (i = 0; i < len; i++) {
395 #ifdef HV_ITERNEXT_WANTPLACEHOLDERS
396                 HE *he = hv_iternext_flags((HV*)sv, HV_ITERNEXT_WANTPLACEHOLDERS);
397 #else
398                 HE *he = hv_iternext((HV*)sv);
399 #endif
400                 I32 keylen;
401                 SV *key = hv_iterkeysv(he);
402                 SV *val = hv_iterval((HV*)sv, he);
403                 syck_emit_item( e, (st_data_t)key );
404                 syck_emit_item( e, (st_data_t)val );
405             }
406             syck_emit_end(e);
407             return;
408         }
409         case SVt_PVCV: {
410             /* XXX TODO XXX */
411             syck_emit_scalar(e, OBJOF("string"), SCALAR_STRING, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
412             break;
413         }
414         case SVt_PVGV:
415         case SVt_PVFM: {
416             /* XXX TODO XXX */
417             syck_emit_scalar(e, OBJOF("string"), SCALAR_STRING, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
418             break;
419         }
420         case SVt_PVIO: {
421             syck_emit_scalar(e, OBJOF("string"), SCALAR_STRING, 0, 0, 0, SvPV_nolen(sv), sv_len(sv));
422             break;
423         }
424     }
425 cleanup:
426     *tag = '\0';
427 }
428
429 SV* Dump(SV *sv) {
430     struct emitter_xtra *bonus;
431     SV* out = newSVpvn("", 0);
432     SyckEmitter *emitter = syck_new_emitter();
433     SV *headless = GvSV(gv_fetchpv(form("%s::Headless", PACKAGE_NAME), TRUE, SVt_PV));
434
435     emitter->headless = SvTRUE(headless);
436
437     bonus = emitter->bonus = S_ALLOC_N(struct emitter_xtra, 1);
438     bonus->port = out;
439     New(801, bonus->tag, 512, char);
440
441     syck_emitter_handler( emitter, perl_syck_emitter_handler );
442     syck_output_handler( emitter, perl_syck_output_handler );
443
444     perl_syck_mark_emitter( emitter );
445     syck_emit( emitter, (st_data_t)sv );
446     syck_emitter_flush( emitter, 0 );
447     syck_free_emitter( emitter );
448
449     Safefree(bonus->tag);
450
451 #ifdef YAML_IS_JSON
452     if (SvCUR(out) > 0) {
453         /* Trim the trailing newline */
454         SvCUR_set(out, SvCUR(out)-1);
455     }
456 #endif
457
458 #ifdef YAML_IS_JSON
459     perl_json_postprocess(out);
460 #endif
461
462     return out;
463 }
Note: See TracBrowser for help on using the browser.