#include "JS.h"

PJS_GTYPEDEF(JSObject, RawObj);

MODULE = JSPL::RawObj	PACKAGE = JSPL::RawObj PREFIX = rop_
PROTOTYPES: DISABLE

const char *
get_class_name(object, pcx)
    JSPL::Context pcx;
    JSPL::RawObj object;
    CODE:
	RETVAL = PJS_GET_CLASS(PJS_getJScx(pcx), object)->name;
    OUTPUT:
	RETVAL

void 
rop_seal_object(object, pcx, deep = 0)
    JSPL::Context pcx;
    JSPL::RawObj	object;
    U32	    deep;
    CODE:
#if JS_VERSION < 185
	JS_SealObject(PJS_getJScx(pcx), object, (JSBool)deep);
#else
	deep ? JS_DeepFreezeObject(PJS_getJScx(pcx), object)
	     : JS_FreezeObject(PJS_getJScx(pcx), object);
#endif

#define PJS_EL_MODE_FLAG	2

int
rop_set_prop(dest, pcx, name, val)
    JSPL::RawObj  dest;
    JSPL::Context pcx;
    SV *name = SvREADONLY($arg) ? sv_mortalcopy($arg) : $arg;
    SV *val;
    ALIAS:
	set_elem = 2
    PREINIT:
	JSBool ok = JS_FALSE;
	jsval rval;
	JSContext *cx;
    CODE:
	cx = PJS_getJScx(pcx);

	ok = PJS_ReflectPerl2JS(aTHX_ cx, NULL, val, &rval);

	if(ok) {
	    if(ix & PJS_EL_MODE_FLAG)
		ok = JS_SetElement(cx, dest, SvIV(name), &rval);
	    else {
		STRLEN len;
		char *str = PJS_SvPV(name, len);
		if((int)len >= 0) ok = JS_SetProperty(cx, dest, str, &rval);
		else ok = JS_SetUCProperty(cx, dest, (jschar *)str, -(int)len, &rval);
	    }
        }

	if(!ok && PJS_report_exception(aTHX_ pcx))
	    XSRETURN_UNDEF;
	RETVAL = 1;
    OUTPUT:
	RETVAL

jsval
rop_get_prop(source, pcx, property)
    JSPL::RawObj  source;
    JSPL::Context pcx;
    SV *property = SvREADONLY($arg) ? sv_mortalcopy($arg) : $arg;
    ALIAS:
	get_elem = 2
    PREINIT:
	JSBool ok = JS_FALSE;
	JSContext *cx;
    CODE:
	cx = PJS_getJScx(pcx);

	if(ix & PJS_EL_MODE_FLAG)
	    ok = JS_GetElement(cx, source, SvIV(property), &RETVAL);
	else {
	    STRLEN len;
	    char *name = PJS_SvPV(property, len);
#if JS_HAS_XML_SUPPORT
	    if(strEQ(PJS_GET_CLASS(cx, source)->name, "XML") && (int)len > 0) {
		/* TODO: if len < 0, name is UC2 encoded, so we need a JS_GetUCMethod */
		JSObject *other;
		ok = JS_GetMethod(cx, source, name, &other, &RETVAL);
		// Don't report if method fails
		if(!ok) JS_ClearPendingException(cx);
	    }
#endif
	    if(!ok) {
		if((int)len >= 0) ok = JS_GetProperty(cx, source, name, &RETVAL);
		else ok = JS_GetUCProperty(cx, source, (jschar *)name, -(int)len,
		                           &RETVAL);
	    }
	}
	if(!ok && PJS_report_exception(aTHX_ pcx))
	    XSRETURN_UNDEF;
    OUTPUT:
	RETVAL

int
rop_delete_prop(dest, pcx, name)
    JSPL::RawObj  dest;
    JSPL::Context pcx;
    SV *name = SvREADONLY($arg) ? sv_mortalcopy($arg) : $arg;
    ALIAS:
	delete_elem = 2
    PREINIT:
	JSContext *cx;
	JSBool ok;
    CODE:
	cx = PJS_getJScx(pcx);

	if(ix & PJS_EL_MODE_FLAG)
	    ok = JS_DeleteElement(cx, dest, SvIV(name));
	else {
	    STRLEN len;
	    char *str = PJS_SvPV(name, len);
	    jsval tmp;
	    if((int)len >= 0)
		ok = JS_DeleteProperty2(cx, dest, str, &tmp);
	    else ok = JS_DeleteUCProperty2(cx, dest, (jschar *)str, -(int)len, &tmp);
	}
	if(!ok && PJS_report_exception(aTHX_ pcx))
	    XSRETURN_UNDEF;
	RETVAL = 1;
    OUTPUT:
	RETVAL

#undef PJS_EX_MODE_FLAG
#undef PJS_EL_MODE_FLAG

JSPL::RawObj
rop_firstkey(object, pcx)
    JSPL::RawObj  object;
    JSPL::Context pcx;
    PREINIT:
	JSContext *cx;
	char hkey[32];
    CODE:
	cx = PJS_getJScx(pcx);

	RETVAL = JS_NewPropertyIterator(cx, object);

	/* Root Iterator */
	snprintf(hkey, 32, "%p", (void *)RETVAL);
	JS_DefineProperty(cx, pcx->pvisitors, hkey,
	    OBJECT_TO_JSVAL(RETVAL), NULL, NULL, 0);
    OUTPUT:
	RETVAL
	
jsval
rop_nextkey(iterator, pcx)
    JSPL::RawObj  iterator;
    JSPL::Context pcx;
    PREINIT:
	JSContext *cx;
	jsid idp;
    CODE:
	cx = PJS_getJScx(pcx);

	if(!JS_NextProperty(cx, iterator, &idp))
	    croak("NextProperty fail!");

	if(PJSID_IS(VOID,idp)) {
	    /* End of properties, unroot iterator */
	    char hkey[32];
	    snprintf(hkey, 32, "%p", (void *)iterator);
	    JS_DeleteProperty(cx, pcx->pvisitors, hkey);
            XSRETURN_UNDEF;
	}
	if(!JS_IdToValue(cx, idp, &RETVAL))
	    croak("Can't convert id to value");
    OUTPUT:
	RETVAL

SV *
rop_length(source, pcx)
    JSPL::RawObj  source;
    JSPL::Context pcx;
    PREINIT:
	JSContext *cx;
	jsuint len;
    CODE:
	cx = PJS_getJScx(pcx);
#ifdef JS_NEED_ARRAYLENGTH
	if(JS_GetArrayLength(cx, source, &len)) {
	    RETVAL = newSViv(len);
	} else {
	    JS_ClearPendingException(cx);
	    RETVAL = &PL_sv_undef;
	}
#else
	RETVAL = JS_HasArrayLength(cx, source, &len) ? newSViv(len) : &PL_sv_undef;
#endif
    OUTPUT:
	RETVAL

SV *
rop_tie(thing, pcx, isarr)
    JSPL::RawObj  thing;
    JSPL::Context pcx;
    I32 isarr;
    PREINIT:
	SV *box;
	SV *tied = NULL;
	SV *tier;
	AV *avbox;
	SV **last;
    CODE:
	box = PJS_GetPassport(aTHX_ PJS_getJScx(pcx), thing);
	avbox = (AV *)SvRV(box);
	last = av_fetch(avbox, 5+isarr, 1);
	if(last && SvOK(*last) && SvROK(*last)) {
	    RETVAL = newSVsv(*last);
	    PJS_DEBUG1("Tied cached:%s\n", SvPV_nolen(RETVAL));
	} else {
	    tied = isarr ? (SV *)newAV() : (SV *)newHV();
	    tier = newRV_inc(box);
	    hv_magic((HV *)tied, (GV *)tier, PERL_MAGIC_tied);
	    sv_free(tier);
	    RETVAL = newRV_noinc(tied);
	    sv_setsv(*last, RETVAL);
	    sv_rvweaken(*last);
	    PJS_DEBUG1("Return extra tied for %s\n", SvPV_nolen(tier));
	}
    OUTPUT:
	RETVAL

void
rop_free_root(thing, pcx)
    JSPL::RawObj  thing;
    JSPL::Context pcx;
    PREINIT:
	char hkey[32];
	SV *box;
    CODE:
	snprintf(hkey, 32, "%p", (void *)thing);
	box = PJS_GetPassport(aTHX_ PJS_getJScx(pcx), thing);
	PJS_DEBUG2("Freing %s brc: %d\n", hkey, (int)SvREFCNT(box));
	/* Invalidate CODEREF cache, its maybe holding a reference */
	av_store((AV *)SvRV(box), 7, &PL_sv_undef);
	/* Avoid destructing box a little, will be freed in passport_finalize.
	 * This transfers ownership to the passport, because there isn't more
	 * references in perl land to the Boxed.
	 */
	if(!PL_dirty) (void)SvREFCNT_inc_simple_NN(box); 
	JS_DeleteProperty(PJS_getJScx(pcx), pcx->pvisitors, hkey);
	PJS_GC(PJS_getJScx(pcx));