javascript/PJS_PerlHash.c at master · claesjac/javascript · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
#include "XSUB.h"

#include "JavaScript_Env.h"

#include "PJS_Context.h"
#include "PJS_Class.h"
#include "PJS_PerlHash.h"

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

static JSBool perlhash_get(JSContext *cx, JSObject *obj, jsval id, jsval *vp);
static JSBool perlhash_set(JSContext *cx, JSObject *obj, jsval id, jsval *vp);

static const char *PerlHashPkg = "JavaScript::PerlHash";

static JSClass perlhash_class = {
    "PerlHash", JSCLASS_HAS_PRIVATE,
    JS_PropertyStub, JS_PropertyStub,
    perlhash_get, perlhash_set,
    JS_EnumerateStub, JS_ResolveStub,
    JS_ConvertStub, perlhash_finalize,
    JSCLASS_NO_OPTIONAL_MEMBERS
};

static JSPropertySpec perlhash_props[] = {
    {0, 0, 0, 0, 0}
};

static JSFunctionSpec perlhash_methods[] = {
    {0, 0, 0, 0 ,0}
};

PJS_PerlHash * PJS_NewPerlHash() {
    dTHX;
    PJS_PerlHash *obj;

    Newz(1, obj, 1, PJS_PerlHash);
    obj->hv = newHV();

    return obj;
}

JSObject *PJS_InitPerlHashClass(PJS_Context *pcx, JSObject *global) {
    dTHX;
    PJS_Class *cls;

    Newz(1, cls, 1, PJS_Class);

    cls->pkg  = savepv(PerlHashPkg);
    cls->clasp = &perlhash_class;

    cls->proto = JS_InitClass(
        pcx->cx, global, NULL, &perlhash_class, PerlHash, 0,
        perlhash_props, perlhash_methods,
        NULL, NULL
    );

    PJS_store_class(pcx, cls);

    return cls->proto;
}

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

static JSBool PerlHash(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
    dTHX;
    PJS_PerlHash *hash = PJS_NewPerlHash();

    SV *sv = newSV(0);
    sv_setref_pv(sv, "JavaScript::PerlHash", (void*) hash);
    JS_SetPrivate(cx, obj, (void *) sv);

    return JS_TRUE;
}

static JSBool perlhash_get(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlHash *hash = INT2PTR(PJS_PerlHash *, tmp);
    HV *hv = hash->hv;
    SV **v;
    const char *key;

    if (!JSVAL_IS_STRING(id)) {
        return JS_FALSE;
    }

    key = JS_GetStringBytes(JSVAL_TO_STRING(id));
    v = hv_fetch(hv, key, strlen(key), 0);
    if (v != NULL) {
        PJS_ConvertPerlToJSType(cx, NULL, obj, *v, vp);
    }
    else {
        *vp = JSVAL_NULL;
    }

    return JS_TRUE;
}

static JSBool perlhash_set(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
    dTHX;
    IV tmp = SvIV((SV *) SvRV((SV *) JS_GetPrivate(cx, obj)));
    PJS_PerlHash *hash = INT2PTR(PJS_PerlHash *, tmp);
    HV *hv = hash->hv;
    SV *sv;
    const char *key;

    if (!JSVAL_IS_STRING(id)) {
        return JS_FALSE;
    }

    key = JS_GetStringBytes(JSVAL_TO_STRING(id));
    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;
    }

    hv_store(hv, key, strlen(key), sv, 0);

    return JS_TRUE;
}