#include "JavaScript.h" #include "PJS_Call.h" #include "PJS_Context.h" JSBool checkSeen( JSContext *cx, JSObject *seen, SV *ref, jsval *rval ) { /* a string rep of a pointer to the object */ char hkey[32]; int klen = snprintf(hkey, 32, "%p", ref); jsval seen_value; if ( JS_GetProperty(cx, seen, hkey, &seen_value) == JS_FALSE ) return JS_FALSE; if (!( JSVAL_IS_NULL(seen_value) || JSVAL_IS_VOID(seen_value))) { /* seen this before */ *rval = seen_value; return JS_TRUE; } return JS_FALSE; } JSBool setSeen( JSContext *cx, JSObject *seen, SV *ref, jsval rval ) { /* a string rep of a pointer to the object */ char hkey[32]; int klen = snprintf(hkey, 32, "%p", ref); return JS_DefineProperty(cx, seen, hkey, rval, NULL, NULL, JSPROP_ENUMERATE); } /* Converts perl values to equivalent JavaScript values */ JSBool PJS_ConvertPerlToJSType(JSContext *cx, JSObject *seen, JSObject *obj, SV *ref, jsval *rval) { int destroy_seen = 0; /* TODO - do we _need_ to clean up after us? */ if (sv_isobject(ref) && strcmp(HvNAME(SvSTASH(SvRV(ref))), PJS_BOXED_PACKAGE) == 0) { /* XXX: test this more */ ref = *av_fetch((AV *) SvRV(SvRV(ref)), 0, 0); } if (sv_isobject(ref)) { /* blessed */ PJS_Context *pcx; PJS_Class *pjsc; JSObject *newobj; HV *stash = SvSTASH(SvRV(ref)); char *name = HvNAME(stash); if (strcmp(name, PJS_FUNCTION_PACKAGE) == 0) { JSFunction *func = INT2PTR(JSFunction *, SvIV((SV *) SvRV(PJS_call_perl_method("content", ref, NULL)))); JSObject *obj = JS_GetFunctionObject(func); *rval = OBJECT_TO_JSVAL(obj); return JS_TRUE; } if((pcx = PJS_GET_CONTEXT(cx)) == NULL) { *rval = JSVAL_VOID; return JS_FALSE; } if((pjsc = PJS_GetClassByPackage(pcx, name)) == NULL) { *rval = JSVAL_VOID; return JS_FALSE; } SvREFCNT_inc(ref); newobj = JS_NewObject(cx, pjsc->clasp, NULL, obj); JS_SetPrivate(cx, newobj, (void *) ref); *rval = OBJECT_TO_JSVAL(newobj); return JS_TRUE; } if (!SvOK(ref)) { /* Returned value is undefined */ *rval = JSVAL_VOID; } else if (SvIOK(ref)) { /* Returned value is an integer */ 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)) { /* Returned value is a string */ char *str; STRLEN len; #ifdef JS_C_STRINGS_ARE_UTF8 str = SvPVutf8(ref, len); #else str = SvPVbyte(ref, len); #endif *rval = STRING_TO_JSVAL(JS_NewStringCopyN(cx, str, len)); } else if(SvROK(ref)) { /* reference */ I32 type; if (!seen) { seen = JS_NewObject(cx, NULL, NULL, NULL); if(seen == NULL) croak("Failed to create new JavaScript object"); destroy_seen = 1; } type = SvTYPE(SvRV(ref)); /* Most likely it's an hash that is returned */ if(type == SVt_PVHV) { JSObject *new_obj; HV *hv = (HV *) SvRV(ref); I32 items; HE *key; char *keyname; SV *keysv; STRLEN keylen; SV *keyval; jsval elem; if ( checkSeen( cx, seen, (SV*)hv, rval ) == JS_TRUE ) return JS_TRUE; new_obj = JS_NewObject(cx, NULL, NULL, NULL); if(new_obj == NULL) croak("Failed to create new JavaScript object"); setSeen( cx, seen, (SV*)hv, OBJECT_TO_JSVAL(new_obj) ); /* Assign properties, lets iterate over the hash */ items = hv_iterinit(hv); while((key = hv_iternext(hv)) != NULL) { /* although most hash keys are stored as char*, it's _way_ easier from a logic point of view to convert the bytes to an SV (so we know the charset) and then back again. TODO - we should only do this if we need to change the encoding of the key. */ /* if the key is an SV, this will return a *SV, otherwise null */ keysv = HeSVKEY( key ); if (keysv) { /* great. Do nothing. */ warn ("here - got SV key %p", keysv); #ifdef JS_C_STRINGS_ARE_UTF8 keyname = SvPVutf8(keysv, SvLEN( keysv ) ); #else keyname = SvPVbyte(keysv, SvLEN( keysv ) ); #endif } else { /* otherwise, just a pv key */ keyname = HeKEY( key ); #ifdef JS_C_STRINGS_ARE_UTF8 if (!HeKUTF8( key )) { /* key is bytes, we want utf8. */ keysv = newSV(0); sv_setpv( keysv, keyname ); keyname = SvPVutf8(keysv, SvLEN( keysv ) ); sv_2mortal( keysv ); } #else if (HeKUTF8( key )) { /* key is utf8, we want bytes. */ keysv = newSV(0); sv_setpv( keysv, keyname ); SvUTF8_on(keysv); keyname = SvPVbyte(keysv, SvLEN( keysv ) ); sv_2mortal( keysv ); } #endif } keyval = (SV *) hv_iterval(hv, key); if (PJS_ConvertPerlToJSType(cx, seen, obj, keyval, &elem) == JS_FALSE) { *rval = JSVAL_VOID; return JS_FALSE; } if (JS_DefineProperty(cx, new_obj, keyname, elem, NULL, NULL, JSPROP_ENUMERATE) == JS_FALSE) { warn("Failed to defined property %%", keyname); } } *rval = OBJECT_TO_JSVAL(new_obj); } else if(type == SVt_PVAV) { jsint av_length; jsint cnt; jsval *elems; JSObject *arr_obj; /* Then it's probablly an array */ AV *av = (AV *) SvRV(ref); if ( checkSeen( cx, seen, (SV*)av, rval ) == JS_TRUE ) return JS_TRUE; arr_obj = JS_NewArrayObject(cx, 0, NULL); setSeen( cx, seen, (SV*)av, OBJECT_TO_JSVAL(arr_obj) ); av_length = av_len(av); for(cnt = 0; cnt <= av_length; cnt++) { jsval value; if (PJS_ConvertPerlToJSType(cx, seen, obj, av_shift(av), &value) == JS_FALSE) { *rval = JSVAL_VOID; return JS_FALSE; } JS_DefineElement(cx, arr_obj, cnt, value, NULL, NULL, JSPROP_ENUMERATE ); } *rval = OBJECT_TO_JSVAL(arr_obj); } else if(type == SVt_PVGV) { *rval = PRIVATE_TO_JSVAL(ref); } else if(type == SVt_PV || type == SVt_IV || type == SVt_NV || type == SVt_RV) { /* Not very likely to return a reference to a primitive type, but we need to support that aswell */ warn("returning references to primitive types is not supported yet"); } else if(type == SVt_PVCV) { JSObject *newobj; JSFunction *jsfun; SvREFCNT_inc(ref); jsfun = JS_NewFunction(cx, perl_call_jsfunc, 0, 0, NULL, NULL); newobj = JS_GetFunctionObject(jsfun); /* put the cv as a property on the function object */ if (JS_DefineProperty(cx, newobj, "_perl_func", PRIVATE_TO_JSVAL(ref), NULL, NULL, 0) == JS_FALSE) { warn("Failed to defined property for _perl_func"); } *rval = OBJECT_TO_JSVAL(newobj); } else { warn("JavaScript.pm not handling this yet"); *rval = JSVAL_VOID; return JS_FALSE; } } else { warn("I have no idea what ref is (it's of type %i), I'll pretend it's null", SvTYPE(ref)); *rval = JSVAL_VOID; } return JS_TRUE; } /* Converts a JavaScript value to equivalent Perl value */ JSBool JSVALToSV(JSContext *cx, HV *seen, jsval v, SV** sv) { if (JSVAL_IS_PRIMITIVE(v)) { if (JSVAL_IS_NULL(v) || JSVAL_IS_VOID(v)){ *sv = &PL_sv_undef; } else if (JSVAL_IS_INT(v)) { sv_setiv(*sv, JSVAL_TO_INT(v)); } else if (JSVAL_IS_DOUBLE(v)) { sv_setnv(*sv, *JSVAL_TO_DOUBLE(v)); } else if (JSVAL_IS_STRING(v)) { /* XXX: review this, JS_GetStringBytes twice causing assertaion failure */ #ifdef JS_C_STRINGS_ARE_UTF8 char *tmp = JS_smprintf("%hs", JS_GetStringChars(JSVAL_TO_STRING(v))); sv_setpv(*sv, tmp); SvUTF8_on(*sv); free(tmp); #else sv_setpv(*sv, JS_GetStringBytes(JSVAL_TO_STRING(v))); #endif } else if (JSVAL_IS_BOOLEAN(v)) { if (JSVAL_TO_BOOLEAN(v)) { *sv = &PL_sv_yes; } else { *sv = &PL_sv_no; } } else { croak("Unknown primitive type"); } } else { if (JSVAL_IS_OBJECT(v)) { JSObject *object = JSVAL_TO_OBJECT(v); int destroy_hv; SV **used; char hkey[32]; int klen; /* stringify object with a default value for now, such as String. We might want to actually tie the object in the future, so the additional properties won't go away */ { jsval dvalue; if (OBJ_DEFAULT_VALUE(cx, object, JSTYPE_OBJECT, &dvalue) && JSVAL_IS_STRING(dvalue)) { sv_setpv(*sv, JS_GetStringBytes(JSVAL_TO_STRING(dvalue))); return JS_TRUE; } } #ifdef JS_ENABLE_E4X if (OBJECT_IS_XML(cx,object)) { /* We can't use private functions so let's call the toString method on the object */ jsval tv; JSString *xmlstring; JS_CallFunctionName(cx, object, "toXMLString", 0, NULL, &tv); xmlstring = JS_ValueToString(cx,tv); sv_setpv(*sv, JS_GetStringBytes(xmlstring)); SvUTF8_on(*sv); return JS_TRUE; } else if (JS_ObjectIsFunction(cx, object)) { #else if (JS_ObjectIsFunction(cx, object)) { #endif JSFunction *jsfun = JS_ValueToFunction(cx, v); SV *pcx = sv_2mortal(newSViv(PTR2IV(PJS_GET_CONTEXT(cx)))); SV *content = sv_2mortal(newRV_noinc(newSViv(PTR2IV(jsfun)))); jsval *x; Newz(1, x, 1, jsval); if (x == NULL) { croak("Failed to allocate memory for jsval"); } *x = v; JS_AddRoot(cx, (void *)x); sv_setsv(*sv, PJS_call_perl_method("new", newSVpv(PJS_FUNCTION_PACKAGE, 0), content, pcx, sv_2mortal(newSViv(PTR2IV(x))), NULL)); return JS_TRUE; } else if (OBJ_IS_NATIVE(object) && (OBJ_GET_CLASS(cx, object)->flags & JSCLASS_HAS_PRIVATE) && (strcmp(OBJ_GET_CLASS(cx, object)->name, "Error") != 0)) { /* Object with a private means the actual perl object is there */ /* This is kludgy because function is also object with private, we need to turn this to use hidden property on object */ SV *priv = (SV *)JS_GetPrivate(cx, object); if (priv && SvROK(priv)) { SvREFCNT_inc(priv); sv_setsv(*sv, priv); return JS_TRUE; } } destroy_hv = 0; if (!seen) { seen = newHV(); destroy_hv = 1; } klen = snprintf(hkey, 32, "%p", object); if ((used = hv_fetch(seen, hkey, klen, 0)) != NULL) { sv_setsv(*sv, *used); return JS_TRUE; } else if(JS_IsArrayObject(cx, object)) { SV *arr_sv; arr_sv = JSARRToSV(cx, seen, object); sv_setsv(*sv, arr_sv); } else { SV *hash_sv; hash_sv = JSHASHToSV(cx, seen, object); sv_setsv(*sv, hash_sv); } if (destroy_hv) { hv_undef(seen); } } else { croak("Not an object nor a primitive"); } } return JS_TRUE; } /* Converts an JavaScript array object to an Perl array reference */ SV *JSARRToSV(JSContext *cx, HV *seen, JSObject *object) { jsuint jsarrlen; jsuint index; jsval elem; AV *av = newAV(); SV *sv = sv_2mortal(newRV_noinc((SV *) av)); char hkey[32]; int klen = snprintf(hkey, 32, "%p", object); hv_store(seen, hkey, klen, sv, 0); SvREFCNT_inc(sv); JS_GetArrayLength(cx, object, &jsarrlen); for(index = 0; index < jsarrlen; index++) { SV *elem_sv; JS_GetElement(cx, object, index, &elem); elem_sv = newSV(0); JSVALToSV(cx, seen, elem, &elem_sv); av_push(av, elem_sv); } return sv; } /* Converts a JavaScript object (not array) to a anonymous perl hash reference */ SV *JSHASHToSV(JSContext *cx, HV *seen, JSObject *object) { JSIdArray *prop_arr = JS_Enumerate(cx, object); int idx; HV *hv = newHV(); SV *sv = sv_2mortal(newRV_noinc((SV *) hv)); char hkey[32]; int klen = snprintf(hkey, 32, "%p", object); hv_store(seen, hkey, klen, sv, 0); SvREFCNT_inc(sv); for(idx = 0; idx < prop_arr->length; idx++) { jsval key; JS_IdToValue(cx, (prop_arr->vector)[idx], &key); if(JSVAL_IS_STRING(key)) { jsval value; SV *val_sv; SV *js_key_sv = newSV(0); char *js_key = JS_GetStringBytes(JSVAL_TO_STRING(key)); sv_setpv(js_key_sv, js_key); #ifdef JS_C_STRINGS_ARE_UTF8 /* char *js_key = JS_smprintf("%hs", JS_GetStringChars(JSVAL_TO_STRING(v))); */ SvUTF8_on(js_key_sv); #endif if ( JS_GetProperty(cx, object, js_key, &value) == JS_FALSE ) { /* we're enumerating the properties of an object. This returns false if there's no such property. Urk. */ croak("this can't happen."); } val_sv = newSV(0); JSVALToSV(cx, seen, value, &val_sv); hv_store_ent(hv, js_key_sv, val_sv, 0); } else { croak("can't coerce object key into a hash"); } } JS_DestroyIdArray(cx, prop_arr); return sv; }