VAstEnt* VAstEnt::findSym (const string& name) { HV* hvp = subhash(); assert(hvp); // $svpp = $table{$name} SV** svpp = hv_fetch(hvp, name.c_str(), name.length(), 0/*no-change*/); if (!svpp) return NULL; SV* svp = *svpp; if (!svp || !SvROK(svp) || SvTYPE(SvRV(svp)) != SVt_PVAV) return NULL; // $sub_avp = @{$table{$name}} AV* sub_avp = (AV*)(SvRV(svp)); VAstEnt* entp = avToSymEnt(sub_avp); if (debug()) cout<<"VAstEnt::find found under="<<this<<" "<<entp->ascii(name)<<"\n"; return entp; }
static SV* check_handler(pTHX_ SV* h) { if (SvROK(h)) { SV* myref = SvRV(h); if (SvTYPE(myref) == SVt_PVCV) return newSVsv(h); if (SvTYPE(myref) == SVt_PVAV) return SvREFCNT_inc(myref); croak("Only code or array references allowed as handler"); } return SvOK(h) ? newSVsv(h) : 0; }
std::vector<T> toMsgVec(SV* sv) { std::vector<T> return_vec; if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) Perl_croak(aTHX_ "Expected an array ref of messages"); AV* msg_av = (AV*) SvRV(sv); int length = AvFILL(msg_av) + 1; for (int i = 0; i < length; i++) { SV* el = *(av_fetch(msg_av, i, 0)); return_vec.push_back(toMsg<T>(el)); } return return_vec; }
USER_OBJECT_ RS_PerlLength(USER_OBJECT_ obj) { SV *sv; int n; USER_OBJECT_ ans; dTHX; sv = RS_PerlGetSV(obj); if(!sv) { PROBLEM "Can't get Perl object from S object" ERROR; } /* Check for a) objects, b) references here. */ #if 0 if(sv_isobject(sv)) { /*XXX What are we warning here. Is it debugging? */ PROBLEM "Calling length on a Perl object" WARN; } #endif if(SvROK(sv)) { sv = SvRV(sv); } switch(SvTYPE(sv)) { case SVt_PVHV: n = hv_iterinit((HV*) sv); break; case SVt_PVAV: n = av_len((AV*) sv) + 1; break; default: n = 0; break; } ans = NEW_INTEGER(1); INTEGER_DATA(ans)[0] = n; return(ans); }
/* * convert perl HV to partition_info_t */ int hv_to_partition_info(HV *hv, partition_info_t *part_info) { SV **svp; AV *av; int i, n; memset(part_info, 0, sizeof(partition_info_t)); FETCH_FIELD(hv, part_info, allow_alloc_nodes, charp, FALSE); FETCH_FIELD(hv, part_info, allow_accounts, charp, FALSE); FETCH_FIELD(hv, part_info, allow_groups, charp, FALSE); FETCH_FIELD(hv, part_info, allow_qos, charp, FALSE); FETCH_FIELD(hv, part_info, alternate, charp, FALSE); FETCH_FIELD(hv, part_info, cr_type, uint16_t, FALSE); FETCH_FIELD(hv, part_info, def_mem_per_cpu, uint32_t, FALSE); FETCH_FIELD(hv, part_info, default_time, uint32_t, TRUE); FETCH_FIELD(hv, part_info, deny_accounts, charp, FALSE); FETCH_FIELD(hv, part_info, deny_qos, charp, FALSE); FETCH_FIELD(hv, part_info, flags, uint16_t, TRUE); FETCH_FIELD(hv, part_info, grace_time, uint32_t, FALSE); FETCH_FIELD(hv, part_info, max_cpus_per_node, uint32_t, FALSE); FETCH_FIELD(hv, part_info, max_mem_per_cpu, uint32_t, FALSE); FETCH_FIELD(hv, part_info, max_nodes, uint32_t, TRUE); FETCH_FIELD(hv, part_info, max_share, uint16_t, TRUE); FETCH_FIELD(hv, part_info, max_time, uint32_t, TRUE); FETCH_FIELD(hv, part_info, min_nodes, uint32_t, TRUE); FETCH_FIELD(hv, part_info, name, charp, TRUE); svp = hv_fetch(hv, "node_inx", 8, FALSE); if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { av = (AV*)SvRV(*svp); n = av_len(av) + 2; /* for trailing -1 */ part_info->node_inx = xmalloc(n * sizeof(int)); for (i = 0 ; i < n-1; i += 2) { part_info->node_inx[i] = (int)SvIV(*(av_fetch(av, i, FALSE))); part_info->node_inx[i+1] = (int)SvIV(*(av_fetch(av, i+1 ,FALSE))); } part_info->node_inx[n-1] = -1; } else { /* nothing to do */ } FETCH_FIELD(hv, part_info, nodes, charp, FALSE); FETCH_FIELD(hv, part_info, preempt_mode, uint16_t, TRUE); FETCH_FIELD(hv, part_info, priority, uint16_t, TRUE); FETCH_FIELD(hv, part_info, qos_char, charp, TRUE); FETCH_FIELD(hv, part_info, state_up, uint16_t, TRUE); FETCH_FIELD(hv, part_info, total_cpus, uint32_t, TRUE); FETCH_FIELD(hv, part_info, total_nodes, uint32_t, TRUE); return 0; }
request_rec *modperl_xs_sv2request_rec(pTHX_ SV *in, char *classname, CV *cv) { SV *sv = (SV *)NULL; MAGIC *mg; if (SvROK(in)) { SV *rv = (SV*)SvRV(in); switch (SvTYPE(rv)) { case SVt_PVMG: sv = rv; break; case SVt_PVHV: sv = modperl_hv_request_find(aTHX_ in, classname, cv); break; default: Perl_croak(aTHX_ "panic: unsupported request_rec type %d", (int)SvTYPE(rv)); } } /* might be Apache2::ServerRec::warn method */ if (!sv && !(classname && SvPOK(in) && !strEQ(classname, SvPVX(in)))) { request_rec *r = NULL; (void)modperl_tls_get_request_rec(&r); if (!r) { Perl_croak(aTHX_ "Apache2->%s called without setting Apache2->request!", cv ? GvNAME(CvGV(cv)) : "unknown"); } return r; } /* there could be pool magic attached to custom $r object, so make * sure that mg->mg_ptr is set */ if ((mg = mg_find(sv, PERL_MAGIC_ext)) && mg->mg_ptr) { return (request_rec *)mg->mg_ptr; } else { if (classname && !sv_derived_from(in, classname)) { /* XXX: find something faster than sv_derived_from */ return NULL; } return INT2PTR(request_rec *, SvIV(sv)); } return NULL; }
static CORBA_boolean put_union (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv) { SV **discriminator; SV **value; AV *av; CORBA_long arm; if (sv == &PL_sv_undef) { if (PL_dowarn & G_WARN_ON) warn ("Uninitialized union"); if (!porbit_put_sv (buf, tc->discriminator, &PL_sv_undef)) return CORBA_FALSE; arm = porbit_union_find_arm (tc, &PL_sv_undef); if (arm < 0) { warn("union discriminator branch does not match any arm, and no default arm"); return CORBA_FALSE; } return porbit_put_sv (buf, tc->subtypes[arm], &PL_sv_undef); } if (!SvROK(sv) || (SvTYPE(SvRV(sv)) != SVt_PVAV)) { warn("Union must be array reference"); return CORBA_FALSE; } av = (AV *)SvRV(sv); discriminator = av_fetch(av, 0, 0); if (!discriminator && (PL_dowarn & G_WARN_ON)) warn ("Uninitialized union discriminator"); if (!porbit_put_sv (buf, tc->discriminator, discriminator ? *discriminator : &PL_sv_undef)) return CORBA_FALSE; arm = porbit_union_find_arm (tc, discriminator ? *discriminator : &PL_sv_undef); if (arm < 0) { warn("union discriminator branch does not match any arm, and no default arm"); return CORBA_FALSE; } value = av_fetch(av, 1, 0); return porbit_put_sv (buf, tc->subtypes[arm], value ? *value : &PL_sv_undef); }
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); }
lucy_RegexTokenizer* lucy_RegexTokenizer_init(lucy_RegexTokenizer *self, cfish_String *pattern) { lucy_Analyzer_init((lucy_Analyzer*)self); lucy_RegexTokenizerIVARS *const ivars = lucy_RegexTokenizer_IVARS(self); #define DEFAULT_PATTERN "\\w+(?:['\\x{2019}]\\w+)*" if (pattern) { if (CFISH_Str_Contains_Utf8(pattern, "\\p", 2) || CFISH_Str_Contains_Utf8(pattern, "\\P", 2) ) { CFISH_DECREF(self); THROW(CFISH_ERR, "\\p and \\P constructs forbidden"); } ivars->pattern = CFISH_Str_Clone(pattern); } else { ivars->pattern = cfish_Str_new_from_trusted_utf8( DEFAULT_PATTERN, sizeof(DEFAULT_PATTERN) - 1); } // Acquire a compiled regex engine for matching one token. dTHX; SV *token_re = S_compile_token_re(aTHX_ ivars->pattern); #if (PERL_VERSION > 10) REGEXP *rx = SvRX((SV*)token_re); #else if (!SvROK(token_re)) { THROW(CFISH_ERR, "token_re is not a qr// entity"); } SV *inner = SvRV(token_re); MAGIC *magic = NULL; if (SvMAGICAL((SV*)inner)) { magic = mg_find((SV*)inner, PERL_MAGIC_qr); } if (!magic) { THROW(CFISH_ERR, "token_re is not a qr// entity"); } REGEXP *rx = (REGEXP*)magic->mg_obj; #endif if (rx == NULL) { THROW(CFISH_ERR, "Failed to extract REGEXP from token_re '%s'", SvPV_nolen((SV*)token_re)); } ivars->token_re = rx; (void)ReREFCNT_inc(((REGEXP*)ivars->token_re)); SvREFCNT_dec(token_re); return self; }
static JSBool perlsub_construct( JSContext *cx, DEFJSFSARGS_ ) { dTHX; DECJSFSARGS; JSObject *func = JSVAL_TO_OBJECT(JS_ARGV_CALLEE(argv)); SV *callee = (SV *)JS_GetPrivate(cx, func); SV *caller = NULL; #if JS_VERSION < 185 JSObject *This = JSVAL_TO_OBJECT(argv[-1]); #else JSObject *This = JS_NewObjectForConstructor(cx, vp); #endif JSObject *proto = JS_GetPrototype(cx, This); PJS_DEBUG1("Want construct, This is a %s", PJS_GET_CLASS(cx, This)->name); if(PJS_GET_CLASS(cx, proto) == &perlpackage_class || ( JS_LookupProperty(cx, func, "prototype", &argv[-1]) && JSVAL_IS_OBJECT(argv[-1]) && !JSVAL_IS_NULL(argv[-1]) && (proto = JS_GetPrototype(cx, JSVAL_TO_OBJECT(argv[-1]))) && strEQ(PJS_GET_CLASS(cx, proto)->name, PJS_PACKAGE_CLASS_NAME)) ) { SV *rsv = NULL; char *pkgname = PJS_GetPackageName(aTHX_ cx, proto); #if JS_VERSION >= 185 JSAutoByteString bytes; bytes.initBytes(pkgname); #endif caller = newSVpv(pkgname, 0); argv[-1] = OBJECT_TO_JSVAL(This); if(!PJS_Call_sv_with_jsvals_rsv(aTHX_ cx, obj, callee, caller, argc, argv, &rsv, G_SCALAR)) return JS_FALSE; if(SvROK(rsv) && sv_derived_from(rsv, pkgname)) { JSObject *newobj = PJS_NewPerlObject(aTHX_ cx, JS_GetParent(cx, func), rsv); *rval = OBJECT_TO_JSVAL(newobj); return JS_TRUE; } JS_ReportError(cx, "%s's constructor don't return an object", SvPV_nolen(caller)); } else JS_ReportError(cx, "Can't use as a constructor"); // Yet! ;-) return JS_FALSE; }
/* * convert perl HV to node_info_msg_t */ int hv_to_node_info_msg(HV *hv, node_info_msg_t *node_info_msg) { SV **svp; AV *av; int i, n; memset(node_info_msg, 0, sizeof(node_info_msg_t)); FETCH_FIELD(hv, node_info_msg, last_update, time_t, TRUE); FETCH_FIELD(hv, node_info_msg, node_scaling, uint16_t, TRUE); svp = hv_fetch(hv, "node_array", 10, FALSE); if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV)) { Perl_warn (aTHX_ "node_array is not an array reference in HV for node_info_msg_t"); return -1; } av = (AV*)SvRV(*svp); n = av_len(av) + 1; node_info_msg->record_count = n; node_info_msg->node_array = xmalloc(n * sizeof(node_info_t)); for (i = 0; i < n; i ++) { svp = av_fetch(av, i, FALSE); if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV)) { Perl_warn (aTHX_ "element %d in node_array is not valid", i); return -1; } if (hv_to_node_info((HV*)SvRV(*svp), &node_info_msg->node_array[i]) < 0) { Perl_warn (aTHX_ "failed to convert element %d in node_array", i); return -1; } } return 0; }
/* * convert perl HV to job_step_info_response_msg_t */ int hv_to_job_step_info_response_msg(HV *hv, job_step_info_response_msg_t *step_info_msg) { int i, n; SV **svp; AV *av; memset(step_info_msg, 0, sizeof(job_step_info_response_msg_t)); FETCH_FIELD(hv, step_info_msg, last_update, time_t, TRUE); svp = hv_fetch(hv, "job_steps", 9, FALSE); if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV)) { Perl_warn (aTHX_ "job_steps is not an array reference in HV for job_step_info_response_msg_t"); return -1; } av = (AV*)SvRV(*svp); n = av_len(av) + 1; step_info_msg->job_step_count = n; step_info_msg->job_steps = xmalloc(n * sizeof(job_step_info_t)); for (i = 0; i < n; i ++) { svp = av_fetch(av, i, FALSE); if (! (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV)) { Perl_warn (aTHX_ "element %d in job_steps is not valid", i); return -1; } if (hv_to_job_step_info((HV*)SvRV(*svp), &step_info_msg->job_steps[i]) < 0) { Perl_warn (aTHX_ "failed to convert element %d in job_steps", i); return -1; } } return 0; }
PWSTR NonEmptyWStrFromScalar(PERL_CALL SV *string, BOOL isRef) { if(!string) return NULL; if(isRef && !(string = SvROK(string) ? SvRV(string) : NULL)) return NULL; PSTR str = SvPV(string, PL_na); if(str && *str) return S2W(str); return NULL; }
SV *ScalarFromArray(PERL_CALL AV *array, int idx, BOOL isRef) { if(isRef && array) { if(!(array = SvROK(array) ? (AV*)SvRV(array) : NULL)) return NULL; if(SvTYPE(array) != SVt_PVAV) return NULL; } SV **item = array ? av_fetch(array, idx, 0) : NULL; return item ? *item : NULL; }
SV* ScalarFromHash(PERL_CALL HV *hash, PSTR idx, BOOL isRef) { if(isRef && hash) { if(!(hash = SvROK(hash) ? (HV*)SvRV(hash) : NULL)) return NULL; if(SvTYPE(hash) != SVt_PVHV) return NULL; } SV **item = hash ? hv_fetch(hash, idx, strlen(idx), 0) : NULL; return item ? *item : NULL; }
PyObject* PerlPyObject_pyo_or_null(SV* sv) { MAGIC *mg; dCTXP; ASSERT_LOCK_PERL; if (SvROK(sv) && sv_derived_from(sv, "Python::Object")) { sv = SvRV(sv); mg = mg_find(sv, '~'); if (SvIOK(sv) && mg && mg->mg_virtual == &vtbl_free_pyo) { IV ival = SvIV(sv); return INT2PTR(PyObject *, ival); }
void plcb_convert_storage(PLCB_t *object, AV *docav, plcb_DOCVAL *vspec) { SV *pv = SvROK(vspec->value) ? SvRV(vspec->value) : vspec->value; uint32_t fmt = vspec->spec; if (object->cv_customenc) { vspec->need_free = 1; vspec->value = custom_convert(docav, object->cv_customenc, vspec->value, &vspec->flags, CONVERT_OUT); } else if (fmt == PLCB_CF_JSON) { vspec->flags = PLCB_LF_JSON|PLCB_CF_JSON; vspec->need_free = 1; vspec->value = serialize_convert(object->cv_jsonenc, vspec->value, CONVERT_OUT); } else if (fmt == PLCB_CF_STORABLE) { vspec->flags = PLCB_CF_STORABLE | PLCB_LF_STORABLE; vspec->need_free = 1; vspec->value = serialize_convert(object->cv_serialize, vspec->value, CONVERT_OUT); } else if (fmt == PLCB_CF_RAW) { vspec->flags = PLCB_CF_RAW | PLCB_LF_RAW; vspec->need_free = 0; if (!SvPOK(pv)) { die("Raw conversion requires string value!"); } } else if (vspec->spec == PLCB_CF_UTF8) { vspec->flags = PLCB_CF_UTF8 | PLCB_LF_UTF8; vspec->need_free = 0; sv_utf8_upgrade(pv); } else { die("Unrecognized flags used (0x%x) but no custom converted installed!", vspec->spec); } if (!vspec->need_free) { /* Use input as-is */ vspec->value = pv; } /* Assume the resultant value is an SV */ if (SvTYPE(vspec->value) == SVt_PV) { vspec->encoded = SvPVX(vspec->value); vspec->len = SvCUR(vspec->value); } else { vspec->encoded = SvPV(vspec->value, vspec->len); } }
void handle_string_list(pTHX_ const char *option, LinkedList list, SV *sv, SV **rval) { const char *str; if (sv) { LL_flush(list, (LLDestroyFunc) string_delete); if (SvROK(sv)) { sv = SvRV(sv); if (SvTYPE(sv) == SVt_PVAV) { AV *av = (AV *) sv; SV **pSV; int i, max = av_len(av); for (i = 0; i <= max; i++) { if ((pSV = av_fetch(av, i, 0)) != NULL) { SvGETMAGIC(*pSV); LL_push(list, string_new_fromSV(aTHX_ *pSV)); } else fatal("NULL returned by av_fetch() in handle_string_list()"); } } else Perl_croak(aTHX_ "%s wants an array reference", option); } else Perl_croak(aTHX_ "%s wants a reference to an array of strings", option); } if (rval) { ListIterator li; AV *av = newAV(); LL_foreach(str, li, list) av_push(av, newSVpv(CONST_CHAR(str), 0)); *rval = newRV_noinc((SV *) av); } }
USER_OBJECT_ RS_PerlHashElement(USER_OBJECT_ rs_table, USER_OBJECT_ elements, USER_OBJECT_ convert) { int i, n; HV *table; USER_OBJECT_ ans = NULL_USER_OBJECT; SV *obj; unsigned int depth; dTHX; obj = getForeignPerlReference(rs_table); if(obj == NULL) { PROBLEM "No such table reference %s", "?" ERROR; } if(SvROK(obj)) obj = SvRV(obj); if(SvTYPE(obj) != SVt_PVHV) { PROBLEM "Perl object (%s) is not a hash, but of type %d", "?", (int) SvTYPE(obj) ERROR; } table = (HV*) obj; if(TYPEOF(convert) == LGLSXP || TYPEOF(convert) == INTSXP) depth = (TYPEOF(convert) == LGLSXP ? LOGICAL(convert)[0] : INTEGER(convert)[0]); n = GET_LENGTH(elements); if(n > 0) { SV **el; const char *key; PROTECT(ans = NEW_LIST(n)); /* */ for(i = 0; i < n ; i++) { key = CHAR_DEREF(STRING_ELT(elements,i)); el = hv_fetch(table, key, strlen(key), 0); if(el && *el) SET_VECTOR_ELT(ans, i, fromPerl(*el, depth)); } SET_NAMES(ans, elements); UNPROTECT(1); } return(ans); }
USER_OBJECT_ fromPerlHV_SV(SV *sv) { if(SvROK(sv)) { sv = SvRV(sv); } if(SvTYPE(sv) != SVt_PVHV) { PROBLEM "fromPerlHV_SV called with Perl object that is not a Hashtable." ERROR; } if(!sv || SvTYPE(sv) == SVt_NULL) return(NULL_USER_OBJECT); return(fromPerlHV((HV *) sv, 1000)); }
static void ldap_pack_modop(SV *dest, SV *change) { if (change && SvOK(change)) { HV *hv; STRLEN offset1, offset2; if (!SvROK(change) || !(hv = (HV*)SvRV(change)) || (SvTYPE(hv) != SVt_PVHV)) croak("bad change description"); offset1 = start_sequence(dest); pack_enum(dest, SvIV(hv_fetchs_def_undef(hv, "operation"))); offset2 = start_sequence(dest); pack_string_utf8(dest, hv_fetchs_def_undef(hv, "attribute")); pack_set_of_string_utf8(dest, hv_fetchs_def_undef(hv, "values")); end_sequence(dest, offset2); end_sequence(dest, offset1); } }
/* * convert perl HV to job_step_info_t */ int hv_to_job_step_info(HV *hv, job_step_info_t *step_info) { SV **svp; AV *av; int i, n; FETCH_FIELD(hv, step_info, array_job_id, uint32_t, TRUE); FETCH_FIELD(hv, step_info, array_task_id, uint32_t, TRUE); FETCH_FIELD(hv, step_info, ckpt_dir, charp, FALSE); FETCH_FIELD(hv, step_info, ckpt_interval, uint16_t, TRUE); FETCH_FIELD(hv, step_info, gres, charp, FALSE); FETCH_FIELD(hv, step_info, job_id, uint16_t, TRUE); FETCH_FIELD(hv, step_info, name, charp, FALSE); FETCH_FIELD(hv, step_info, network, charp, FALSE); FETCH_FIELD(hv, step_info, nodes, charp, FALSE); svp = hv_fetch(hv, "node_inx", 8, FALSE); if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { av = (AV*)SvRV(*svp); n = av_len(av) + 2; /* for trailing -1 */ step_info->node_inx = xmalloc(n * sizeof(int)); for (i = 0 ; i < n-1; i += 2) { step_info->node_inx[i] = (int)SvIV(*(av_fetch(av, i ,FALSE))); step_info->node_inx[i+1] = (int)SvIV(*(av_fetch(av, i+1 ,FALSE))); } step_info->node_inx[n-1] = -1; } else { /* nothing to do */ } FETCH_FIELD(hv, step_info, num_cpus, uint32_t, TRUE); FETCH_FIELD(hv, step_info, num_tasks, uint32_t, TRUE); FETCH_FIELD(hv, step_info, partition, charp, FALSE); FETCH_FIELD(hv, step_info, profile, uint32_t, TRUE); FETCH_FIELD(hv, step_info, resv_ports, charp, FALSE); FETCH_FIELD(hv, step_info, run_time, time_t, TRUE); FETCH_FIELD(hv, step_info, start_time, time_t, TRUE); FETCH_FIELD(hv, step_info, step_id, uint32_t, TRUE); FETCH_FIELD(hv, step_info, time_limit, uint32_t, TRUE); FETCH_FIELD(hv, step_info, user_id, uint32_t, TRUE); FETCH_FIELD(hv, step_info, state, uint16_t, TRUE); return 0; }
PVOID PtrFromHash(PERL_CALL HV *hash, PSTR idx, unsigned *len, BOOL isRef) { if(isRef && hash) { if(!(hash = SvROK(hash) ? (HV*)SvRV(hash) : NULL)) return NULL; if(SvTYPE(hash) != SVt_PVHV) return NULL; } SV **item = hash ? hv_fetch(hash, idx, strlen(idx), 0) : NULL; if(item && *item) return len ? SvPV(*item, *len) : SvPV(*item, PL_na); else return NULL; }
MP_INLINE server_rec *modperl_sv2server_rec(pTHX_ SV *sv) { if (SvOBJECT(sv) || (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVMG))) { return INT2PTR(server_rec *, SvObjIV(sv)); } /* next see if we have Apache2->request available */ { request_rec *r = NULL; (void)modperl_tls_get_request_rec(&r); if (r) { return r->server; } } /* modperl_global_get_server_rec is not thread safe w/o locking */ return modperl_global_get_server_rec(); }
PVOID PtrFromArray(PERL_CALL AV *array, int idx, unsigned *len, BOOL isRef) { if(isRef && array) { if(!(array = SvROK(array) ? (AV*)SvRV(array) : NULL)) return NULL; if(SvTYPE(array) != SVt_PVAV) return NULL; } SV **item = array ? av_fetch(array, idx, 0) : NULL; if(item && *item) return len ? SvPV(*item, *len) : SvPV(*item, PL_na); else return NULL; }
int IntFromArray(PERL_CALL AV *array, int idx, BOOL isRef) { if(isRef && array) { if(!(array = SvROK(array) ? (AV*)SvRV(array) : NULL)) return NULL; if(SvTYPE(array) != SVt_PVAV) return NULL; } SV **item = array ? av_fetch(array, idx, 0) : NULL; if(item && *item) return SvIV(*item); else return NULL; }
PWSTR WStrFromHash(PERL_CALL HV *hash, PSTR idx, BOOL isRef) { if(isRef && hash) { if(!(hash = SvROK(hash) ? (HV*)SvRV(hash) : NULL)) return NULL; if(SvTYPE(hash) != SVt_PVHV) return NULL; } SV **item = hash ? hv_fetch(hash, idx, strlen(idx), 0) : NULL; if(item && *item) return S2W(SvPV(*item, PL_na)); else return NULL; }
int SLenFromHash(PERL_CALL HV *hash, PSTR idx, BOOL isRef) { if(isRef && hash) { if(!(hash = SvROK(hash) ? (HV*)SvRV(hash) : NULL)) return NULL; if(SvTYPE(hash) != SVt_PVHV) return NULL; } SV **item = hash ? hv_fetch(hash, idx, strlen(idx), 0) : NULL; if(item && *item) return SvLEN(*item) - 1; else return NULL; }
void perl_mongo_sv_to_bson (bson_t * bson, SV *sv, HV *opts) { if (!SvROK (sv)) { croak ("not a reference"); } if ( ! sv_isobject(sv) ) { switch ( SvTYPE(SvRV(sv)) ) { case SVt_PVHV: hvdoc_to_bson (bson, sv, opts, EMPTY_STACK); break; case SVt_PVAV: avdoc_to_bson(bson, sv, opts, EMPTY_STACK); break; default: sv_dump(sv); croak ("type unhandled"); } } else { SV *obj; char *class; obj = SvRV(sv); class = HvNAME(SvSTASH(obj)); if ( strEQ(class, "Tie::IxHash") ) { ixhashdoc_to_bson(bson, sv, opts, EMPTY_STACK); } else if ( strEQ(class, "MongoDB::BSON::_EncodedDoc") ) { STRLEN str_len; SV **svp; SV *encoded; const char *bson_str; bson_t *child; encoded = _hv_fetchs_sv((HV *)obj, "bson"); bson_str = SvPV(encoded, str_len); child = bson_new_from_data((uint8_t*) bson_str, str_len); bson_concat(bson, child); bson_destroy(child); } else if (SvTYPE(obj) == SVt_PVHV) {
static void passport_finalize( JSContext *cx, JSObject *passport ) { dTHX; SV *box = (SV *)JS_GetPrivate(cx, passport); if(box && SvOK(box) && SvROK(box)) { AV *avbox = (AV *)SvRV(box); #ifdef PJSDEBUG JSObject *parent = JS_GetParent(cx, passport); #endif PJS_DEBUG3("About to free a %s rc:%d,%d\n", JS_GET_CLASS(cx, parent)->name, SvREFCNT(box), SvREFCNT(avbox)); if(PL_dirty) return; av_store(avbox, 0, &PL_sv_undef); sv_free(box); } else croak("PJS_Assert: Bad finalize for passport\n"); /* Assertion */ }