KHARON_DECL void
map_element(ssp_val *ret, ssp_val *key, ssp_val *val)
{
if (!val)
(void) hv_store_ent((HV *)*ret, (SV *)*key, newSV(0), 0);
else
(void) hv_store_ent((HV *)*ret, (SV *)*key, (SV *)*val, 0);
D(fprintf(stderr, "map_element(%p, %p, %p)\n", *ret, *key,
val?*val:0));
}
void
scan_search_entry_response(const char** src, const char* max, HV *out) {
SV *dn, *key;
STRLEN len;
dn = newSV(0);
hv_stores(out, "dn", dn);
scan_string_utf8(src, max, dn);
scan_sequence(src, max, &len);
if (len != max - *src)
croak("scan_search_entry_response: packet too short");
key = sv_newmortal();
while (*src < max) {
const char *attribute_max;
AV *values;
scan_sequence(src, max, &len);
attribute_max = *src + len;
scan_string_utf8(src, max, key);
values = newAV();
hv_store_ent(out, key, newRV_noinc((SV*)values), 0);
scan_set(src, max, &len);
if (attribute_max != *src + len)
croak("bad packet");
while (*src < attribute_max) {
SV *v = newSV(0);
av_push(values, v);
scan_string_utf8(src, attribute_max, v);
}
}
}
void decode_udt(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
struct cc_udt *udt;
int i;
STRLEN pos;
HV *the_obj;
SV *the_rv;
the_obj = newHV();
the_rv = newRV_noinc((SV*)the_obj);
sv_setsv(output, the_rv);
SvREFCNT_dec(the_rv);
udt = type->udt;
assert(udt && udt->fields);
pos = 0;
for (i = 0; i < udt->field_count; i++) {
if (len == pos) {
break;
}
struct cc_udt_field *field;
SV *value;
field = &udt->fields[i];
value = newSV(0);
hv_store_ent(the_obj, field->name, value, field->name_hash);
decode_cell(aTHX_ input, len, &pos, &field->type, value);
}
}
void
LUCY_Doc_Store_IMP(lucy_Doc *self, cfish_String *field, cfish_Obj *value) {
dTHX;
lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
const char *key = CFISH_Str_Get_Ptr8(field);
size_t key_size = CFISH_Str_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = XSBind_cfish_to_perl(aTHX_ value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)ivars->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
void
lucy_Doc_store(lucy_Doc *self, const lucy_CharBuf *field, lucy_Obj *value) {
char *key = (char*)Lucy_CB_Get_Ptr8(field);
size_t key_size = Lucy_CB_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = value == NULL
? newSV(0)
: Lucy_Obj_Is_A(value, LUCY_CHARBUF)
? XSBind_cb_to_sv((lucy_CharBuf*)value)
: (SV*)Lucy_Obj_To_Host(value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)self->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
void THX_MopMcV_add_method(pTHX_ SV* metaclass, SV* name, SV* code) {
GV* method_gv;
HV* stash = (HV*) SvRV(metaclass);
SV* method = newMopMmV(code, 0);
HE* method_gv_he = hv_fetch_ent(stash, name, 0, 0);
if (method_gv_he != NULL) {
GV* method_gv = (GV*) HeVAL(method_gv_he);
} else {
method_gv = (GV*) newSV(0);
gv_init_sv(method_gv, stash, name, 0);
(void)hv_store_ent(stash, name, (SV*) method_gv, 0);
}
MopMmV_assign_to_stash(method, method_gv, stash);
}
void
LUCY_Doc_Store_IMP(lucy_Doc *self, cfish_String *field, cfish_Obj *value) {
lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
const char *key = CFISH_Str_Get_Ptr8(field);
size_t key_size = CFISH_Str_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = value == NULL
? newSV(0)
: CFISH_Obj_Is_A(value, CFISH_STRING)
? XSBind_str_to_sv((cfish_String*)value)
: (SV*)CFISH_Obj_To_Host(value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)ivars->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
/*
* Load a YAML mapping into a Perl hash
*/
SV *
load_mapping(perl_yaml_loader_t *loader, char *tag)
{
SV *key_node;
SV *value_node;
HV *hash = newHV();
SV *hash_ref = (SV *)newRV_noinc((SV *)hash);
char *anchor = (char *)loader->event.data.mapping_start.anchor;
if (!tag)
tag = (char *)loader->event.data.mapping_start.tag;
/* Store the anchor label if any */
if (anchor)
hv_store(loader->anchors, anchor, strlen(anchor), SvREFCNT_inc(hash_ref), 0);
/* Get each key string and value node and put them in the hash */
while ((key_node = load_node(loader))) {
assert(SvPOK(key_node));
value_node = load_node(loader);
hv_store_ent(
hash, key_node, value_node, 0
);
}
/* Deal with possibly blessing the hash if the YAML tag has a class */
if (tag && strEQ(tag, TAG_PERL_PREFIX "hash"))
tag = NULL;
if (tag) {
char *class;
char *prefix = TAG_PERL_PREFIX "hash:";
if (*tag == '!') {
prefix = "!";
}
else if (strlen(tag) <= strlen(prefix) ||
! strnEQ(tag, prefix, strlen(prefix))
) croak(
loader_error_msg(loader, form("bad tag found for hash: '%s'", tag))
);
class = tag + strlen(prefix);
sv_bless(hash_ref, gv_stashpv(class, TRUE));
}
return hash_ref;
}
void decode_map(pTHX_ unsigned char *input, STRLEN len, struct cc_type *type, SV *output)
{
struct cc_type *key_type, *value_type;
int i;
STRLEN pos;
HV *the_map;
SV *the_rv;
key_type = &type->inner_type[0];
value_type = &type->inner_type[1];
assert(key_type && value_type);
if (UNLIKELY(len < 4))
croak("decode_map: len < 4");
int32_t num_elements = (int32_t)ntohl(*(uint32_t*)(input));
if (UNLIKELY(num_elements < 0))
croak("decode_map: num_elements < 0");
the_map = newHV();
the_rv = newRV_noinc((SV*)the_map);
sv_setsv(output, the_rv);
SvREFCNT_dec(the_rv);
pos = 4;
for (i = 0; i < num_elements; i++) {
SV *key, *value;
key = newSV(0);
sv_2mortal(key);
decode_cell(aTHX_ input, len, &pos, key_type, key);
value = newSV(0);
hv_store_ent(the_map, key, value, 0);
decode_cell(aTHX_ input, len, &pos, value_type, value);
}
}
void THX_MopMcV_add_attribute(pTHX_ SV* metaclass, SV* attribute) {
SV* attr_name;
SV* attributes = MopOV_get_at_slot(metaclass, CLASS_ATTRIBUTE_SLOT);
if (attributes == NULL) {
attributes = newRV_noinc((SV*) newHV());
MopOV_set_at_slot(metaclass, CLASS_ATTRIBUTE_SLOT, attributes);
}
if (SvTYPE(attributes) != SVt_RV && SvTYPE(SvRV(attributes)) != SVt_PVHV) {
croak("attributes is not a HASH ref, this is wrong");
}
attr_name = MopMaV_get_name(attribute);
if (attr_name == NULL) {
croak("The attribute has no name, this is wrong!");
}
if (NULL == hv_store_ent((HV*) SvRV(attributes), attr_name, attribute, 0)) {
croak("The attribute failed to store, this is wrong!");
}
MopMaV_set_associated_class(attribute, metaclass);
}
/****************************
* SV* Py2Pl(PyObject *obj)
*
* Converts arbitrary Python data structures to Perl data structures
* Note on references: does not Py_DECREF(obj).
*
* Modifications by Eric Wilhelm 2004-07-11 marked as elw
*
****************************/
SV *Py2Pl(PyObject * const obj) {
/* elw: see what python says things are */
#if PY_MAJOR_VERSION >= 3
int const is_string = PyBytes_Check(obj) || PyUnicode_Check(obj);
#else
int const is_string = PyString_Check(obj) || PyUnicode_Check(obj);
#endif
#ifdef I_PY_DEBUG
PyObject *this_type = PyObject_Type(obj); /* new reference */
PyObject *t_string = PyObject_Str(this_type); /* new reference */
#if PY_MAJOR_VERSION >= 3
PyObject *type_str_bytes = PyUnicode_AsUTF8String(t_string); /* new reference */
char *type_str = PyBytes_AsString(type_str_bytes);
#else
char *type_str = PyString_AsString(t_string);
#endif
Printf(("type is %s\n", type_str));
printf("Py2Pl object:\n\t");
PyObject_Print(obj, stdout, Py_PRINT_RAW);
printf("\ntype:\n\t");
PyObject_Print(this_type, stdout, Py_PRINT_RAW);
printf("\n");
Printf(("String check: %i\n", is_string));
Printf(("Number check: %i\n", PyNumber_Check(obj)));
Printf(("Int check: %i\n", PyInt_Check(obj)));
Printf(("Long check: %i\n", PyLong_Check(obj)));
Printf(("Float check: %i\n", PyFloat_Check(obj)));
Printf(("Type check: %i\n", PyType_Check(obj)));
#if PY_MAJOR_VERSION < 3
Printf(("Class check: %i\n", PyClass_Check(obj)));
Printf(("Instance check: %i\n", PyInstance_Check(obj)));
#endif
Printf(("Dict check: %i\n", PyDict_Check(obj)));
Printf(("Mapping check: %i\n", PyMapping_Check(obj)));
Printf(("Sequence check: %i\n", PySequence_Check(obj)));
Printf(("Iter check: %i\n", PyIter_Check(obj)));
Printf(("Function check: %i\n", PyFunction_Check(obj)));
Printf(("Module check: %i\n", PyModule_Check(obj)));
Printf(("Method check: %i\n", PyMethod_Check(obj)));
#if PY_MAJOR_VERSION < 3
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE))
printf("heaptype true\n");
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HAVE_CLASS))
printf("has class\n");
#else
Py_DECREF(type_str_bytes);
#endif
Py_DECREF(t_string);
Py_DECREF(this_type);
#endif
/* elw: this needs to be early */
/* None (like undef) */
if (!obj || obj == Py_None) {
Printf(("Py2Pl: Py_None\n"));
return &PL_sv_undef;
}
else
#ifdef EXPOSE_PERL
/* unwrap Perl objects */
if (PerlObjObject_Check(obj)) {
Printf(("Py2Pl: Obj_object\n"));
return ((PerlObj_object *) obj)->obj;
}
/* unwrap Perl code refs */
else if (PerlSubObject_Check(obj)) {
Printf(("Py2Pl: Sub_object\n"));
SV * ref = ((PerlSub_object *) obj)->ref;
if (! ref) { /* probably an inherited method */
if (! ((PerlSub_object *) obj)->obj)
croak("Error: could not find a code reference or object method for PerlSub");
SV * const sub_obj = (SV*)SvRV(((PerlSub_object *) obj)->obj);
HV * const pkg = SvSTASH(sub_obj);
#if PY_MAJOR_VERSION >= 3
char * const sub = PyBytes_AsString(((PerlSub_object *) obj)->sub);
#else
PyObject *obj_sub_str = PyObject_Str(((PerlSub_object *) obj)->sub); /* new ref. */
char * const sub = PyString_AsString(obj_sub_str);
#endif
GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, sub, TRUE);
if (gv && isGV(gv)) {
ref = (SV *)GvCV(gv);
}
#if PY_MAJOR_VERSION < 3
Py_DECREF(obj_sub_str);
#endif
}
return newRV_inc((SV *) ref);
}
else
#endif
/* wrap an instance of a Python class */
/* elw: here we need to make these look like instances: */
if ((obj->ob_type->tp_flags & Py_TPFLAGS_HEAPTYPE)
#if PY_MAJOR_VERSION < 3
|| PyInstance_Check(obj)
#endif
) {
/* This is a Python class instance -- bless it into an
* Inline::Python::Object. If we're being called from an
* Inline::Python class, it will be re-blessed into whatever
* class that is.
*/
SV * const inst_ptr = newSViv(0);
SV * const inst = newSVrv(inst_ptr, "Inline::Python::Object");;
_inline_magic priv;
/* set up magic */
priv.key = INLINE_MAGIC_KEY;
sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
MAGIC * const mg = mg_find(inst, PERL_MAGIC_ext);
mg->mg_virtual = &inline_mg_vtbl;
sv_setiv(inst, (IV) obj);
/*SvREADONLY_on(inst); */ /* to uncomment this means I can't
re-bless it */
Py_INCREF(obj);
Printf(("Py2Pl: Instance. Obj: %p, inst_ptr: %p\n", obj, inst_ptr));
sv_2mortal(inst_ptr);
return inst_ptr;
}
/* a tuple or a list */
else if (PySequence_Check(obj) && !is_string) {
AV * const retval = newAV();
int i;
int const sz = PySequence_Length(obj);
Printf(("sequence (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject * const tmp = PySequence_GetItem(obj, i); /* new reference */
SV * const next = Py2Pl(tmp);
av_push(retval, next);
if (sv_isobject(next)) // needed because objects get mortalized in Py2Pl
SvREFCNT_inc(next);
Py_DECREF(tmp);
}
if (PyTuple_Check(obj)) {
_inline_magic priv;
priv.key = TUPLE_MAGIC_KEY;
sv_magic((SV * const)retval, (SV * const)NULL, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
}
return newRV_noinc((SV *) retval);
}
/* a dictionary or fake Mapping object */
/* elw: PyMapping_Check() now returns true for strings */
else if (! is_string && PyMapping_Check(obj)) {
HV * const retval = newHV();
int i;
int const sz = PyMapping_Length(obj);
PyObject * const keys = PyMapping_Keys(obj); /* new reference */
PyObject * const vals = PyMapping_Values(obj); /* new reference */
Printf(("Py2Pl: dict/map\n"));
Printf(("mapping (%i)\n", sz));
for (i = 0; i < sz; i++) {
PyObject * const key = PySequence_GetItem(keys, i), /* new reference */
* const val = PySequence_GetItem(vals, i); /* new reference */
SV * const sv_val = Py2Pl(val);
char * key_val;
if (PyUnicode_Check(key)) {
PyObject * const utf8_string = PyUnicode_AsUTF8String(key); /* new reference */
#if PY_MAJOR_VERSION >= 3
key_val = PyBytes_AsString(utf8_string);
SV * const utf8_key = newSVpv(key_val, PyBytes_Size(utf8_string));
#else
key_val = PyString_AsString(utf8_string);
SV * const utf8_key = newSVpv(key_val, PyString_Size(utf8_string));
#endif
SvUTF8_on(utf8_key);
hv_store_ent(retval, utf8_key, sv_val, 0);
Py_DECREF(utf8_string);
}
else {
PyObject * s = NULL;
#if PY_MAJOR_VERSION >= 3
PyObject * s_bytes = NULL;
if (PyBytes_Check(key)) {
key_val = PyBytes_AsString(key);
#else
if (PyString_Check(key)) {
key_val = PyString_AsString(key);
#endif
}
else {
/* Warning -- encountered a non-string key value while converting a
* Python dictionary into a Perl hash. Perl can only use strings as
* key values. Using Python's string representation of the key as
* Perl's key value.
*/
s = PyObject_Str(key); /* new reference */
#if PY_MAJOR_VERSION >= 3
s_bytes = PyUnicode_AsUTF8String(s); /* new reference */
key_val = PyBytes_AsString(s_bytes);
#else
key_val = PyString_AsString(s);
#endif
Py_DECREF(s);
if (PL_dowarn)
warn("Stringifying non-string hash key value: '%s'",
key_val);
}
if (!key_val) {
croak("Invalid key on key %i of mapping\n", i);
}
hv_store(retval, key_val, strlen(key_val), sv_val, 0);
#if PY_MAJOR_VERSION >= 3
Py_XDECREF(s_bytes);
#endif
Py_XDECREF(s);
}
if (sv_isobject(sv_val)) // needed because objects get mortalized in Py2Pl
SvREFCNT_inc(sv_val);
Py_DECREF(key);
Py_DECREF(val);
}
Py_DECREF(keys);
Py_DECREF(vals);
return newRV_noinc((SV *) retval);
}
/* a boolean */
else if (PyBool_Check(obj)) {
void HRA_store_a(SV *self, SV *attr, char *t, SV *value, ...)
{
SV *vstring = newSVuv((UV)SvRV(value)); //reverse lookup key
SV *aobj = NULL; //primary attribute entry, from attr_lookup
SV *vref = NULL; //value's entry in attribute hash
SV *attrhash_ref = NULL; //reference for attribute hash, for adding actions
SV **a_r_ent = NULL; //lval-type HE for looking/storing attr in vhash
char *astring = NULL;
hrattr_simple *aptr; //our private attribute structure
int options = STORE_OPT_O_CREAT;
int i;
dXSARGS;
if ((items-4) % 2) {
die("Expected hash options or nothing (got %d)", items-3);
}
for(i=4;i<items;i+=2) {
_chkopt(STRONG_ATTR, i, options);
_chkopt(STRONG_VALUE, i, options);
}
aobj = attr_get(self, attr, t, options);
if(!aobj) {
die("attr_get() failed to return anything");
}
aptr = attr_from_sv(SvRV(aobj));
assert(SvROK(aobj));
astring = attr_strkey(aptr, attr_getsize(aptr));
if(!insert_into_vhash(value, aobj, astring, REF2TABLE(self), NULL)) {
goto GT_RET; /*No new insertions*/
}
if(!HvKEYS(aptr->attrhash)) {
/*First entry and we've already inserted our reverse entry*/
SvREFCNT_dec(SvRV(aobj));
}
vref = newSVsv(value);
if(hv_store_ent(aptr->attrhash, vstring, vref, 0)) {
if( (options & STORE_OPT_STRONG_VALUE) == 0) {
sv_rvweaken(vref);
}
} else {
SvREFCNT_dec(vref);
}
RV_Newtmp(attrhash_ref, (SV*)aptr->attrhash);
HR_Action v_actions[] = {
HR_DREF_FLDS_ptr_from_hv(SvRV(value), attrhash_ref),
HR_ACTION_LIST_TERMINATOR
};
HR_add_actions_real(value, v_actions);
GT_RET:
SvREFCNT_dec(vstring);
if(attrhash_ref) {
RV_Freetmp(attrhash_ref);
}
XSRETURN(0);
}
static SV *
ghash_to_sv (GITypeInfo *info,
gpointer pointer,
GITransfer transfer)
{
GITypeInfo *key_param_info, *value_param_info;
#ifdef NOISY
GITypeTag key_type_tag, value_type_tag;
#endif
gpointer key_p, value_p;
GITransfer item_transfer;
GHashTableIter iter;
HV *hv;
if (pointer == NULL) {
return &PL_sv_undef;
}
item_transfer = transfer == GI_TRANSFER_EVERYTHING
? GI_TRANSFER_EVERYTHING
: GI_TRANSFER_NOTHING;
key_param_info = g_type_info_get_param_type (info, 0);
value_param_info = g_type_info_get_param_type (info, 1);
#ifdef NOISY
key_type_tag = g_type_info_get_tag (key_param_info);
value_type_tag = g_type_info_get_tag (value_param_info);
#endif
dwarn (" GHashTable: pointer %p\n"
" key type tag %d (%s)\n"
" value type tag %d (%s)\n",
pointer,
key_type_tag, g_type_tag_to_string (key_type_tag),
value_type_tag, g_type_tag_to_string (value_type_tag));
hv = newHV ();
g_hash_table_iter_init (&iter, pointer);
while (g_hash_table_iter_next (&iter, &key_p, &value_p)) {
GIArgument arg = { 0, };
SV *key_sv, *value_sv;
dwarn (" converting key pointer %p\n", key_p);
arg.v_pointer = key_p;
key_sv = arg_to_sv (&arg, key_param_info, item_transfer, NULL);
if (key_sv == NULL)
break;
dwarn (" converting value pointer %p\n", value_p);
arg.v_pointer = value_p;
value_sv = arg_to_sv (&arg, value_param_info, item_transfer, NULL);
if (value_sv == NULL)
break;
(void) hv_store_ent (hv, key_sv, value_sv, 0);
}
g_base_info_unref ((GIBaseInfo *) key_param_info);
g_base_info_unref ((GIBaseInfo *) value_param_info);
return newRV_noinc ((SV *) hv);
}
static void
report_event(PSTATE* p_state,
event_id_t event,
char *beg, char *end, U32 utf8,
token_pos_t *tokens, int num_tokens,
SV* self
)
{
struct p_handler *h;
dTHX;
dSP;
AV *array;
STRLEN my_na;
char *argspec;
char *s;
#ifdef UNICODE_HTML_PARSER
#define CHR_DIST(a,b) (utf8 ? utf8_distance((U8*)(a),(U8*)(b)) : (a) - (b))
#else
#define CHR_DIST(a,b) ((a) - (b))
#endif
/* capture offsets */
STRLEN offset = p_state->offset;
STRLEN line = p_state->line;
STRLEN column = p_state->column;
#if 0
{ /* used for debugging at some point */
char *s = beg;
int i;
/* print debug output */
switch(event) {
case E_DECLARATION: printf("DECLARATION"); break;
case E_COMMENT: printf("COMMENT"); break;
case E_START: printf("START"); break;
case E_END: printf("END"); break;
case E_TEXT: printf("TEXT"); break;
case E_PROCESS: printf("PROCESS"); break;
case E_NONE: printf("NONE"); break;
default: printf("EVENT #%d", event); break;
}
printf(" [");
while (s < end) {
if (*s == '\n') {
putchar('\\'); putchar('n');
}
else
putchar(*s);
s++;
}
printf("] %d\n", end - beg);
for (i = 0; i < num_tokens; i++) {
printf(" token %d: %d %d\n",
i,
tokens[i].beg - beg,
tokens[i].end - tokens[i].beg);
}
}
#endif
if (p_state->pending_end_tag && event != E_TEXT && event != E_COMMENT) {
token_pos_t t;
char dummy;
t.beg = p_state->pending_end_tag;
t.end = p_state->pending_end_tag + strlen(p_state->pending_end_tag);
p_state->pending_end_tag = 0;
report_event(p_state, E_END, &dummy, &dummy, 0, &t, 1, self);
SPAGAIN;
}
/* update offsets */
p_state->offset += CHR_DIST(end, beg);
if (line) {
char *s = beg;
char *nl = NULL;
while (s < end) {
if (*s == '\n') {
p_state->line++;
nl = s;
}
s++;
}
if (nl)
p_state->column = CHR_DIST(end, nl) - 1;
else
p_state->column += CHR_DIST(end, beg);
}
if (event == E_NONE)
goto IGNORE_EVENT;
#ifdef MARKED_SECTION
if (p_state->ms == MS_IGNORE)
goto IGNORE_EVENT;
#endif
/* tag filters */
if (p_state->ignore_tags || p_state->report_tags || p_state->ignore_elements) {
if (event == E_START || event == E_END) {
SV* tagname = p_state->tmp;
assert(num_tokens >= 1);
sv_setpvn(tagname, tokens[0].beg, tokens[0].end - tokens[0].beg);
if (utf8)
SvUTF8_on(tagname);
else
SvUTF8_off(tagname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ tagname);
if (p_state->ignoring_element) {
if (sv_eq(p_state->ignoring_element, tagname)) {
if (event == E_START)
p_state->ignore_depth++;
else if (--p_state->ignore_depth == 0) {
SvREFCNT_dec(p_state->ignoring_element);
p_state->ignoring_element = 0;
}
}
goto IGNORE_EVENT;
}
if (p_state->ignore_elements &&
hv_fetch_ent(p_state->ignore_elements, tagname, 0, 0))
{
p_state->ignoring_element = newSVsv(tagname);
p_state->ignore_depth = 1;
goto IGNORE_EVENT;
}
if (p_state->ignore_tags &&
hv_fetch_ent(p_state->ignore_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
if (p_state->report_tags &&
!hv_fetch_ent(p_state->report_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
}
else if (p_state->ignoring_element) {
goto IGNORE_EVENT;
}
}
h = &p_state->handlers[event];
if (!h->cb) {
/* event = E_DEFAULT; */
h = &p_state->handlers[E_DEFAULT];
if (!h->cb)
goto IGNORE_EVENT;
}
if (SvTYPE(h->cb) != SVt_PVAV && !SvTRUE(h->cb)) {
/* FALSE scalar ('' or 0) means IGNORE this event */
return;
}
if (p_state->unbroken_text && event == E_TEXT) {
/* should buffer text */
if (!p_state->pend_text)
p_state->pend_text = newSV(256);
if (SvOK(p_state->pend_text)) {
if (p_state->is_cdata != p_state->pend_text_is_cdata) {
flush_pending_text(p_state, self);
SPAGAIN;
goto INIT_PEND_TEXT;
}
}
else {
INIT_PEND_TEXT:
p_state->pend_text_offset = offset;
p_state->pend_text_line = line;
p_state->pend_text_column = column;
p_state->pend_text_is_cdata = p_state->is_cdata;
sv_setpvn(p_state->pend_text, "", 0);
if (!utf8)
SvUTF8_off(p_state->pend_text);
}
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->pend_text))
sv_utf8_upgrade(p_state->pend_text);
if (utf8 || !SvUTF8(p_state->pend_text)) {
sv_catpvn(p_state->pend_text, beg, end - beg);
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#else
sv_catpvn(p_state->pend_text, beg, end - beg);
#endif
return;
}
else if (p_state->pend_text && SvOK(p_state->pend_text)) {
flush_pending_text(p_state, self);
SPAGAIN;
}
/* At this point we have decided to generate an event callback */
argspec = h->argspec ? SvPV(h->argspec, my_na) : "";
if (SvTYPE(h->cb) == SVt_PVAV) {
if (*argspec == ARG_FLAG_FLAT_ARRAY) {
argspec++;
array = (AV*)h->cb;
}
else {
/* start sub-array for accumulator array */
array = newAV();
}
}
else {
array = 0;
if (*argspec == ARG_FLAG_FLAT_ARRAY)
argspec++;
/* start argument stack for callback */
ENTER;
SAVETMPS;
PUSHMARK(SP);
}
for (s = argspec; *s; s++) {
SV* arg = 0;
int push_arg = 1;
enum argcode argcode = (enum argcode)*s;
switch( argcode ) {
case ARG_SELF:
arg = sv_mortalcopy(self);
break;
case ARG_TOKENS:
if (num_tokens >= 1) {
AV* av = newAV();
SV* prev_token = &PL_sv_undef;
int i;
av_extend(av, num_tokens);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
prev_token = newSVpvn(tokens[i].beg, tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(prev_token);
av_push(av, prev_token);
}
else { /* boolean */
av_push(av, p_state->bool_attr_val
? newSVsv(p_state->bool_attr_val)
: newSVsv(prev_token));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKENPOS:
if (num_tokens >= 1 && tokens[0].beg >= beg) {
AV* av = newAV();
int i;
av_extend(av, num_tokens*2);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
av_push(av, newSViv(CHR_DIST(tokens[i].beg, beg)));
av_push(av, newSViv(CHR_DIST(tokens[i].end, tokens[i].beg)));
}
else { /* boolean tag value */
av_push(av, newSViv(0));
av_push(av, newSViv(0));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKEN0:
case ARG_TAGNAME:
/* fall through */
case ARG_TAG:
if (num_tokens >= 1) {
arg = sv_2mortal(newSVpvn(tokens[0].beg,
tokens[0].end - tokens[0].beg));
if (utf8)
SvUTF8_on(arg);
if (!CASE_SENSITIVE(p_state) && argcode != ARG_TOKEN0)
sv_lower(aTHX_ arg);
if (argcode == ARG_TAG && event != E_START) {
char *e_type = "!##/#?#";
sv_insert(arg, 0, 0, &e_type[event], 1);
}
}
break;
case ARG_ATTR:
case ARG_ATTRARR:
if (event == E_START) {
HV* hv;
int i;
if (argcode == ARG_ATTR) {
hv = newHV();
arg = sv_2mortal(newRV_noinc((SV*)hv));
}
else {
#ifdef __GNUC__
/* gcc -Wall reports this variable as possibly used uninitialized */
hv = 0;
#endif
push_arg = 0; /* deal with argument pushing here */
}
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
SV* attrval;
if (utf8)
SvUTF8_on(attrname);
if (tokens[i+1].beg) {
char *beg = tokens[i+1].beg;
STRLEN len = tokens[i+1].end - beg;
if (*beg == '"' || *beg == '\'') {
assert(len >= 2 && *beg == beg[len-1]);
beg++; len -= 2;
}
attrval = newSVpvn(beg, len);
if (utf8)
SvUTF8_on(attrval);
if (!p_state->attr_encoded) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(attrval);
#endif
decode_entities(aTHX_ attrval, p_state->entity2char, 0);
if (p_state->utf8_mode)
SvUTF8_off(attrval);
}
}
else { /* boolean */
if (p_state->bool_attr_val)
attrval = newSVsv(p_state->bool_attr_val);
else
attrval = newSVsv(attrname);
}
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
if (argcode == ARG_ATTR) {
if (hv_exists_ent(hv, attrname, 0) ||
!hv_store_ent(hv, attrname, attrval, 0)) {
SvREFCNT_dec(attrval);
}
SvREFCNT_dec(attrname);
}
else { /* ARG_ATTRARR */
if (array) {
av_push(array, attrname);
av_push(array, attrval);
}
else {
XPUSHs(sv_2mortal(attrname));
XPUSHs(sv_2mortal(attrval));
}
}
}
}
else if (argcode == ARG_ATTRARR) {
push_arg = 0;
}
break;
case ARG_ATTRSEQ: /* (v2 compatibility stuff) */
if (event == E_START) {
AV* av = newAV();
int i;
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(attrname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
av_push(av, attrname);
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TEXT:
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
break;
case ARG_DTEXT:
if (event == E_TEXT) {
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
if (!p_state->is_cdata) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(arg);
#endif
decode_entities(aTHX_ arg, p_state->entity2char, 1);
if (p_state->utf8_mode)
SvUTF8_off(arg);
}
}
break;
case ARG_IS_CDATA:
if (event == E_TEXT) {
arg = boolSV(p_state->is_cdata);
}
break;
case ARG_SKIPPED_TEXT:
arg = sv_2mortal(p_state->skipped_text);
p_state->skipped_text = newSVpvn("", 0);
break;
case ARG_OFFSET:
arg = sv_2mortal(newSViv(offset));
break;
case ARG_OFFSET_END:
arg = sv_2mortal(newSViv(offset + CHR_DIST(end, beg)));
break;
case ARG_LENGTH:
arg = sv_2mortal(newSViv(CHR_DIST(end, beg)));
break;
case ARG_LINE:
arg = sv_2mortal(newSViv(line));
break;
case ARG_COLUMN:
arg = sv_2mortal(newSViv(column));
break;
case ARG_EVENT:
assert(event >= 0 && event < EVENT_COUNT);
arg = sv_2mortal(newSVpv(event_id_str[event], 0));
break;
case ARG_LITERAL:
{
int len = (unsigned char)s[1];
arg = sv_2mortal(newSVpvn(s+2, len));
if (SvUTF8(h->argspec))
SvUTF8_on(arg);
s += len + 1;
}
break;
case ARG_UNDEF:
arg = sv_mortalcopy(&PL_sv_undef);
break;
default:
arg = sv_2mortal(newSVpvf("Bad argspec %d", *s));
break;
}
if (push_arg) {
if (!arg)
arg = sv_mortalcopy(&PL_sv_undef);
if (array) {
/* have to fix mortality here or add mortality to
* XPUSHs after removing it from the switch cases.
*/
av_push(array, SvREFCNT_inc(arg));
}
else {
XPUSHs(arg);
}
}
}
if (array) {
if (array != (AV*)h->cb)
av_push((AV*)h->cb, newRV_noinc((SV*)array));
}
else {
PUTBACK;
if ((enum argcode)*argspec == ARG_SELF && !SvROK(h->cb)) {
char *method = SvPV(h->cb, my_na);
perl_call_method(method, G_DISCARD | G_EVAL | G_VOID);
}
else {
perl_call_sv(h->cb, G_DISCARD | G_EVAL | G_VOID);
}
if (SvTRUE(ERRSV)) {
RETHROW;
}
FREETMPS;
LEAVE;
}
if (p_state->skipped_text)
SvCUR_set(p_state->skipped_text, 0);
return;
IGNORE_EVENT:
if (p_state->skipped_text) {
if (event != E_TEXT && p_state->pend_text && SvOK(p_state->pend_text))
flush_pending_text(p_state, self);
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->skipped_text))
sv_utf8_upgrade(p_state->skipped_text);
if (utf8 || !SvUTF8(p_state->skipped_text)) {
#endif
sv_catpvn(p_state->skipped_text, beg, end - beg);
#ifdef UNICODE_HTML_PARSER
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#endif
}
#undef CHR_DIST
return;
}
/*
=for apidoc mro_get_linear_isa_dfs
Returns the Depth-First Search linearization of @ISA
the given stash. The return value is a read-only AV*.
C<level> should be 0 (it is used internally in this
function's recursion).
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
static AV*
S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* av;
const HEK* stashhek;
struct mro_meta* meta;
SV *our_name;
HV *stored;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HEK_KEY(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
return retval;
}
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
av_push(retval, our_name); /* add ourselves at the top */
/* fetch our @ISA */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
/* "stored" is used to keep track of all of the classnames we have added to
the MRO so far, so we can do a quick exists check and avoid adding
duplicate classnames to the MRO as we go.
It's then retained to be re-used as a fast lookup for ->isa(), by adding
our own name and "UNIVERSAL" to it. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
if(av && AvFILLp(av) >= 0) {
SV **svp = AvARRAY(av);
I32 items = AvFILLp(av) + 1;
/* foreach(@ISA) */
while (items--) {
SV* const sv = *svp++;
HV* const basestash = gv_stashsv(sv, 0);
SV *const *subrv_p;
I32 subrv_items;
if (!basestash) {
/* if no stash exists for this @ISA member,
simply add it to the MRO and move on */
subrv_p = &sv;
subrv_items = 1;
}
else {
/* otherwise, recurse into ourselves for the MRO
of this @ISA member, and append their MRO to ours.
The recursive call could throw an exception, which
has memory management implications here, hence the use of
the mortal. */
const AV *const subrv
= mro_get_linear_isa_dfs(basestash, level + 1);
subrv_p = AvARRAY(subrv);
subrv_items = AvFILLp(subrv) + 1;
}
while(subrv_items--) {
SV *const subsv = *subrv_p++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
assert(he);
if(HeVAL(he) != &PL_sv_undef) {
/* It was newly created. Steal it for our new SV, and
replace it in the hash with the "real" thing. */
SV *const val = HeVAL(he);
HEK *const key = HeKEY_hek(he);
HeVAL(he) = &PL_sv_undef;
/* Save copying by making a shared hash key scalar. We
inline this here rather than calling Perl_newSVpvn_share
because we already have the scalar, and we already have
the hash key. */
assert(SvTYPE(val) == SVt_NULL);
sv_upgrade(val, SVt_PV);
SvPV_set(val, HEK_KEY(share_hek_hek(key)));
SvCUR_set(val, HEK_LEN(key));
SvREADONLY_on(val);
SvFAKE_on(val);
SvPOK_on(val);
if (HEK_UTF8(key))
SvUTF8_on(val);
av_push(retval, val);
}
}
}
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
SvREFCNT_inc_simple_void_NN(stored);
SvTEMP_off(stored);
SvREADONLY_on(stored);
meta->isa = stored;
/* now that we're past the exception dangers, grab our own reference to
the AV we're about to use for the result. The reference owned by the
mortals' stack will be released soon, so everything will balance. */
SvREFCNT_inc_simple_void_NN(retval);
SvTEMP_off(retval);
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
MUTABLE_SV(retval)));
}
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;
}
/*
=for apidoc mro_get_linear_isa_dfs
Returns the Depth-First Search linearization of C<@ISA>
the given stash. The return value is a read-only AV*.
C<level> should be 0 (it is used internally in this
function's recursion).
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
static AV*
S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* av;
const HEK* stashhek;
struct mro_meta* meta;
SV *our_name;
HV *stored = NULL;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek
= HvAUX(stash)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(stash)
? HvENAME_HEK_NN(stash)
: HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_
"Recursive inheritance detected in package '%"HEKf"'",
HEKfARG(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
return retval;
}
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
av_push(retval, our_name); /* add ourselves at the top */
/* fetch our @ISA */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
/* "stored" is used to keep track of all of the classnames we have added to
the MRO so far, so we can do a quick exists check and avoid adding
duplicate classnames to the MRO as we go.
It's then retained to be re-used as a fast lookup for ->isa(), by adding
our own name and "UNIVERSAL" to it. */
if(av && AvFILLp(av) >= 0) {
SV **svp = AvARRAY(av);
I32 items = AvFILLp(av) + 1;
/* foreach(@ISA) */
while (items--) {
SV* const sv = *svp ? *svp : &PL_sv_undef;
HV* const basestash = gv_stashsv(sv, 0);
SV *const *subrv_p;
I32 subrv_items;
svp++;
if (!basestash) {
/* if no stash exists for this @ISA member,
simply add it to the MRO and move on */
subrv_p = &sv;
subrv_items = 1;
}
else {
/* otherwise, recurse into ourselves for the MRO
of this @ISA member, and append their MRO to ours.
The recursive call could throw an exception, which
has memory management implications here, hence the use of
the mortal. */
const AV *const subrv
= mro_get_linear_isa_dfs(basestash, level + 1);
subrv_p = AvARRAY(subrv);
subrv_items = AvFILLp(subrv) + 1;
}
if (stored) {
while(subrv_items--) {
SV *const subsv = *subrv_p++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
assert(he);
if(HeVAL(he) != &PL_sv_undef) {
/* It was newly created. Steal it for our new SV, and
replace it in the hash with the "real" thing. */
SV *const val = HeVAL(he);
HEK *const key = HeKEY_hek(he);
HeVAL(he) = &PL_sv_undef;
sv_sethek(val, key);
av_push(retval, val);
}
}
} else {
/* We are the first (or only) parent. We can short cut the
complexity above, because our @ISA is simply us prepended
to our parent's @ISA, and our ->isa cache is simply our
parent's, with our name added. */
/* newSVsv() is slow. This code is only faster if we can avoid
it by ensuring that SVs in the arrays are shared hash key
scalar SVs, because we can "copy" them very efficiently.
Although to be fair, we can't *ensure* this, as a reference
to the internal array is returned by mro::get_linear_isa(),
so we'll have to be defensive just in case someone faffed
with it. */
if (basestash) {
SV **svp;
stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa)));
av_extend(retval, subrv_items);
AvFILLp(retval) = subrv_items;
svp = AvARRAY(retval);
while(subrv_items--) {
SV *const val = *subrv_p++;
*++svp = SvIsCOW_shared_hash(val)
? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val)))
: newSVsv(val);
}
} else {
/* They have no stash. So create ourselves an ->isa cache
as if we'd copied it from what theirs should be. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
av_push(retval,
newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
&PL_sv_undef, 0))));
}
}
}
} else {
/* We have no parents. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
SvREFCNT_inc_simple_void_NN(stored);
SvTEMP_off(stored);
SvREADONLY_on(stored);
meta->isa = stored;
/* now that we're past the exception dangers, grab our own reference to
the AV we're about to use for the result. The reference owned by the
mortals' stack will be released soon, so everything will balance. */
SvREFCNT_inc_simple_void_NN(retval);
SvTEMP_off(retval);
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
MUTABLE_SV(retval)));
}
lucy_HitDoc*
lucy_DefDocReader_fetch_doc(lucy_DefaultDocReader *self, int32_t doc_id) {
lucy_Schema *const schema = self->schema;
lucy_InStream *const dat_in = self->dat_in;
lucy_InStream *const ix_in = self->ix_in;
HV *fields = newHV();
int64_t start;
uint32_t num_fields;
SV *field_name_sv = newSV(1);
// Get data file pointer from index, read number of fields.
Lucy_InStream_Seek(ix_in, (int64_t)doc_id * 8);
start = Lucy_InStream_Read_U64(ix_in);
Lucy_InStream_Seek(dat_in, start);
num_fields = Lucy_InStream_Read_C32(dat_in);
// Decode stored data and build up the doc field by field.
while (num_fields--) {
STRLEN field_name_len;
char *field_name_ptr;
SV *value_sv;
lucy_FieldType *type;
// Read field name.
field_name_len = Lucy_InStream_Read_C32(dat_in);
field_name_ptr = SvGROW(field_name_sv, field_name_len + 1);
Lucy_InStream_Read_Bytes(dat_in, field_name_ptr, field_name_len);
SvPOK_on(field_name_sv);
SvCUR_set(field_name_sv, field_name_len);
SvUTF8_on(field_name_sv);
*SvEND(field_name_sv) = '\0';
// Find the Field's FieldType.
lucy_ZombieCharBuf *field_name_zcb
= CFISH_ZCB_WRAP_STR(field_name_ptr, field_name_len);
Lucy_ZCB_Assign_Str(field_name_zcb, field_name_ptr, field_name_len);
type = Lucy_Schema_Fetch_Type(schema, (lucy_CharBuf*)field_name_zcb);
// Read the field value.
switch (Lucy_FType_Primitive_ID(type) & lucy_FType_PRIMITIVE_ID_MASK) {
case lucy_FType_TEXT: {
STRLEN value_len = Lucy_InStream_Read_C32(dat_in);
value_sv = newSV((value_len ? value_len : 1));
Lucy_InStream_Read_Bytes(dat_in, SvPVX(value_sv), value_len);
SvCUR_set(value_sv, value_len);
*SvEND(value_sv) = '\0';
SvPOK_on(value_sv);
SvUTF8_on(value_sv);
break;
}
case lucy_FType_BLOB: {
STRLEN value_len = Lucy_InStream_Read_C32(dat_in);
value_sv = newSV((value_len ? value_len : 1));
Lucy_InStream_Read_Bytes(dat_in, SvPVX(value_sv), value_len);
SvCUR_set(value_sv, value_len);
*SvEND(value_sv) = '\0';
SvPOK_on(value_sv);
break;
}
case lucy_FType_FLOAT32:
value_sv = newSVnv(Lucy_InStream_Read_F32(dat_in));
break;
case lucy_FType_FLOAT64:
value_sv = newSVnv(Lucy_InStream_Read_F64(dat_in));
break;
case lucy_FType_INT32:
value_sv = newSViv((int32_t)Lucy_InStream_Read_C32(dat_in));
break;
case lucy_FType_INT64:
if (sizeof(IV) == 8) {
int64_t val = (int64_t)Lucy_InStream_Read_C64(dat_in);
value_sv = newSViv((IV)val);
}
else { // (lossy)
int64_t val = (int64_t)Lucy_InStream_Read_C64(dat_in);
value_sv = newSVnv((double)val);
}
break;
default:
value_sv = NULL;
CFISH_THROW(LUCY_ERR, "Unrecognized type: %o", type);
}
// Store the value.
(void)hv_store_ent(fields, field_name_sv, value_sv, 0);
}
SvREFCNT_dec(field_name_sv);
lucy_HitDoc *retval = lucy_HitDoc_new(fields, doc_id, 0.0);
SvREFCNT_dec((SV*)fields);
return retval;
}
/*
=for apidoc mro_get_linear_isa
Returns the mro linearisation for the given stash. By default, this
will be whatever C<mro_get_linear_isa_dfs> returns unless some
other MRO is in effect for the stash. The return value is a
read-only AV*.
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
AV*
Perl_mro_get_linear_isa(pTHX_ HV *stash)
{
struct mro_meta* meta;
AV *isa;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA;
if(!SvOOK(stash))
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
meta = HvMROMETA(stash);
if (!meta->mro_which)
Perl_croak(aTHX_ "panic: invalid MRO!");
isa = meta->mro_which->resolve(aTHX_ stash, 0);
if (meta->mro_which != &dfs_alg) { /* skip for dfs, for speed */
SV * const namesv =
(HvENAME(stash)||HvNAME(stash))
? newSVhek(HvENAME_HEK(stash)
? HvENAME_HEK(stash)
: HvNAME_HEK(stash))
: NULL;
if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv)))
{
AV * const old = isa;
SV **svp;
SV **ovp = AvARRAY(old);
SV * const * const oend = ovp + AvFILLp(old) + 1;
isa = (AV *)sv_2mortal((SV *)newAV());
av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1);
*AvARRAY(isa) = namesv;
svp = AvARRAY(isa)+1;
while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++);
}
else SvREFCNT_dec(namesv);
}
if (!meta->isa) {
HV *const isa_hash = newHV();
/* Linearisation didn't build it for us, so do it here. */
SV *const *svp = AvARRAY(isa);
SV *const *const svp_end = svp + AvFILLp(isa) + 1;
const HEK *canon_name = HvENAME_HEK(stash);
if (!canon_name) canon_name = HvNAME_HEK(stash);
while (svp < svp_end) {
(void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0);
}
(void) hv_common(isa_hash, NULL, HEK_KEY(canon_name),
HEK_LEN(canon_name), HEK_FLAGS(canon_name),
HV_FETCH_ISSTORE, &PL_sv_undef,
HEK_HASH(canon_name));
(void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
SvREADONLY_on(isa_hash);
meta->isa = isa_hash;
}
return isa;
}