static void
rowreq_init_common(PLCB_t *parent, AV *req)
{
SV *selfref;
av_fill(req, PLCB_VHIDX_MAX);
av_store(req, PLCB_VHIDX_ROWBUF, newRV_noinc((SV *)newAV()));
av_store(req, PLCB_VHIDX_RAWROWS, newRV_noinc((SV *)newAV()));
av_store(req, PLCB_VHIDX_PARENT, newRV_inc(parent->selfobj));
selfref = newRV_inc((SV*)req);
sv_rvweaken(selfref);
av_store(req, PLCB_VHIDX_SELFREF, selfref);
}
void VAstEnt::initAVEnt(AV* avp, VAstType type, AV* parentp) {
// $avp = [type, parent, {}]
av_push(avp, newSViv(type));
if (parentp) {
SV* parentsv = newRV((SV*)parentp);
#ifdef SvWEAKREF // Newer perls
// We're making a circular reference, so to garbage collect properly we need to break it
// On older Perl's we'll just leak.
sv_rvweaken(parentsv);
#endif
av_push(avp, parentsv );
} else { // netlist top
av_push(avp, &PL_sv_undef);
}
av_push(avp, newRV_noinc((SV*)newHV()) );
}
SV *
PLCB_ioprocs_new(SV *options)
{
plcb_IOPROCS async_s = { NULL }, *async = NULL;
lcb_io_opt_t cbcio = NULL;
SV *ptriv, *blessedrv;
/* First make sure all the options are ok */
plcb_OPTION argopts[] = {
#define X(name, t, tgt) PLCB_KWARG(name, t, &async_s.tgt),
X_IOPROCS_OPTIONS(X)
#undef X
{ NULL }
};
plcb_extract_args(options, argopts);
/* Verify we have at least the basic functions */
if (!async_s.cv_evmod) {
die("Need event_update");
}
if (!async_s.cv_timermod) {
die("Need timer_update");
}
if (!async_s.userdata) {
async_s.userdata = &PL_sv_undef;
}
Newxz(cbcio, 1, struct lcb_io_opt_st);
Newxz(async, 1, plcb_IOPROCS);
*async = async_s;
#define X(name, t, tgt) SvREFCNT_inc(async->tgt);
X_IOPROCS_OPTIONS(X)
#undef X
ptriv = newSViv(PTR2IV(async));
blessedrv = newRV_noinc(ptriv);
sv_bless(blessedrv, gv_stashpv(PLCB_IOPROCS_CLASS, GV_ADD));
async->refcount = 1;
async->iops_ptr = cbcio;
cbcio->v.v0.cookie = async;
async->selfrv = newRV_inc(ptriv); sv_rvweaken(async->selfrv);
async->action_sv = newSViv(0); SvREADONLY_on(async->action_sv);
async->flags_sv = newSViv(0); SvREADONLY_on(async->flags_sv);
async->usec_sv = newSVnv(0); SvREADONLY_on(async->usec_sv);
async->sched_r_sv = newSViv(0); SvREADONLY_on(async->sched_r_sv);
async->sched_w_sv = newSViv(0); SvREADONLY_on(async->sched_w_sv);
async->stop_r_sv = newSViv(0); SvREADONLY_on(async->stop_r_sv);
async->stop_w_sv = newSViv(0); SvREADONLY_on(async->stop_w_sv);
/* i/o events */
cbcio->v.v0.create_event = create_event;
cbcio->v.v0.destroy_event = destroy_event;
cbcio->v.v0.update_event = update_event;
cbcio->v.v0.delete_event = delete_event;
/* timer events */
cbcio->v.v0.create_timer = create_timer;
cbcio->v.v0.destroy_timer = destroy_event;
cbcio->v.v0.delete_timer = delete_timer;
cbcio->v.v0.update_timer = update_timer;
wire_lcb_bsd_impl(cbcio);
cbcio->v.v0.run_event_loop = startstop_dummy;
cbcio->v.v0.stop_event_loop = startstop_dummy;
cbcio->v.v0.need_cleanup = 0;
/* Now all we need to do is return the blessed reference */
return blessedrv;
}
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);
}
}
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 inline SV*
attr_get(SV *self, SV *attr, char *t, int options)
{
char *attr_ustr = NULL, *attr_fullstr = NULL;
char smallbuf[128] = { '\0' };
char ptr_buf[128] = { '\0' };
SV *kt_lookup, *attr_lookup;
SV **kt_ent;
SV *aobj = NULL;
SV **a_ent;
SV *my_stashcache_ref;
HR_BlessParams stash_params;
int attrlen = 0;
int on_heap = 0;
int prefix_len = 0;
get_hashes(REF2TABLE(self),
HR_HKEY_LOOKUP_ATTR, &attr_lookup,
HR_HKEY_LOOKUP_KT, &kt_lookup,
HR_HKEY_LOOKUP_PRIVDATA, &my_stashcache_ref,
HR_HKEY_LOOKUP_NULL
);
blessparam_init(stash_params);
if(! (kt_ent = hv_fetch(REF2HASH(kt_lookup), t, strlen(t), 0))) {
die("Couldn't determine keytype '%s'", t);
}
attrlen = strlen(SvPV_nolen(*kt_ent)) + 1;
if(SvROK(attr)) {
attrlen += sprintf(ptr_buf, "%lu", SvRV(attr));
attr_ustr = ptr_buf;
} else {
attrlen += strlen(SvPV_nolen(attr));
attr_ustr = SvPV_nolen(attr);
}
attrlen += sizeof(HR_PREFIX_DELIM) - 1;
if(attrlen > 128) {
on_heap = 1;
Newx(attr_fullstr, attrlen, char);
} else {
attr_fullstr = smallbuf;
}
*attr_fullstr = '\0';
sprintf(attr_fullstr, "%s%s%s", SvPV_nolen(*kt_ent), HR_PREFIX_DELIM, attr_ustr);
HR_DEBUG("ATTRKEY=%s", attr_fullstr);
a_ent = hv_fetch(REF2HASH(attr_lookup), attr_fullstr, attrlen-1, 0);
if(!a_ent) {
prefix_len = strlen(t);
if( (options & STORE_OPT_O_CREAT) == 0) {
HR_DEBUG("Could not locate attribute and O_CREAT not specified");
goto GT_RET;
} else if(SvROK(attr)) {
blessparam_setstash(stash_params,
stash_from_cache_nocheck(my_stashcache_ref, HR_STASH_ATTR_ENCAP));
aobj = attr_encap_new(blessparam2chrp(stash_params),
attr_fullstr, attr, self);
if( (options & STORE_OPT_STRONG_KEY) == 0) {
sv_rvweaken( ((hrattr_encap*)attr_from_sv(SvRV(aobj)))->obj_rv );
}
} else {
blessparam_setstash(stash_params,
stash_from_cache_nocheck(my_stashcache_ref,HR_STASH_ATTR_SCALAR));
aobj = attr_simple_new(blessparam2chrp(stash_params), attr_fullstr, self);
}
a_ent = hv_store(REF2HASH(attr_lookup),
attr_fullstr, attrlen-1,
newSVsv(aobj), 0);
/*Actual attribute entry is ALWAYS weak and is entirely dependent on vhash
entries*/
(attr_from_sv(SvRV(aobj)))->prefix_len = prefix_len;
assert(a_ent);
sv_rvweaken(*a_ent);
} else {
aobj = *a_ent;
}
GT_RET:
if(on_heap) {
Safefree(attr_fullstr);
}
HR_DEBUG("Returning %p", aobj);
return aobj;
}
/* Wrap a JS value to export into perl
* Returns a new SV, REFCNT_dec is caller's responsability
*/
JSBool
PJS_ReflectJS2Perl(
pTHX_
JSContext *cx,
jsval value,
SV** sv,
int full
) {
if(JSVAL_IS_PRIMITIVE(value)) {
*sv = PrimJSVALToSV(aTHX_ cx, value);
if(*sv) return JS_TRUE;
}
else if(JSVAL_IS_OBJECT(value)) {
PJS_Context *pcx = PJS_GET_CONTEXT(cx);
JSObject *object = JSVAL_TO_OBJECT(value);
JSClass *clasp = PJS_GET_CLASS(cx, object);
const char *classname = clasp->name;
JSObject *passport;
SV *wrapper;
SV *box;
char hkey[32];
jsval temp = JSVAL_VOID;
snprintf(hkey, 32, "%p", (void *)object);
PJS_DEBUG2("Wrapping a %s(%s)\n", classname, hkey);
if(PJS_getFlag(pcx, "ConvertRegExp") && strEQ(classname, "RegExp")) {
jsval src;
char *str;
if(JS_CallFunctionName(cx, object, "toSource", 0, NULL, &src) &&
(str = JS_GetStringBytes(JS_ValueToString(cx, src))) )
{
dSP;
SV *tmp = newSVpvf("qr%s", str);
eval_sv(tmp, G_SCALAR);
sv_free(tmp); // Don't leak
SPAGAIN;
tmp = POPs;
PUTBACK;
if(!SvTRUE(ERRSV)) {
*sv = SvREFCNT_inc_simple_NN(tmp);
return JS_TRUE;
}
}
return JS_FALSE;
}
if(IS_PERL_CLASS(clasp)) {
/* IS_PERL_CLASS means actual perl object is there */
SV *priv = (SV *)JS_GetPrivate(cx, object);
if(priv && SvOK(priv) && SvROK(priv)) {
*sv = SvREFCNT_inc_simple_NN(priv);
return JS_TRUE;
}
croak("A private %s?!\n", classname);
return JS_FALSE;
}
/* Common JSObject case */
/* Check registered perl visitors */
JS_LookupProperty(cx, pcx->pvisitors, hkey, &temp);
if(temp != JSVAL_VOID) {
/* Already registered, so exits a reference in perl space
* _must_ hold a PASSPORT */
assert(JSVAL_TO_OBJECT(temp) == object);
box = PJS_GetPassport(aTHX_ cx, object);
SvREFCNT_inc_void_NN(box); /* In perl should be one more */
PJS_DEBUG1("Cached!: %s\n", hkey);
} else {
/* Check if with a PASSPORT */
JS_LookupPropertyWithFlags(cx, object, PJS_PASSPORT_PROP, 0, &temp);
if(JSVAL_IS_OBJECT(temp) && (passport = JSVAL_TO_OBJECT(temp)) &&
PJS_GET_CLASS(cx, passport) == &passport_class &&
JS_GetReservedSlot(cx, passport, 0, &temp) &&
object == (JSObject *)JSVAL_TO_PRIVATE(temp)
) { /* Yes, reentering perl */
box = (SV *)JS_GetPrivate(cx, passport);
/* Here we don't increment refcount, the ownership in passport is
* transferred to perl land.
*/
PJS_DEBUG1("Reenter: %s\n", hkey);
}
else { /* No, first time, must wrap the object */
SV *boxref;
const char *package;
SV *robj = newSV(0);
SV *rjsv = newSV(0);
if (JS_ObjectIsFunction(cx, object))
package = PJS_FUNCTION_PACKAGE;
else if(JS_IsArrayObject(cx, object))
package = PJS_ARRAY_PACKAGE;
else if(strEQ(classname, PJS_PACKAGE_CLASS_NAME))
package = PJS_STASH_PACKAGE;
#if JS_HAS_XML_SUPPORT
else if(strEQ(classname, "XML"))
package = PJS_XMLOBJ_PACKAGE;
#endif
else if(strEQ(classname, "Error"))
package = PJS_ERROR_PACKAGE;
else {
SV **sv = hv_fetch(get_hv(NAMESPACE"ClassMap", 1), classname,
strlen(classname), 0);
if(sv) package = SvPV_nolen(*sv);
else package = PJS_OBJECT_PACKAGE;
}
sv_setref_pv(robj, PJS_RAW_OBJECT, (void*)object);
sv_setref_iv(rjsv, PJS_RAW_JSVAL, (IV)value);
boxref = PJS_CallPerlMethod(aTHX_ cx,
"__new",
sv_2mortal(newSVpv(package, 0)), // package
sv_2mortal(robj), // content
sv_2mortal(rjsv), // jsval
NULL
);
if(!boxref) return JS_FALSE;
if(!SvOK(boxref) || !sv_derived_from(boxref, PJS_BOXED_PACKAGE))
croak("PJS_Assert: Contructor must return a "NAMESPACE"Boxed");
/* Create a new PASSPORT */
passport = JS_NewObject(cx, &passport_class, NULL, object);
if(!passport ||
!JS_DefineProperty(cx, object, PJS_PASSPORT_PROP,
OBJECT_TO_JSVAL(passport),
NULL, NULL, JSPROP_READONLY | JSPROP_PERMANENT))
return JS_FALSE;
box = SvRV(boxref);
/* boxref is mortal, so we need to increment its rc, at end of
* scope, PASSPORT owns created box */
JS_SetPrivate(cx, passport, (void *)SvREFCNT_inc_simple_NN(box));
JS_SetReservedSlot(cx, passport, 0, PRIVATE_TO_JSVAL(object));
PJS_DEBUG2("New boxed: %s brc: %d\n", hkey, SvREFCNT(box));
}
/* Root object adding it to pvisitors list, will be unrooted by
* jsc_free_root at Boxed DESTROY time
*/
JS_DefineProperty(cx, pcx->pvisitors, hkey, value, NULL, NULL, 0);
}
/* Here the RC of box in PASSPORT reflects wrapper's ownership */
if(full && PJS_getFlag(pcx, "AutoTie") &&
(strEQ(classname, "Object") || strEQ(classname, "Array"))
) {
/* Return tied */
AV *avbox = (AV *)SvRV(box);
SV **last;
SV *tied;
SV *tier;
if(strEQ(classname, "Array")) {
last = av_fetch(avbox, 6, 1);
if(last && SvOK(*last) && SvROK(*last)) { // Cached
*sv = newSVsv(*last);
sv_free(box); /* Hard copy 'sv' owns the reference */
return JS_TRUE;
}
tied = (SV *)newAV();
} else { // Object
last = av_fetch(avbox, 5, 1);
if(last && SvOK(*last) && SvROK(*last)) { // Cached
*sv = newSVsv(*last);
sv_free(box); /* Hard copy 'sv' owns the reference */
return JS_TRUE;
}
tied = (SV *)newHV();
}
/* hv_magic below own a reference to box, we use an explicit path,
* to make clear that to perl land only one reference is given
*/
tier = newRV_inc(box);
hv_magic((HV *)tied, (GV *)tier, PERL_MAGIC_tied);
sv_free(tier);
wrapper = newRV_noinc(tied); /* Don't leak the hidden tied variable */
/* Save in cache a weaken copy, the cache itself dosn't hold a reference */
sv_setsv(*last, wrapper);
sv_rvweaken(*last);
PJS_DEBUG1("Return tied for %s\n", SvPV_nolen(tier));
}
else {
wrapper = newRV_noinc(box); /* Transfer ownership to wrapper */
#if PERL_VERSION < 9
sv_bless(wrapper, SvSTASH(box));
#endif
}
*sv = wrapper;
return JS_TRUE;
}
return JS_FALSE;
}