mozilla
/
pjs
зеркало из https://github.com/mozilla/pjs.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

JS.pm works correctly

This commit is contained in:
pavel%gingerall.cz 2001-06-29 10:59:32 +00:00
Родитель 86a924e978
Коммит 637bc70a37
6 изменённых файлов: 136 добавлений и 32 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

26
js/src/perlconnect/JS.pm
Просмотреть файл

@ -129,6 +129,32 @@ sub DESTROY #7/31/98 4:54PM
JS::Runtime::DestroyContext($self);
} ##DESTROY
############################################################
# JS::Script
############################################################
package JS::Script;
sub new {
my ($class, $code, $name, $rt, $cx) = @_;
$class = ref $class || $class;
my $self = {};
bless $self, $class;
$self->{_rt} = $rt;
my $wcx = $cx or $rt->createContext(8192);
$self->{_script} = $wcx->compileScript($code, $name);
undef $wcx unless $cx;
return $self;
}
sub DESTROY {
my ($self, $cx) = @_;
my $wcx = $cx or $self->{_rt}->createContext(8192);
$wcx->destroyScript($self);
undef $self->{_rt};
undef $wcx unless $cx;
}
############################################################
# JS::Object
############################################################

65
js/src/perlconnect/JS.xs
Просмотреть файл

