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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "JavaScript_Env.h"
#include "PJS_Call.h"
#include "PJS_Context.h"
#include "PJS_TypeConversion.h"
SV *PJS_call_perl_method(const char *method, ...) {
dSP;
va_list ap;
SV *arg, *ret = sv_newmortal();
int rcount;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start(ap, method);
while ((arg = va_arg(ap, SV*)) != NULL) {
XPUSHs(arg);
}
PUTBACK;
rcount = perl_call_method(method, G_SCALAR);
SPAGAIN;
sv_setsv(ret, POPs);
PUTBACK;
FREETMPS;
LEAVE;
return ret;
}
I32 perl_call_sv_with_jsvals_rsv(JSContext *cx, JSObject *obj, SV *code, SV *caller, uintN argc, jsval *argv, SV **rsv) {
dSP;
I32 rcount = 0;
int arg;
if (SvROK(code) && SvTYPE(SvRV(code)) == SVt_PVCV) {
ENTER ;
SAVETMPS ;
PUSHMARK(SP) ;
if (caller) {
XPUSHs(caller);
}
for (arg = 0; arg < argc; arg++) {
SV *sv = sv_newmortal();
JSVALToSV(cx, NULL, argv[arg], &sv);
XPUSHs(sv);
}
PUTBACK ;
rcount = perl_call_sv(SvRV(code), G_SCALAR|G_EVAL);
SPAGAIN ;
if(rcount) {
int i;
/* XXX: this is wrong */
for (i = 0; i < rcount; ++i) {
if (rsv) {
*rsv = POPs;
SvREFCNT_inc(*rsv);
}
}
}
else {
}
if (SvTRUE(ERRSV)) {
jsval rval;
SV* cp = sv_mortalcopy( ERRSV );
if (PJS_ConvertPerlToJSType(cx, NULL, obj, cp, &rval) != JS_FALSE) {
JS_SetPendingException(cx, rval);
rcount = -1;
/* ERRSV is now converted into JS space. If it leaves again,
we'll turn it into a perl exception, so we can drop the
perl-space error here. */
sv_setsv(ERRSV, &PL_sv_undef);
}
else {
croak("Can't convert perl error into JSVAL");
}
}
PUTBACK ;
FREETMPS ;
LEAVE ;
}
else {
warn("not a coderef");
}
return rcount;
}
I32 perl_call_sv_with_jsvals(JSContext *cx, JSObject *obj, SV *code, SV *caller, uintN argc, jsval *argv, jsval *rval) {
SV *rsv;
I32 rcount = perl_call_sv_with_jsvals_rsv(cx, obj, code, caller, argc, argv, rval ? &rsv : NULL);
if (rval) {
PJS_ConvertPerlToJSType(cx, NULL, obj, rsv, rval);
}
return rcount;
}
JSBool PJS_call_javascript_function(PJS_Context *pcx, jsval func, SV *args, jsval *rval) {
jsval *arg_list;
SV *val;
AV *av;
int arg_count, i;
JSFunction *js_fun;
/* Clear $@ */
sv_setsv(ERRSV, &PL_sv_undef);
av = (AV *) SvRV(args);
arg_count = av_len(av);
Newz(1, arg_list, arg_count + 1, jsval);
if (arg_list == NULL) {
croak("Failed to allocate memory for argument list");
}
for (i = 0; i <= arg_count; i++) {
val = *av_fetch(av, i, 0);
if (PJS_ConvertPerlToJSType(PJS_GetJSContext(pcx), NULL, JS_GetGlobalObject(PJS_GetJSContext(pcx)), val, &(arg_list[i])) == JS_FALSE) {
Safefree(arg_list);
croak("Can't convert argument number %d to jsval", i);
}
}
js_fun = JS_ValueToFunction(PJS_GetJSContext(pcx), func);
if (JS_CallFunction(PJS_GetJSContext(pcx), JS_GetGlobalObject(PJS_GetJSContext(pcx)), js_fun,
arg_count + 1, (jsval *) arg_list, (jsval *) rval) == JS_FALSE) {
PJS_report_exception(pcx);
return JS_FALSE;
}
return JS_TRUE;
}
JSBool perl_call_jsfunc(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *rval) {
jsval tmp;
SV *code;
JSFunction *jsfun = PJS_FUNC_SELF;
JSObject *funobj = JS_GetFunctionObject(jsfun);
if (JS_GetProperty(cx, funobj, "_perl_func", &tmp) == JS_FALSE) {
croak("Can't get coderef\n");
}
code = JSVAL_TO_PRIVATE(tmp);
if (perl_call_sv_with_jsvals(cx, obj, code, NULL, argc, argv, rval) < 0) {
return JS_FALSE;
}
return JS_TRUE;
}
|
