/* convert a hash to a string, with the format "key=val,key=val" */
char *
hash2str( HV* hash )
{
SV* val; /* temp for iterating over hash */
char* key; /* temp for iterating over hash */
I32 keylen; /* temp for iterating over hash */
int len = 0; /* length of final string, including EOS */
int n; /* number of elements in hash */
char* str; /* final string */
char* ptr; /* temp ptr */
/* iterate over hash, determining the length of the final string */
hv_iterinit(hash);
while( val = hv_iternextsv(hash, &key, &keylen) )
{
/* complain if the value is undefined or if it's a reference */
if ( !SvOK(val) || SvROK(val) )
croak( "hash entry for `%s' not a scalar", key );
n++;
len += keylen + SvCUR(val);
}
len += n /* '=' */
+ n-1 /* ',' */
+ 1; /* EOS */
/* now, fill in string */
New( 0, str, len, char );
ptr = str;
hv_iterinit(hash);
while( val = hv_iternextsv(hash, &key, &keylen) )
{
STRLEN cur;
char *pv;
strcpy(ptr, key);
ptr += keylen;
*ptr++ = '=';
pv = SvPV(val, cur);
strncpy(ptr, pv, cur);
ptr += cur;
*ptr++ = ',';
}
/* the EOS position now contains a ',', and ptr is one
past that. fix that */
*--ptr = '\0';
return str;
}
/*
This assumes that `val' is actually a Perl Hash table
and that elementType identifies a _primitive_ Perl
type and that all the elements in the table are of
that type. This then creates an S vector of
the corresponding type and populates it with the
elements of the table and puts the names of the elements
as the names of the S vector.
*/
USER_OBJECT_
fromHomogeneousTable(SV *val, svtype elementType)
{
USER_OBJECT_ ans, names;
SV *av, *el;
I32 len;
char *key;
int n, i;
dTHX;
if(SvROK(val))
av = SvRV(val) ;
else
av = val;
n = hv_iterinit((HV *) av);
PROTECT(ans = PerlAllocHomogeneousVector(n, elementType));
PROTECT(names = NEW_CHARACTER(n));
for(i = 0; i < n; i++) {
el = hv_iternextsv((HV *) av, &key, &len);
if(el) {
PerlAddHomogeneousElement(el, i, ans, elementType);
}
if(key && key[0]) {
SET_STRING_ELT(names, i, COPY_TO_USER_STRING(key));
}
}
SET_NAMES(ans, names);
UNPROTECT(2);
return(ans);
}
/*
* Gets the content from hashes
*/
static int get_hv_content(TALLOC_CTX *ctx, REQUEST *request, HV *my_hv, VALUE_PAIR **vps,
const char *hash_name, const char *list_name)
{
SV *res_sv, **av_sv;
AV *av;
char *key;
I32 key_len, len, i, j;
int ret = 0;
*vps = NULL;
for (i = hv_iterinit(my_hv); i > 0; i--) {
res_sv = hv_iternextsv(my_hv,&key,&key_len);
if (SvROK(res_sv) && (SvTYPE(SvRV(res_sv)) == SVt_PVAV)) {
av = (AV*)SvRV(res_sv);
len = av_len(av);
for (j = 0; j <= len; j++) {
av_sv = av_fetch(av, j, 0);
ret = pairadd_sv(ctx, request, vps, key, *av_sv, T_OP_ADD, hash_name, list_name) + ret;
}
} else ret = pairadd_sv(ctx, request, vps, key, res_sv, T_OP_EQ, hash_name, list_name) + ret;
}
if (*vps) LIST_VERIFY(*vps);
return ret;
}
/*
Loop over all the key-value pairs and convert
them to string and USER_OBJECT_ and put the latter
into an R/S LIST and use the vector of keys as the names.
*/
USER_OBJECT_
fromPerlHV(HV *table, unsigned int depth)
{
I32 len;
char *key;
SV *el;
I32 n, i;
Rboolean sameType;
svtype elType;
dTHX;
USER_OBJECT_ names, ans;
sameType = isHomogeneous((SV*)table, &elType);
if(sameType && isPerlPrimitiveType(elType, (SV *)table)) {
return(fromHomogeneousTable((SV *) table, elType));
}
n = hv_iterinit(table);
i = 0;
PROTECT(names = NEW_CHARACTER(n));
PROTECT(ans = NEW_LIST(n));
while(i < n) {
el = hv_iternextsv(table, &key, &len);
if(key == NULL)
break;
SET_VECTOR_ELT(ans, i, fromPerl(el, TRUE));
SET_STRING_ELT(names, i, COPY_TO_USER_STRING(key));
i++;
}
SET_NAMES(ans, names);
UNPROTECT(2);
return(ans);
}
static HeapTuple
plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
{
TupleDesc td = attinmeta->tupdesc;
char **values;
SV *val;
char *key;
I32 klen;
HeapTuple tup;
values = (char **) palloc0(td->natts * sizeof(char *));
hv_iterinit(perlhash);
while ((val = hv_iternextsv(perlhash, &key, &klen)))
{
int attn = SPI_fnumber(td, key);
if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"",
key)));
if (SvOK(val) && SvTYPE(val) != SVt_NULL)
values[attn - 1] = SvPV(val, PL_na);
}
hv_iterinit(perlhash);
tup = BuildTupleFromCStrings(attinmeta, values);
pfree(values);
return tup;
}
USER_OBJECT_
RS_GetPerlReferenceObjects(USER_OBJECT_ which)
{
USER_OBJECT_ ans, tmp;
int n, i = 0;
ForeignReferenceTable *table= &exportReferenceTable;
SV *el;
char *key;
I32 len;
dTHX;
if(table->entries == NULL) {
return(NULL_USER_OBJECT);
}
n = GET_LENGTH(which);
if(n == 0) {
n = hv_iterinit(table->entries);
PROTECT(ans = NEW_LIST(n));
while(i < n) {
el = hv_iternextsv(table->entries, &key, &len);
if(el == NULL)
break;
tmp = makeRSReferenceObject(key, computeRSPerlClassVector(el, NULL, TRUE), table);
SET_VECTOR_ELT(ans, i, tmp);
i++;
}
} else {
}
return(ans);
}
int
plcb_extract_args(SV *sv, plcb_OPTION *values)
{
char *cur_key;
I32 klen;
if (SvROK(sv)) {
sv = SvRV(sv);
}
if (SvTYPE(sv) == SVt_PVHV) {
HV *hv = (HV*)sv;
SV *cur_val;
hv_iterinit(hv);
while ( (cur_val = hv_iternextsv(hv, &cur_key, &klen)) ) {
plcb_OPTION *curdst = find_valspec(values, cur_key, klen);
if (!curdst) {
warn("Unrecognized key '%.*s'", (int)klen, cur_key);
continue;
}
if (convert_valspec(curdst, cur_val) == -1) {
die("Bad value for %.*s'", (int)klen, cur_key);
}
curdst->sv = cur_val;
}
} else {
die("Unrecognized options type. Must be hash");
}
return 0;
}
SV * newSVFlagsHash(long value, char * optname, HV * o)
{
SV * target, *result;
int i;
HE * he;
SV * s;
I32 len;
char * key;
if (!pgtk_use_array)
target = (SV*)newHV();
else
target = (SV*)newAV();
hv_iterinit(o);
while((s = hv_iternextsv(o, &key, &len))) {
int val = SvIV(s);
if ((value & val) == val) {
if (!pgtk_use_array)
hv_store((HV*)target, key, len, newSViv(1), 0);
else
av_push((AV*)target, newSVpv(key, len));
value &= ~val;
}
}
result = newRV(target);
SvREFCNT_dec(target);
return result;
}
USER_OBJECT_
RS_PerlNames(USER_OBJECT_ obj)
{
HV* hv;
SV *el;
int n, i;
USER_OBJECT_ names;
char *key;
I32 len;
dTHX;
if(IS_CHARACTER(obj)) {
hv = get_hv(CHAR_DEREF(STRING_ELT(obj,0)), FALSE);
} else
hv = (HV *) RS_PerlGetSV(obj);
if(hv == NULL) {
PROBLEM "identifier does not refer to a Perl hashtable object"
ERROR;
}
if(SvTYPE(hv) != SVt_PVHV) {
if(SvROK(hv) && SvTYPE(SvRV(hv)) == SVt_PVHV) {
hv = (HV *) SvRV(hv);
} else {
PROBLEM "identifier is not a Perl hashtable object, but some other type %s", getPerlType((SV*)hv)
ERROR;
}
}
n = hv_iterinit(hv);
if(n == 0)
return(NULL_USER_OBJECT);
PROTECT(names = NEW_CHARACTER(n));
i = 0;
while(i < n) {
el = hv_iternextsv(hv, &key, &len);
if(key == NULL)
break;
SET_STRING_ELT(names, i, COPY_TO_USER_STRING(key));
i++;
}
UNPROTECT(1);
return(names);
}
void HRXSATTR_ithread_predup(SV *self, SV *table, HV *ptr_map)
{
hrattr_simple *attr = attr_from_sv(SvRV(self));
/*Make sure our attribute hash is visible to perl space*/
SV *attrhash_ref;
RV_Newtmp(attrhash_ref, (SV*)attr->attrhash);
hr_dup_store_rv(ptr_map, attrhash_ref);
RV_Freetmp(attrhash_ref);
char *ktmp;
I32 tmplen;
SV *vtmp;
SV *rlookup;
get_hashes(REF2TABLE(table),
HR_HKEY_LOOKUP_REVERSE, &rlookup,
HR_HKEY_LOOKUP_NULL);
hv_iterinit(attr->attrhash);
while( (vtmp = hv_iternextsv(attr->attrhash, &ktmp, &tmplen))) {
HR_Dup_Vinfo *vi = hr_dup_get_vinfo(ptr_map, SvRV(vtmp), 1);
if(!vi->vhash) {
SV *vaddr = newSVuv((UV)SvRV(vtmp));
SV *vhash = get_vhash_from_rlookup(rlookup, vaddr, 0);
vi->vhash = vhash;
SvREFCNT_dec(vaddr);
}
}
if(attr->encap) {
hrattr_encap *aencap = attr_encap_cast(attr);
hr_dup_store_rv(ptr_map, aencap->obj_rv);
char *ai = (char*)hr_dup_store_kinfo(
ptr_map, HR_DUPKEY_AENCAP, aencap->obj_paddr, 1);
if(SvWEAKREF(aencap->obj_rv)) {
*ai = HRK_DUP_WEAK_ENCAP;
} else {
*ai = 0;
}
}
}
struct t_hashtable *
weechat_perl_hash_to_hashtable (SV *hash, int size, const char *type_keys,
const char *type_values)
{
struct t_hashtable *hashtable;
HV *hash2;
SV *value;
char *str_key;
I32 retlen;
hashtable = weechat_hashtable_new (size, type_keys, type_values,
NULL, NULL);
if (!hashtable)
return NULL;
if ((hash) && SvROK(hash) && SvRV(hash)
&& (SvTYPE(SvRV(hash)) == SVt_PVHV))
{
hash2 = (HV *)SvRV(hash);
hv_iterinit (hash2);
while ((value = hv_iternextsv (hash2, &str_key, &retlen)))
{
if (strcmp (type_values, WEECHAT_HASHTABLE_STRING) == 0)
{
weechat_hashtable_set (hashtable, str_key,
SvPV (value, PL_na));
}
else if (strcmp (type_values, WEECHAT_HASHTABLE_POINTER) == 0)
{
weechat_hashtable_set (hashtable, str_key,
plugin_script_str2ptr (
weechat_perl_plugin,
NULL, NULL,
SvPV (value, PL_na)));
}
}
}
return hashtable;
}
/*
* Boyan :
* Gets the content from hashes
*/
static int get_hv_content(HV *my_hv, VALUE_PAIR **vp)
{
SV *res_sv, **av_sv;
AV *av;
char *key;
I32 key_len, len, i, j;
int ret=0;
for (i = hv_iterinit(my_hv); i > 0; i--) {
res_sv = hv_iternextsv(my_hv,&key,&key_len);
if (SvROK(res_sv) && (SvTYPE(SvRV(res_sv)) == SVt_PVAV)) {
av = (AV*)SvRV(res_sv);
len = av_len(av);
for (j = 0; j <= len; j++) {
av_sv = av_fetch(av, j, 0);
ret = pairadd_sv(vp, key, *av_sv, T_OP_ADD) + ret;
}
} else ret = pairadd_sv(vp, key, res_sv, T_OP_EQ) + ret;
}
return ret;
}
static void perl_hash_to_json( SV *input, json_writer_t *writer )
{
HV *h;
char *prop;
I32 cnt, retlen;
SV *item;
json_writer_start_object( writer );
if ( ( SvROK( input ) && SvTYPE( SvRV( input ) ) == SVt_PVHV ) ) {
h = (HV *) SvRV( input );
cnt = hv_iterinit( h );
while ( cnt-- ) {
item = hv_iternextsv( h, &prop, &retlen );
json_writer_start_property( writer, prop );
perl_variable_to_json_internal( item, writer );
json_writer_end_property( writer );
}
}
json_writer_end_object( writer );
}
static HeapTuple
plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
{
SV **svp;
HV *hvNew;
HeapTuple rtup;
SV *val;
char *key;
I32 klen;
int slotsused;
int *modattrs;
Datum *modvalues;
char *modnulls;
TupleDesc tupdesc;
tupdesc = tdata->tg_relation->rd_att;
svp = hv_fetch(hvTD, "new", 3, FALSE);
if (!svp)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist")));
if (!SvOK(*svp) || SvTYPE(*svp) != SVt_RV || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
errmsg("$_TD->{new} is not a hash reference")));
hvNew = (HV *) SvRV(*svp);
modattrs = palloc(tupdesc->natts * sizeof(int));
modvalues = palloc(tupdesc->natts * sizeof(Datum));
modnulls = palloc(tupdesc->natts * sizeof(char));
slotsused = 0;
hv_iterinit(hvNew);
while ((val = hv_iternextsv(hvNew, &key, &klen)))
{
int attn = SPI_fnumber(tupdesc, key);
if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("Perl hash contains nonexistent column \"%s\"",
key)));
if (SvOK(val) && SvTYPE(val) != SVt_NULL)
{
Oid typinput;
Oid typioparam;
FmgrInfo finfo;
/* XXX would be better to cache these lookups */
getTypeInputInfo(tupdesc->attrs[attn - 1]->atttypid,
&typinput, &typioparam);
fmgr_info(typinput, &finfo);
modvalues[slotsused] = FunctionCall3(&finfo,
CStringGetDatum(SvPV(val, PL_na)),
ObjectIdGetDatum(typioparam),
Int32GetDatum(tupdesc->attrs[attn - 1]->atttypmod));
modnulls[slotsused] = ' ';
}
else
{
modvalues[slotsused] = (Datum) 0;
modnulls[slotsused] = 'n';
}
modattrs[slotsused] = attn;
slotsused++;
}
hv_iterinit(hvNew);
rtup = SPI_modifytuple(tdata->tg_relation, otup, slotsused,
modattrs, modvalues, modnulls);
pfree(modattrs);
pfree(modvalues);
pfree(modnulls);
if (rtup == NULL)
elog(ERROR, "SPI_modifytuple failed: %s",
SPI_result_code_string(SPI_result));
return rtup;
}
static void fill_metric_info(HV* plhash, pl_metric_init_t* minfo, char *modname, apr_pool_t *pool)
{
char *metric_name = "";
char *key;
SV* sv_value;
I32 ret;
memset(minfo, 0, sizeof(*minfo));
/* create the apr table here */
minfo->extra_data = apr_table_make(pool, 2);
hv_iterinit(plhash);
while ((sv_value = hv_iternextsv(plhash, &key, &ret))) {
if (!strcasecmp(key, "name")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->mname, value, sizeof(minfo->mname))) {
err_msg("[PERL] No metric name given in module [%s].\n", modname);
}
else
metric_name = minfo->mname;
continue;
}
if (!strcasecmp(key, "call_back")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->pcb, value, sizeof(minfo->pcb))) {
err_msg("[PERL] No perl call back given for metric [%s] in module [%s]. Will not call\n",
metric_name, modname);
}
continue;
}
if (!strcasecmp(key, "time_max")) {
int value = SvIV(sv_value);
if (!(minfo->tmax = value)) {
minfo->tmax = 60;
err_msg("[PERL] No time max given for metric [%s] in module [%s]. Using %d.\n",
metric_name, modname, minfo->tmax);
}
continue;
}
if (!strcasecmp(key, "value_type")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->vtype, value, sizeof(minfo->vtype))) {
strcpy (minfo->vtype, "uint");
err_msg("[PERL] No value type given for metric [%s] in module [%s]. Using %s.\n",
metric_name, modname, minfo->vtype);
}
continue;
}
if (!strcasecmp(key, "units")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->units, value, sizeof(minfo->units))) {
strcpy (minfo->units, "unknown");
err_msg("[PERL] No metric units given for metric [%s] in module [%s]. Using %s.\n",
metric_name, modname, minfo->units);
}
continue;
}
if (!strcasecmp(key, "slope")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->slope, value, sizeof(minfo->slope))) {
strcpy (minfo->slope, "both");
err_msg("[PERL] No slope given for metric [%s] in module [%s]. Using %s.\n",
metric_name, modname, minfo->slope);
}
continue;
}
if (!strcasecmp(key, "format")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->format, value, sizeof(minfo->format))) {
strcpy (minfo->format, "%u");
err_msg("[PERL] No format given for metric [%s] in module [%s]. Using %s.\n",
metric_name, modname, minfo->format);
}
continue;
}
if (!strcasecmp(key, "description")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->desc, value, sizeof(minfo->desc))) {
strcpy (minfo->desc, "unknown metric");
err_msg("[PERL] No description given for metric [%s] in module [%s]. Using %s.\n",
metric_name, modname, minfo->desc);
}
continue;
}
if (!strcasecmp(key, "groups")) {
STRLEN len;
char *value = SvPV(sv_value, len);
if (!strncpy(minfo->groups, value, sizeof(minfo->groups))) {
strcpy (minfo->groups, "");
}
continue;
}
STRLEN len;
char *value;
if (!(value = SvPV(sv_value, len))) {
err_msg("[PERL] Extra data key [%s] could not be processed.\n", key);
}
else {
apr_table_add(minfo->extra_data, key, value);
}
}
/*err_msg("name: %s", minfo->mname);
err_msg("callback: %s", minfo->pcb);
err_msg("time_max: %d", minfo->tmax);
err_msg("value_type: %s", minfo->vtype);
err_msg("units: %s", minfo->units);
err_msg("slope: %s", minfo->slope);
err_msg("format: %s", minfo->format);
err_msg("description: %s", minfo->desc);
err_msg("groups: %s", minfo->groups);*/
}
void HRXSATTR_ithread_postdup(SV *newself, SV *newtable, HV *ptr_map)
{
hrattr_simple *attr = attr_from_sv(SvRV(newself));
HR_DEBUG("Fetching new attrhash_ref");
SV *new_attrhash_ref = hr_dup_newsv_for_oldsv(ptr_map, attr->attrhash, 0);
attr->attrhash = (HV*)SvRV(new_attrhash_ref);
SvREFCNT_inc(attr->attrhash); /*Because the copy hash will soon be deleted*/
attr->table = SvRV(newtable);
HR_DEBUG("New attrhash: %p", attr->attrhash);
/*Now do the equivalent of: my @keys = keys %attrhash; foreach my $key (@keys)*/
int n_keys = hv_iterinit(attr->attrhash);
if(n_keys) {
char **keylist = NULL;
char **klist_head = NULL;
int tmp_len, i;
HR_DEBUG("Have %d keys", n_keys);
Newx(keylist, n_keys, char*);
klist_head = keylist;
while(hv_iternextsv(attr->attrhash, keylist++, &tmp_len));
/*No body*/
for(i=0, keylist = klist_head; i < n_keys; i++) {
HR_DEBUG("Key: %s", keylist[i]);
SV *stored = hv_delete(attr->attrhash, keylist[i], strlen(keylist[i]), 0);
assert(stored);
assert(SvROK(stored));
mk_ptr_string(new_s, SvRV(stored));
hv_store(attr->attrhash, new_s, strlen(new_s), stored, 0);
HR_Action v_actions[] = {
HR_DREF_FLDS_ptr_from_hv(SvRV(stored), new_attrhash_ref),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add new actions for value in attrhash");
HR_add_actions_real(stored, v_actions);
}
Safefree(klist_head);
}
HR_Action attr_actions[] = {
HR_DREF_FLDS_arg_for_cfunc(SvRV(newself), &attr_destroy_trigger),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add new actions for attribute object");
HR_add_actions_real(newself, attr_actions);
if(attr->encap) {
hrattr_encap *aencap = attr_encap_cast(attr);
SV *new_encap = hr_dup_newsv_for_oldsv(ptr_map, aencap->obj_paddr, 1);
char *ainfo = (char*)hr_dup_get_kinfo(
ptr_map, HR_DUPKEY_AENCAP, aencap->obj_paddr);
if(*ainfo == HRK_DUP_WEAK_ENCAP) {
sv_rvweaken(new_encap);
}
HR_Action encap_actions[] = {
HR_DREF_FLDS_arg_for_cfunc(SvRV(newself), (SV*)&encap_attr_destroy_hook),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add actions for new encapsulated object");
HR_add_actions_real(new_encap, encap_actions);
aencap->obj_rv = new_encap;
aencap->obj_paddr = (char*)SvRV(new_encap);
/*We also need to change our key string...*/
char *oldstr = attr_strkey(aencap, sizeof(hrattr_encap));
char *oldptr = strrchr(oldstr, HR_PREFIX_DELIM[0]);
assert(oldptr);
HR_DEBUG("Old attr string: %s", oldstr);
oldptr++;
*(oldptr) = '\0';
mk_ptr_string(newptr, aencap->obj_paddr);
SvGROW(SvRV(newself), sizeof(hrattr_encap)
+strlen(oldstr)+strlen(newptr)+1);
strcat(oldstr, newptr);
HR_DEBUG("New string: %s", oldstr);
}
}
static void attr_destroy_trigger(SV *self_sv, SV *encap_obj, HR_Action *action_list)
{
HR_DEBUG("self_sv=%p", self_sv);
HR_DEBUG("Attr destroy hook");
HR_DEBUG("We are ATTR=%p", self_sv);
//sv_dump(self_sv);
hrattr_simple *attr = attr_from_sv(self_sv);
HR_DEBUG("hrattr=%p", attr);
HR_Table_t parent = attr_parent_tbl(attr);
HR_DEBUG("Parent=%p", parent);
SV *rlookup = NULL, *attr_lookup = NULL;
if(SvREFCNT(parent)) {
get_hashes(parent,
HR_HKEY_LOOKUP_REVERSE, &rlookup,
HR_HKEY_LOOKUP_ATTR, &attr_lookup,
HR_HKEY_LOOKUP_NULL);
HR_DEBUG("rlookup=%p, attr_lookup=%p", rlookup, attr_lookup);
} else {
HR_DEBUG("Main lookup table being destroyed?");
parent = NULL;
}
char *ktmp;
int attrsz = attr_getsize(attr);
SV *vtmp, *vhash;
I32 tmplen;
mk_ptr_string(oaddr, self_sv);
int oaddr_len = strlen(oaddr);
SV *attrhash_ref = NULL, *self_ref = NULL;
RV_Newtmp( attrhash_ref, ((SV*)attr->attrhash) );
RV_Newtmp( self_ref, self_sv );
if(action_list) {
while( (HR_nullify_action(action_list,
(SV*)&attr_destroy_trigger,
NULL,
HR_KEY_TYPE_NULL|HR_KEY_SFLAG_HASHREF_OPAQUE)
== HR_ACTION_DELETED) );
/*No body*/
} else {
HR_PL_del_action_container(self_ref, (SV*)&attr_destroy_trigger);
}
HR_DEBUG("Deleted self destroy hook");
if(attr->encap) {
hrattr_encap *aencap = (hrattr_encap*)attr;
if(aencap->obj_paddr) {
SV *encap_ref = NULL;
RV_Newtmp(encap_ref, (SV*)aencap->obj_paddr);
HR_PL_del_action_container(encap_ref,
(SV*)&encap_attr_destroy_hook);
RV_Freetmp(encap_ref);
HR_DEBUG("Deleted encap destroy hook");
}
if(aencap->obj_rv) {
SvREFCNT_dec( aencap->obj_rv );
}
}
if(attr_lookup) {
HR_DEBUG("Deleting our attr_lookup entry..");
hv_delete(REF2HASH(attr_lookup),
attr_strkey(attr, attrsz),
strlen(attr_strkey(attr, attrsz)),
G_DISCARD);
HR_DEBUG("attr_lookup entry deleted");
}
U32 old_refcount = refcnt_ka_begin(self_sv);
I32 attrvals = hv_iterinit(attr->attrhash);
HR_DEBUG("We have %d values", attrvals);
while( (vtmp = hv_iternextsv(attr->attrhash, &ktmp, &tmplen)) ) {
SV *vptr, *vref;
sscanf(ktmp, "%lu", &vptr); /*Don't ask.. also, uses slightly less memory*/
RV_Newtmp(vref, vptr);
U32 old_v_refcount = refcnt_ka_begin(vptr);
attr_delete_value_from_attrhash(self_ref, vref);
if(SvROK(vref) && parent) {
HR_DEBUG("Deleting vhash entry");
attr_delete_from_vhash(self_ref, vref);
} else {
HR_DEBUG("Eh?");
}
RV_Freetmp(vref);
refcnt_ka_end(vptr, old_v_refcount);
}
SvREFCNT_dec(attr->attrhash);
RV_Freetmp(self_ref);
RV_Freetmp(attrhash_ref);
refcnt_ka_end(self_sv, old_refcount);
HR_DEBUG("Attr destroy done");
}
xh_int_t
xh_h2x_native_attr(xh_h2x_ctx_t *ctx, xh_char_t *key, I32 key_len, SV *value, xh_int_t flag)
{
xh_uint_t type;
size_t len, i, nattrs, done;
xh_sort_hash_t *sorted_hash;
SV *item_value;
xh_char_t *item;
I32 item_len;
GV *method;
nattrs = 0;
if (ctx->opts.content[0] != '\0' && xh_strcmp(key, ctx->opts.content) == 0)
flag = flag | XH_H2X_F_CONTENT;
value = xh_h2x_resolve_value(ctx, value, &type);
if (type & XH_H2X_T_BLESSED && (method = gv_fetchmethod_autoload(SvSTASH(value), "iternext", 0)) != NULL) {
if (!(flag & XH_H2X_F_COMPLEX)) goto FINISH;
while (1) {
item_value = xh_h2x_call_method(value, method);
if (!SvOK(item_value)) break;
(void) xh_h2x_native_attr(ctx, key, key_len, item_value, XH_H2X_F_SIMPLE | XH_H2X_F_COMPLEX);
SvREFCNT_dec(item_value);
}
nattrs++;
goto FINISH;
}
if (type & XH_H2X_T_SCALAR) {
if (flag & XH_H2X_F_COMPLEX && (flag & XH_H2X_F_SIMPLE || type & XH_H2X_T_RAW)) {
xh_xml_write_node(&ctx->writer, key, key_len, value, type & XH_H2X_T_RAW);
}
else if (flag & XH_H2X_F_COMPLEX && flag & XH_H2X_F_CONTENT) {
xh_xml_write_content(&ctx->writer, value);
}
else if (flag & XH_H2X_F_SIMPLE && !(flag & XH_H2X_F_CONTENT) && !(type & XH_H2X_T_RAW)) {
xh_xml_write_attribute(&ctx->writer, key, key_len, value);
nattrs++;
}
}
else if (type & XH_H2X_T_HASH) {
if (!(flag & XH_H2X_F_COMPLEX)) goto FINISH;
len = HvUSEDKEYS((SV *) value);
if (len == 0) {
xh_xml_write_empty_node(&ctx->writer, key, key_len);
goto FINISH;
}
xh_xml_write_start_tag(&ctx->writer, key, key_len);
done = 0;
if (len > 1 && ctx->opts.canonical) {
sorted_hash = xh_sort_hash((HV *) value, len);
for (i = 0; i < len; i++) {
done += xh_h2x_native_attr(ctx, sorted_hash[i].key, sorted_hash[i].key_len, sorted_hash[i].value, XH_H2X_F_SIMPLE);
}
if (done == len) {
xh_xml_write_closed_end_tag(&ctx->writer);
}
else {
xh_xml_write_end_tag(&ctx->writer);
for (i = 0; i < len; i++) {
(void) xh_h2x_native_attr(ctx, sorted_hash[i].key, sorted_hash[i].key_len, sorted_hash[i].value, XH_H2X_F_COMPLEX);
}
xh_xml_write_end_node(&ctx->writer, key, key_len);
}
free(sorted_hash);
}
else {
hv_iterinit((HV *) value);
while ((item_value = hv_iternextsv((HV *) value, (char **) &item, &item_len))) {
done += xh_h2x_native_attr(ctx, item, item_len,item_value, XH_H2X_F_SIMPLE);
}
if (done == len) {
xh_xml_write_closed_end_tag(&ctx->writer);
}
else {
xh_xml_write_end_tag(&ctx->writer);
hv_iterinit((HV *) value);
while ((item_value = hv_iternextsv((HV *) value, (char **) &item, &item_len))) {
(void) xh_h2x_native_attr(ctx, item, item_len,item_value, XH_H2X_F_COMPLEX);
}
xh_xml_write_end_node(&ctx->writer, key, key_len);
}
}
nattrs++;
}
else if (type & XH_H2X_T_ARRAY) {
if (!(flag & XH_H2X_F_COMPLEX)) goto FINISH;
len = av_len((AV *) value) + 1;
for (i = 0; i < len; i++) {
(void) xh_h2x_native_attr(ctx, key, key_len, *av_fetch((AV *) value, i, 0), XH_H2X_F_SIMPLE | XH_H2X_F_COMPLEX);
}
nattrs++;
}
else {
if (flag & XH_H2X_F_SIMPLE && flag & XH_H2X_F_COMPLEX) {
xh_xml_write_empty_node(&ctx->writer, key, key_len);
}
else if (flag & XH_H2X_F_SIMPLE && !(flag & XH_H2X_F_CONTENT)) {
xh_xml_write_attribute(&ctx->writer, key, key_len, NULL);
nattrs++;
}
}
FINISH:
ctx->depth--;
return nattrs;
}
