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); }