static void
S_attributes__push_fetch(pTHX_ SV *sv)
{
dSP;
switch (SvTYPE(sv)) {
case SVt_PVCV:
{
cv_flags_t cvflags = CvFLAGS((const CV *)sv);
if (cvflags & CVf_LVALUE) {
XPUSHs(newSVpvs_flags("lvalue", SVs_TEMP));
}
if (cvflags & CVf_METHOD) {
XPUSHs(newSVpvs_flags("method", SVs_TEMP));
}
if (cvflags & CVf_PURE) {
XPUSHs(newSVpvs_flags("pure", SVs_TEMP));
}
if (cvflags & CVf_TYPED) {
HV *typestash = CvTYPE((CV*)sv);
XPUSHs(newSVpvn_flags(HvNAME(typestash), HvNAMELEN(typestash),
SVs_TEMP|HvNAMEUTF8(typestash)));
}
break;
}
default:
break;
}
PUTBACK;
}
const char *
_munpack_item(const char *p, size_t len, SV **res, HV *ext, int utf)
{
if (!len || !p)
croak("Internal error: out of pointer");
const char *pe = p + len;
switch(mp_typeof(*p)) {
case MP_UINT:
*res = newSViv( mp_decode_uint(&p) );
break;
case MP_INT:
*res = newSViv( mp_decode_int(&p) );
break;
case MP_FLOAT:
*res = newSVnv( mp_decode_float(&p) );
break;
case MP_DOUBLE:
*res = newSVnv( mp_decode_double(&p) );
break;
case MP_STR: {
const char *s;
uint32_t len;
s = mp_decode_str(&p, &len);
*res = newSVpvn_flags(s, len, utf ? SVf_UTF8 : 0);
break;
}
case MP_NIL: {
mp_decode_nil(&p);
*res = newSV(0);
break;
}
case MP_BOOL:
if (mp_decode_bool(&p)) {
*res = newSViv(1);
} else {
*res = newSViv(0);
}
break;
case MP_MAP: {
uint32_t l, i;
l = mp_decode_map(&p);
HV * h = newHV();
sv_2mortal((SV *)h);
for (i = 0; i < l; i++) {
SV *k = 0;
SV *v = 0;
if (p >= pe)
croak("Unexpected EOF msgunpack str");
p = _munpack_item(p, pe - p, &k, ext, utf);
sv_2mortal(k);
if (p >= pe)
croak("Unexpected EOF msgunpack str");
p = _munpack_item(p, pe - p, &v, ext, utf);
hv_store_ent(h, k, v, 0);
}
*res = newRV((SV *)h);
break;
}
case MP_ARRAY: {
uint32_t l, i;
l = mp_decode_array(&p);
AV *a = newAV();
sv_2mortal((SV *)a);
for (i = 0; i < l; i++) {
SV *item = 0;
if (p >= pe)
croak("Unexpected EOF msgunpack str");
p = _munpack_item(p, pe - p, &item, ext, utf);
av_push(a, item);
}
*res = newRV((SV *)a);
break;
}
case MP_EXT: {
croak("Isn't defined yet");
}
default:
croak("Unexpected symbol 0x%02x", 0xFF & (int)(*p));
}
return p;
}
SV *p5_buf_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
PERL_SET_CONTEXT(my_perl);
return newSVpvn_flags(value, len, 0);
}
SV *p5_buf_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
return newSVpvn_flags(value, len, 0);
}
SV *p5_str_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
return newSVpvn_flags(value, len, SVf_UTF8);
}
