static amf0_data_t* _amf0_data(SV* sv) { amf0_data_t* d; if (NULL == sv || !SvOK(sv)) { d = (amf0_data_t*)amf0_null_init(); } else if (SvPOKp(sv)) { STRLEN len; char* c = SvPV(sv, len); d = (amf0_data_t*)amf0_string_init_len(c, len); } else if (SvNOKp(sv)) { d = (amf0_data_t*)amf0_number_init((double)SvNVX(sv)); } else if (SvIOK_UV(sv)) { d = (amf0_data_t*)amf0_number_init((double)SvUV(sv)); } else if (SvIOKp(sv)) { d = (amf0_data_t*)amf0_number_init((double)SvIV(sv)); } else if (SvROK(sv)) { d = _amf0_data_rv(SvRV(sv)); } else { Perl_croak(aTHX_ "Data::AMF::XS doesn't support SvTYPE: %d\n", SvTYPE(sv)); } return d; }
static void pe_tracevar(pe_watcher *wa, SV *sv, int got) { /* Adapted from tkGlue.c We are a "magic" set processor. So we are (I think) supposed to look at "private" flags and set the public ones if appropriate. e.g. "chop" sets SvPOKp as a hint but not SvPOK presumably other operators set other private bits. Question are successive "magics" called in correct order? i.e. if we are tracing a tied variable should we call some magic list or be careful how we insert ourselves in the list? */ pe_ioevent *ev; if (SvPOKp(sv)) SvPOK_on(sv); if (SvNOKp(sv)) SvNOK_on(sv); if (SvIOKp(sv)) SvIOK_on(sv); ev = (pe_ioevent*) (*wa->vtbl->new_event)(wa); ++ev->base.hits; ev->got |= got; queueEvent((pe_event*) ev); }
SEXP GetRScalar(SV *val) { dTHX; SEXP ans = NULL_USER_OBJECT; if(SvIOKp(val)) { PROTECT(ans = NEW_INTEGER(1)); INTEGER_DATA(ans)[0] = SvIV(val); UNPROTECT(1); } else if(SvNOKp(val)) { PROTECT(ans = NEW_NUMERIC(1)); NUMERIC_DATA(ans)[0] = SvNV(val); UNPROTECT(1); } else if(SvPOK(val)) { PROTECT(ans = NEW_CHARACTER(1)); SET_STRING_ELT(ans, 0, COPY_TO_USER_STRING(SvPV(val, PL_na))); UNPROTECT(1); } else if(SvROK(val)) { fprintf(stderr, "Not handling nested references in conversion from Perl to R at present. Suggestions for semantics welcome!\n");fflush(stderr); } else if(SvTYPE(val) == SVt_PVMG) { /*XXX get more info about the type of the magic object. struct magic *mg = SvMAGIC(val); */ PROTECT(ans = createPerlReference(val)); UNPROTECT(1); } else { fprintf(stderr, "Cannot deal currently with Perl types %d\n", SvTYPE(val));fflush(stderr); } return(ans); }
// <<< HELPER FUNCTION DEFINITIONS >> int RPerl_SvIOKp(SV* input_sv) { return(SvIOKp(input_sv)); }
/* Converts perl values to equivalent JS values */ JSBool PJS_ReflectPerl2JS( pTHX_ JSContext *cx, JSObject *pobj, SV *ref, jsval *rval ) { PJS_Context *pcx = PJS_GET_CONTEXT(cx); JSObject *newobj = NULL; if(++pcx->svconv % 2000 == 0) { JSErrorReporter older; ENTER; SAVETMPS; /* Scope for finalizers */ older = JS_SetErrorReporter(cx, NULL); if(pcx->svconv > 10000) { JS_GC(cx); pcx->svconv = 0; } else JS_MaybeGC(cx); JS_SetErrorReporter(cx, older); FREETMPS; LEAVE; } if(SvROK(ref)) { MAGIC *mg; /* First check old jsvisitors */ if((newobj = PJS_IsPerlVisitor(aTHX_ pcx, SvRV(ref)))) { PJS_DEBUG("Old jsvisitor returns\n"); *rval = OBJECT_TO_JSVAL(newobj); return JS_TRUE; } if(SvMAGICAL(SvRV(ref)) && (mg = mg_find(SvRV(ref), PERL_MAGIC_tied)) && mg->mg_obj && sv_derived_from(mg->mg_obj, PJS_BOXED_PACKAGE)) { PJS_DEBUG1("A magical ref %s, shortcircuit!\n", SvPV_nolen((SV*)mg->mg_obj)); ref = mg->mg_obj; } if(sv_derived_from(ref, PJS_BOXED_PACKAGE)) { SV **fref = av_fetch((AV *)SvRV(SvRV(ref)), 2, 0); assert(sv_derived_from(*fref, PJS_RAW_JSVAL)); *rval = (jsval)SvIV(SvRV(*fref)); return JS_TRUE; } if(sv_derived_from(ref, PJS_BOOLEAN)) { *rval = SvTRUE(SvRV(ref)) ? JSVAL_TRUE : JSVAL_FALSE; return JS_TRUE; } if(sv_isobject(ref)) { newobj = PJS_NewPerlObject(aTHX_ cx, pobj, ref); if(newobj) { *rval = OBJECT_TO_JSVAL(newobj); return JS_TRUE; } return JS_FALSE; } } SvGETMAGIC(ref); if(!SvOK(ref)) /* undef */ *rval = JSVAL_VOID; else if(SvIOK(ref) || SvIOKp(ref)) { if(SvIV(ref) <= JSVAL_INT_MAX) *rval = INT_TO_JSVAL(SvIV(ref)); else JS_NewDoubleValue(cx, (double) SvIV(ref), rval); } else if(SvNOK(ref)) JS_NewDoubleValue(cx, SvNV(ref), rval); else if(SvPOK(ref) || SvPOKp(ref)) { STRLEN len; char *str; SV *temp=NULL; if(SvREADONLY(ref)) { temp = newSVsv(ref); str = PJS_SvPV(temp, len); } else str = PJS_SvPV(ref, len); JSString *jstr = ((int)len >= 0) ? JS_NewStringCopyN(cx, str, len) : JS_NewUCStringCopyN(cx, (jschar *)str, -(int)len); sv_free(temp); if(!jstr) return JS_FALSE; *rval = STRING_TO_JSVAL(jstr); } else if(SvROK(ref)) { /* Plain reference */ I32 type = SvTYPE(SvRV(ref)); if(type == SVt_PVHV) newobj = PJS_NewPerlHash(aTHX_ cx, pobj, ref); else if(type == SVt_PVAV) newobj = PJS_NewPerlArray(aTHX_ cx, pobj, ref); else if(type == SVt_PVCV) newobj = PJS_NewPerlSub(aTHX_ cx, pobj, ref); else newobj = PJS_NewPerlScalar(aTHX_ cx, pobj, ref); if(!newobj) return JS_FALSE; *rval = OBJECT_TO_JSVAL(newobj); } else { warn("I have no idea what perl send us (it's of type %i), I'll pretend it's undef", SvTYPE(ref)); *rval = JSVAL_VOID; } return JS_TRUE; }