ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/CBOR-XS/XS.xs
(Generate patch)

Comparing CBOR-XS/XS.xs (file contents):
Revision 1.1 by root, Fri Oct 25 23:09:45 2013 UTC vs.
Revision 1.62 by root, Sat Nov 26 02:11:52 2016 UTC

6#include <string.h> 6#include <string.h>
7#include <stdlib.h> 7#include <stdlib.h>
8#include <stdio.h> 8#include <stdio.h>
9#include <limits.h> 9#include <limits.h>
10#include <float.h> 10#include <float.h>
11#include <inttypes.h>
11 12
13#define ECB_NO_THREADS 1
12#include "ecb.h" 14#include "ecb.h"
13 15
14#if defined(__BORLANDC__) || defined(_MSC_VER) 16// compatibility with perl <5.18
15# define snprintf _snprintf // C compilers have this in stdio.h 17#ifndef HvNAMELEN_get
18# define HvNAMELEN_get(hv) strlen (HvNAME (hv))
16#endif 19#endif
20#ifndef HvNAMELEN
21# define HvNAMELEN(hv) HvNAMELEN_get (hv)
22#endif
23#ifndef HvNAMEUTF8
24# define HvNAMEUTF8(hv) 0
25#endif
26#ifndef SvREFCNT_dec_NN
27# define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
28#endif
17 29
30// known major and minor types
31enum cbor_type
32{
33 MAJOR_SHIFT = 5,
34 MINOR_MASK = 0x1f,
35
36 MAJOR_POS_INT = 0 << MAJOR_SHIFT,
37 MAJOR_NEG_INT = 1 << MAJOR_SHIFT,
38 MAJOR_BYTES = 2 << MAJOR_SHIFT,
39 MAJOR_TEXT = 3 << MAJOR_SHIFT,
40 MAJOR_ARRAY = 4 << MAJOR_SHIFT,
41 MAJOR_MAP = 5 << MAJOR_SHIFT,
42 MAJOR_TAG = 6 << MAJOR_SHIFT,
43 MAJOR_MISC = 7 << MAJOR_SHIFT,
44
45 // INT/STRING/ARRAY/MAP subtypes
46 LENGTH_EXT1 = 24,
47 LENGTH_EXT2 = 25,
48 LENGTH_EXT4 = 26,
49 LENGTH_EXT8 = 27,
50
51 // SIMPLE types (effectively MISC subtypes)
52 SIMPLE_FALSE = 20,
53 SIMPLE_TRUE = 21,
54 SIMPLE_NULL = 22,
55 SIMPLE_UNDEF = 23,
56
57 // MISC subtype (unused)
58 MISC_EXT1 = 24,
59 MISC_FLOAT16 = 25,
60 MISC_FLOAT32 = 26,
61 MISC_FLOAT64 = 27,
62
63 // BYTES/TEXT/ARRAY/MAP
64 MINOR_INDEF = 31,
65};
66
67// known tags
68enum cbor_tag
69{
70 // extensions
71 CBOR_TAG_STRINGREF = 25, // http://cbor.schmorp.de/stringref
72 CBOR_TAG_PERL_OBJECT = 26, // http://cbor.schmorp.de/perl-object
73 CBOR_TAG_GENERIC_OBJECT = 27, // http://cbor.schmorp.de/generic-object
74 CBOR_TAG_VALUE_SHAREABLE = 28, // http://cbor.schmorp.de/value-sharing
75 CBOR_TAG_VALUE_SHAREDREF = 29, // http://cbor.schmorp.de/value-sharing
76 CBOR_TAG_STRINGREF_NAMESPACE = 256, // http://cbor.schmorp.de/stringref
77 CBOR_TAG_INDIRECTION = 22098, // http://cbor.schmorp.de/indirection
78
79 // rfc7049
80 CBOR_TAG_DATETIME = 0, // rfc4287, utf-8
81 CBOR_TAG_TIMESTAMP = 1, // unix timestamp, any
82 CBOR_TAG_POS_BIGNUM = 2, // byte string
83 CBOR_TAG_NEG_BIGNUM = 3, // byte string
84 CBOR_TAG_DECIMAL = 4, // decimal fraction, array
85 CBOR_TAG_BIGFLOAT = 5, // array
86
87 CBOR_TAG_CONV_B64U = 21, // base64url, any
88 CBOR_TAG_CONV_B64 = 22, // base64, any
89 CBOR_TAG_CONV_HEX = 23, // base16, any
90 CBOR_TAG_CBOR = 24, // embedded cbor, byte string
91
92 CBOR_TAG_URI = 32, // URI rfc3986, utf-8
93 CBOR_TAG_B64U = 33, // base64url rfc4648, utf-8
94 CBOR_TAG_B64 = 34, // base6 rfc46484, utf-8
95 CBOR_TAG_REGEX = 35, // regex pcre/ecma262, utf-8
96 CBOR_TAG_MIME = 36, // mime message rfc2045, utf-8
97
98 CBOR_TAG_MAGIC = 55799, // self-describe cbor
99};
100
18#define F_SHRINK 0x00000200UL 101#define F_SHRINK 0x00000001UL
19#define F_ALLOW_UNKNOWN 0x00002000UL 102#define F_ALLOW_UNKNOWN 0x00000002UL
103#define F_ALLOW_SHARING 0x00000004UL
104#define F_ALLOW_CYCLES 0x00000008UL
105#define F_FORBID_OBJECTS 0x00000010UL
106#define F_PACK_STRINGS 0x00000020UL
107#define F_TEXT_KEYS 0x00000040UL
108#define F_TEXT_STRINGS 0x00000080UL
109#define F_VALIDATE_UTF8 0x00000100UL
20 110
21#define INIT_SIZE 32 // initial scalar size to be allocated 111#define INIT_SIZE 32 // initial scalar size to be allocated
22 112
23#define SB do { 113#define SB do {
24#define SE } while (0) 114#define SE } while (0)
25
26#if __GNUC__ >= 3
27# define expect(expr,value) __builtin_expect ((expr), (value))
28# define INLINE static inline
29#else
30# define expect(expr,value) (expr)
31# define INLINE static
32#endif
33
34#define expect_false(expr) expect ((expr) != 0, 0)
35#define expect_true(expr) expect ((expr) != 0, 1)
36 115
37#define IN_RANGE_INC(type,val,beg,end) \ 116#define IN_RANGE_INC(type,val,beg,end) \
38 ((unsigned type)((unsigned type)(val) - (unsigned type)(beg)) \ 117 ((unsigned type)((unsigned type)(val) - (unsigned type)(beg)) \
39 <= (unsigned type)((unsigned type)(end) - (unsigned type)(beg))) 118 <= (unsigned type)((unsigned type)(end) - (unsigned type)(beg)))
40 119
46#else 125#else
47# define CBOR_SLOW 0 126# define CBOR_SLOW 0
48# define CBOR_STASH cbor_stash 127# define CBOR_STASH cbor_stash
49#endif 128#endif
50 129
51static HV *cbor_stash, *cbor_boolean_stash; // CBOR::XS:: 130static HV *cbor_stash, *types_boolean_stash, *types_error_stash, *cbor_tagged_stash; // CBOR::XS::
52static SV *cbor_true, *cbor_false; 131static SV *types_true, *types_false, *types_error, *sv_cbor, *default_filter;
53 132
54typedef struct { 133typedef struct {
55 U32 flags; 134 U32 flags;
56 U32 max_depth; 135 U32 max_depth;
57 STRLEN max_size; 136 STRLEN max_size;
137 SV *filter;
58 138
59 SV *cb_object; 139 // for the incremental parser
60 HV *cb_sk_object; 140 STRLEN incr_pos; // the current offset into the text
141 STRLEN incr_need; // minimum bytes needed to decode
142 AV *incr_count; // for every nesting level, the number of outstanding values, or -1 for indef.
61} CBOR; 143} CBOR;
62 144
63INLINE void 145ecb_inline void
64cbor_init (CBOR *cbor) 146cbor_init (CBOR *cbor)
65{ 147{
66 Zero (cbor, 1, CBOR); 148 Zero (cbor, 1, CBOR);
67 cbor->max_depth = 512; 149 cbor->max_depth = 512;
68} 150}
69 151
152ecb_inline void
153cbor_free (CBOR *cbor)
154{
155 SvREFCNT_dec (cbor->filter);
156 SvREFCNT_dec (cbor->incr_count);
157}
158
70///////////////////////////////////////////////////////////////////////////// 159/////////////////////////////////////////////////////////////////////////////
71// utility functions 160// utility functions
72 161
73INLINE SV * 162ecb_inline SV *
74get_bool (const char *name) 163get_bool (const char *name)
75{ 164{
76 SV *sv = get_sv (name, 1); 165 SV *sv = get_sv (name, 1);
77 166
78 SvREADONLY_on (sv); 167 SvREADONLY_on (sv);
79 SvREADONLY_on (SvRV (sv)); 168 SvREADONLY_on (SvRV (sv));
80 169
81 return sv; 170 return sv;
82} 171}
83 172
84INLINE void 173ecb_inline void
85shrink (SV *sv) 174shrink (SV *sv)
86{ 175{
87 sv_utf8_downgrade (sv, 1); 176 sv_utf8_downgrade (sv, 1);
88 177
89 if (SvLEN (sv) > SvCUR (sv) + 1) 178 if (SvLEN (sv) > SvCUR (sv) + 1)
94 SvPV_renew (sv, SvCUR (sv) + 1); 183 SvPV_renew (sv, SvCUR (sv) + 1);
95#endif 184#endif
96 } 185 }
97} 186}
98 187
99///////////////////////////////////////////////////////////////////////////// 188// minimum length of a string to be registered for stringref
100// fp hell 189ecb_inline int
101 190minimum_string_length (UV idx)
102//TODO 191{
192 return idx <= 23 ? 3
193 : idx <= 0xffU ? 4
194 : idx <= 0xffffU ? 5
195 : idx <= 0xffffffffU ? 7
196 : 11;
197}
103 198
104///////////////////////////////////////////////////////////////////////////// 199/////////////////////////////////////////////////////////////////////////////
105// encoder 200// encoder
106 201
107// structure used for encoding CBOR 202// structure used for encoding CBOR
110 char *cur; // SvPVX (sv) + current output position 205 char *cur; // SvPVX (sv) + current output position
111 char *end; // SvEND (sv) 206 char *end; // SvEND (sv)
112 SV *sv; // result scalar 207 SV *sv; // result scalar
113 CBOR cbor; 208 CBOR cbor;
114 U32 depth; // recursion level 209 U32 depth; // recursion level
210 HV *stringref[2]; // string => index, or 0 ([0] = bytes, [1] = utf-8)
211 UV stringref_idx;
212 HV *shareable; // ptr => index, or 0
213 UV shareable_idx;
115} enc_t; 214} enc_t;
116 215
117INLINE void 216ecb_inline void
118need (enc_t *enc, STRLEN len) 217need (enc_t *enc, STRLEN len)
119{ 218{
120 if (expect_false (enc->cur + len >= enc->end)) 219 if (ecb_expect_false ((uintptr_t)(enc->end - enc->cur) < len))
121 { 220 {
122 STRLEN cur = enc->cur - (char *)SvPVX (enc->sv); 221 STRLEN cur = enc->cur - (char *)SvPVX (enc->sv);
123 SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1); 222 SvGROW (enc->sv, cur + (len < (cur >> 2) ? cur >> 2 : len) + 1);
124 enc->cur = SvPVX (enc->sv) + cur; 223 enc->cur = SvPVX (enc->sv) + cur;
125 enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1; 224 enc->end = SvPVX (enc->sv) + SvLEN (enc->sv) - 1;
126 } 225 }
127} 226}
128 227
129INLINE void 228ecb_inline void
130encode_ch (enc_t *enc, char ch) 229encode_ch (enc_t *enc, char ch)
131{ 230{
132 need (enc, 1); 231 need (enc, 1);
133 *enc->cur++ = ch; 232 *enc->cur++ = ch;
134} 233}
136static void 235static void
137encode_uint (enc_t *enc, int major, UV len) 236encode_uint (enc_t *enc, int major, UV len)
138{ 237{
139 need (enc, 9); 238 need (enc, 9);
140 239
141 if (len < 24) 240 if (ecb_expect_true (len < LENGTH_EXT1))
142 *enc->cur++ = major | len; 241 *enc->cur++ = major | len;
143 else if (len < 0x100) 242 else if (ecb_expect_true (len <= 0xffU))
144 { 243 {
145 *enc->cur++ = major | 24; 244 *enc->cur++ = major | LENGTH_EXT1;
146 *enc->cur++ = len; 245 *enc->cur++ = len;
147 } 246 }
148 else if (len < 0x10000) 247 else if (len <= 0xffffU)
149 { 248 {
150 *enc->cur++ = major | 25; 249 *enc->cur++ = major | LENGTH_EXT2;
151 *enc->cur++ = len >> 8; 250 *enc->cur++ = len >> 8;
152 *enc->cur++ = len; 251 *enc->cur++ = len;
153 } 252 }
154 else if (len < 0x100000000) 253 else if (len <= 0xffffffffU)
155 { 254 {
156 *enc->cur++ = major | 26; 255 *enc->cur++ = major | LENGTH_EXT4;
157 *enc->cur++ = len >> 24; 256 *enc->cur++ = len >> 24;
158 *enc->cur++ = len >> 16; 257 *enc->cur++ = len >> 16;
159 *enc->cur++ = len >> 8; 258 *enc->cur++ = len >> 8;
160 *enc->cur++ = len; 259 *enc->cur++ = len;
161 } 260 }
162 else if (len) 261 else
163 { 262 {
164 *enc->cur++ = major | 27; 263 *enc->cur++ = major | LENGTH_EXT8;
165 *enc->cur++ = len >> 56; 264 *enc->cur++ = len >> 56;
166 *enc->cur++ = len >> 48; 265 *enc->cur++ = len >> 48;
167 *enc->cur++ = len >> 40; 266 *enc->cur++ = len >> 40;
168 *enc->cur++ = len >> 32; 267 *enc->cur++ = len >> 32;
169 *enc->cur++ = len >> 24; 268 *enc->cur++ = len >> 24;
171 *enc->cur++ = len >> 8; 270 *enc->cur++ = len >> 8;
172 *enc->cur++ = len; 271 *enc->cur++ = len;
173 } 272 }
174} 273}
175 274
176static void 275ecb_inline void
276encode_tag (enc_t *enc, UV tag)
277{
278 encode_uint (enc, MAJOR_TAG, tag);
279}
280
281// exceptional (hopefully) slow path for byte strings that need to be utf8-encoded
282ecb_noinline static void
177encode_str (enc_t *enc, int utf8, char *str, STRLEN len) 283encode_str_utf8 (enc_t *enc, int utf8, char *str, STRLEN len)
178{ 284{
179 encode_uint (enc, utf8 ? 0x60 : 0x40, len); 285 STRLEN ulen = len;
286 U8 *p, *pend = (U8 *)str + len;
287
288 for (p = (U8 *)str; p < pend; ++p)
289 ulen += *p >> 7; // count set high bits
290
291 encode_uint (enc, MAJOR_TEXT, ulen);
292
293 need (enc, ulen);
294 for (p = (U8 *)str; p < pend; ++p)
295 if (*p < 0x80)
296 *enc->cur++ = *p;
297 else
298 {
299 *enc->cur++ = 0xc0 + (*p >> 6);
300 *enc->cur++ = 0x80 + (*p & 63);
301 }
302}
303
304ecb_inline void
305encode_str (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
306{
307 if (ecb_expect_false (upgrade_utf8))
308 if (!utf8)
309 {
310 encode_str_utf8 (enc, utf8, str, len);
311 return;
312 }
313
314 encode_uint (enc, utf8 ? MAJOR_TEXT : MAJOR_BYTES, len);
180 need (enc, len); 315 need (enc, len);
181 memcpy (enc->cur, str, len); 316 memcpy (enc->cur, str, len);
182 enc->cur += len; 317 enc->cur += len;
183} 318}
184 319
320ecb_inline void
321encode_strref (enc_t *enc, int upgrade_utf8, int utf8, char *str, STRLEN len)
322{
323 if (ecb_expect_false (enc->cbor.flags & F_PACK_STRINGS))
324 {
325 SV **svp = hv_fetch (enc->stringref[!!utf8], str, len, 1);
326
327 if (SvOK (*svp))
328 {
329 // already registered, use stringref
330 encode_tag (enc, CBOR_TAG_STRINGREF);
331 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
332 return;
333 }
334 else if (len >= minimum_string_length (enc->stringref_idx))
335 {
336 // register only
337 sv_setuv (*svp, enc->stringref_idx);
338 ++enc->stringref_idx;
339 }
340 }
341
342 encode_str (enc, upgrade_utf8, utf8, str, len);
343}
344
185static void encode_sv (enc_t *enc, SV *sv); 345static void encode_sv (enc_t *enc, SV *sv);
186 346
187static void 347static void
188encode_av (enc_t *enc, AV *av) 348encode_av (enc_t *enc, AV *av)
189{ 349{
192 if (enc->depth >= enc->cbor.max_depth) 352 if (enc->depth >= enc->cbor.max_depth)
193 croak (ERR_NESTING_EXCEEDED); 353 croak (ERR_NESTING_EXCEEDED);
194 354
195 ++enc->depth; 355 ++enc->depth;
196 356
197 encode_uint (enc, 0x80, len + 1); 357 encode_uint (enc, MAJOR_ARRAY, len + 1);
198 358
359 if (SvMAGICAL (av))
199 for (i = 0; i <= len; ++i) 360 for (i = 0; i <= len; ++i)
200 { 361 {
201 SV **svp = av_fetch (av, i, 0); 362 SV **svp = av_fetch (av, i, 0);
202 encode_sv (enc, svp ? *svp : &PL_sv_undef); 363 encode_sv (enc, svp ? *svp : &PL_sv_undef);
203 } 364 }
365 else
366 for (i = 0; i <= len; ++i)
367 {
368 SV *sv = AvARRAY (av)[i];
369 encode_sv (enc, sv ? sv : &PL_sv_undef);
370 }
204 371
205 --enc->depth; 372 --enc->depth;
206} 373}
207 374
208static void 375static void
217 384
218 int pairs = hv_iterinit (hv); 385 int pairs = hv_iterinit (hv);
219 int mg = SvMAGICAL (hv); 386 int mg = SvMAGICAL (hv);
220 387
221 if (mg) 388 if (mg)
222 encode_ch (enc, 0xa0 | 31); 389 encode_ch (enc, MAJOR_MAP | MINOR_INDEF);
223 else 390 else
224 encode_uint (enc, 0xa0, pairs); 391 encode_uint (enc, MAJOR_MAP, pairs);
225 392
226 while ((he = hv_iternext (hv))) 393 while ((he = hv_iternext (hv)))
227 { 394 {
228 if (HeKLEN (he) == HEf_SVKEY) 395 if (HeKLEN (he) == HEf_SVKEY)
229 encode_sv (enc, HeSVKEY (he)); 396 encode_sv (enc, HeSVKEY (he));
230 else 397 else
231 encode_str (enc, HeKUTF8 (he), HeKEY (he), HeKLEN (he)); 398 encode_strref (enc, enc->cbor.flags & (F_TEXT_KEYS | F_TEXT_STRINGS), HeKUTF8 (he), HeKEY (he), HeKLEN (he));
232 399
233 encode_sv (enc, expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he)); 400 encode_sv (enc, ecb_expect_false (mg) ? hv_iterval (hv, he) : HeVAL (he));
234 } 401 }
235 402
236 if (mg) 403 if (mg)
237 encode_ch (enc, 0xe0 | 31); 404 encode_ch (enc, MAJOR_MISC | MINOR_INDEF);
238 405
239 --enc->depth; 406 --enc->depth;
240} 407}
241 408
242// encode objects, arrays and special \0=false and \1=true values. 409// encode objects, arrays and special \0=false and \1=true values.
243static void 410static void
244encode_rv (enc_t *enc, SV *sv) 411encode_rv (enc_t *enc, SV *sv)
245{ 412{
246 svtype svt;
247
248 SvGETMAGIC (sv); 413 SvGETMAGIC (sv);
414
249 svt = SvTYPE (sv); 415 svtype svt = SvTYPE (sv);
250 416
251 if (expect_false (SvOBJECT (sv))) 417 if (ecb_expect_false (SvOBJECT (sv)))
252 { 418 {
253 HV *stash = !CBOR_SLOW || cbor_boolean_stash 419 HV *boolean_stash = !CBOR_SLOW || types_boolean_stash
254 ? cbor_boolean_stash 420 ? types_boolean_stash
421 : gv_stashpv ("Types::Serialiser::Boolean", 1);
422 HV *error_stash = !CBOR_SLOW || types_error_stash
423 ? types_error_stash
424 : gv_stashpv ("Types::Serialiser::Error", 1);
425 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
426 ? cbor_tagged_stash
255 : gv_stashpv ("CBOR::XS::Boolean", 1); 427 : gv_stashpv ("CBOR::XS::Tagged" , 1);
256 428
257 if (SvSTASH (sv) == stash) 429 HV *stash = SvSTASH (sv);
258 encode_ch (enc, SvIV (sv) ? 0xe0 | 21 : 0xe0 | 20); 430
431 if (stash == boolean_stash)
432 {
433 encode_ch (enc, SvIV (sv) ? MAJOR_MISC | SIMPLE_TRUE : MAJOR_MISC | SIMPLE_FALSE);
434 return;
435 }
436 else if (stash == error_stash)
437 {
438 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
439 return;
440 }
441 else if (stash == tagged_stash)
442 {
443 if (svt != SVt_PVAV)
444 croak ("encountered CBOR::XS::Tagged object that isn't an array");
445
446 encode_uint (enc, MAJOR_TAG, SvUV (*av_fetch ((AV *)sv, 0, 1)));
447 encode_sv (enc, *av_fetch ((AV *)sv, 1, 1));
448
449 return;
450 }
451 }
452
453 if (ecb_expect_false (SvREFCNT (sv) > 1)
454 && ecb_expect_false (enc->cbor.flags & F_ALLOW_SHARING))
455 {
456 if (!enc->shareable)
457 enc->shareable = (HV *)sv_2mortal ((SV *)newHV ());
458
459 SV **svp = hv_fetch (enc->shareable, (char *)&sv, sizeof (sv), 1);
460
461 if (SvOK (*svp))
462 {
463 encode_tag (enc, CBOR_TAG_VALUE_SHAREDREF);
464 encode_uint (enc, MAJOR_POS_INT, SvUV (*svp));
465 return;
466 }
259 else 467 else
260 { 468 {
261#if 0 //TODO 469 sv_setuv (*svp, enc->shareable_idx);
262 if (enc->cbor.flags & F_CONV_BLESSED) 470 ++enc->shareable_idx;
471 encode_tag (enc, CBOR_TAG_VALUE_SHAREABLE);
472 }
473 }
474
475 if (ecb_expect_false (SvOBJECT (sv)))
476 {
477 HV *stash = SvSTASH (sv);
478 GV *method;
479
480 if (enc->cbor.flags & F_FORBID_OBJECTS)
481 croak ("encountered object '%s', but forbid_objects is enabled",
482 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
483 else if ((method = gv_fetchmethod_autoload (stash, "TO_CBOR", 0)))
263 { 484 {
485 dSP;
486
487 ENTER; SAVETMPS;
488 PUSHMARK (SP);
264 // we re-bless the reference to get overload and other niceties right 489 // we re-bless the reference to get overload and other niceties right
265 GV *to_cbor = gv_fetchmethod_autoload (SvSTASH (sv), "TO_CBOR", 0);
266
267 if (to_cbor)
268 {
269 dSP;
270
271 ENTER; SAVETMPS; PUSHMARK (SP);
272 XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), SvSTASH (sv))); 490 XPUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
273 491
274 // calling with G_SCALAR ensures that we always get a 1 return value
275 PUTBACK; 492 PUTBACK;
493 // G_SCALAR ensures that return value is 1
276 call_sv ((SV *)GvCV (to_cbor), G_SCALAR); 494 call_sv ((SV *)GvCV (method), G_SCALAR);
277 SPAGAIN; 495 SPAGAIN;
278 496
279 // catch this surprisingly common error 497 // catch this surprisingly common error
280 if (SvROK (TOPs) && SvRV (TOPs) == sv) 498 if (SvROK (TOPs) && SvRV (TOPs) == sv)
281 croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (SvSTASH (sv))); 499 croak ("%s::TO_CBOR method returned same object as was passed instead of a new one", HvNAME (stash));
282 500
283 sv = POPs;
284 PUTBACK;
285
286 encode_sv (enc, sv); 501 encode_sv (enc, POPs);
287 502
503 PUTBACK;
504
288 FREETMPS; LEAVE; 505 FREETMPS; LEAVE;
289 }
290 else if (enc->cbor.flags & F_ALLOW_BLESSED)
291 encode_str (enc, "null", 4, 0);
292 else
293 croak ("encountered object '%s', but neither allow_blessed enabled nor TO_CBOR method available on it",
294 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
295 } 506 }
296 else if (enc->cbor.flags & F_ALLOW_BLESSED) 507 else if ((method = gv_fetchmethod_autoload (stash, "FREEZE", 0)) != 0)
297 encode_str (enc, "null", 4, 0); 508 {
509 dSP;
510
511 ENTER; SAVETMPS;
512 SAVESTACK_POS ();
513 PUSHMARK (SP);
514 EXTEND (SP, 2);
515 // we re-bless the reference to get overload and other niceties right
516 PUSHs (sv_bless (sv_2mortal (newRV_inc (sv)), stash));
517 PUSHs (sv_cbor);
518
519 PUTBACK;
520 int count = call_sv ((SV *)GvCV (method), G_ARRAY);
521 SPAGAIN;
522
523 // catch this surprisingly common error
524 if (count == 1 && SvROK (TOPs) && SvRV (TOPs) == sv)
525 croak ("%s::FREEZE(CBOR) method returned same object as was passed instead of a new one", HvNAME (stash));
526
527 encode_tag (enc, CBOR_TAG_PERL_OBJECT);
528 encode_uint (enc, MAJOR_ARRAY, count + 1);
529 encode_strref (enc, 0, HvNAMEUTF8 (stash), HvNAME (stash), HvNAMELEN (stash));
530
531 while (count)
532 encode_sv (enc, SP[1 - count--]);
533
534 PUTBACK;
535
536 FREETMPS; LEAVE;
537 }
298 else 538 else
299 croak ("encountered object '%s', but neither allow_blessed nor convert_blessed settings are enabled", 539 croak ("encountered object '%s', but no TO_CBOR or FREEZE methods available on it",
300 SvPV_nolen (sv_2mortal (newRV_inc (sv)))); 540 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
301#endif
302 }
303 } 541 }
304 else if (svt == SVt_PVHV) 542 else if (svt == SVt_PVHV)
305 encode_hv (enc, (HV *)sv); 543 encode_hv (enc, (HV *)sv);
306 else if (svt == SVt_PVAV) 544 else if (svt == SVt_PVAV)
307 encode_av (enc, (AV *)sv); 545 encode_av (enc, (AV *)sv);
308 else if (svt < SVt_PVAV)
309 {
310 STRLEN len = 0;
311 char *pv = svt ? SvPV (sv, len) : 0;
312
313 if (len == 1 && *pv == '1')
314 encode_ch (enc, 0xe0 | 21);
315 else if (len == 1 && *pv == '0')
316 encode_ch (enc, 0xe0 | 20);
317 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
318 encode_ch (enc, 0xe0 | 23);
319 else
320 croak ("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
321 SvPV_nolen (sv_2mortal (newRV_inc (sv))));
322 }
323 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
324 encode_ch (enc, 0xe0 | 23);
325 else 546 else
326 croak ("encountered %s, but CBOR can only represent references to arrays or hashes", 547 {
327 SvPV_nolen (sv_2mortal (newRV_inc (sv)))); 548 encode_tag (enc, CBOR_TAG_INDIRECTION);
549 encode_sv (enc, sv);
550 }
328} 551}
329 552
330static void 553static void
331encode_nv (enc_t *enc, SV *sv) 554encode_nv (enc_t *enc, SV *sv)
332{ 555{
333 double nv = SvNVX (sv); 556 double nv = SvNVX (sv);
334 557
335 need (enc, 9); 558 need (enc, 9);
336 559
337 if (expect_false (nv == (U32)nv)) 560 if (ecb_expect_false (nv == (NV)(U32)nv))
338 encode_uint (enc, 0x00, (U32)nv); 561 encode_uint (enc, MAJOR_POS_INT, (U32)nv);
339 //TODO: maybe I32? 562 //TODO: maybe I32?
340 else if (expect_false (nv == (float)nv)) 563 else if (ecb_expect_false (nv == (float)nv))
341 { 564 {
342 uint32_t fp = ecb_float_to_binary32 (nv); 565 uint32_t fp = ecb_float_to_binary32 (nv);
343 566
344 *enc->cur++ = 0xe0 | 26; 567 *enc->cur++ = MAJOR_MISC | MISC_FLOAT32;
345 568
346 if (!ecb_big_endian ()) 569 if (!ecb_big_endian ())
347 fp = ecb_bswap32 (fp); 570 fp = ecb_bswap32 (fp);
348 571
349 memcpy (enc->cur, &fp, 4); 572 memcpy (enc->cur, &fp, 4);
351 } 574 }
352 else 575 else
353 { 576 {
354 uint64_t fp = ecb_double_to_binary64 (nv); 577 uint64_t fp = ecb_double_to_binary64 (nv);
355 578
356 *enc->cur++ = 0xe0 | 27; 579 *enc->cur++ = MAJOR_MISC | MISC_FLOAT64;
357 580
358 if (!ecb_big_endian ()) 581 if (!ecb_big_endian ())
359 fp = ecb_bswap64 (fp); 582 fp = ecb_bswap64 (fp);
360 583
361 memcpy (enc->cur, &fp, 8); 584 memcpy (enc->cur, &fp, 8);
370 593
371 if (SvPOKp (sv)) 594 if (SvPOKp (sv))
372 { 595 {
373 STRLEN len; 596 STRLEN len;
374 char *str = SvPV (sv, len); 597 char *str = SvPV (sv, len);
375 encode_str (enc, SvUTF8 (sv), str, len); 598 encode_strref (enc, enc->cbor.flags & F_TEXT_STRINGS, SvUTF8 (sv), str, len);
376 } 599 }
377 else if (SvNOKp (sv)) 600 else if (SvNOKp (sv))
378 encode_nv (enc, sv); 601 encode_nv (enc, sv);
379 else if (SvIOKp (sv)) 602 else if (SvIOKp (sv))
380 { 603 {
381 if (SvIsUV (sv)) 604 if (SvIsUV (sv))
382 encode_uint (enc, 0x00, SvUVX (sv)); 605 encode_uint (enc, MAJOR_POS_INT, SvUVX (sv));
383 else if (SvIVX (sv) >= 0) 606 else if (SvIVX (sv) >= 0)
384 encode_uint (enc, 0x00, SvIVX (sv)); 607 encode_uint (enc, MAJOR_POS_INT, SvIVX (sv));
385 else 608 else
386 encode_uint (enc, 0x20, -(SvIVX (sv) + 1)); 609 encode_uint (enc, MAJOR_NEG_INT, -(SvIVX (sv) + 1));
387 } 610 }
388 else if (SvROK (sv)) 611 else if (SvROK (sv))
389 encode_rv (enc, SvRV (sv)); 612 encode_rv (enc, SvRV (sv));
390 else if (!SvOK (sv)) 613 else if (!SvOK (sv))
391 encode_ch (enc, 0xe0 | 22); 614 encode_ch (enc, MAJOR_MISC | SIMPLE_NULL);
392 else if (enc->cbor.flags & F_ALLOW_UNKNOWN) 615 else if (enc->cbor.flags & F_ALLOW_UNKNOWN)
393 encode_ch (enc, 0xe0 | 23); 616 encode_ch (enc, MAJOR_MISC | SIMPLE_UNDEF);
394 else 617 else
395 croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data", 618 croak ("encountered perl type (%s,0x%x) that CBOR cannot handle, check your input data",
396 SvPV_nolen (sv), (unsigned int)SvFLAGS (sv)); 619 SvPV_nolen (sv), (unsigned int)SvFLAGS (sv));
397} 620}
398 621
399static SV * 622static SV *
400encode_cbor (SV *scalar, CBOR *cbor) 623encode_cbor (SV *scalar, CBOR *cbor)
401{ 624{
402 enc_t enc; 625 enc_t enc = { 0 };
403 626
404 enc.cbor = *cbor; 627 enc.cbor = *cbor;
405 enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE)); 628 enc.sv = sv_2mortal (NEWSV (0, INIT_SIZE));
406 enc.cur = SvPVX (enc.sv); 629 enc.cur = SvPVX (enc.sv);
407 enc.end = SvEND (enc.sv); 630 enc.end = SvEND (enc.sv);
408 enc.depth = 0;
409 631
410 SvPOK_only (enc.sv); 632 SvPOK_only (enc.sv);
633
634 if (cbor->flags & F_PACK_STRINGS)
635 {
636 encode_tag (&enc, CBOR_TAG_STRINGREF_NAMESPACE);
637 enc.stringref[0]= (HV *)sv_2mortal ((SV *)newHV ());
638 enc.stringref[1]= (HV *)sv_2mortal ((SV *)newHV ());
639 }
640
411 encode_sv (&enc, scalar); 641 encode_sv (&enc, scalar);
412 642
413 SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv)); 643 SvCUR_set (enc.sv, enc.cur - SvPVX (enc.sv));
414 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings 644 *SvEND (enc.sv) = 0; // many xs functions expect a trailing 0 for text strings
415 645
429 U8 *end; // end of input string 659 U8 *end; // end of input string
430 const char *err; // parse error, if != 0 660 const char *err; // parse error, if != 0
431 CBOR cbor; 661 CBOR cbor;
432 U32 depth; // recursion depth 662 U32 depth; // recursion depth
433 U32 maxdepth; // recursion depth limit 663 U32 maxdepth; // recursion depth limit
664 AV *shareable;
665 AV *stringref;
666 SV *decode_tagged;
667 SV *err_sv; // optional sv for error, needs to be freed
434} dec_t; 668} dec_t;
435 669
436#define ERR(reason) SB if (!dec->err) dec->err = reason; goto fail; SE 670// set dec->err to ERRSV
671ecb_cold static void
672err_errsv (dec_t *dec)
673{
674 if (!dec->err)
675 {
676 dec->err_sv = newSVsv (ERRSV);
437 677
438#define WANT(len) if (expect_false (dec->cur + len > dec->end)) ERR ("unexpected end of CBOR data"); 678 // chop off the trailing \n
679 SvCUR_set (dec->err_sv, SvCUR (dec->err_sv) - 1);
680 *SvEND (dec->err_sv) = 0;
439 681
682 dec->err = SvPVutf8_nolen (dec->err_sv);
683 }
684}
685
686// the following functions are used to reduce code size and help the compiler to optimise
687ecb_cold static void
688err_set (dec_t *dec, const char *reason)
689{
690 if (!dec->err)
691 dec->err = reason;
692}
693
694ecb_cold static void
695err_unexpected_end (dec_t *dec)
696{
697 err_set (dec, "unexpected end of CBOR data");
698}
699
700ecb_cold static void
701err_nesting_exceeded (dec_t *dec)
702{
703 err_set (dec, ERR_NESTING_EXCEEDED);
704}
705
706#define ERR_DO(do) SB do; goto fail; SE
707#define ERR(reason) ERR_DO (err_set (dec, reason))
708#define ERR_ERRSV ERR_DO (err_errsv (dec))
709
710#define WANT(len) if (ecb_expect_false ((uintptr_t)(dec->end - dec->cur) < (STRLEN)len)) ERR_DO (err_unexpected_end (dec))
711
440#define DEC_INC_DEPTH if (++dec->depth > dec->cbor.max_depth) ERR (ERR_NESTING_EXCEEDED) 712#define DEC_INC_DEPTH if (ecb_expect_false (++dec->depth > dec->cbor.max_depth)) ERR (ERR_NESTING_EXCEEDED)
441#define DEC_DEC_DEPTH --dec->depth 713#define DEC_DEC_DEPTH --dec->depth
442 714
443static UV 715static UV
444decode_uint (dec_t *dec) 716decode_uint (dec_t *dec)
445{ 717{
446 switch (*dec->cur & 31) 718 U8 m = *dec->cur & MINOR_MASK;
447 { 719 ++dec->cur;
448 case 0: case 1: case 2: case 3: case 4: case 5: case 6: case 7:
449 case 8: case 9: case 10: case 11: case 12: case 13: case 14: case 15:
450 case 16: case 17: case 18: case 19: case 20: case 21: case 22: case 23:
451 return *dec->cur++ & 31;
452 720
453 case 24: 721 if (ecb_expect_true (m < LENGTH_EXT1))
722 return m;
723 else if (ecb_expect_true (m == LENGTH_EXT1))
724 {
454 WANT (2); 725 WANT (1);
455 dec->cur += 2; 726 dec->cur += 1;
456 return dec->cur[-1]; 727 return dec->cur[-1];
457 728 }
458 case 25: 729 else if (ecb_expect_true (m == LENGTH_EXT2))
730 {
459 WANT (3); 731 WANT (2);
460 dec->cur += 3; 732 dec->cur += 2;
461 return (((UV)dec->cur[-2]) << 8) 733 return (((UV)dec->cur[-2]) << 8)
462 | ((UV)dec->cur[-1]); 734 | ((UV)dec->cur[-1]);
463 735 }
464 case 26: 736 else if (ecb_expect_true (m == LENGTH_EXT4))
737 {
465 WANT (5); 738 WANT (4);
466 dec->cur += 5; 739 dec->cur += 4;
467 return (((UV)dec->cur[-4]) << 24) 740 return (((UV)dec->cur[-4]) << 24)
468 | (((UV)dec->cur[-3]) << 16) 741 | (((UV)dec->cur[-3]) << 16)
469 | (((UV)dec->cur[-2]) << 8) 742 | (((UV)dec->cur[-2]) << 8)
470 | ((UV)dec->cur[-1]); 743 | ((UV)dec->cur[-1]);
471 744 }
472 case 27: 745 else if (ecb_expect_true (m == LENGTH_EXT8))
746 {
473 WANT (9); 747 WANT (8);
474 dec->cur += 9; 748 dec->cur += 8;
749
750 return
751#if UVSIZE < 8
752 0
753#else
475 return (((UV)dec->cur[-8]) << 56) 754 (((UV)dec->cur[-8]) << 56)
476 | (((UV)dec->cur[-7]) << 48) 755 | (((UV)dec->cur[-7]) << 48)
477 | (((UV)dec->cur[-6]) << 40) 756 | (((UV)dec->cur[-6]) << 40)
478 | (((UV)dec->cur[-5]) << 32) 757 | (((UV)dec->cur[-5]) << 32)
758#endif
479 | (((UV)dec->cur[-4]) << 24) 759 | (((UV)dec->cur[-4]) << 24)
480 | (((UV)dec->cur[-3]) << 16) 760 | (((UV)dec->cur[-3]) << 16)
481 | (((UV)dec->cur[-2]) << 8) 761 | (((UV)dec->cur[-2]) << 8)
482 | ((UV)dec->cur[-1]); 762 | ((UV)dec->cur[-1]);
483 763 }
484 default: 764 else
485 ERR ("corrupted CBOR data (unsupported integer minor encoding)"); 765 ERR ("corrupted CBOR data (unsupported integer minor encoding)");
486 }
487 766
488fail: 767fail:
489 return 0; 768 return 0;
490} 769}
491 770
496{ 775{
497 AV *av = newAV (); 776 AV *av = newAV ();
498 777
499 DEC_INC_DEPTH; 778 DEC_INC_DEPTH;
500 779
501 if ((*dec->cur & 31) == 31) 780 if (*dec->cur == (MAJOR_ARRAY | MINOR_INDEF))
502 { 781 {
503 ++dec->cur; 782 ++dec->cur;
504 783
505 for (;;) 784 for (;;)
506 { 785 {
507 WANT (1); 786 WANT (1);
508 787
509 if (*dec->cur == 0xe0 | 31) 788 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
510 { 789 {
511 ++dec->cur; 790 ++dec->cur;
512 break; 791 break;
513 } 792 }
514 793
515 av_push (av, decode_sv (dec)); 794 av_push (av, decode_sv (dec));
516 } 795 }
517 } 796 }
518 else 797 else
519 { 798 {
520 int i, len = decode_uint (dec); 799 UV i, len = decode_uint (dec);
521 800
801 WANT (len); // complexity check for av_fill - need at least one byte per value, do not allow supersize arrays
522 av_fill (av, len - 1); 802 av_fill (av, len - 1);
523 803
524 for (i = 0; i < len; ++i) 804 for (i = 0; i < len; ++i)
525 AvARRAY (av)[i] = decode_sv (dec); 805 AvARRAY (av)[i] = decode_sv (dec);
526 } 806 }
532 SvREFCNT_dec (av); 812 SvREFCNT_dec (av);
533 DEC_DEC_DEPTH; 813 DEC_DEC_DEPTH;
534 return &PL_sv_undef; 814 return &PL_sv_undef;
535} 815}
536 816
817static void
818decode_he (dec_t *dec, HV *hv)
819{
820 // for speed reasons, we specialcase single-string
821 // byte or utf-8 strings as keys, but only when !stringref
822
823 if (ecb_expect_true (!dec->stringref))
824 if (ecb_expect_true ((U8)(*dec->cur - MAJOR_BYTES) <= LENGTH_EXT8))
825 {
826 STRLEN len = decode_uint (dec);
827 char *key = (char *)dec->cur;
828
829 WANT (len);
830 dec->cur += len;
831
832 hv_store (hv, key, len, decode_sv (dec), 0);
833
834 return;
835 }
836 else if (ecb_expect_true ((U8)(*dec->cur - MAJOR_TEXT) <= LENGTH_EXT8))
837 {
838 STRLEN len = decode_uint (dec);
839 char *key = (char *)dec->cur;
840
841 WANT (len);
842 dec->cur += len;
843
844 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
845 if (!is_utf8_string (key, len))
846 ERR ("corrupted CBOR data (invalid UTF-8 in map key)");
847
848 hv_store (hv, key, -len, decode_sv (dec), 0);
849
850 return;
851 }
852
853 SV *k = decode_sv (dec);
854 SV *v = decode_sv (dec);
855
856 // we leak memory if uncaught exceptions are thrown by random magical
857 // methods, and this is hopefully the only place where it can happen,
858 // so if there is a chance of an exception, take the very slow path.
859 // since catching exceptions is "undocumented/internal/forbidden" by
860 // the new p5p powers, we need to call out to a perl function :/
861 if (ecb_expect_false (SvAMAGIC (k)))
862 {
863 dSP;
864
865 ENTER; SAVETMPS;
866 PUSHMARK (SP);
867 EXTEND (SP, 3);
868 PUSHs (sv_2mortal (newRV_inc ((SV *)hv)));
869 PUSHs (sv_2mortal (k));
870 PUSHs (sv_2mortal (v));
871
872 PUTBACK;
873 call_pv ("CBOR::XS::_hv_store", G_VOID | G_DISCARD | G_EVAL);
874 SPAGAIN;
875
876 FREETMPS; LEAVE;
877
878 if (SvTRUE (ERRSV))
879 ERR_ERRSV;
880
881 return;
882 }
883
884 hv_store_ent (hv, k, v, 0);
885 SvREFCNT_dec (k);
886
887fail:
888 ;
889}
890
537static SV * 891static SV *
538decode_hv (dec_t *dec) 892decode_hv (dec_t *dec)
539{ 893{
540 HV *hv = newHV (); 894 HV *hv = newHV ();
541 895
542 DEC_INC_DEPTH; 896 DEC_INC_DEPTH;
543 897
544 if ((*dec->cur & 31) == 31) 898 if (*dec->cur == (MAJOR_MAP | MINOR_INDEF))
545 { 899 {
546 ++dec->cur; 900 ++dec->cur;
547 901
548 for (;;) 902 for (;;)
549 { 903 {
550 WANT (1); 904 WANT (1);
551 905
552 if (*dec->cur == 0xe0 | 31) 906 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
553 { 907 {
554 ++dec->cur; 908 ++dec->cur;
555 break; 909 break;
556 } 910 }
557 911
558 SV *k = decode_sv (dec); 912 decode_he (dec, hv);
559 SV *v = decode_sv (dec);
560
561 hv_store_ent (hv, k, v, 0);
562 } 913 }
563 } 914 }
564 else 915 else
565 { 916 {
566 int len = decode_uint (dec); 917 UV pairs = decode_uint (dec);
567 918
919 WANT (pairs); // complexity check - need at least one byte per value, do not allow supersize hashes
920
568 while (len--) 921 while (pairs--)
569 { 922 decode_he (dec, hv);
570 SV *k = decode_sv (dec);
571 SV *v = decode_sv (dec);
572
573 hv_store_ent (hv, k, v, 0);
574 }
575 } 923 }
576 924
577 DEC_DEC_DEPTH; 925 DEC_DEC_DEPTH;
578 return newRV_noinc ((SV *)hv); 926 return newRV_noinc ((SV *)hv);
579
580#if 0
581 SV *sv;
582 HV *hv = newHV ();
583
584 DEC_INC_DEPTH;
585 decode_ws (dec);
586
587 for (;;)
588 {
589 // heuristic: assume that
590 // a) decode_str + hv_store_ent are abysmally slow.
591 // b) most hash keys are short, simple ascii text.
592 // => try to "fast-match" such strings to avoid
593 // the overhead of decode_str + hv_store_ent.
594 {
595 SV *value;
596 char *p = dec->cur;
597 char *e = p + 24; // only try up to 24 bytes
598
599 for (;;)
600 {
601 // the >= 0x80 is false on most architectures
602 if (p == e || *p < 0x20 || *p >= 0x80 || *p == '\\')
603 {
604 // slow path, back up and use decode_str
605 SV *key = decode_str (dec);
606 if (!key)
607 goto fail;
608
609 decode_ws (dec); EXPECT_CH (':');
610
611 decode_ws (dec);
612 value = decode_sv (dec);
613 if (!value)
614 {
615 SvREFCNT_dec (key);
616 goto fail;
617 }
618
619 hv_store_ent (hv, key, value, 0);
620 SvREFCNT_dec (key);
621
622 break;
623 }
624 else if (*p == '"')
625 {
626 // fast path, got a simple key
627 char *key = dec->cur;
628 int len = p - key;
629 dec->cur = p + 1;
630
631 decode_ws (dec); EXPECT_CH (':');
632
633 decode_ws (dec);
634 value = decode_sv (dec);
635 if (!value)
636 goto fail;
637
638 hv_store (hv, key, len, value, 0);
639
640 break;
641 }
642
643 ++p;
644 }
645 }
646
647 decode_ws (dec);
648
649 if (*dec->cur == '}')
650 {
651 ++dec->cur;
652 break;
653 }
654
655 if (*dec->cur != ',')
656 ERR (", or } expected while parsing object/hash");
657
658 ++dec->cur;
659
660 decode_ws (dec);
661
662 if (*dec->cur == '}' && dec->cbor.flags & F_RELAXED)
663 {
664 ++dec->cur;
665 break;
666 }
667 }
668
669 DEC_DEC_DEPTH;
670 sv = newRV_noinc ((SV *)hv);
671
672 // check filter callbacks
673 if (dec->cbor.flags & F_HOOK)
674 {
675 if (dec->cbor.cb_sk_object && HvKEYS (hv) == 1)
676 {
677 HE *cb, *he;
678
679 hv_iterinit (hv);
680 he = hv_iternext (hv);
681 hv_iterinit (hv);
682
683 // the next line creates a mortal sv each time its called.
684 // might want to optimise this for common cases.
685 cb = hv_fetch_ent (dec->cbor.cb_sk_object, hv_iterkeysv (he), 0, 0);
686
687 if (cb)
688 {
689 dSP;
690 int count;
691
692 ENTER; SAVETMPS; PUSHMARK (SP);
693 XPUSHs (HeVAL (he));
694 sv_2mortal (sv);
695
696 PUTBACK; count = call_sv (HeVAL (cb), G_ARRAY); SPAGAIN;
697
698 if (count == 1)
699 {
700 sv = newSVsv (POPs);
701 FREETMPS; LEAVE;
702 return sv;
703 }
704
705 SvREFCNT_inc (sv);
706 FREETMPS; LEAVE;
707 }
708 }
709
710 if (dec->cbor.cb_object)
711 {
712 dSP;
713 int count;
714
715 ENTER; SAVETMPS; PUSHMARK (SP);
716 XPUSHs (sv_2mortal (sv));
717
718 PUTBACK; count = call_sv (dec->cbor.cb_object, G_ARRAY); SPAGAIN;
719
720 if (count == 1)
721 {
722 sv = newSVsv (POPs);
723 FREETMPS; LEAVE;
724 return sv;
725 }
726
727 SvREFCNT_inc (sv);
728 FREETMPS; LEAVE;
729 }
730 }
731
732 return sv;
733#endif
734 927
735fail: 928fail:
736 SvREFCNT_dec (hv); 929 SvREFCNT_dec (hv);
737 DEC_DEC_DEPTH; 930 DEC_DEC_DEPTH;
738 return &PL_sv_undef; 931 return &PL_sv_undef;
739} 932}
740 933
741static SV * 934static SV *
742decode_str (dec_t *dec, int utf8) 935decode_str (dec_t *dec, int utf8)
743{ 936{
744 SV *sv; 937 SV *sv = 0;
745 938
746 if ((*dec->cur & 31) == 31) 939 if ((*dec->cur & MINOR_MASK) == MINOR_INDEF)
747 { 940 {
941 // indefinite length strings
748 ++dec->cur; 942 ++dec->cur;
749 943
944 U8 major = *dec->cur & MAJOR_MISC;
945
750 sv = newSVpvn ("", 0); 946 sv = newSVpvn ("", 0);
751 947
752 // not very fast, and certainly not robust against illegal input
753 for (;;) 948 for (;;)
754 { 949 {
755 WANT (1); 950 WANT (1);
756 951
757 if (*dec->cur == 0xe0 | 31) 952 if ((*dec->cur - major) > LENGTH_EXT8)
953 if (*dec->cur == (MAJOR_MISC | MINOR_INDEF))
758 { 954 {
759 ++dec->cur; 955 ++dec->cur;
760 break; 956 break;
761 } 957 }
958 else
959 ERR ("corrupted CBOR data (invalid chunks in indefinite length string)");
762 960
763 SV *sv2 = decode_sv (dec); 961 STRLEN len = decode_uint (dec);
764 sv_catsv (sv, sv2); 962
963 WANT (len);
964 sv_catpvn (sv, dec->cur, len);
965 dec->cur += len;
765 } 966 }
766 } 967 }
767 else 968 else
768 { 969 {
769 STRLEN len = decode_uint (dec); 970 STRLEN len = decode_uint (dec);
770 971
771 WANT (len); 972 WANT (len);
772 sv = newSVpvn (dec->cur, len); 973 sv = newSVpvn (dec->cur, len);
773 dec->cur += len; 974 dec->cur += len;
975
976 if (ecb_expect_false (dec->stringref)
977 && SvCUR (sv) >= minimum_string_length (AvFILLp (dec->stringref) + 1))
978 av_push (dec->stringref, SvREFCNT_inc_NN (sv));
774 } 979 }
775 980
776 if (utf8) 981 if (utf8)
982 {
983 if (ecb_expect_false (dec->cbor.flags & F_VALIDATE_UTF8))
984 if (!is_utf8_string (SvPVX (sv), SvCUR (sv)))
985 ERR ("corrupted CBOR data (invalid UTF-8 in text string)");
986
777 SvUTF8_on (sv); 987 SvUTF8_on (sv);
988 }
778 989
779 return sv; 990 return sv;
780 991
781fail: 992fail:
993 SvREFCNT_dec (sv);
994 return &PL_sv_undef;
995}
996
997static SV *
998decode_tagged (dec_t *dec)
999{
1000 SV *sv = 0;
1001 UV tag = decode_uint (dec);
1002
1003 WANT (1);
1004
1005 switch (tag)
1006 {
1007 case CBOR_TAG_MAGIC:
1008 sv = decode_sv (dec);
1009 break;
1010
1011 case CBOR_TAG_INDIRECTION:
1012 sv = newRV_noinc (decode_sv (dec));
1013 break;
1014
1015 case CBOR_TAG_STRINGREF_NAMESPACE:
1016 {
1017 // do nmot use SAVETMPS/FREETMPS, as these will
1018 // erase mortalised caches, e.g. "shareable"
1019 ENTER;
1020
1021 SAVESPTR (dec->stringref);
1022 dec->stringref = (AV *)sv_2mortal ((SV *)newAV ());
1023
1024 sv = decode_sv (dec);
1025
1026 LEAVE;
1027 }
1028 break;
1029
1030 case CBOR_TAG_STRINGREF:
1031 {
1032 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
1033 ERR ("corrupted CBOR data (stringref index not an unsigned integer)");
1034
1035 UV idx = decode_uint (dec);
1036
1037 if (!dec->stringref || (int)idx > AvFILLp (dec->stringref))
1038 ERR ("corrupted CBOR data (stringref index out of bounds or outside namespace)");
1039
1040 sv = newSVsv (AvARRAY (dec->stringref)[idx]);
1041 }
1042 break;
1043
1044 case CBOR_TAG_VALUE_SHAREABLE:
1045 {
1046 if (ecb_expect_false (!dec->shareable))
1047 dec->shareable = (AV *)sv_2mortal ((SV *)newAV ());
1048
1049 if (dec->cbor.flags & F_ALLOW_CYCLES)
1050 {
1051 sv = newSV (0);
1052 av_push (dec->shareable, SvREFCNT_inc_NN (sv));
1053
1054 SV *osv = decode_sv (dec);
1055 sv_setsv (sv, osv);
1056 SvREFCNT_dec_NN (osv);
1057 }
1058 else
1059 {
1060 av_push (dec->shareable, &PL_sv_undef);
1061 int idx = AvFILLp (dec->shareable);
1062 sv = decode_sv (dec);
1063 av_store (dec->shareable, idx, SvREFCNT_inc_NN (sv));
1064 }
1065 }
1066 break;
1067
1068 case CBOR_TAG_VALUE_SHAREDREF:
1069 {
1070 if ((*dec->cur >> MAJOR_SHIFT) != (MAJOR_POS_INT >> MAJOR_SHIFT))
1071 ERR ("corrupted CBOR data (sharedref index not an unsigned integer)");
1072
1073 UV idx = decode_uint (dec);
1074
1075 if (!dec->shareable || (int)idx > AvFILLp (dec->shareable))
1076 ERR ("corrupted CBOR data (sharedref index out of bounds)");
1077
1078 sv = SvREFCNT_inc_NN (AvARRAY (dec->shareable)[idx]);
1079
1080 if (sv == &PL_sv_undef)
1081 ERR ("cyclic CBOR data structure found, but allow_cycles is not enabled");
1082 }
1083 break;
1084
1085 case CBOR_TAG_PERL_OBJECT:
1086 {
1087 if (dec->cbor.flags & F_FORBID_OBJECTS)
1088 goto filter;
1089
1090 sv = decode_sv (dec);
1091
1092 if (!SvROK (sv) || SvTYPE (SvRV (sv)) != SVt_PVAV)
1093 ERR ("corrupted CBOR data (non-array perl object)");
1094
1095 AV *av = (AV *)SvRV (sv);
1096 int len = av_len (av) + 1;
1097 HV *stash = gv_stashsv (*av_fetch (av, 0, 1), 0);
1098
1099 if (!stash)
1100 ERR ("cannot decode perl-object (package does not exist)");
1101
1102 GV *method = gv_fetchmethod_autoload (stash, "THAW", 0);
1103
1104 if (!method)
1105 ERR ("cannot decode perl-object (package does not have a THAW method)");
1106
1107 dSP;
1108
1109 ENTER; SAVETMPS;
1110 PUSHMARK (SP);
1111 EXTEND (SP, len + 1);
1112 // we re-bless the reference to get overload and other niceties right
1113 PUSHs (*av_fetch (av, 0, 1));
1114 PUSHs (sv_cbor);
1115
1116 int i;
1117
1118 for (i = 1; i < len; ++i)
1119 PUSHs (*av_fetch (av, i, 1));
1120
1121 PUTBACK;
1122 call_sv ((SV *)GvCV (method), G_SCALAR | G_EVAL);
1123 SPAGAIN;
1124
1125 if (SvTRUE (ERRSV))
1126 {
1127 FREETMPS; LEAVE;
1128 ERR_ERRSV;
1129 }
1130
1131 SvREFCNT_dec (sv);
1132 sv = SvREFCNT_inc (POPs);
1133
1134 PUTBACK;
1135
1136 FREETMPS; LEAVE;
1137 }
1138 break;
1139
1140 default:
1141 filter:
1142 {
1143 SV *tag_sv = newSVuv (tag);
1144
1145 sv = decode_sv (dec);
1146
1147 dSP;
1148 ENTER; SAVETMPS;
1149 SAVESTACK_POS ();
1150 PUSHMARK (SP);
1151 EXTEND (SP, 2);
1152 PUSHs (tag_sv);
1153 PUSHs (sv);
1154
1155 PUTBACK;
1156 int count = call_sv (dec->cbor.filter ? dec->cbor.filter : default_filter, G_ARRAY | G_EVAL);
1157 SPAGAIN;
1158
1159 if (SvTRUE (ERRSV))
1160 {
1161 SvREFCNT_dec (tag_sv);
1162 FREETMPS; LEAVE;
1163 ERR_ERRSV;
1164 }
1165
1166 if (count)
1167 {
1168 SvREFCNT_dec (tag_sv);
1169 SvREFCNT_dec (sv);
1170 sv = SvREFCNT_inc (POPs);
1171 }
1172 else
1173 {
1174 AV *av = newAV ();
1175 av_push (av, tag_sv);
1176 av_push (av, sv);
1177
1178 HV *tagged_stash = !CBOR_SLOW || cbor_tagged_stash
1179 ? cbor_tagged_stash
1180 : gv_stashpv ("CBOR::XS::Tagged" , 1);
1181 sv = sv_bless (newRV_noinc ((SV *)av), tagged_stash);
1182 }
1183
1184 PUTBACK;
1185
1186 FREETMPS; LEAVE;
1187 }
1188 break;
1189 }
1190
1191 return sv;
1192
1193fail:
1194 SvREFCNT_dec (sv);
782 return &PL_sv_undef; 1195 return &PL_sv_undef;
783} 1196}
784 1197
785static SV * 1198static SV *
786decode_sv (dec_t *dec) 1199decode_sv (dec_t *dec)
787{ 1200{
788 WANT (1); 1201 WANT (1);
789 1202
790 switch (*dec->cur >> 5) 1203 switch (*dec->cur >> MAJOR_SHIFT)
791 { 1204 {
792 case 0: // unsigned int 1205 case MAJOR_POS_INT >> MAJOR_SHIFT: return newSVuv (decode_uint (dec));
793 //TODO: 64 bit values on 3 2bit perls 1206 case MAJOR_NEG_INT >> MAJOR_SHIFT: return newSViv (-1 - (IV)decode_uint (dec));
794 return newSVuv (decode_uint (dec)); 1207 case MAJOR_BYTES >> MAJOR_SHIFT: return decode_str (dec, 0);
795 case 1: // negative int 1208 case MAJOR_TEXT >> MAJOR_SHIFT: return decode_str (dec, 1);
796 return newSViv (-1 - (IV)decode_uint (dec)); 1209 case MAJOR_ARRAY >> MAJOR_SHIFT: return decode_av (dec);
797 case 2: // octet string 1210 case MAJOR_MAP >> MAJOR_SHIFT: return decode_hv (dec);
798 return decode_str (dec, 0); 1211 case MAJOR_TAG >> MAJOR_SHIFT: return decode_tagged (dec);
799 case 3: // utf-8 string 1212
800 return decode_str (dec, 1); 1213 case MAJOR_MISC >> MAJOR_SHIFT:
801 case 4: // array
802 return decode_av (dec);
803 case 5: // map
804 return decode_hv (dec);
805 case 6: // tag
806 abort ();
807 break;
808 case 7: // misc
809 switch (*dec->cur++ & 31) 1214 switch (*dec->cur++ & MINOR_MASK)
810 { 1215 {
811 case 20: 1216 case SIMPLE_FALSE:
812#if CBOR_SLOW 1217#if CBOR_SLOW
813 cbor_false = get_bool ("CBOR::XS::false"); 1218 types_false = get_bool ("Types::Serialiser::false");
814#endif 1219#endif
815 return newSVsv (cbor_false); 1220 return newSVsv (types_false);
816 case 21: 1221 case SIMPLE_TRUE:
817#if CBOR_SLOW 1222#if CBOR_SLOW
818 cbor_true = get_bool ("CBOR::XS::true"); 1223 types_true = get_bool ("Types::Serialiser::true");
819#endif 1224#endif
820 return newSVsv (cbor_true); 1225 return newSVsv (types_true);
821 case 22: 1226 case SIMPLE_NULL:
822 return newSVsv (&PL_sv_undef); 1227 return newSVsv (&PL_sv_undef);
1228 case SIMPLE_UNDEF:
1229#if CBOR_SLOW
1230 types_error = get_bool ("Types::Serialiser::error");
1231#endif
1232 return newSVsv (types_error);
823 1233
824 case 25: 1234 case MISC_FLOAT16:
825 // half float
826 abort ();
827 break; 1235 {
1236 WANT (2);
828 1237
1238 uint16_t fp = (dec->cur[0] << 8) | dec->cur[1];
1239 dec->cur += 2;
1240
1241 return newSVnv (ecb_binary16_to_float (fp));
1242 }
1243
829 case 26: 1244 case MISC_FLOAT32:
830 { 1245 {
831 uint32_t fp; 1246 uint32_t fp;
832 WANT (4); 1247 WANT (4);
833 memcpy (&fp, dec->cur, 4); 1248 memcpy (&fp, dec->cur, 4);
834 dec->cur += 4; 1249 dec->cur += 4;
837 fp = ecb_bswap32 (fp); 1252 fp = ecb_bswap32 (fp);
838 1253
839 return newSVnv (ecb_binary32_to_float (fp)); 1254 return newSVnv (ecb_binary32_to_float (fp));
840 } 1255 }
841 1256
842 case 27: 1257 case MISC_FLOAT64:
843 { 1258 {
844 uint64_t fp; 1259 uint64_t fp;
845 WANT (8); 1260 WANT (8);
846 memcpy (&fp, dec->cur, 8); 1261 memcpy (&fp, dec->cur, 8);
847 dec->cur += 8; 1262 dec->cur += 8;
850 fp = ecb_bswap64 (fp); 1265 fp = ecb_bswap64 (fp);
851 1266
852 return newSVnv (ecb_binary64_to_double (fp)); 1267 return newSVnv (ecb_binary64_to_double (fp));
853 } 1268 }
854 1269
855 // 0..19 unassigned 1270 // 0..19 unassigned simple
856 // 24 reserved + unassigned (reserved values are not encodable) 1271 // 24 reserved + unassigned simple (reserved values are not encodable)
1272 // 28-30 unassigned misc
1273 // 31 break code
857 default: 1274 default:
858 ERR ("corrupted CBOR data (reserved/unassigned major 7 value)"); 1275 ERR ("corrupted CBOR data (reserved/unassigned/unexpected major 7 value)");
859 } 1276 }
860 1277
861 break; 1278 break;
862 } 1279 }
863#if 0
864 switch (*dec->cur)
865 {
866 //case '"': ++dec->cur; return decode_str (dec);
867 case '[': ++dec->cur; return decode_av (dec);
868 case '{': ++dec->cur; return decode_hv (dec);
869
870 case '-':
871 case '0': case '1': case '2': case '3': case '4':
872 case '5': case '6': case '7': case '8': case '9':
873 //TODO return decode_num (dec);
874
875 case 't':
876 if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "true", 4))
877 {
878 dec->cur += 4;
879#if CBOR_SLOW
880 cbor_true = get_bool ("CBOR::XS::true");
881#endif
882 return newSVsv (cbor_true);
883 }
884 else
885 ERR ("'true' expected");
886
887 break;
888
889 case 'f':
890 if (dec->end - dec->cur >= 5 && !memcmp (dec->cur, "false", 5))
891 {
892 dec->cur += 5;
893#if CBOR_SLOW
894 cbor_false = get_bool ("CBOR::XS::false");
895#endif
896 return newSVsv (cbor_false);
897 }
898 else
899 ERR ("'false' expected");
900
901 break;
902
903 case 'n':
904 if (dec->end - dec->cur >= 4 && !memcmp (dec->cur, "null", 4))
905 {
906 dec->cur += 4;
907 return newSVsv (&PL_sv_undef);
908 }
909 else
910 ERR ("'null' expected");
911
912 break;
913
914 default:
915 ERR ("malformed CBOR string, neither array, object, number, string or atom");
916 break;
917 }
918#endif
919 1280
920fail: 1281fail:
921 return &PL_sv_undef; 1282 return &PL_sv_undef;
922} 1283}
923 1284
924static SV * 1285static SV *
925decode_cbor (SV *string, CBOR *cbor, char **offset_return) 1286decode_cbor (SV *string, CBOR *cbor, char **offset_return)
926{ 1287{
927 dec_t dec; 1288 dec_t dec = { 0 };
928 SV *sv; 1289 SV *sv;
1290 STRLEN len;
1291 char *data = SvPVbyte (string, len);
929 1292
930 /* work around bugs in 5.10 where manipulating magic values
931 * makes perl ignore the magic in subsequent accesses.
932 * also make a copy of non-PV values, to get them into a clean
933 * state (SvPV should do that, but it's buggy, see below).
934 */
935 /*SvGETMAGIC (string);*/
936 if (SvMAGICAL (string) || !SvPOK (string))
937 string = sv_2mortal (newSVsv (string));
938
939 SvUPGRADE (string, SVt_PV);
940
941 /* work around a bug in perl 5.10, which causes SvCUR to fail an
942 * assertion with -DDEBUGGING, although SvCUR is documented to
943 * return the xpv_cur field which certainly exists after upgrading.
944 * according to nicholas clark, calling SvPOK fixes this.
945 * But it doesn't fix it, so try another workaround, call SvPV_nolen
946 * and hope for the best.
947 * Damnit, SvPV_nolen still trips over yet another assertion. This
948 * assertion business is seriously broken, try yet another workaround
949 * for the broken -DDEBUGGING.
950 */
951 {
952#ifdef DEBUGGING
953 STRLEN offset = SvOK (string) ? sv_len (string) : 0;
954#else
955 STRLEN offset = SvCUR (string);
956#endif
957
958 if (offset > cbor->max_size && cbor->max_size) 1293 if (len > cbor->max_size && cbor->max_size)
959 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu", 1294 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
960 (unsigned long)SvCUR (string), (unsigned long)cbor->max_size); 1295 (unsigned long)len, (unsigned long)cbor->max_size);
961 }
962
963 sv_utf8_downgrade (string, 0);
964 1296
965 dec.cbor = *cbor; 1297 dec.cbor = *cbor;
966 dec.cur = (U8 *)SvPVX (string); 1298 dec.cur = (U8 *)data;
967 dec.end = (U8 *)SvEND (string); 1299 dec.end = (U8 *)data + len;
968 dec.err = 0;
969 dec.depth = 0;
970
971 if (dec.cbor.cb_object || dec.cbor.cb_sk_object)
972 ;//TODO dec.cbor.flags |= F_HOOK;
973 1300
974 sv = decode_sv (&dec); 1301 sv = decode_sv (&dec);
975 1302
976 if (offset_return) 1303 if (offset_return)
977 *offset_return = dec.cur; 1304 *offset_return = dec.cur;
978 1305
979 if (!(offset_return || !sv)) 1306 if (!(offset_return || !sv))
980 {
981 if (*dec.cur && !dec.err) 1307 if (dec.cur != dec.end && !dec.err)
982 {
983 dec.err = "garbage after CBOR object"; 1308 dec.err = "garbage after CBOR object";
1309
1310 if (dec.err)
1311 {
1312 if (dec.shareable)
1313 {
1314 // need to break cyclic links, which would all be in shareable
1315 int i;
1316 SV **svp;
1317
1318 for (i = av_len (dec.shareable) + 1; i--; )
1319 if ((svp = av_fetch (dec.shareable, i, 0)))
1320 sv_setsv (*svp, &PL_sv_undef);
1321 }
1322
984 SvREFCNT_dec (sv); 1323 SvREFCNT_dec (sv);
985 sv = 0;
986 }
987 }
988 1324
989 if (!sv) 1325 if (dec.err_sv)
1326 sv_2mortal (dec.err_sv);
1327
990 croak ("%s, at offset %d (octet 0x%02x)", dec.err, dec.cur - (U8 *)SvPVX (string), (int)(uint8_t)*dec.cur); 1328 croak ("%s, at offset %d (octet 0x%02x)", dec.err, dec.cur - (U8 *)data, (int)(uint8_t)*dec.cur);
1329 }
991 1330
992 sv = sv_2mortal (sv); 1331 sv = sv_2mortal (sv);
993 1332
994 return sv; 1333 return sv;
995} 1334}
996 1335
1336/////////////////////////////////////////////////////////////////////////////
1337// incremental parser
1338
1339#define INCR_DONE(cbor) (AvFILLp (cbor->incr_count) < 0)
1340
1341// returns 0 for notyet, 1 for success or error
1342static int
1343incr_parse (CBOR *self, SV *cborstr)
1344{
1345 STRLEN cur;
1346 SvPV (cborstr, cur);
1347
1348 while (ecb_expect_true (self->incr_need <= cur))
1349 {
1350 // table of integer count bytes
1351 static I8 incr_len[MINOR_MASK + 1] = {
1352 0, 0, 0, 0, 0, 0, 0, 0,
1353 0, 0, 0, 0, 0, 0, 0, 0,
1354 0, 0, 0, 0, 0, 0, 0, 0,
1355 1, 2, 4, 8,-1,-1,-1,-2
1356 };
1357
1358 const U8 *p = SvPVX (cborstr) + self->incr_pos;
1359 U8 m = *p & MINOR_MASK;
1360 IV count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1361 I8 ilen = incr_len[m];
1362
1363 self->incr_need = self->incr_pos + 1;
1364
1365 if (ecb_expect_false (ilen < 0))
1366 {
1367 if (m != MINOR_INDEF)
1368 return 1; // error
1369
1370 if (*p == (MAJOR_MISC | MINOR_INDEF))
1371 {
1372 if (count >= 0)
1373 return 1; // error
1374
1375 count = 1;
1376 }
1377 else
1378 {
1379 av_push (self->incr_count, newSViv (-1)); //TODO: nest
1380 count = -1;
1381 }
1382 }
1383 else
1384 {
1385 self->incr_need += ilen;
1386 if (ecb_expect_false (self->incr_need > cur))
1387 return 0;
1388
1389 int major = *p >> MAJOR_SHIFT;
1390
1391 switch (major)
1392 {
1393 case MAJOR_TAG >> MAJOR_SHIFT:
1394 ++count; // tags merely prefix another value
1395 break;
1396
1397 case MAJOR_BYTES >> MAJOR_SHIFT:
1398 case MAJOR_TEXT >> MAJOR_SHIFT:
1399 case MAJOR_ARRAY >> MAJOR_SHIFT:
1400 case MAJOR_MAP >> MAJOR_SHIFT:
1401 {
1402 UV len;
1403
1404 if (ecb_expect_false (ilen))
1405 {
1406 len = 0;
1407
1408 do {
1409 len = (len << 8) | *++p;
1410 } while (--ilen);
1411 }
1412 else
1413 len = m;
1414
1415 switch (major)
1416 {
1417 case MAJOR_BYTES >> MAJOR_SHIFT:
1418 case MAJOR_TEXT >> MAJOR_SHIFT:
1419 self->incr_need += len;
1420 if (ecb_expect_false (self->incr_need > cur))
1421 return 0;
1422
1423 break;
1424
1425 case MAJOR_MAP >> MAJOR_SHIFT:
1426 len <<= 1;
1427 case MAJOR_ARRAY >> MAJOR_SHIFT:
1428 if (len)
1429 {
1430 av_push (self->incr_count, newSViv (len + 1)); //TODO: nest
1431 count = len + 1;
1432 }
1433 break;
1434 }
1435 }
1436 }
1437 }
1438
1439 self->incr_pos = self->incr_need;
1440
1441 if (count > 0)
1442 {
1443 while (!--count)
1444 {
1445 if (!AvFILLp (self->incr_count))
1446 return 1; // done
1447
1448 SvREFCNT_dec_NN (av_pop (self->incr_count));
1449 count = SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]);
1450 }
1451
1452 SvIVX (AvARRAY (self->incr_count)[AvFILLp (self->incr_count)]) = count;
1453 }
1454 }
1455
1456 return 0;
1457}
1458
1459
997///////////////////////////////////////////////////////////////////////////// 1460/////////////////////////////////////////////////////////////////////////////
998// XS interface functions 1461// XS interface functions
999 1462
1000MODULE = CBOR::XS PACKAGE = CBOR::XS 1463MODULE = CBOR::XS PACKAGE = CBOR::XS
1001 1464
1002BOOT: 1465BOOT:
1003{ 1466{
1004 cbor_stash = gv_stashpv ("CBOR::XS" , 1); 1467 cbor_stash = gv_stashpv ("CBOR::XS" , 1);
1005 cbor_boolean_stash = gv_stashpv ("CBOR::XS::Boolean", 1); 1468 cbor_tagged_stash = gv_stashpv ("CBOR::XS::Tagged" , 1);
1006 1469
1007 cbor_true = get_bool ("CBOR::XS::true"); 1470 types_boolean_stash = gv_stashpv ("Types::Serialiser::Boolean", 1);
1008 cbor_false = get_bool ("CBOR::XS::false"); 1471 types_error_stash = gv_stashpv ("Types::Serialiser::Error" , 1);
1472
1473 types_true = get_bool ("Types::Serialiser::true" );
1474 types_false = get_bool ("Types::Serialiser::false");
1475 types_error = get_bool ("Types::Serialiser::error");
1476
1477 default_filter = newSVpv ("CBOR::XS::default_filter", 0);
1478
1479 sv_cbor = newSVpv ("CBOR", 0);
1480 SvREADONLY_on (sv_cbor);
1481
1482 assert (("STRLEN must be an unsigned type", 0 <= (STRLEN)-1));
1009} 1483}
1010 1484
1011PROTOTYPES: DISABLE 1485PROTOTYPES: DISABLE
1012 1486
1013void CLONE (...) 1487void CLONE (...)
1014 CODE: 1488 CODE:
1015 cbor_stash = 0; 1489 cbor_stash = 0;
1490 cbor_tagged_stash = 0;
1491 types_error_stash = 0;
1016 cbor_boolean_stash = 0; 1492 types_boolean_stash = 0;
1017 1493
1018void new (char *klass) 1494void new (char *klass)
1019 PPCODE: 1495 PPCODE:
1020{ 1496{
1021 SV *pv = NEWSV (0, sizeof (CBOR)); 1497 SV *pv = NEWSV (0, sizeof (CBOR));
1029 1505
1030void shrink (CBOR *self, int enable = 1) 1506void shrink (CBOR *self, int enable = 1)
1031 ALIAS: 1507 ALIAS:
1032 shrink = F_SHRINK 1508 shrink = F_SHRINK
1033 allow_unknown = F_ALLOW_UNKNOWN 1509 allow_unknown = F_ALLOW_UNKNOWN
1510 allow_sharing = F_ALLOW_SHARING
1511 allow_cycles = F_ALLOW_CYCLES
1512 forbid_objects = F_FORBID_OBJECTS
1513 pack_strings = F_PACK_STRINGS
1514 text_keys = F_TEXT_KEYS
1515 text_strings = F_TEXT_STRINGS
1516 validate_utf8 = F_VALIDATE_UTF8
1034 PPCODE: 1517 PPCODE:
1035{ 1518{
1036 if (enable) 1519 if (enable)
1037 self->flags |= ix; 1520 self->flags |= ix;
1038 else 1521 else
1043 1526
1044void get_shrink (CBOR *self) 1527void get_shrink (CBOR *self)
1045 ALIAS: 1528 ALIAS:
1046 get_shrink = F_SHRINK 1529 get_shrink = F_SHRINK
1047 get_allow_unknown = F_ALLOW_UNKNOWN 1530 get_allow_unknown = F_ALLOW_UNKNOWN
1531 get_allow_sharing = F_ALLOW_SHARING
1532 get_allow_cycles = F_ALLOW_CYCLES
1533 get_forbid_objects = F_FORBID_OBJECTS
1534 get_pack_strings = F_PACK_STRINGS
1535 get_text_keys = F_TEXT_KEYS
1536 get_text_strings = F_TEXT_STRINGS
1537 get_validate_utf8 = F_VALIDATE_UTF8
1048 PPCODE: 1538 PPCODE:
1049 XPUSHs (boolSV (self->flags & ix)); 1539 XPUSHs (boolSV (self->flags & ix));
1050 1540
1051void max_depth (CBOR *self, U32 max_depth = 0x80000000UL) 1541void max_depth (CBOR *self, U32 max_depth = 0x80000000UL)
1052 PPCODE: 1542 PPCODE:
1068 CODE: 1558 CODE:
1069 RETVAL = self->max_size; 1559 RETVAL = self->max_size;
1070 OUTPUT: 1560 OUTPUT:
1071 RETVAL 1561 RETVAL
1072 1562
1073#if 0 //TODO 1563void filter (CBOR *self, SV *filter = 0)
1074
1075void filter_cbor_object (CBOR *self, SV *cb = &PL_sv_undef)
1076 PPCODE: 1564 PPCODE:
1077{
1078 SvREFCNT_dec (self->cb_object); 1565 SvREFCNT_dec (self->filter);
1079 self->cb_object = SvOK (cb) ? newSVsv (cb) : 0; 1566 self->filter = filter ? newSVsv (filter) : filter;
1080
1081 XPUSHs (ST (0)); 1567 XPUSHs (ST (0));
1082}
1083 1568
1084void filter_cbor_single_key_object (CBOR *self, SV *key, SV *cb = &PL_sv_undef) 1569SV *get_filter (CBOR *self)
1085 PPCODE: 1570 CODE:
1086{ 1571 RETVAL = self->filter ? self->filter : NEWSV (0, 0);
1087 if (!self->cb_sk_object) 1572 OUTPUT:
1088 self->cb_sk_object = newHV (); 1573 RETVAL
1089
1090 if (SvOK (cb))
1091 hv_store_ent (self->cb_sk_object, key, newSVsv (cb), 0);
1092 else
1093 {
1094 hv_delete_ent (self->cb_sk_object, key, G_DISCARD, 0);
1095
1096 if (!HvKEYS (self->cb_sk_object))
1097 {
1098 SvREFCNT_dec (self->cb_sk_object);
1099 self->cb_sk_object = 0;
1100 }
1101 }
1102
1103 XPUSHs (ST (0));
1104}
1105
1106#endif
1107 1574
1108void encode (CBOR *self, SV *scalar) 1575void encode (CBOR *self, SV *scalar)
1109 PPCODE: 1576 PPCODE:
1110 PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN; 1577 PUTBACK; scalar = encode_cbor (scalar, self); SPAGAIN;
1111 XPUSHs (scalar); 1578 XPUSHs (scalar);
1124 EXTEND (SP, 2); 1591 EXTEND (SP, 2);
1125 PUSHs (sv); 1592 PUSHs (sv);
1126 PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr)))); 1593 PUSHs (sv_2mortal (newSVuv (offset - SvPVX (cborstr))));
1127} 1594}
1128 1595
1596void incr_parse (CBOR *self, SV *cborstr)
1597 ALIAS:
1598 incr_parse_multiple = 1
1599 PPCODE:
1600{
1601 if (SvUTF8 (cborstr))
1602 sv_utf8_downgrade (cborstr, 0);
1603
1604 if (!self->incr_count)
1605 {
1606 self->incr_count = newAV ();
1607 self->incr_pos = 0;
1608 self->incr_need = 1;
1609
1610 av_push (self->incr_count, newSViv (1));
1611 }
1612
1613 do
1614 {
1615 if (!incr_parse (self, cborstr))
1616 {
1617 if (self->incr_need > self->max_size && self->max_size)
1618 croak ("attempted decode of CBOR text of %lu bytes size, but max_size is set to %lu",
1619 (unsigned long)self->incr_need, (unsigned long)self->max_size);
1620
1621 break;
1622 }
1623
1624 SV *sv;
1625 char *offset;
1626
1627 PUTBACK; sv = decode_cbor (cborstr, self, &offset); SPAGAIN;
1628 XPUSHs (sv);
1629
1630 sv_chop (cborstr, offset);
1631
1632 av_clear (self->incr_count);
1633 av_push (self->incr_count, newSViv (1));
1634
1635 self->incr_pos = 0;
1636 self->incr_need = self->incr_pos + 1;
1637 }
1638 while (ix);
1639}
1640
1641void incr_reset (CBOR *self)
1642 CODE:
1643{
1644 SvREFCNT_dec (self->incr_count);
1645 self->incr_count = 0;
1646}
1647
1129void DESTROY (CBOR *self) 1648void DESTROY (CBOR *self)
1130 CODE: 1649 PPCODE:
1131 SvREFCNT_dec (self->cb_sk_object); 1650 cbor_free (self);
1132 SvREFCNT_dec (self->cb_object);
1133 1651
1134PROTOTYPES: ENABLE 1652PROTOTYPES: ENABLE
1135 1653
1136void encode_cbor (SV *scalar) 1654void encode_cbor (SV *scalar)
1655 ALIAS:
1656 encode_cbor = 0
1657 encode_cbor_sharing = F_ALLOW_SHARING
1137 PPCODE: 1658 PPCODE:
1138{ 1659{
1139 CBOR cbor; 1660 CBOR cbor;
1140 cbor_init (&cbor); 1661 cbor_init (&cbor);
1662 cbor.flags |= ix;
1141 PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN; 1663 PUTBACK; scalar = encode_cbor (scalar, &cbor); SPAGAIN;
1142 XPUSHs (scalar); 1664 XPUSHs (scalar);
1143} 1665}
1144 1666
1145void decode_cbor (SV *cborstr) 1667void decode_cbor (SV *cborstr)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines