PJS_PerlArray.c

#include "XSUB.h"

#include "JavaScript_Env.h"

#include "PJS_Context.h"
#include "PJS_Class.h"
#include "PJS_PerlArray.h"

static void perlarray_finalize(JSContext *cx, JSObject *obj);
static JSBool PerlArray(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);

static JSBool perlarray_push(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);
static JSBool perlarray_unshift(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);
static JSBool perlarray_shift(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);
static JSBool perlarray_pop(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval);

static JSBool perlarray_get(JSContext *cx, JSObject *obj, jsval id, jsval *vp);
static JSBool perlarray_set(JSContext *cx, JSObject *obj, jsval id, jsval *vp);
static JSBool perlarray_property_length(JSContext *cx, JSObject *obj, jsval id, jsval *vp);

static const char *PerlArrayPkg = "JavaScript::PerlArray";

static JSClass perlarray_class = {
    "PerlArray", JSCLASS_HAS_PRIVATE,
    JS_PropertyStub, JS_PropertyStub,
    perlarray_get, perlarray_set,
    JS_EnumerateStub, JS_ResolveStub,
    JS_ConvertStub, perlarray_finalize,
    JSCLASS_NO_OPTIONAL_MEMBERS
};

static JSPropertySpec perlarray_props[] = {
    {"length", 0, JSPROP_READONLY | JSPROP_PERMANENT, perlarray_property_length, 0 },
    {0, 0, 0, 0, 0}
};

static JSFunctionSpec perlarray_methods[] = {
    {"push", perlarray_push, 1, 0, 0},
    {"unshift", perlarray_unshift, 1, 0, 0},
    {"shift", perlarray_shift, 0, 0, 0},
    {"pop", perlarray_pop, 0, 0, 0},
    {0, 0, 0, 0 ,0}
};

PJS_PerlArray * PJS_NewPerlArray() {
    dTHX;
    PJS_PerlArray *obj;
    
    Newz(1, obj, 1, PJS_PerlArray);
    obj->av = newAV();
    
    return obj;
}

JSObject *PJS_InitPerlArrayClass(PJS_Context *pcx, JSObject *global) {
    dTHX;
    PJS_Class *cls;
    
    Newz(1, cls, 1, PJS_Class);
    
    cls->pkg  = savepv(PerlArrayPkg);
    cls->clasp = &perlarray_class;
    
    cls->proto = JS_InitClass(
        pcx->cx, global, NULL, &perlarray_class, PerlArray, 0, 
        perlarray_props, perlarray_methods,
        NULL, NULL
    );
    
    PJS_store_class(pcx, cls);
    
    return cls->proto;
}

static void perlarray_finalize(JSContext *cx, JSObject *obj) {
    dTHX;
    SV *self = (SV *) JS_GetPrivate(cx, obj);
    SvREFCNT_dec(self);
}

static JSBool PerlArray(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    PJS_PerlArray *arr = PJS_NewPerlArray();

    SV *sv = newSV(0);
    sv_setref_pv(sv, "JavaScript::PerlArray", (void*) arr);
    JS_SetPrivate(cx, obj, (void *) sv); 
    
    return JS_TRUE;
}

static JSBool perlarray_push(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    if (argc) {
        for (tmp = 0; tmp < argc; tmp++) {
            SV *sv = newSV(0);
            if (JSVALToSV(cx, NULL, argv[tmp], &sv) != JS_TRUE) {
                JS_ReportError(cx, "Failed to convert argument %d to Perl", tmp);
                return JS_FALSE;
            }
            av_push(av, sv);
        }
    }
    
    return JS_TRUE;
}

static JSBool perlarray_unshift(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    if (argc) {
        av_unshift(av, argc);
        for (tmp = 0; tmp < argc; tmp++) {
            SV *sv = newSV(0);
            if (JSVALToSV(cx, NULL, argv[tmp], &sv) != JS_TRUE) {
                JS_ReportError(cx, "Failed to convert argument %d to Perl", tmp);
                return JS_FALSE;
            }
            av_store(av, tmp, sv);
        }
    }
    
    return JS_TRUE;
}

static JSBool perlarray_shift(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    SV *sv = av_shift(av);
    
    if (sv == NULL || sv == &PL_sv_undef) {
        *rval = JSVAL_VOID;
        return JS_TRUE;
    }
    
    PJS_ConvertPerlToJSType(cx, NULL, obj, sv, rval);
    
    return JS_TRUE;
}

static JSBool perlarray_pop(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    SV *sv = av_pop(av);
    
    if (sv == NULL || sv == &PL_sv_undef) {
        *rval = JSVAL_VOID;
        return JS_TRUE;
    }
    
    PJS_ConvertPerlToJSType(cx, NULL, obj, sv, rval);
    
    return JS_TRUE;
}

static JSBool perlarray_get(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    if (JSVAL_IS_INT(id)) {
        IV ix = JSVAL_TO_INT(id);
        SV **v;
        v = av_fetch(av, ix, 0);
        if (v != NULL) {
            PJS_ConvertPerlToJSType(cx, NULL, obj, *v, vp);
        }
        else {
            JS_ReportError(cx, "Failed to retrieve element at index: %d", ix);
            return JS_FALSE;
        }
    }
    
    return JS_TRUE;
}

static JSBool perlarray_set(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    
    if (JSVAL_IS_INT(id)) {
        IV ix = JSVAL_TO_INT(id);
        SV *sv = newSV(0);
        
        if (JSVALToSV(cx, NULL, *vp, &sv) != JS_TRUE) {
            JS_ReportError(cx, "Failed to convert argument %d to Perl", tmp);
            return JS_FALSE;
        }    
        
        av_store(av, ix, sv);
    }
    
    return JS_TRUE;
}


static JSBool perlarray_property_length(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlArray *arr = INT2PTR(PJS_PerlArray *, tmp);
    AV *av = arr->av;
    I32 len = av_len(av) + 1;
    
    *vp = INT_TO_JSVAL(len);
    
    return JS_TRUE;
}