#define NEED_newRV_noinc #define NEED_sv_2pv_flags #include "xshelper.h" typedef struct { int finished; SV* source; int incremented; } unpack_user; #include "msgpack/unpack_define.h" #define msgpack_unpack_struct(name) \ struct template ## name #define msgpack_unpack_func(ret, name) \ STATIC_INLINE ret template ## name #define msgpack_unpack_callback(name) \ template_callback ## name #define msgpack_unpack_object SV* #define msgpack_unpack_user unpack_user /* ---------------------------------------------------------------------- */ /* utility functions */ STATIC_INLINE SV * get_bool (const char *name) { dTHX; SV * sv = sv_mortalcopy(get_sv( name, 1 )); SvREADONLY_on(sv); SvREADONLY_on( SvRV(sv) ); return sv; } /* ---------------------------------------------------------------------- */ struct template_context; typedef struct template_context msgpack_unpack_t; static void template_init(msgpack_unpack_t* u); static SV* template_data(msgpack_unpack_t* u); static int template_execute(msgpack_unpack_t* u PERL_UNUSED_DECL, const char* data, size_t len, size_t* off); STATIC_INLINE SV* template_callback_root(unpack_user* u PERL_UNUSED_DECL) { dTHX; return &PL_sv_undef; } STATIC_INLINE int template_callback_uint8(unpack_user* u PERL_UNUSED_DECL, uint8_t d, SV** o) { dTHX; *o = sv_2mortal(newSVuv(d)); return 0; } STATIC_INLINE int template_callback_uint16(unpack_user* u PERL_UNUSED_DECL, uint16_t d, SV** o) { dTHX; *o = sv_2mortal(newSVuv(d)); return 0; } STATIC_INLINE int template_callback_uint32(unpack_user* u PERL_UNUSED_DECL, uint32_t d, SV** o) { dTHX; *o = sv_2mortal(newSVuv(d)); return 0; } STATIC_INLINE int template_callback_uint64(unpack_user* u PERL_UNUSED_DECL, uint64_t d, SV** o) { dTHX; #if IVSIZE==4 *o = sv_2mortal(newSVnv(d)); #else *o = sv_2mortal(newSVuv(d)); #endif return 0; } STATIC_INLINE int template_callback_int8(unpack_user* u PERL_UNUSED_DECL, int8_t d, SV** o) { dTHX; *o = sv_2mortal(newSViv(d)); return 0; } STATIC_INLINE int template_callback_int16(unpack_user* u PERL_UNUSED_DECL, int16_t d, SV** o) { dTHX; *o = sv_2mortal(newSViv(d)); return 0; } STATIC_INLINE int template_callback_int32(unpack_user* u PERL_UNUSED_DECL, int32_t d, SV** o) { dTHX; *o = sv_2mortal(newSViv(d)); return 0; } STATIC_INLINE int template_callback_int64(unpack_user* u PERL_UNUSED_DECL, int64_t d, SV** o) { dTHX; #if IVSIZE==4 *o = sv_2mortal(newSVnv(d)); #else *o = sv_2mortal(newSViv(d)); #endif return 0; } STATIC_INLINE int template_callback_float(unpack_user* u PERL_UNUSED_DECL, float d, SV** o) { dTHX; *o = sv_2mortal(newSVnv(d)); return 0; } STATIC_INLINE int template_callback_double(unpack_user* u PERL_UNUSED_DECL, double d, SV** o) { dTHX; *o = sv_2mortal(newSVnv(d)); return 0; } /* &PL_sv_undef is not so good. see http://gist.github.com/387743 */ STATIC_INLINE int template_callback_nil(unpack_user* u PERL_UNUSED_DECL, SV** o) { dTHX; *o = sv_newmortal(); return 0; } STATIC_INLINE int template_callback_true(unpack_user* u PERL_UNUSED_DECL, SV** o) { dTHX; *o = get_bool("Data::MessagePack::true"); return 0; } STATIC_INLINE int template_callback_false(unpack_user* u PERL_UNUSED_DECL, SV** o) { dTHX; *o = get_bool("Data::MessagePack::false"); return 0; } STATIC_INLINE int template_callback_array(unpack_user* u PERL_UNUSED_DECL, unsigned int n, SV** o) { dTHX; AV* const a = newAV(); *o = sv_2mortal(newRV_noinc((SV*)a)); av_extend(a, n + 1); return 0; } STATIC_INLINE int template_callback_array_item(unpack_user* u PERL_UNUSED_DECL, SV** c, SV* o) { dTHX; av_push((AV*)SvRV(*c), o); SvREFCNT_inc_simple_void_NN(o); return 0; } STATIC_INLINE int template_callback_map(unpack_user* u PERL_UNUSED_DECL, unsigned int n PERL_UNUSED_DECL, SV** o) { dTHX; HV* const h = newHV(); *o = sv_2mortal(newRV_noinc((SV*)h)); return 0; } STATIC_INLINE int template_callback_map_item(unpack_user* u PERL_UNUSED_DECL, SV** c, SV* k, SV* v) { dTHX; (void)hv_store_ent((HV*)SvRV(*c), k, v, 0); SvREFCNT_inc_simple_void_NN(v); return 0; } STATIC_INLINE int template_callback_raw(unpack_user* u PERL_UNUSED_DECL, const char* b PERL_UNUSED_DECL, const char* p, unsigned int l, SV** o) { dTHX; /* *o = newSVpvn_flags(p, l, SVs_TEMP); <= this does not work. */ *o = sv_2mortal((l==0) ? newSVpv("", 0) : newSVpv(p, l)); return 0; } #define UNPACKER(from, name) \ msgpack_unpack_t *name; \ name = INT2PTR(msgpack_unpack_t*, SvROK((from)) ? SvIV(SvRV((from))) : SvIV((from))); \ if(name == NULL) { \ Perl_croak(aTHX_ "NULL found for " # name " when shouldn't be."); \ } #include "msgpack/unpack_template.h" STATIC_INLINE SV* _msgpack_unpack(SV* data, int limit) { msgpack_unpack_t mp; dTHX; unpack_user u = {0, &PL_sv_undef, false}; int ret; size_t from = 0; STRLEN dlen; const char * dptr = SvPV_const(data, dlen); SV* obj; template_init(&mp); mp.user = u; mp.user.source = data; ret = template_execute(&mp, dptr, (size_t)dlen, &from); mp.user.source = &PL_sv_undef; obj = template_data(&mp); if(ret < 0) { Perl_croak(aTHX_ "parse error."); } else if(ret == 0) { Perl_croak(aTHX_ "insufficient bytes."); } else { if(from < dlen) { Perl_croak(aTHX_ "extra bytes."); } return obj; } } XS(xs_unpack_limit) { dXSARGS; if (items != 3) { Perl_croak(aTHX_ "Usage: Data::MessagePack->unpack('datadata', $limit)"); } { int limit = SvIV(ST(2)); ST(0) = _msgpack_unpack(ST(1), limit); } XSRETURN(1); } XS(xs_unpack) { dXSARGS; if (items != 2) { Perl_croak(aTHX_ "Usage: Data::MessagePack->unpack('datadata')"); } { ST(0) = _msgpack_unpack(ST(1), sv_len(ST(1))); } XSRETURN(1); } /* ------------------------------ stream -- */ /* http://twitter.com/frsyuki/status/13249304748 */ STATIC_INLINE void _reset(SV* self) { dTHX; unpack_user u = {0, &PL_sv_undef, 0}; UNPACKER(self, mp); template_init(mp); mp->user = u; } XS(xs_unpacker_new) { dXSARGS; if (items != 1) { Perl_croak(aTHX_ "Usage: Data::MessagePack::Unpacker->new()"); } SV* self = sv_newmortal(); msgpack_unpack_t *mp; Newx(mp, 1, msgpack_unpack_t); sv_setref_pv(self, "Data::MessagePack::Unpacker", mp); _reset(self); ST(0) = self; XSRETURN(1); } STATIC_INLINE SV* _execute_impl(SV* self, SV* data, UV off, I32 limit) { dTHX; UNPACKER(self, mp); size_t from = off; const char* dptr = SvPV_nolen_const(data); long dlen = limit; int ret; if(from >= (size_t)dlen) { Perl_croak(aTHX_ "offset is bigger than data buffer size."); } mp->user.source = data; ret = template_execute(mp, dptr, (size_t)dlen, &from); mp->user.source = &PL_sv_undef; if(ret < 0) { Perl_croak(aTHX_ "parse error."); } else if(ret > 0) { mp->user.finished = 1; return sv_2mortal(newSVuv(from)); } else { mp->user.finished = 0; return sv_2mortal(newSVuv(from)); } } XS(xs_unpacker_execute) { dXSARGS; if (items != 3) { Perl_croak(aTHX_ "Usage: $unpacker->execute_limit(data, off)"); } UNPACKER(ST(0), mp); { SV* self = ST(0); SV* data = ST(1); IV off = SvIV(ST(2)); /* offset of $data. normaly, 0. */ ST(0) = _execute_impl(self, data, off, sv_len(data)); { SV * d2 = template_data(mp); if (!mp->user.incremented && d2) { SvREFCNT_inc(d2); mp->user.incremented = 1; } } } XSRETURN(1); } XS(xs_unpacker_execute_limit) { dXSARGS; if (items != 4) { Perl_croak(aTHX_ "Usage: $unpacker->execute_limit(data, off, limit)"); } SV* self = ST(0); SV* data = ST(1); IV off = SvIV(ST(2)); IV limit = SvIV(ST(3)); ST(0) = _execute_impl(self, data, off, limit); XSRETURN(1); } XS(xs_unpacker_is_finished) { dXSARGS; if (items != 1) { Perl_croak(aTHX_ "Usage: $unpacker->is_finished()"); } UNPACKER(ST(0), mp); ST(0) = (mp->user.finished) ? &PL_sv_yes : &PL_sv_no; XSRETURN(1); } XS(xs_unpacker_data) { dXSARGS; if (items != 1) { Perl_croak(aTHX_ "Usage: $unpacker->data()"); } UNPACKER(ST(0), mp); ST(0) = sv_2mortal(newSVsv(template_data(mp))); XSRETURN(1); } XS(xs_unpacker_reset) { dXSARGS; if (items != 1) { Perl_croak(aTHX_ "Usage: $unpacker->reset()"); } UNPACKER(ST(0), mp); { SV * data = template_data(mp); if (data) { SvREFCNT_dec(data); } } _reset(ST(0)); XSRETURN(0); } XS(xs_unpacker_destroy) { dXSARGS; if (items != 1) { Perl_croak(aTHX_ "Usage: $unpacker->DESTROY()"); } UNPACKER(ST(0), mp); SV * data = template_data(mp); if (SvOK(data)) { SvREFCNT_dec(data); } Safefree(mp); XSRETURN(0); }