r1689 - in packages/libjavascript-perl/branches/upstream/current: .
t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Mon Dec 19 15:13:30 UTC 2005
Author: eloy
Date: 2005-12-19 15:13:29 +0000 (Mon, 19 Dec 2005)
New Revision: 1689
Added:
packages/libjavascript-perl/branches/upstream/current/META.yml
packages/libjavascript-perl/branches/upstream/current/t/t90error.t
Modified:
packages/libjavascript-perl/branches/upstream/current/Changes
packages/libjavascript-perl/branches/upstream/current/JavaScript.pm
packages/libjavascript-perl/branches/upstream/current/JavaScript.pod
packages/libjavascript-perl/branches/upstream/current/JavaScript.xs
packages/libjavascript-perl/branches/upstream/current/MANIFEST
packages/libjavascript-perl/branches/upstream/current/Makefile.PL
packages/libjavascript-perl/branches/upstream/current/README
packages/libjavascript-perl/branches/upstream/current/t/t10class.t
packages/libjavascript-perl/branches/upstream/current/t/t50object.t
packages/libjavascript-perl/branches/upstream/current/typemap
Log:
Load /tmp/tmp.fkRTH3/libjavascript-perl-0.55 into
packages/libjavascript-perl/branches/upstream/current.
Modified: packages/libjavascript-perl/branches/upstream/current/Changes
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/Changes 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/Changes 2005-12-19 15:13:29 UTC (rev 1689)
@@ -17,3 +17,21 @@
- Fixed issues with package
- Fixed return from call
- Brought docs up to sync with implementation
+
+0.53 Fri Mar 18 19:49:25 CET 2005 (Joost Diepenmaat)
+ - Added JS_THREADSAFE define, which fixed bug on perl 5.8.5
+ thread-multi linux
+ - added tests for debian spidermonkey libs (debian users can
+ now do "apt-get install libsmjs-dev" and compile the module)
+ - Added JS_PROP_ACCESSOR
+ - Added conversion of boolean values from JS to Perl
+ - moved JS_THREADSAFE to Makefile.PL and made code handle handle
+ both cases (though it appears to be mandatory to get the code
+ to run on perl 5.8.6 threaded and unthreaded)
+ - Fixed a couple of alloc()s
+
+0.54 Tue Jun 29 11:50:00 CET 2005
+ - Make Makefile.PL play happy games with Gentoo (patch by sungo)
+
+0.55 Wed Jun 30 9:05:00 CET 2005
+ - Fixed error handling (patch by G. Allen Morris III)
Modified: packages/libjavascript-perl/branches/upstream/current/JavaScript.pm
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/JavaScript.pm 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/JavaScript.pm 2005-12-19 15:13:29 UTC (rev 1689)
@@ -18,6 +18,7 @@
package JavaScript::Context;
use strict;
+use Carp qw(croak);
sub new {
my ($class, $rt, $stacksize) = @_;
@@ -106,8 +107,19 @@
die "Argument 'properties' must be a hash reference\n" unless(ref($args{properties}) eq 'HASH');
# Make sure that all methods are valid, ie. they must be of integer type
- foreach(keys %{$args{properties}}) {
- die "Defined property '$_' is not numeric\n" unless($args{properties}->{$_} =~ /^\d+$/);
+ while (my($name,$opts) = each %{$args{properties}}) {
+ if (!ref($opts)) { # flags only
+ $opts ||= 0;
+ croak "Defined property '$name' is not numeric" unless($opts =~ /^\d+$/);
+ $opts = { flags => $opts};
+ $args{properties}->{$name} = $opts;
+
+ }
+ if ($opts->{JavaScript::JS_PROP_ACCESSOR()}) {
+ unless ( ref($opts->{getter}) eq 'CODE' and ref ($opts->{setter}) eq 'CODE') {
+ croak("getter and setter for propery '$name' must be code-refs");
+ }
+ }
}
} else {
$args{properties} = {};
@@ -122,7 +134,7 @@
unless(exists $args{package}) {
$args{package} = undef;
}
-
+
my $rval = BindPerlClassImpl($self->{impl}, $args{name}, $args{constructor}, $args{methods}, $args{properties}, $args{package}, $args{flags});
return $rval;
}
@@ -140,7 +152,9 @@
die "Argument isn't a CODE reference\n" unless(ref($sub) eq 'CODE');
- SetErrorCallbackImpl($self->{impl}, $sub);
+ $self->{_error_handler} = $sub;
+
+ SetErrorCallbackImpl($self->{impl}, $self->{_error_handler});
}
sub compile {
@@ -166,6 +180,7 @@
sub DESTROY {
my ($self) = @_;
+ delete $self->{_error_handler};
}
sub create_context {
@@ -200,15 +215,17 @@
our @EXPORT = qw(
JS_PROP_PRIVATE
JS_PROP_READONLY
+ JS_PROP_ACCESSOR
JS_CLASS_NO_INSTANCE
);
-our $VERSION = '0.52';
+our $VERSION = '0.55';
use vars qw($STACKSIZE $MAXBYTES $INITIALIZED);
use constant JS_PROP_PRIVATE => 0x1;
use constant JS_PROP_READONLY => 0x2;
+use constant JS_PROP_ACCESSOR => 0x4;
use constant JS_CLASS_NO_INSTANCE => 0x1;
BEGIN {
Property changes on: packages/libjavascript-perl/branches/upstream/current/JavaScript.pm
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libjavascript-perl/branches/upstream/current/JavaScript.pod
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/JavaScript.pod 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/JavaScript.pod 2005-12-19 15:13:29 UTC (rev 1689)
@@ -64,6 +64,10 @@
Sets that an objects property can't be set from JavaScript
+I<JS_PROP_ACCESSOR>
+
+Access to this property is by method calls.
+
I<JS_CLASS_NO_INSTANCE>
Sets that instances of this class can't be created from JavaScript
@@ -174,7 +178,22 @@
constructor => sub { return new Foo(@_); },
methods => {
bar => \&Foo::bar,
- baz => \&Foo::baz, },
+ baz => \&Foo::baz,
+ },
+ propoperties {
+ propa => {
+ flags => JS_PROP_ACCESSOR,
+ getter => \&Foo::get_prop_a,
+ setter => \&Foo::set_prop_a,
+ },
+ propb => {
+ flags => JS_PROP_READONLY | JS_PROP_ACCESSOR,
+ getter => \&Foo:get_prop_b,
+ },
+ propc => {
+ flags => JS_PROP_READONLY, # access hash directly
+ },
+ },
package => 'Foo'
);
@@ -268,18 +287,16 @@
JavaScript.pm has a mailing list at perl.org.
-You may subscribe by sending an empty email to perl-javascript-subscribe at perl.org (NOTE!! this is currently not working)
+You may subscribe by sending an empty email to perl-javascript-subscribe at perl.org
-=head2 Website
+=head1 THANKS
-JavaScript.pm has a website at http://labs.contiller.se/JavaScript/
+Joost Diepenmaat for fixing lots of stuff.
-=head2 IRC
+sungo for providing Makefile.PL fixes for Gentoo.
-Channel #javascript.pm on irc.infobot.org
+G. Allen Morris III for fixing error handling callbacks.
-=head1 THANKS
-
Mozilla Crew and Netscape for excellent SpiderMonkey JS engine.
#perl on irc.infobot.org for feedback and help.
@@ -288,12 +305,14 @@
Doesn't handle memory issues very well atm.
-=head1 AUTHOR
+=head1 AUTHOR(s)
-Claes Jacobsson, Contiller AB, claes at contiller.se
+Claes Jacobsson, claesjac at cpan.org
+Joost Diepenmaat, jdiepen at cpan.org
+
=head1 COPYRIGHT
-JavaScript.pm is Copyright 2001 Claes Jacobsson, Contiller AB. All right reserved.
+JavaScript.pm is Copyright 2001-2005 Claes Jacobsson. All rights reserved.
JavaScript.pm is free software; you may redistribute it and/or modify it under the same terms as Perl itself.
Modified: packages/libjavascript-perl/branches/upstream/current/JavaScript.xs
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/JavaScript.xs 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/JavaScript.xs 2005-12-19 15:13:29 UTC (rev 1689)
@@ -1,7 +1,11 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#ifdef INCLUDES_IN_SMJS
+#include <smjs/jsapi.h>
+#else
#include <jsapi.h>
+#endif
#include <malloc.h>
#define _IS_UNDEF(a) (SvANY(a) == SvANY(&PL_sv_undef))
@@ -10,6 +14,7 @@
#define JS_PROP_PRIVATE 0x1
#define JS_PROP_READONLY 0x2
+#define JS_PROP_ACCESSOR 0x4
#define JS_CLASS_NO_INSTANCE 0x1
/* Global class, does nothing */
@@ -39,8 +44,10 @@
typedef struct PCB_Method PCB_Method;
struct PCB_Property {
- char *name;
- I32 flags;
+ char *name;
+ I32 flags;
+ SV *getter; /* these are coderefs! */
+ SV *setter;
struct PCB_Property *next;
};
@@ -65,9 +72,9 @@
JSContext *cx; /* The JavaScript context which this instance belongs to */
PCB_Function *func_list; /* Pointer to the first callback item that is registered */
PCB_Class *class_list;
- SV *error;
struct PCB_Context *next; /* Pointer to the next created context */
struct PCB_Runtime *rt;
+ SV *error_handler;
};
typedef struct PCB_Context PCB_Context;
@@ -142,10 +149,16 @@
static PCB_Class *
PCB_GetClass(PCB_Context *cx, char *name) {
PCB_Class *ret = NULL;
-
+ if (!name) {
+ croak("No name specified in PCB_GetClass");
+ }
+
ret = cx->class_list;
while(ret) {
+ if (!ret->classname) {
+ croak("No ret->classname specified in PCB_GetClass");
+ }
if(strcmp(ret->classname, name) == 0) {
return ret;
}
@@ -156,6 +169,7 @@
return NULL;
}
+
static PCB_Class *
PCB_GetClassByPackage(PCB_Context *cx, char *package) {
PCB_Class *ret = NULL;
@@ -192,15 +206,16 @@
return NULL;
}
-static I32
-PCB_GetPropertyFlags(PCB_Class *cls, char *name) {
+
+static PCB_Property*
+PCB_GetPropertyStruct(PCB_Class *cls, char *name) {
PCB_Property *prop;
prop = cls->properties;
while(prop) {
if(strcmp(prop->name, name) == 0) {
- return prop->flags;
+ return prop;
}
prop = prop->next;
@@ -274,7 +289,9 @@
JSClass *jsc;
jsc = (JSClass*) calloc(1, sizeof(JSClass));
- jsc->name = (char *) calloc(strlen(name), sizeof(char));
+ if (!(jsc->name = (char *) calloc(strlen(name)+1, sizeof(char)))) {
+ croak("Can't allocate space for classname");
+ }
strcpy(jsc->name, name);
jsc->flags = JSCLASS_HAS_PRIVATE;
@@ -329,8 +346,11 @@
}
/* Extract constructor */
- jsclass = JS_GetClass(obj);
-
+#ifdef JS_THREADSAFE
+ jsclass = JS_GetClass(cx,obj);
+#else
+ jsclass = JS_GetClass(obj);
+#endif
/* Check if we are allowed to instanciate this class */
if((pl_class->flags & JS_CLASS_NO_INSTANCE)) {
JS_ReportError(cx, "Class '%s' can't be instanciated", jsclass->name);
@@ -396,8 +416,12 @@
if(!(context = PCB_GetContext(cx))) {
croak("Can't get context\n");
}
+#ifdef JS_THREADSAFE
+ jsclass = JS_GetClass(cx,obj);
+#else
+ jsclass = JS_GetClass(obj);
+#endif
- jsclass = JS_GetClass(obj);
if(!(pl_class = PCB_GetClass(context, jsclass->name))) {
croak("Can't find class\n");
@@ -459,101 +483,140 @@
static JSBool
PCB_GetProperty(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
- PCB_Context *context;
- PCB_Class *pl_class;
+ PCB_Context *context;
+ PCB_Class *pl_class;
- SV *pobj;
- char *keyname;
- JSClass *jsclass;
- I32 flags;
+ SV *pobj;
+ char *keyname;
+ JSClass *jsclass;
- keyname = JS_GetStringBytes(JSVAL_TO_STRING(id));
+ PCB_Property *prop;
+ dSP;
- pobj = (SV *) JS_GetPrivate(cx, obj);
+ keyname = JS_GetStringBytes(JSVAL_TO_STRING(id));
- if(SvROK(pobj)) {
- if(SvTYPE(SvRV(pobj)) == SVt_PVHV) {
- HV *hv_obj;
- SV **keyval;
+ pobj = (SV *) JS_GetPrivate(cx, obj);
- hv_obj = (HV *) SvRV(pobj);
+ if(SvROK(pobj) && sv_isobject(pobj)) {
+ if(!(context = PCB_GetContext(cx))) {
+ croak("Can't get context\n");
+ }
- if(hv_exists(hv_obj, keyname, strlen(keyname))) {
- /* Find property */
- if(sv_isobject(pobj)) {
- if(!(context = PCB_GetContext(cx))) {
- croak("Can't get context\n");
- }
+#ifdef JS_THREADSAFE
+ jsclass = JS_GetClass(cx,obj);
+#else
+ jsclass = JS_GetClass(obj);
+#endif
- jsclass = JS_GetClass(obj);
+ if(!(pl_class = PCB_GetClass(context, jsclass->name))) {
+ croak("Can't find class\n");
+ }
- if(!(pl_class = PCB_GetClass(context, jsclass->name))) {
- croak("Can't find class\n");
- }
+ prop = PCB_GetPropertyStruct(pl_class, keyname);
+ if (!prop) {
+ return JS_FALSE;
+ }
+ if(prop->flags & JS_PROP_ACCESSOR) {
+ SV * value;
- flags = PCB_GetPropertyFlags(pl_class, keyname);
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs(pobj);
+ PUTBACK;
+ if (call_sv(SvRV(prop->getter),G_SCALAR) != 1) {
+ croak("No value returned by getter for property %s!",keyname);
+ }
+ SPAGAIN;
+ value = POPs;
+ SVToJSVAL(cx, obj, value, vp);
+ PUTBACK ;
+ FREETMPS ;
+ LEAVE ;
+ }
+ else if(SvTYPE(SvRV(pobj)) == SVt_PVHV) {
+ HV *hv_obj;
+ SV **keyval;
- }
-
- keyval = hv_fetch(hv_obj, keyname, strlen(keyname), 0);
-
- SVToJSVAL(cx, obj, *keyval, vp);
- }
- }
- }
+ hv_obj = (HV *) SvRV(pobj);
- return JS_TRUE;
+ if(hv_exists(hv_obj, keyname, strlen(keyname))) {
+ keyval = hv_fetch(hv_obj, keyname, strlen(keyname), 0);
+
+ SVToJSVAL(cx, obj, *keyval, vp);
+ }
+ }
+ }
+
+ return JS_TRUE;
}
static JSBool
PCB_SetProperty(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
- PCB_Context *context;
- PCB_Class *pl_class;
- JSClass *jsclass;
- SV *pobj;
- char *keyname;
- I32 flags;
+ dSP;
+ PCB_Context *context;
+ PCB_Class *pl_class;
+ JSClass *jsclass;
+ SV *pobj;
+ char *keyname;
+ PCB_Property *prop;
- keyname = JS_GetStringBytes(JSVAL_TO_STRING(id));
+ keyname = JS_GetStringBytes(JSVAL_TO_STRING(id));
- pobj = (SV *) JS_GetPrivate(cx, obj);
+ pobj = (SV *) JS_GetPrivate(cx, obj);
- if(SvROK(pobj)) {
- if(SvTYPE(SvRV(pobj)) == SVt_PVHV) {
- HV *hv_obj;
- SV *value = newSViv(0);
-
- hv_obj = (HV *) SvRV(pobj);
+ if(SvROK(pobj)) {
+ if(!(context = PCB_GetContext(cx))) {
+ croak("Can't get context\n");
+ }
+#ifdef JS_THREADSAFE
+ jsclass = JS_GetClass(cx,obj);
+#else
+ jsclass = JS_GetClass(obj);
+#endif
- if(hv_exists(hv_obj, keyname, strlen(keyname))) {
- /* Find property */
- if(sv_isobject(pobj)) {
- if(!(context = PCB_GetContext(cx))) {
- croak("Can't get context\n");
- }
- jsclass = JS_GetClass(obj);
- if(!(pl_class = PCB_GetClass(context, jsclass->name))) {
- croak("Can't find class\n");
- }
+ if(!(pl_class = PCB_GetClass(context, jsclass->name))) {
+ croak("Can't find class\n");
+ }
- flags = PCB_GetPropertyFlags(pl_class, keyname);
+ prop = PCB_GetPropertyStruct(pl_class, keyname);
+ if (!prop) {
+ return JS_FALSE;
+ }
- if(flags & JS_PROP_READONLY) {
- JS_ReportError(cx, "Property '%s' is readonly\n", keyname);
- return JS_FALSE;
- }
- }
+ if(prop->flags & JS_PROP_READONLY) {
+ JS_ReportError(cx, "Property '%s' is readonly\n", keyname);
+ return JS_FALSE;
+ }
+ if(prop->flags & JS_PROP_ACCESSOR) {
+ SV * value;
- JSVALToSV(cx, obj, *vp, &value);
- hv_store(hv_obj, keyname, strlen(keyname), value, 0);
- }
- }
- }
+ value = newSViv(0);
+
+ JSVALToSV(cx, obj, *vp, &value);
+ PUSHMARK(SP);
+ XPUSHs(pobj);
+ XPUSHs(sv_2mortal(value)) ;
+ PUTBACK;
+ call_sv(SvRV(prop->setter),G_DISCARD);
+ }
+ else if(SvTYPE(SvRV(pobj)) == SVt_PVHV) {
+ HV *hv_obj;
+ SV *value = newSViv(0);
+
+ hv_obj = (HV *) SvRV(pobj);
+
+ JSVALToSV(cx, obj, *vp, &value);
+ hv_store(hv_obj, keyname, strlen(keyname), value, 0);
+ }
+ }
+ return JS_TRUE;
}
static void
@@ -581,7 +644,7 @@
perl_class->package = NULL;
if(pkname != NULL) {
- perl_class->package = (char *) calloc(strlen(pkname) + 1, sizeof(char));
+ perl_class->package = (char *) calloc(strlen(pkname) + 1, sizeof(char));
perl_class->package = strcpy(perl_class->package, pkname);
}
@@ -600,32 +663,83 @@
I32 flags;
PCB_Property *prop = NULL;
+ HV *property_hv;
+ SV **property_value;
HV *properties_hv = (HV *) SvRV(properties);
-
hvlen = hv_iterinit(properties_hv);
+
while((heelem = hv_iternext(properties_hv)) != NULL) {
keyname = hv_iterkey(heelem, &keylen);
svelem = hv_iterval(properties_hv, heelem);
- if(SvIOK(svelem) && keylen) {
- if(SvIV(svelem) & (JS_PROP_PRIVATE | JS_PROP_READONLY)) {
- prop = (PCB_Property *) malloc(sizeof(PCB_Property));
-
- /* Copy the name of the property so we can identify it */
- prop->name = (char *) calloc(strlen(keyname), sizeof(char));
- strcpy(prop->name, keyname);
+ if(SvROK(svelem) && SvTYPE(SvRV(svelem)) == SVt_PVHV) {
+ property_hv = (HV*) SvRV(svelem);
+
+ if (property_value = hv_fetch(property_hv,"flags",5,0)) {
+ if(SvIOK(*property_value)) {
+ prop = (PCB_Property *) calloc(1,sizeof(PCB_Property));
- /* Set flags to supplied value in properties hash */
- prop->flags = SvIV(svelem);
-
- prop->next = perl_class->properties;
- perl_class->properties = prop;
- }
- }
+ /* Copy the name of the property so we can identify it */
+ prop->name = (char *) calloc(strlen(keyname)+1, sizeof(char));
+ strcpy(prop->name, keyname);
+
+ /* Set flags to supplied value in properties hash */
+ prop->flags = SvIV(*property_value);
+
+ prop->next = perl_class->properties;
+ perl_class->properties = prop;
+ }
+ else {
+ croak("No valid flags for property %s (must be integer)",keyname);
+ }
+ }
+ else {
+ croak("No flags for property %s",keyname);
+ }
+
+ if (prop->flags & JS_PROP_ACCESSOR) {
+ if (property_value = hv_fetch(property_hv,"getter",6,0)) {
+ if (SvROK(*property_value) &&
+ SvTYPE(SvRV(*property_value)) == SVt_PVCV) {
+
+ /* insert setter gunction */
+ prop->getter = *property_value;
+ SvREFCNT_inc(prop->getter);
+ }
+ else {
+ croak("Getter for property %s must be coderef");
+ }
+ }
+ else {
+ croak("No getter for property %s",keyname);
+ }
+ if (! (prop->flags & JS_PROP_READONLY)) {
+ if (property_value = hv_fetch(property_hv,"setter",6,0)) {
+ if (SvROK(*property_value) &&
+ SvTYPE(SvRV(*property_value)) == SVt_PVCV) {
+
+ /* insert setter gunction */
+ prop->setter = *property_value;
+ SvREFCNT_inc(prop->setter);
+ }
+ else {
+ croak("Setter for property %s must be coderef");
+ }
+ }
+ else {
+ croak("No setter for property %s",keyname);
+ }
+ }
+ }
+
+ }
+ else {
+ croak("Property %s must be hashref",keyname);
+ }
}
}
-
+
/* Create method spec array */
if(SvROK(methods)) {
if(SvTYPE(SvRV(methods)) == SVt_PVHV) {
@@ -652,15 +766,19 @@
methods_cnt++;
}
+ else {
+ croak("Invalid method");
+ }
}
}
/* Set index to zero */
idx = 0;
-
+ /* always reserve space for empty def at end (see below) */
+ jsmethods = (JSFunctionSpec *) calloc(methods_cnt + 1, sizeof(JSFunctionSpec));
+
if(methods_cnt) {
/* Assume all keys are code references */
- jsmethods = (JSFunctionSpec *) calloc(methods_cnt + 1, sizeof(JSFunctionSpec));
/* Add methods */
hvlen = hv_iterinit(methods_hv);
@@ -677,7 +795,7 @@
spec = &jsmethods[idx];
/* Woohoo, code reference */
- spec->name = (char *) calloc(strlen(keyname), sizeof(char));
+ spec->name = (char *) calloc(strlen(keyname)+1, sizeof(char));
spec->name = strcpy((char *)spec->name, keyname);
@@ -693,7 +811,7 @@
pmethod = (PCB_Method *) calloc(1, sizeof(PCB_Method));
- pmethod->js_native_name = (char *) calloc(strlen(keyname), sizeof(char));
+ pmethod->js_native_name = (char *) calloc(strlen(keyname)+1, sizeof(char));
pmethod->js_native_name = strcpy(pmethod->js_native_name, keyname);
pmethod->pl_func_reference = svelem;
pmethod->next = perl_class->methods;
@@ -713,10 +831,11 @@
}
perl_class->jsclass = jsclass;
+
perl_class->base_obj = JS_InitClass(cx, JS_GetGlobalObject(cx), NULL, perl_class->jsclass, PCB_InstancePerlClassStub, 0, NULL, jsmethods, NULL, NULL);
if(perl_class->base_obj == NULL) {
+ warn("perl_class->base_obj == NULL");
}
-
perl_class->next = context->class_list;
context->class_list = perl_class;
@@ -831,6 +950,7 @@
SVToJSVAL(cx, obj, keyval, &elem);
if(!JS_DefineProperty(cx, new_obj, keyname, elem, NULL, NULL, JSPROP_ENUMERATE)) {
+ warn("Could not create property %%",keyval);
}
}
@@ -859,7 +979,7 @@
*rval = PRIVATE_TO_JSVAL(ref);
} else if(type == SVt_PV || type == SVt_IV || type == SVt_NV || type == SVt_RV) {
/* Not very likely to return a reference to a primitive type, but we need to support that aswell */
-
+ warn("returning references to primitive types is not supported yet");
}
}
@@ -878,9 +998,14 @@
sv_setnv(*sv, *JSVAL_TO_DOUBLE(v));
} else if(JSVAL_IS_STRING(v)){
sv_setpv(*sv, JS_GetStringBytes(JSVAL_TO_STRING(v)));
+ } else if(JSVAL_IS_BOOLEAN(v)) {
+ if (JSVAL_TO_BOOLEAN(v)) {
+ *sv = &PL_sv_yes;
+ } else {
+ *sv = &PL_sv_no;
+ }
} else {
-
- warn("Unknown primitive type");
+ croak("Unknown primitive type");
}
} else {
if(JSVAL_IS_OBJECT(v)) {
@@ -932,7 +1057,17 @@
av_push(av, newSVnv(*JSVAL_TO_DOUBLE(elem)));
} else if(JSVAL_IS_STRING(elem)) {
av_push(av, newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(elem)), 0));
- }
+ } else if(JSVAL_IS_BOOLEAN(elem)) {
+ if (JSVAL_TO_BOOLEAN(elem)) {
+ av_push(av, &PL_sv_yes);
+ } else {
+ av_push(av, &PL_sv_no);
+ }
+ } else {
+ croak("Unkown primitive type");
+ }
+
+
} else {
if(JSVAL_IS_OBJECT(elem)) {
JSObject *lobject = JSVAL_TO_OBJECT(elem);
@@ -985,7 +1120,16 @@
hv_store(hv, js_key, strlen(js_key), newSVnv(*JSVAL_TO_DOUBLE(value)), 0);
} else if(JSVAL_IS_STRING(value)) {
hv_store(hv, js_key, strlen(js_key), newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(value)), 0), 0);
- }
+ } else if(JSVAL_IS_BOOLEAN(value)) {
+ if (JSVAL_TO_BOOLEAN(value)) {
+ hv_store(hv, js_key, strlen(js_key), &PL_sv_yes, 0);
+ } else {
+ hv_store(hv, js_key, strlen(js_key), &PL_sv_no, 0);
+ }
+ } else {
+ croak("Unknown primitive type");
+ }
+
} else {
if(JSVAL_IS_OBJECT(value)) {
JSObject *lobject = JSVAL_TO_OBJECT(value);
@@ -1010,28 +1154,28 @@
/* Error rapporting */
static void
PCB_ErrorReporter(JSContext *cx, const char *message, JSErrorReport *report) {
- fprintf(stderr, "%s at line %d: %s\n", message, report->lineno, report->linebuf);
-
-/* PCB_Context *context;
+ PCB_Context *context;
SV *errfunc;
dSP;
context = PCB_GetContext(cx);
- if(context != null) {
- errfunc = context->error;
-
+ if (context != NULL) {
+ if (context->error_handler) {
ENTER ;
SAVETMPS ;
PUSHMARK(SP) ;
- XPUSHs(newSVpv(message, strlen(message));
- XPUSHs(newSViv(report->lineno);
- XPUSHs(newSVpv(report->linebuf, strlen(report->linebuf));
+ XPUSHs(newSVpv(message, strlen(message)));
+ XPUSHs(newSViv(report->lineno));
+ if (report->linebuf) {
+ XPUSHs(newSVpv(report->linebuf, strlen(report->linebuf)));
+ }
PUTBACK;
-
- perl_call_sv(SvRV(context->error), G_SCALAR);
- } */
+ perl_call_sv(SvRV(context->error_handler), G_DISCARD);
+ } else
+ fprintf(stderr, "%s at line %d: %s\n", message, report->lineno, report->linebuf);
+ }
}
/* Calls a Perl function which is bound to a JavaScript function */
@@ -1137,7 +1281,7 @@
croak("Callback is not a reference\n");
} else {
if(SvTYPE(SvRV(function)) == SVt_PVCV) {
- cx->error = function;
+ cx->error_handler = function;
} else {
croak("Callback is not a code reference\n");
}
@@ -1176,6 +1320,9 @@
if(SvTRUE(package) && SvPOK(package)) {
pkname = SvPV_nolen(package);
}
+ else {
+ croak("No package specified");
+ }
PCB_AddPerlClass(cx, classname, constructor, methods, properties, SvIV(flags), pkname);
RETVAL = 1;
@@ -1196,7 +1343,7 @@
char *pname = HvNAME(stash);
if(!(pjsc = PCB_GetClassByPackage(cx, pname))) {
- croak("Missing class definition");
+ croak("Missing class definition for %_",object);
}
SvREFCNT_inc(object);
Property changes on: packages/libjavascript-perl/branches/upstream/current/JavaScript.xs
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libjavascript-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/MANIFEST 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/MANIFEST 2005-12-19 15:13:29 UTC (rev 1689)
@@ -16,3 +16,5 @@
t/t60can.t
t/t70file.js
t/t70file.t
+t/t90error.t
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libjavascript-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/META.yml 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/META.yml 2005-12-19 15:13:29 UTC (rev 1689)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: JavaScript
+version: 0.55
+version_from: JavaScript.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libjavascript-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/Makefile.PL 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/Makefile.PL 2005-12-19 15:13:29 UTC (rev 1689)
@@ -2,24 +2,50 @@
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
+$define = "";
# Make sure we know what platform we are compiling for
if($^O eq 'MSWin32') {
- $define = "-DXP_PC";
+ $define .= " -DXP_PC";
} else {
- $define = "-DXP_UNIX";
+ $define .= " -DXP_UNIX";
}
+my $inc = '';
+
+if(-f "/etc/gentoo-release") {
+ # Gentoo puts libjs in a slightly hidden spot.
+ $inc = '-I/usr/lib/MozillaFirefox/include/js/ -I/usr/lib/MozillaFirefox/';
+}
+
+#test for debian type include files...
+if (-f "/usr/include/smjs/jsapi.h" or -f "/usr/local/include/smjs/jsapi.h") {
+ $define .= " -DINCLUDES_IN_SMJS"
+}
+
+if($ENV{JS_THREADSAFE}) {
+ $define .= " -DJS_THREADSAFE";
+}
+
+my $lib = "-ljs";
+#test for debian type libsmjs
+#this could probably be done better, but I'm not sure how to
+#get this platform independant
+if (-f "/usr/lib/libsmjs.so" or -f "/usr/local/lib/libsmjs.so") {
+ $lib = "-lsmjs";
+}
+
+
WriteMakefile(
'NAME' => 'JavaScript',
'VERSION_FROM' => 'JavaScript.pm', # finds $VERSION
'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'JavaScript.pm', # retrieve abstract from module
- AUTHOR => 'A. U. Thor <a.u.thor at a.galaxy.far.far.away>') : ()),
- 'LIBS' => ['-ljs'], # e.g., '-lm'
+ AUTHOR => 'claesjac at cpan.org>') : ()),
+ 'LIBS' => [$lib], # e.g., '-lm'
'DEFINE' => $define, # e.g., '-DHAVE_SOMETHING'
# Insert -I. if you add *.h files later:
- 'INC' => '', # e.g., '-I/usr/include/other'
+ 'INC' => $inc, # e.g., '-I/usr/include/other'
# Un-comment this if you add C files to link with later:
# 'OBJECT' => '$(O_FILES)', # link all the C files too
);
Property changes on: packages/libjavascript-perl/branches/upstream/current/Makefile.PL
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libjavascript-perl/branches/upstream/current/README
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/README 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/README 2005-12-19 15:13:29 UTC (rev 1689)
@@ -24,9 +24,11 @@
-------------
INSTALLATION:
-To install JavaScript.pm, make sure you have libjs installed. Otherwize, grab a recent one from
-ftp://ftp.mozilla.org/pub/js. The module is tested with 1.5 and later.
+To install JavaScript.pm, make sure you have libjs installed. Otherwize, grab a recent one from ftp://ftp.mozilla.org/pub/js. The module is tested with 1.5 and later.
+Debian users can alternatively install the libsmjs-dev package by doing
+> apt-get install libsmjs-dev
+
Once libjs is installed and jsapi.h and other necessery headers can be found do:
> perl Makefile.PL
@@ -34,6 +36,7 @@
> make test
> make install
+If you're getting errors in make test that looks something like "Assertion failure: (uint32)2 < JS_MIN(((obj)->map)->freeslot, ((obj)->map)->nslots), at jsapi.c:1969" you probablly have a libjs built with JS_THREADSAFE. To fix the problem set the environment vairable JS_THREADSAFE before running perl Makefile.PL. This should fix the problem.
--------------
DOCUMENTATION:
@@ -42,29 +45,26 @@
> perldoc JavaScript
-
------------
INFORMATION:
-= Official website is http://labs.contiller.se/JavaScript/
-= Support is available on IRC on channel #javascript.pm on irc.infobot.org
= Mailing list is on the way, perl-javascript at perl.org, send an empty email to perl-javascript-subscribe at perl.org
-Please send questions/patches/docs/comments to "Claes Jacobsson", CLAESJAC at cpan.org
+Please send questions/patches/docs/comments to "Claes Jacobsson", claesjac at cpan.org
-
-------
THANKS:
+Joost Diepenmaat for fixing lots of stuff.
+
SpiderMonkey creators at Netscape and Mozilla.org
#perl on irc.infobot.org for support and feedback (ingy, Addi, sky, Co-Kane, sheriff_p, crab and everyone else i forgot to mention).
-
COPYRIGHT:
----------
-Copyright (c) 2001, Claes Jacobsson, All Rights Reserved.
+Copyright (c) 2001-2005, Claes Jacobsson, All Rights Reserved.
JavaScript.pm is free software; you may redistribute it and/or modify
it under the same conditions as perl itself.
Property changes on: packages/libjavascript-perl/branches/upstream/current/t/t10class.t
___________________________________________________________________
Name: svn:executable
-
+ *
Modified: packages/libjavascript-perl/branches/upstream/current/t/t50object.t
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/t/t50object.t 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/t/t50object.t 2005-12-19 15:13:29 UTC (rev 1689)
@@ -1,6 +1,6 @@
package Foo;
use strict;
-
+use warnings;
sub new { return bless {}, __PACKAGE__; }
sub bar {
my $self = shift;
@@ -12,11 +12,23 @@
return "five";
}
+sub getWrap {
+ my ($self) = @_;
+ $self->{"getter_called"} = 1;
+ $self->{"wrapped"};
+}
+
+sub setWrap {
+ my ($self,$value) = @_;
+ $self->{"setter_called"} = 1;
+ $self->{"wrapped"} = $value;
+}
+
use Test;
use strict;
# How many tests
-BEGIN { plan tests => 5 };
+BEGIN { plan tests => 16 };
# Load JavaScript module
use JavaScript;
@@ -33,13 +45,21 @@
ok(1);
$context->bind_class(
- name => 'Foo',
- constructor => sub { return new Foo(); },
- methods => {
- bar => \&Foo::bar,
- baz => \&Foo::baz,
- },
- package => 'Foo'
+ name => 'Foo',
+ constructor => sub { return new Foo(); },
+ methods => {
+ bar => \&Foo::bar,
+ baz => \&Foo::baz,
+ },
+ properties => {
+ std => 0,
+ wrapped_value => {
+ flags => JS_PROP_ACCESSOR,
+ setter => Foo->can('setWrap'),
+ getter => Foo->can('getWrap'),
+ },
+ },
+ package => 'Foo'
);
my $foo = new Foo();
@@ -62,3 +82,51 @@
!);
ok(1);
+
+$context->eval(q{
+FooSan.std = 1;
+});
+
+ok($foo->{std} == 1);
+
+$foo->{std} = 3;
+
+ok($context->eval(q{ FooSan.std }) == 3);
+
+
+
+
+
+$context->eval(q!
+FooSan.wrapped_value = 1;
+!);
+
+ok($foo->{"setter_called"});
+
+
+ok($foo->{wrapped} == 1);
+
+
+ok($context && ref($context)); # somehow disappeared during development
+
+$foo->{wrapped} = 2;
+
+ok($context->eval(q{
+ FooSan.wrapped_value
+}) == 2);
+ok($foo->{"getter_called"});
+
+ok($context && ref($context)); # somehow disappeared during development
+
+
+$context->eval(q{
+FooSan.wrapped_value = FooSan.wrapped_value + 1;
+});
+ok($foo->{"getter_called"});
+
+ok($context && ref($context)); # somehow disappeared during development
+
+
+ok($foo->{wrapped} == 3);
+
+
Added: packages/libjavascript-perl/branches/upstream/current/t/t90error.t
===================================================================
--- packages/libjavascript-perl/branches/upstream/current/t/t90error.t 2005-12-17 19:02:56 UTC (rev 1688)
+++ packages/libjavascript-perl/branches/upstream/current/t/t90error.t 2005-12-19 15:13:29 UTC (rev 1689)
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+
+use Data::Dumper qw(Dumper);
+
+# How many tests
+BEGIN { plan tests => 5 };
+
+# Load JavaScript module
+use JavaScript;
+
+# First test, JavaScript has set up properly
+ok(1);
+
+# Create a new runtime
+my $runtime = new JavaScript::Runtime();
+ok(1);
+
+# Create a new context
+my $context = $runtime->create_context();
+ok(1);
+
+our $test = 0;
+$context->set_error_handler( sub { $test++; print "# ", join(':', @_), "\n"; return 1; } );
+
+ok(1);
+
+$context->eval(<<EOP);
+
+"bobabasdfasd";
+
+joe;
+
+EOP
+
+ok($test == 1);
Property changes on: packages/libjavascript-perl/branches/upstream/current/typemap
___________________________________________________________________
Name: svn:executable
-
+ *
More information about the Pkg-perl-cvs-commits
mailing list