/* Dump this index into Perl. * Used in testing only. */ SV* dump() const { HV* idx = newHV(); for (const auto& token2entries : index) { HV* entries = newHV(); for (const auto& id2tf : token2entries.second) { std::string k = std::to_string(id2tf.first); hv_store(entries, k.c_str(), k.size(), newSViv(id2tf.second), 0); } hv_store(idx, token2entries.first.c_str(), token2entries.first.size(), newRV_noinc(reinterpret_cast<SV*>(entries)), 0); } HV* len = newHV(); for (const auto& id2length : lengths) { std::string id = std::to_string(id2length.first); hv_store(len, id.c_str(), id.size(), newSVpvf("%.2f", id2length.second), 0); } HV* dump = newHV(); hv_stores(dump, "index", newRV_noinc(reinterpret_cast<SV*>(idx))); hv_stores(dump, "lengths", newRV_noinc(reinterpret_cast<SV*>(len))); return newRV_noinc(reinterpret_cast<SV*>(dump)); }
/** * NI_set_ipv6_n128s(): set N128 integers in IPv6 Net::IP::XS object. * @ip: Net::IP::XS object. * * Relies on 'binip' and 'last_bin' being set in the object. */ int NI_set_ipv6_n128s(SV *ipo) { n128_t ipv6_begin; n128_t ipv6_end; const char *binbuf1; const char *binbuf2; SV *begin; SV *end; HV_PV_GET_OR_RETURN(binbuf1, ipo, "binip", 5); HV_PV_GET_OR_RETURN(binbuf2, ipo, "last_bin", 8); n128_set_str_binary(&ipv6_begin, binbuf1, 128); n128_set_str_binary(&ipv6_end, binbuf2, 128); /* Previously, this part of the code used malloc to allocate * n128_ts, which were then stored within the Net::IP::XS object. * This didn't work properly when threads were in use, because * those raw pointers were copied to each new thread, and * consequently freed by each thread in DESTROY. This now stores * the raw data as PVs instead. See * https://rt.cpan.org/Ticket/Display.html?id=102155 for more * information. */ begin = newSVpv((const char*) &ipv6_begin, 16); end = newSVpv((const char*) &ipv6_end, 16); hv_store((HV*) SvRV(ipo), "xs_v6_ip0", 9, begin, 0); hv_store((HV*) SvRV(ipo), "xs_v6_ip1", 9, end, 0); return 1; }
HV *perl_encode_namedvars(nv_list *nv, void *data) { HV *ret; int i =0; ret = newHV(); while (nv->format[i].fldname != NULL) { switch(nv->format[i].type) { case NV_PSTR: case NV_STR: hv_store(ret, nv->format[i].fldname, strlen(nv->format[i].fldname), newSVpv(nv_gf_string(data, nv, i), strlen(nv_gf_string(data, nv, i))), 0); break; case NV_INT: case NV_LONG: hv_store(ret, nv->format[i].fldname, strlen(nv->format[i].fldname), newSViv(nv_gf_int(data, nv, i)), 0); break; case NV_VOID: case NV_PSTRA: nlog(LOG_WARNING, "perl_encode_namedvars: void/string todo!"); break; } i++; } return ret; }
/* convert XPAGet client data to a Perl hash */ HV * cdata2hash_Get( char *buf, int len, char *name, char *message ) { SV *sv; SV *ref; /* create hash which will contain buf, name, message */ HV *hash = newHV(); /* buf may be big, so try to get perl to use it directly */ sv = NEWSV(0,0); sv_usepvn( sv, buf, len ); if ( NULL == hv_store( hash, "buf", 3, sv, 0 ) ) croak( "error storing length for response\n" ); if ( NULL == hv_store( hash, "name", 4, newSVpv( name, 0 ), 0 ) ) croak( "error storing name for response\n" ); if ( message ) { if ( NULL == hv_store( hash, "message", 7, newSVpv( message, 0 ), 0 ) ) croak( "error storing message for response\n" ); } return hash; }
static HV * plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status) { HV *result; result = newHV(); hv_store(result, "status", strlen("status"), newSVpv((char *) SPI_result_code_string(status), 0), 0); hv_store(result, "processed", strlen("processed"), newSViv(processed), 0); if (status == SPI_OK_SELECT) { AV *rows; SV *row; int i; rows = newAV(); for (i = 0; i < processed; i++) { row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc); av_push(rows, row); } hv_store(result, "rows", strlen("rows"), newRV_noinc((SV *) rows), 0); } SPI_freetuptable(tuptable); return result; }
/* * Parse a configuration section, and populate a HV. * This function is recursively called (allows to have nested hashes.) */ static void perl_parse_config(CONF_SECTION *cs, int lvl, HV *rad_hv) { if (!cs || !rad_hv) return; int indent_section = (lvl + 1) * 4; int indent_item = (lvl + 2) * 4; DEBUG("%*s%s {", indent_section, " ", cf_section_name1(cs)); CONF_ITEM *ci = NULL; while ((ci = cf_item_next(cs, ci))) { /* * This is a section. * Create a new HV, store it as a reference in current HV, * Then recursively call perl_parse_config with this section and the new HV. */ if (cf_item_is_section(ci)) { CONF_SECTION *sub_cs = cf_item_to_section(ci); char const *key = cf_section_name1(sub_cs); /* hash key */ HV *sub_hv; SV *ref; if (!key) continue; if (hv_exists(rad_hv, key, strlen(key))) { WARN("Ignoring duplicate config section '%s'", key); continue; } sub_hv = newHV(); ref = newRV_inc((SV*) sub_hv); (void)hv_store(rad_hv, key, strlen(key), ref, 0); perl_parse_config(sub_cs, lvl + 1, sub_hv); } else if (cf_item_is_pair(ci)){ CONF_PAIR *cp = cf_item_to_pair(ci); char const *key = cf_pair_attr(cp); /* hash key */ char const *value = cf_pair_value(cp); /* hash value */ if (!key || !value) continue; /* * This is an item. * Store item attr / value in current HV. */ if (hv_exists(rad_hv, key, strlen(key))) { WARN("Ignoring duplicate config item '%s'", key); continue; } (void)hv_store(rad_hv, key, strlen(key), newSVpvn(value, strlen(value)), 0); DEBUG("%*s%s = %s", indent_item, " ", key, value); } } DEBUG("%*s}", indent_section, " "); }
static SV* c2p_file(alpm_file_t *file){ HV *hv; hv = newHV(); hv_store(hv, "name", 4, newSVpv(file->name, 0), 0); hv_store(hv, "size", 4, newSViv(file->size), 0); hv_store(hv, "mode", 4, newSViv(file->mode), 0); return newRV_noinc((SV*)hv); }
SV * newSVDefFlagsHash (GtkType type, long value) { GtkFlagValue * vals; SV * result; char *s, *p; vals = gtk_type_flags_get_values(type); if (!vals) { warn("Invalid type for flags: %s", gtk_type_name(type)); return newSViv(value); } if (!pgtk_use_array) { HV * h = newHV(); result = newRV((SV*)h); SvREFCNT_dec(h); while(vals && vals->value_nick) { if ((value & vals->value) == vals->value) { if (pgtk_use_minus) hv_store(h, vals->value_nick, strlen(vals->value_nick), newSViv(1), 0); else { p = s = g_strdup(vals->value_nick); while (*s) { if (*s == '-') *s = '_'; s++; } hv_store(h, p, strlen(p), newSViv(1), 0); g_free(p); } value &= ~vals->value; } vals++; } } else { AV * a = newAV(); result = newRV((SV*)a); SvREFCNT_dec(a); while(vals && vals->value_nick) { if ((value & vals->value) == vals->value) { if (pgtk_use_minus) av_push(a, newSVpv(vals->value_nick, 0)); else { p = s = g_strdup(vals->value_nick); while (*s) { if (*s == '-') *s = '_'; s++; } av_push(a, newSVpv(p, 0)); g_free(p); } value &= ~vals->value; } vals++; } } /* check for unhandled bits in value ... */ return result; }
static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) { HV *hv; int i; hv = newHV(); for (i = 0; i < tupdesc->natts; i++) { Datum attr; bool isnull; char *attname; char *outputstr; Oid typoutput; bool typisvarlena; int namelen; SV *sv; if (tupdesc->attrs[i]->attisdropped) continue; attname = NameStr(tupdesc->attrs[i]->attname); namelen = strlen(attname); attr = heap_getattr(tuple, i + 1, tupdesc, &isnull); if (isnull) { /* Store (attname => undef) and move on. */ hv_store(hv, attname, namelen, newSV(0), 0); continue; } /* XXX should have a way to cache these lookups */ getTypeOutputInfo(tupdesc->attrs[i]->atttypid, &typoutput, &typisvarlena); outputstr = DatumGetCString(OidFunctionCall1(typoutput, attr)); sv = newSVpv(outputstr, 0); #if PERL_BCDVERSION >= 0x5006000L if (GetDatabaseEncoding() == PG_UTF8) SvUTF8_on(sv); #endif hv_store(hv, attname, namelen, sv, 0); pfree(outputstr); } return newRV_noinc((SV *) hv); }
SV* c2p_conflict(void *p) { alpm_conflict_t *c; HV *hv; hv = newHV(); c = p; hv_store(hv, "package1", 8, newSVpv(c->package1, 0), 0); hv_store(hv, "package2", 8, newSVpv(c->package2, 0), 0); hv_store(hv, "reason", 6, c2p_depend(c->reason), 0); return newRV_noinc((SV*)hv); }
SV* c2p_depend(void *p) { alpm_depend_t *dep; HV *hv; hv = newHV(); dep = p; hv_store(hv, "name", 4, newSVpv(dep->name, 0), 0); hv_store(hv, "version", 7, newSVpv(dep->version, 0), 0); hv_store(hv, "mod", 3, c2p_depmod(dep->mod), 0); if(dep->desc) hv_store(hv, "desc", 4, newSVpv(dep->desc, 0), 0); return newRV_noinc((SV*)hv); }
/* * get the vps and put them in perl hash * If one VP have multiple values it is added as array_ref * Example for this is Cisco-AVPair that holds multiple values. * Which will be available as array_ref in $RAD_REQUEST{'Cisco-AVPair'} */ static void perl_store_vps(VALUE_PAIR *vp, HV *rad_hv) { VALUE_PAIR *nvp, *vpa, *vpn; AV *av; char namebuf[256], *name; char buffer[1024]; int attr, vendor, len; hv_undef(rad_hv); nvp = paircopy(vp); while (nvp != NULL) { name = nvp->name; attr = nvp->attribute; vendor = nvp->vendor; vpa = paircopy2(nvp, attr, vendor); if (vpa->next) { av = newAV(); vpn = vpa; while (vpn) { len = vp_prints_value(buffer, sizeof(buffer), vpn, FALSE); av_push(av, newSVpv(buffer, len)); vpn = vpn->next; } hv_store(rad_hv, nvp->name, strlen(nvp->name), newRV_noinc((SV *) av), 0); } else { if ((vpa->flags.has_tag) && (vpa->flags.tag != 0)) { snprintf(namebuf, sizeof(namebuf), "%s:%d", nvp->name, nvp->flags.tag); name = namebuf; } len = vp_prints_value(buffer, sizeof(buffer), vpa, FALSE); hv_store(rad_hv, name, strlen(name), newSVpv(buffer, len), 0); } pairfree(&vpa); vpa = nvp; while ((vpa != NULL) && (vpa->attribute == attr) && (vpa->vendor == vendor)) vpa = vpa->next; pairdelete(&nvp, attr, vendor); nvp = vpa; } }
static HV* build_params_hash(cfg_t *plmodule) { int k; HV *params_hash; params_hash = newHV(); if (plmodule && params_hash) { for (k = 0; k < cfg_size(plmodule, "param"); k++) { cfg_t *param; char *name, *value; SV *sv_value; param = cfg_getnsec(plmodule, "param", k); name = apr_pstrdup(pool, param->title); value = apr_pstrdup(pool, cfg_getstr(param, "value")); sv_value = newSVpv(value, 0); if (name && sv_value) { /* Silence "value computed is not used" warning */ (void)hv_store(params_hash, name, strlen(name), sv_value, 0); } } } return params_hash; }
static html_valid_status_t html_valid_tag_information (HV * hv) { int i; // n_html_tags is defined in html-tidy5.h as part of the "extra" // material. html_valid_tag_t tags[n_html_tags]; TagInformation (tags); for (i = 0; i < n_html_tags; i++) { int name_len; AV * constants; SV * constants_ref; constants = newAV (); // Store the ID for reverse lookup of attributes. av_push (constants, newSVuv (i)); av_push (constants, newSVuv (tags[i].versions)); av_push (constants, newSVuv (tags[i].model)); constants_ref = newRV_inc ((SV *) constants); name_len = strlen (tags[i].name); /* fprintf (stderr, "Storing %s (%d) into hash.\n", tags[i].name, name_len); */ (void) hv_store (hv, tags[i].name, name_len, constants_ref, 0 /* no hash value */); } return html_valid_ok; }
PJS_Function * PJS_DefineFunction(PJS_Context *inContext, const char *functionName, SV *perlCallback) { PJS_Function *function; JSContext *js_context = inContext->cx; SV *sv; if (PJS_GetFunctionByName(inContext, functionName) != NULL) { warn("Function named '%s' is already defined in the context"); return NULL; } if ((function = PJS_CreateFunction(functionName, perlCallback)) == NULL) { return NULL; } /* Add the function to the javascript context */ if (JS_DefineFunction(js_context, JS_GetGlobalObject(js_context), functionName, PJS_invoke_perl_function, 0, 0) == JS_FALSE) { warn("Failed to define function"); PJS_DestroyFunction(function); return NULL; } sv = newSV(0); sv_setref_pv(sv, "JavaScript::PerlFunction", (void*) function); if (functionName != NULL) { SvREFCNT_inc(sv); hv_store(inContext->function_by_name, functionName, strlen(functionName), sv, 0); } return function; }
static void op_names_init(pTHX) { int i; STRLEN len; char **op_names; char *bitmap; dMY_CXT; op_named_bits = newHV(); op_names = get_op_names(); for(i=0; i < PL_maxo; ++i) { SV * const sv = newSViv(i); SvREADONLY_on(sv); (void) hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); } put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv))); opset_all = new_opset(aTHX_ Nullsv); bitmap = SvPV(opset_all, len); memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */ /* Take care to set the right number of bits in the last byte */ bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */ }
static void DecodeError(csv_t* csv) { if(csv->tmp) { if (hv_store(csv->self, "_ERROR_INPUT", 12, csv->tmp, 0)) { SvREFCNT_inc(csv->tmp); } } }
SV * newSVMiscRef(void * object, char * classname, int * newref) { HV * previous; SV * result; if (!object) return newSVsv(&PL_sv_undef); previous = RetrieveMisc(object); if (previous) { /*printf("Retriveing object %d as HV %d\n", object, previous);*/ result = newRV((SV*)previous); if (newref) *newref = 0; } else { HV * h = newHV(); hv_store(h, "_gtk", 4, newSViv((long)object), 0); result = newRV((SV*)h); RegisterMisc(h, object); sv_bless(result, gv_stashpv(classname, FALSE)); SvREFCNT_dec(h); if (newref) *newref = 1; /*printf("Storing object %p (%s) as HV %p (refcount: %d, %d)\n", object, classname, h, SvREFCNT(h), SvREFCNT(result));*/ } return result; }
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; }
BrokerError awxsSetHashFromTypeDef ( BrokerTypeDef type_def, HV * hv ) { char **Keys; int i, numKeys; SV * sv; gErr = awGetTypeDefFieldNames ( type_def, NULL, &numKeys, &Keys ); if ( gErr != AW_NO_ERROR ) return ( gErr ); for ( i = 0; i < numKeys; i++ ) { sv = getFieldTypeAsSV ( type_def, Keys[i] ); if ( gErr != AW_NO_ERROR ) break; hv_store ( hv, Keys[i], strlen ( Keys[i] ), sv, 0 ); } free ( Keys ); return ( gErr ); }
static int copy_env(void *rec, const char *key, const char *val) { dTHX; HV *env = (HV *) rec; (void) hv_store(env, key, strlen(key), newSVpv(val, 0), 0); return 1; }
SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val, request_rec *r, conn_rec *c) { SV *retval = (SV *)NULL; if (!*pnotes) { apr_pool_t *pool = r ? r->pool : c->pool; void *cleanup_data; *pnotes = newHV(); cleanup_data = modperl_pnotes_cleanup_data(aTHX_ pnotes, pool); apr_pool_cleanup_register(pool, cleanup_data, modperl_cleanup_pnotes, apr_pool_cleanup_null); } if (key) { STRLEN len; char *k = SvPV(key, len); if (val) { retval = *hv_store(*pnotes, k, len, SvREFCNT_inc(val), 0); } else if (hv_exists(*pnotes, k, len)) { retval = *hv_fetch(*pnotes, k, len, FALSE); } return retval ? SvREFCNT_inc(retval) : &PL_sv_undef; } return newRV_inc((SV *)*pnotes); }
SV * newSVOptFlags(long value, char * optname, struct opts * o) { SV * result; if (!pgtk_use_array) { HV * h = newHV(); int i; result = newRV((SV*)h); SvREFCNT_dec(h); for(i=0;o[i].name;i++) if ((value & o[i].value) == o[i].value) { hv_store(h, o[i].name, strlen(o[i].name), newSViv(1), 0); value &= ~o[i].value; } } else { AV * a = newAV(); int i; result = newRV((SV*)a); SvREFCNT_dec(a); for(i=0;o[i].name;i++) if ((value & o[i].value) == o[i].value) { av_push(a, newSVpv(o[i].name, 0)); value &= ~o[i].value; } } return result; }
/* Load a YAML sequence into a Perl array */ SV * load_sequence(perl_yaml_loader_t *loader) { SV *node; AV *array = newAV(); SV *array_ref = (SV *)newRV_noinc((SV *)array); char *anchor = (char *)loader->event.data.sequence_start.anchor; char *tag = (char *)loader->event.data.mapping_start.tag; if (anchor) hv_store(loader->anchors, anchor, strlen(anchor), SvREFCNT_inc(array_ref), 0); while ((node = load_node(loader))) { av_push(array, node); } if (tag && strEQ(tag, TAG_PERL_PREFIX "array")) tag = NULL; if (tag) { char *class; char *prefix = TAG_PERL_PREFIX "array:"; if (*tag == '!') prefix = "!"; else if (strlen(tag) <= strlen(prefix) || ! strnEQ(tag, prefix, strlen(prefix)) ) croak( loader_error_msg(loader, form("bad tag found for array: '%s'", tag)) ); class = tag + strlen(prefix); sv_bless(array_ref, gv_stashpv(class, TRUE)); } return array_ref; }
/* convert XPASet/XPAInfo/XPAAccess client data to a Perl hash */ HV * cdata2hash_Set( char *name, char *message ) { /* create hash which will contain name, message */ HV *hash = newHV(); if ( NULL == hv_store( hash, "name", 4, newSVpv( name, 0 ), 0 ) ) croak( "error storing name for response\n" ); if ( message ) { if ( NULL == hv_store( hash, "message", 7, newSVpv( message, 0 ), 0 ) ) croak( "error storing message for response\n" ); } return hash; }
Datum hstore_to_plperl(PG_FUNCTION_ARGS) { HStore *in = PG_GETARG_HS(0); int i; int count = HS_COUNT(in); char *base = STRPTR(in); HEntry *entries = ARRPTR(in); HV *hv; hv = newHV(); for (i = 0; i < count; i++) { const char *key; SV *value; key = pnstrdup(HS_KEY(entries, base, i), HS_KEYLEN(entries, i)); value = HS_VALISNULL(entries, i) ? newSV(0) : cstr2sv(pnstrdup(HS_VAL(entries, base, i), HS_VALLEN(entries, i))); (void) hv_store(hv, key, strlen(key), value, 0); } return PointerGetDatum(newRV((SV *) hv)); }
SV * route_c2sv(RouteEntry *entry) { HV *out = newHV(); SV *out_ref = newRV_noinc((SV *)out); char *dst, *gw; if (entry != NULL) { dst = addr_ntoa(&(entry->route_dst)); dst == NULL ? hv_store(out, "route_dst", 9, &PL_sv_undef, 0) : hv_store(out, "route_dst", 9, newSVpv(dst, 0), 0); gw = addr_ntoa(&(entry->route_gw)); gw == NULL ? hv_store(out, "route_gw", 8, &PL_sv_undef, 0) : hv_store(out, "route_gw", 8, newSVpv(gw, 0), 0); } return out_ref; }
void Perl_ithread_set (pTHX_ ithread* thread) { SV* thread_sv = newSViv(PTR2IV(thread)); if(!hv_store(PL_modglobal, "threads::self", 12, thread_sv,0)) { croak("%s\n","Internal error, couldn't set TLS"); } }
static SV* _amf0_sv(amf0_data_t* data) { SV* sv = NULL; SV* svh; SV* sva; HV* hv; AV* av; int i; amf0_object_t* obj; const char* key; amf0_data_t* value; switch (data->type) { case AMF0_NUMBER: sv = newSVnv(((amf0_number_t*)data)->value); break; case AMF0_BOOLEAN: sv = newSViv(((amf0_boolean_t*)data)->value); break; case AMF0_STRING: sv = newSV(0); sv_setpv(sv, ((amf0_string_t*)data)->value); break; case AMF0_OBJECT: hv = newHV(); obj = (amf0_object_t*)data; for (i = 0; i < obj->used; ++i) { key = obj->data[i]->key; value = obj->data[i]->value; svh = _amf0_sv(value); hv_store(hv, key, strlen(key), svh, 0); } sv = newRV(sv_2mortal((SV*)hv)); break; case AMF0_NULL: case AMF0_UNDEFINED: sv = newSV(0); break; case AMF0_STRICTARRAY: av = newAV(); for (i = 0; i < ((amf0_strictarray_t*)data)->used; ++i) { sva = _amf0_sv(((amf0_strictarray_t*)data)->data[i]); av_push(av, sva); } sv = newRV(sv_2mortal((SV *)av)); break; default: Perl_croak(aTHX_ "Unsupported datatype: %d\n", data->type); break; } return sv; }
static void foreach_fn(gpointer key_p, gpointer value_p, gpointer user_data_p) { char *key = key_p; char *value = value_p; HV *hv = user_data_p; hv_store(hv, key, strlen(key), newSVpv(value, 0), 0); }