@ -61,6 +61,25 @@
/* __REMOVE__ */
/* #include <stdio.h> */
/************************************************************/
/* utils */
static JSBool
checkError(JSContext *cx)
{
if(SvTRUE(GvSV(PL_errgv))){
JS_ReportError(cx, "perl eval failed: %s",
SvPV(GvSV(PL_errgv), PL_na));
/* clear error status. there should be a way to do this faster */
perl_eval_sv(newSVpv("undef $@;", 0), G_KEEPERR);
return JS_FALSE;
}
return JS_TRUE;
}
/************************************************************/
/* calback stub */
/* this is internal js structure needed in errorFromPrivate */
typedef struct JSExnPrivate {
JSErrorReport *errorReport;
@ -70,7 +89,7 @@ static
JSClass global_class = {
"Global", 0,
JS_PropertyStub, JS_PropertyStub, JS_PropertyStub, JS_PropertyStub,
JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub
JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub
};
/* __PH__BEGIN */
@ -329,6 +348,8 @@ PCB_GetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
/* start of perl call stuff */
gv = gv_fetchmeth(stash, prop_name, strlen(prop_name), -1);
/* better check and error report should be done here */
if (!gv) return JS_FALSE;
ENTER;
SAVETMPS;
@ -337,7 +358,7 @@ PCB_GetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
PUTBACK;
/* cnt = perl_call_sv(proc_sv, 0); */
cnt = perl_call_sv((SV*)GvCV(gv), 0);
cnt = perl_call_sv((SV*)GvCV(gv), G_ARRAY);
SPAGAIN;
/* adjust stack for use of ST macro (see perlcall) */
@ -348,7 +369,15 @@ PCB_GetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
if (cnt == 1) {
SVToJSVAL(cx, obj, ST(0), rval);
} else {
warn("sorry, but array properties are not supported yet...");
JSObject *jsarr;
jsval val;
int i;
jsarr = JS_NewArrayObject(cx, 0, NULL);
for (i = 0; i < cnt; i++) {
SVToJSVAL(cx, JS_GetGlobalObject(cx), ST(i), &val);
JS_DefineElement(cx, jsarr, i, val, NULL, NULL, 0);
}
*rval = OBJECT_TO_JSVAL(jsarr);
}
PUTBACK;
@ -394,7 +423,7 @@ PCB_SetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
XPUSHs(value_sv);
PUTBACK;
cnt = perl_call_sv(proc_sv, 0);
cnt = perl_call_sv(proc_sv, G_ARRAY);
SPAGAIN;
/* adjust stack for use of ST macro (see perlcall) */
@ -405,7 +434,15 @@ PCB_SetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
if (cnt == 1) {
SVToJSVAL(cx, obj, ST(0), rval);
} else {
warn("sorry, but array properties are not supported yet...");
JSObject *jsarr;
jsval val;
int i;
jsarr = JS_NewArrayObject(cx, 0, NULL);
for (i = 0; i < cnt; i++) {
SVToJSVAL(cx, JS_GetGlobalObject(cx), ST(i), &val);
JS_DefineElement(cx, jsarr, i, val, NULL, NULL, 0);
}
*rval = OBJECT_TO_JSVAL(jsarr);
}
PUTBACK;
@ -463,9 +500,8 @@ PCB_UniversalStub (JSContext *cx, JSObject *obj, uintN argc,
XPUSHs(sv);
}
PUTBACK;
cnt = perl_call_sv(SvRV(cbk->perl_proc), G_ARRAY | G_KEEPERR | G_EVAL);
cnt = perl_call_sv(SvRV(cbk->perl_proc), 0);
SPAGAIN;
/* adjust stack for use of ST macro (see perlcall) */
SP -= cnt;
@ -475,7 +511,15 @@ PCB_UniversalStub (JSContext *cx, JSObject *obj, uintN argc,
if (cnt == 1) {
SVToJSVAL(cx, obj, ST(0), rval);
} else {
warn("sorry, but array results are not supported yet...");
JSObject *jsarr;
jsval val;
int i;
jsarr = JS_NewArrayObject(cx, 0, NULL);
for (i = 0; i < cnt; i++) {
SVToJSVAL(cx, JS_GetGlobalObject(cx), ST(i), &val);
JS_DefineElement(cx, jsarr, i, val, NULL, NULL, 0);
}
*rval = OBJECT_TO_JSVAL(jsarr);
}
PUTBACK;
@ -483,7 +527,7 @@ PCB_UniversalStub (JSContext *cx, JSObject *obj, uintN argc,
LEAVE;
/* this solution is not perfect, but usefull when nested call happens */
return(! JS_IsExceptionPending(cx));
return(checkError(cx) && !JS_IsExceptionPending(cx));
};
/* __PH__END */
@ -629,6 +673,7 @@ JS_compileScript(cx, bytes, ...)
PREINIT:
JSContextItem *cxitem;
char *filename = NULL;
JSObject *scrobj;
CODE:
{
if (items > 2) { filename = SvPV(ST(2), PL_na); };
@ -643,6 +688,8 @@ JS_compileScript(cx, bytes, ...)
croak("JS script compilation failed");
XSRETURN_UNDEF;
}
//scrobj = JS_NewScriptObject(cx, RETVAL);
//JS_AddRoot(cx, &scrobj);
}
OUTPUT:
RETVAL

4
js/src/perlconnect/Makefile.PL
Просмотреть файл

@ -43,7 +43,7 @@ if ($foo{'m'}) {
my $objdir = `gmake -f tempmakefile`;
unlink "tempmakefile";
$inc = "-I.. -I../$objdir";
$libpath = "-L../objdir";
$libpath = "-L../$objdir";
}
}
@ -57,6 +57,8 @@ if ($^O eq "MSWin32") {
$define = '-DXP_UNIX';
}
print "+++> $libpath\n";
WriteMakefile(NAME => 'JS',
DEFINE => $define,
INC => $inc,

53
js/src/perlconnect/jsperl.c
Просмотреть файл

@ -541,6 +541,7 @@ PVCallStub (JSContext *cx, JSObject *obj, uintN argc,
fun = JS_ValueToFunction(cx, argv[-2]);
name = (char*) JS_GetFunctionName(fun);
stash = SvSTASH(SvRV(perl_object));
gv = gv_fetchmeth(stash, name, strlen(name), 0);
/* cnt = perl_call_pv(method_name, 0); */
@ -565,7 +566,7 @@ PVCallStub (JSContext *cx, JSObject *obj, uintN argc,
}
PUTBACK;
cnt = perl_call_sv((SV*)GvCV(gv), 0);
cnt = perl_call_sv((SV*)GvCV(gv), G_ARRAY | G_KEEPERR | G_EVAL);
//SvREFCNT_dec(perl_object);
@ -578,14 +579,23 @@ PVCallStub (JSContext *cx, JSObject *obj, uintN argc,
if (cnt == 1) {
SVToJSVAL(cx, obj, ST(0), rval);
} else {
warn("sorry, but array results are not supported yet...");
JSObject *jsarr;
jsval val;
int i;
jsarr = JS_NewArrayObject(cx, 0, NULL);
for (i = 0; i < cnt; i++) {
SVToJSVAL(cx, JS_GetGlobalObject(cx), ST(i), &val);
JS_DefineElement(cx, jsarr, i, val, NULL, NULL, 0);
}
*rval = OBJECT_TO_JSVAL(jsarr);
}
PUTBACK;
FREETMPS;
LEAVE;
return(JS_TRUE);
//return(JS_TRUE);
return checkError(cx);
}
/*
@ -595,7 +605,7 @@ PVCallStub (JSContext *cx, JSObject *obj, uintN argc,
first. *rval contains the result.
*/
/* __PH__
...but. PVGetproperty now firstly look for method in given
...but. PVGetproperty now firstly looks for method in given
object package. If such method if found, then is returned
universal method stub. Sideeffect of this behavior is, that
method are looked first before properties of the same name.
@ -610,7 +620,7 @@ PVGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
{
char* str;
/* __PH__ OK, array properties should be served first */
/* __PH__ array properties should be served first */
if(JSVAL_IS_INT(name)){
int32 ip;
@ -640,8 +650,8 @@ PVGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
}
}else{
int i;
/* __PH__ predefined methods have to win */
for(i=0;i<sizeof(predefined_methods)/sizeof(char*);i++){
/* __PH__ predefined methods NUST win */
for(i=0; i < sizeof(predefined_methods)/sizeof(char*); i++){
if(!strcmp(predefined_methods[i], str)){
return JS_TRUE;
}
@ -649,15 +659,15 @@ PVGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
/* __PH__ properties in hash should be served at last (possibly) */
PVGetKey(cx, obj, str, rval);
if(*rval!=JSVAL_VOID){
if (*rval!=JSVAL_VOID) {
return JS_TRUE;
}else{
} else {
#if 0
char* str = JS_GetStringBytes(JS_ValueToString(cx, name));
JS_ReportError(cx, "Perl: can't get property '%s'", str);
return JS_FALSE;
#else
/* when Volodya does another job, we can experiment :-) */
/* when Volodya does another job, we may experiment :-) */
char* str = JS_GetStringBytes(JS_ValueToString(cx, name));
/* great, but who will dispose it? (GC of JS??) */
JSFunction *fun = JS_NewFunction(cx, PVCallStub, 0, 0, NULL, str);
@ -715,7 +725,8 @@ PVGetElement(JSContext *cx, JSObject *obj, jsint index, jsval *rval)
if(!sv){
return JS_FALSE;
}
return SVToJSVAL(cx, obj, newRV_inc(*sv), rval);
//return SVToJSVAL(cx, obj, newRV_inc(*sv), rval);
return SVToJSVAL(cx, obj, *sv, rval);
}
/*
@ -817,14 +828,14 @@ PVToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval)
/*return perl_call(cx, obj, 2, args, rval);*/
if(type==SVt_PVAV){
if (type==SVt_PVAV) {
JSObject *arrayObject = JS_NewArrayObject(cx,0,NULL);
JSFunction *fun;
JS_GetProperty(cx, arrayObject, "toString", &v);
fun = JS_ValueToFunction(cx, v);
JS_CallFunction(cx, obj, fun, 0, NULL, rval);
}else{
} else {
char out[256];
JS_GetProperty(cx, obj, "type", &v);
if(!JSVAL_IS_VOID(v))
@ -838,7 +849,7 @@ PVToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval)
}
static JSBool
PVConvert(JSContext *cx, JSObject *obj, JSType type, jsval *rval)
PVConvert (JSContext *cx, JSObject *obj, JSType type, jsval *rval)
{
*rval = OBJECT_TO_JSVAL(obj);
return JS_TRUE;
@ -852,7 +863,7 @@ PVConvert(JSContext *cx, JSObject *obj, JSType type, jsval *rval)
/* #include <stdio.h> */
static void
PVFinalize(JSContext *cx, JSObject *obj)
PVFinalize (JSContext *cx, JSObject *obj)
{
/* SV* sv = SvRV(PVGetRef(cx, obj)); */
SV *sv;
@ -864,7 +875,7 @@ PVFinalize(JSContext *cx, JSObject *obj)
if ( SvROK(sv) ) sv = SvRV( sv ); _PH_ test*/
/* TODO: GC */
if(sv && SvREFCNT(sv)>0){
if(sv && SvREFCNT(sv) > 0){
/*fprintf(stderr, "Finilization: %d references left", SvREFCNT(sv));*/
SvREFCNT_dec(sv);
/*fprintf(stderr, "Finilization: %d references left", SvREFCNT(sv));*/
@ -957,12 +968,13 @@ SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval) {
SV *sv;
char* name=NULL;
/* we'll use the dereferrenced value (ecpet for object) */
/* we'll use the dereferrenced value (excpet for object) */
if( SvROK(ref) ) {
sv = SvRV(ref);
}else{
sv = ref;
}
/* printf("+++> In SVToJSVAL value %s, type=%d\n", SvPV(sv, PL_na), SvTYPE(sv)); */
if ( ! SvOK( ref ) ){
@ -971,6 +983,7 @@ SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval) {
} else
if ( SV_BIND_TO_OBJECT(ref) ) {
JSObject *perlValue, *prototype;
/*svtype type = SvTYPE(sv);
switch(type){
case SVt_RV: name = "Perl Reference"; break;
@ -988,12 +1001,15 @@ SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval) {
name = "Perl Value";
/* __PH__ */
SvREFCNT_inc(ref);
if (SvTYPE(sv) == SVt_PVAV)
prototype = JS_NewArrayObject(cx, 0, NULL);
else
prototype = NULL;
perlValue = JS_DefineObject(cx, obj, "PerlValue",
&perlValueClass, prototype, JSPROP_ENUMERATE);
&perlValueClass, prototype,
JSPROP_ENUMERATE);
JS_SetPrivate(cx, perlValue, ref);
JS_DefineFunctions(cx, perlValue, perlValueMethods);
JS_DefineProperty(cx, perlValue, "type",
@ -1016,6 +1032,5 @@ SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval) {
*rval = JSVAL_VOID; /* shouldn't happen */
/* printf("---> SVToJSVAL returning VOID (panic)\n"); */
}
return JS_TRUE;
}

6
js/src/perlconnect/test.pl
Просмотреть файл

@ -107,8 +107,10 @@ sub getHash {
package main;
use JS;
BEGIN
{ $| = 1; print "1..12\n"; }
BEGIN {
$| = 1; print "1..12\n";
}
END
{ print "not ok 1\n" unless $loaded; }

14
js/src/perlconnect/typemap
Просмотреть файл

@ -39,6 +39,7 @@ TYPEMAP
# These types have direct equivalents implemented as Perl packages
JSRuntime * RUNTIME
JSContext * CONTEXT
JSScript * SCRIPT
jsval jsval
# This is an auxilary type. Object serves as a wrapper for it
JSObject * OBJECT
@ -47,7 +48,7 @@ JSObject * OBJECT
OUTPUT
jsval
{
SV *foo;
SV *foo = sv_newmortal();
JSVALToSV(cx, JS_GetGlobalObject(cx), $var, &foo);
sv_setsv($arg, foo);
}
@ -58,6 +59,9 @@ OBJECT
CONTEXT
sv_setref_pv($arg, "JS::Context", (void*)$var);
SCRIPT
sv_setref_pv($arg, "JS::Script", (void*)$var);
RUNTIME
sv_setref_pv($arg, "JS::Runtime", (void*)$var);
@ -87,6 +91,14 @@ CONTEXT
XSRETURN_UNDEF;
}
SCRIPT
if(sv_isa($arg, \"JS::Script\"))
$var = ($type)SvIV((SV*)SvRV($arg));
else{
warn(\"${Package}::$func_name() -- $var is not a blessed JS::Script reference\");
XSRETURN_UNDEF;
}
RUNTIME
if(sv_isa($arg, \"JS::Runtime\"))
$var = ($type)SvIV((SV*)SvRV($arg));