OSSP CVS Repository

ossp - Check-in [5444]
Not logged in
[Honeypot]  [Browse]  [Home]  [Login]  [Reports
[Search]  [Ticket]  [Timeline
  [Patchset]  [Tagging/Branching

Check-in Number: 5444
Date: 2005-Nov-25 09:16:37 (local)
2005-Nov-25 08:16:37 (UTC)
User:rse
Branch:
Comment: Import new upstream version: Mozilla JavaScript 1.6-1.5.0.5-20060722
Tickets:
Inspections:
Files:
ossp-pkg/js/src/perlconnect/JS.xs      1.1 -> 1.1.1.1    
ossp-pkg/js/src/perlconnect/JS.xs      added-> 1.1

ossp-pkg/js/src/perlconnect/JS.xs -> 1.1

*** /dev/null    Sat Nov 23 08:41:24 2024
--- -    Sat Nov 23 08:41:37 2024
***************
*** 0 ****
--- 1,1050 ----
+ /* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*-
+  *
+  * ***** BEGIN LICENSE BLOCK *****
+  * Version: MPL 1.1/GPL 2.0/LGPL 2.1
+  *
+  * The contents of this file are subject to the Mozilla Public License Version
+  * 1.1 (the "License"); you may not use this file except in compliance with
+  * the License. You may obtain a copy of the License at
+  * http://www.mozilla.org/MPL/
+  *
+  * Software distributed under the License is distributed on an "AS IS" basis,
+  * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  * for the specific language governing rights and limitations under the
+  * License.
+  *
+  * The Original Code is Mozilla Communicator client code, released
+  * March 31, 1998.
+  *
+  * The Initial Developer of the Original Code is
+  * Netscape Communications Corporation.
+  * Portions created by the Initial Developer are Copyright (C) 1998
+  * the Initial Developer. All Rights Reserved.
+  *
+  * Contributor(s):
+  *
+  * Alternatively, the contents of this file may be used under the terms of
+  * either the GNU General Public License Version 2 or later (the "GPL"), or
+  * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+  * in which case the provisions of the GPL or the LGPL are applicable instead
+  * of those above. If you wish to allow use of your version of this file only
+  * under the terms of either the GPL or the LGPL, and not to allow others to
+  * use your version of this file under the terms of the MPL, indicate your
+  * decision by deleting the provisions above and replace them with the notice
+  * and other provisions required by the GPL or the LGPL. If you do not delete
+  * the provisions above, a recipient may use your version of this file under
+  * the terms of any one of the MPL, the GPL or the LGPL.
+  *
+  * ***** END LICENSE BLOCK ***** */
+ 
+ /*
+  * PerlConnect. Provides means for OO Perl <==> JS communications
+  */
+ 
+ /* This is an program written in XSUB. You need to compile it using xsubpp   */
+ /* usually found in your perl\bin directory. On my machine I do it like this:*/
+ /*      perl c:\perl\lib\ExtUtils\xsubpp  -typemap  \                        */
+ /*           c:\perl\lib\extutils\typemap -typemap typemap JS.xs > JS.c      */
+ /* See perlxs man page for details.                                          */
+ /* Don't edit the resulting C file directly. See README.html for more info   */
+ /* on PerlConnect in general                                                 */
+ 
+ #ifdef __cplusplus
+     extern "C"; {
+ #endif
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+ #ifdef __cplusplus
+     }
+ #endif
+ 
+ #include <jsapi.h>
+ #include "jsperlpvt.h"
+ #include <malloc.h>
+ 
+ /* __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;
+ }
+ 
+ static void
+ clearException(JSContext *cx) 
+ {
+     if (JS_IsExceptionPending(cx)) {
+         JS_ClearPendingException(cx);
+     }
+ }
+ 
+ /************************************************************/
+ /* calback stub */
+ 
+ /* this is internal js structure needed in errorFromPrivate */
+ typedef struct JSExnPrivate {
+     JSErrorReport *errorReport;
+ } JSExnPrivate;
+ 
+ static
+ JSClass global_class = {
+     "Global", 0,
+     JS_PropertyStub,  JS_PropertyStub,  JS_PropertyStub,  JS_PropertyStub,
+     JS_EnumerateStub, JS_ResolveStub,   JS_ConvertStub, JS_FinalizeStub
+ };
+ 
+ /* __PH__BEGIN  */
+ /* perl callback structure */
+ /* prefix PCB means Perl CallBack */
+ 
+ struct PerlCallbackItem{
+     char*  name;
+     SV*    perl_proc;
+     int    param_num;
+     struct PerlCallbackItem *next;
+ };
+ 
+ typedef struct PerlCallbackItem PerlCallbackItem;
+ 
+ 
+ struct PerlObjectItem {
+     char * name;
+     SV* pObject;
+     //JSObject *jsStub;
+     JSObject *jsObject;
+     JSClass *jsClass;
+     struct PerlCallbackItem* vector;
+     struct PerlObjectItem *next;
+ };
+ 
+ typedef struct PerlObjectItem PerlObjectItem;
+ 
+ /* error reporter */
+ //struct JSContextItem;
+ //struct JSContextItem;
+ struct  JSContextItem {
+     JSContext *cx;
+     SV *errorReporter;
+     PerlObjectItem *objects;
+     int dieFromErrors;
+     struct JSContextItem* next;
+ };
+ 
+ typedef struct JSContextItem JSContextItem;
+ 
+ static JSContextItem *context_list = NULL;
+ 
+ static JSContextItem*
+ PCB_NewContextItem() {
+     JSContextItem *ret;
+     ret = (JSContextItem*)calloc(1, sizeof(JSContextItem));
+     return ret;
+ }
+ 
+ static JSContextItem*
+ PCB_FindContextItem (JSContext *cx) {
+     JSContextItem *cxitem =  context_list;
+     while ( cxitem ) {
+         if (cxitem->cx == cx ) return cxitem;
+         cxitem = cxitem->next;
+     }
+     return NULL;
+ }
+ 
+ static  SV*
+ PCB_FindErrorReporter (JSContext *cx) {
+     JSContextItem *cxitem;
+     if (cxitem = PCB_FindContextItem(cx)) {
+         return cxitem->errorReporter;
+     } else {
+         return NULL;
+     }
+ }
+ 
+ static void
+ PCB_ErrorReporter(JSContext *cx, const char *message, JSErrorReport *report)
+ {
+     SV *report_proc;
+     if ( report_proc = PCB_FindErrorReporter(cx) ) {
+         dSP;
+         PUSHMARK(SP);
+         XPUSHs(sv_2mortal(newSVpv((char*)message, 0)));
+         if ( report ) {
+             if ( report->filename ) {
+                 XPUSHs(sv_2mortal(newSVpv((char*)report->filename, 0)));
+             }
+             XPUSHs(sv_2mortal(newSViv(report->lineno)));
+             if (report->linebuf) {
+                 XPUSHs(sv_2mortal(newSVpv((char*)report->linebuf, 0)));
+                 XPUSHs(sv_2mortal(newSVpv((char*)report->tokenptr, 0)));
+             }
+         }
+         PUTBACK;
+         perl_call_sv(report_proc, G_VOID | G_DISCARD);
+     } else {
+         warn(message);
+     }
+ }
+ 
+ /* perl object stuff */
+ 
+ 
+ /* functions for callback list handling */
+ static PerlCallbackItem*
+ PCB_AddCallback(PerlObjectItem* object, char *name, 
+                 SV* perl_proc, int param_num) {
+     PerlCallbackItem *cbk;
+ 
+     cbk = (PerlCallbackItem*)calloc(1, sizeof(PerlCallbackItem));
+     cbk->name = (char*) malloc(strlen(name) + 1);
+     strcpy(cbk->name, name);
+     SvREFCNT_inc(perl_proc);
+     cbk->perl_proc = perl_proc;
+     cbk->param_num = param_num;
+ 
+     cbk->next = object->vector;
+     object->vector = cbk;
+ 
+     return cbk;
+ }
+ 
+ /* functions for perl object list handling */
+ 
+ static PerlObjectItem*
+ PCB_AddObject(char *name, SV *pobj, JSContext *cx, JSObject *jso, JSClass *class) {
+     JSContextItem *cxitem;
+     PerlObjectItem *object;
+ 
+     /* we should always find the item */
+     cxitem = PCB_FindContextItem(cx);
+     object = (PerlObjectItem*) calloc(1, sizeof(PerlObjectItem));
+     object->name = (char*) malloc(strlen(name) + 1);
+     strcpy(object->name, name);
+     SvREFCNT_inc(pobj);
+     object->pObject = pobj;
+     object->jsObject = jso;
+     object->jsClass = class;
+     object->next = cxitem->objects;
+     cxitem->objects = object;
+ 
+     return object;
+ }
+ 
+ static PerlObjectItem*
+ PCB_FindObject(JSContext *cx, JSObject *jso) {
+     JSContextItem *cxitem;
+     PerlObjectItem *objitem;
+ 
+     cxitem = PCB_FindContextItem(cx);
+     objitem = cxitem->objects;
+ 
+     while ( objitem ) {
+         if ( objitem->jsObject == jso ) return objitem;
+         objitem = objitem->next;
+     }
+     return NULL;
+ }
+ 
+ static PerlCallbackItem*
+ PCB_FindCallback(PerlObjectItem *obj, const char *name) {
+     PerlCallbackItem *cbkitem;
+ 
+     cbkitem = obj->vector;
+     while ( cbkitem ) {
+         if ( strcmp(name, cbkitem->name) == 0 ) return cbkitem;
+         cbkitem = cbkitem->next;
+     }
+     return NULL;
+ }
+ 
+ /* deletion functions */
+ 
+ static void 
+ PCB_FreeCallbackItem(PerlCallbackItem *callback) {
+     free(callback->name);
+     /* we have to decrease ref. count to proc */
+     SvREFCNT_dec(callback->perl_proc);
+     free(callback);
+ }
+ 
+ static void 
+ PCB_FreeObjectItem(PerlObjectItem *object) {
+     PerlCallbackItem *cbkitem, *next;
+     JSClass *class;
+ 
+     free(object->name);
+     free(object->jsClass);
+ 
+     SvREFCNT_dec(object->pObject);
+     cbkitem = object->vector;
+     while ( cbkitem ) {
+         next = cbkitem->next;
+         PCB_FreeCallbackItem(cbkitem);
+         cbkitem = next;
+     }
+     free(object);
+ }
+ 
+ static void 
+ PCB_FreeContextItem(JSContext *cx) {
+     JSContextItem *cxitem, *aux;
+     PerlObjectItem *objitem, *next;
+ 
+     cxitem = PCB_FindContextItem(cx);
+     objitem = cxitem->objects;
+ 
+     while ( objitem ) {
+         next = objitem->next;
+         PCB_FreeObjectItem(objitem);
+         objitem = next;
+     }
+ 
+     if (cxitem->errorReporter) {
+         SvREFCNT_dec(cxitem->errorReporter);
+     }
+     
+     if ( context_list == cxitem ) {
+         context_list = cxitem->next;
+     } else {
+         aux = context_list;
+         while ( aux->next != cxitem ) aux = aux->next;
+         aux->next = cxitem->next;
+     }
+     free(cxitem);
+ }
+ 
+ /* later the object list should be bind to JS Context
+    in this case is needed to update destructor PerlFreeObjectList
+  */
+ 
+ /* property getter and setter - cooperate with AUTOLOAD */
+ 
+ static JSBool
+ PCB_GetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
+     PerlObjectItem *po;
+     int i, cnt, len;
+     I32 ax;
+     SV *proc_sv;
+     HV *stash;
+     char prop_name[256];
+     char full_name[256];
+     char *foo;
+     GV *gv;
+     dSP;
+ 
+     /* property name */
+     strcpy(prop_name, JS_GetStringBytes(JSVAL_TO_STRING(name)));
+ 
+     if (! (po = PCB_FindObject(cx, obj)))
+         croak("Couldn't find stub for object");
+     if ( (PCB_FindCallback(po, prop_name)))
+         return(JS_TRUE);
+ 
+     stash = SvSTASH(SvRV(po->pObject));
+     /* strcpy(full_name, HvNAME(stash));
+     strcat(full_name, "::");
+     strcat(full_name, prop_name);
+ 
+     proc_sv = sv_newmortal();
+     sv_setpv(proc_sv, full_name); */
+     /* 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;
+     PUSHMARK(SP);
+     XPUSHs(po->pObject); /* self for perl AUTOLOAD */
+     PUTBACK;
+ 
+     /* cnt = perl_call_sv(proc_sv, 0); */
+     cnt = perl_call_sv((SV*)GvCV(gv), G_ARRAY);    
+ 
+     SPAGAIN;
+     /* adjust stack for use of ST macro (see perlcall) */
+     SP -= cnt;
+     ax = (SP - PL_stack_base) + 1;
+ 
+     /* read value(s) */
+     if (cnt == 1) {
+         SVToJSVAL(cx, obj, ST(0), rval);
+     } else {
+         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);
+ }
+ 
+ static JSBool
+ PCB_SetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval) {
+     PerlObjectItem *po;
+     int i, cnt, len;
+     I32 ax;
+     SV *proc_sv, *value_sv;
+     HV *stash;
+     char prop_name[256];
+     char full_name[256];
+     char *foo;
+     dSP;
+ 
+     /* property name */
+     strcpy(prop_name, JS_GetStringBytes(JSVAL_TO_STRING(name)));
+ 
+     if (! (po = PCB_FindObject(cx, obj)))
+         croak("Couldn't find stub for object");
+     if ( (PCB_FindCallback(po, prop_name)))
+         return(JS_TRUE);
+ 
+     stash = SvSTASH(SvRV(po->pObject));
+     strcpy(full_name, HvNAME(stash));
+     strcat(full_name, "::");
+     strcat(full_name, prop_name);
+ 
+     proc_sv = sv_newmortal();
+     sv_setpv(proc_sv, full_name);
+     JSVALToSV(cx, obj, *rval, &value_sv);
+     /* start of perl call stuff */
+     ENTER;
+     SAVETMPS;
+     PUSHMARK(SP);
+     XPUSHs(po->pObject); /* self for perl AUTOLOAD */
+     XPUSHs(value_sv);
+     PUTBACK;
+ 
+     cnt = perl_call_sv(proc_sv, G_ARRAY);
+     
+     SPAGAIN;
+     /* adjust stack for use of ST macro (see perlcall) */
+     SP -= cnt;
+     ax = (SP - PL_stack_base) + 1;
+ 
+     /* read value(s) */
+     if (cnt == 1) {
+         SVToJSVAL(cx, obj, ST(0), rval);
+     } else {
+         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);
+ }
+ 
+ /* helper functions */ 
+ /* JSClass pointer is disposed by 
+    JS engine during context cleanup _PH_ 
+  */
+ void
+ PCB_FinalizeStub(JSContext *cx, JSObject *obj) {
+ }
+ 
+ static JSClass* 
+ PCB_NewStdJSClass(char *name) {        
+     JSClass *class;
+ 
+     class = (JSClass*)calloc(1, sizeof(JSClass));
+     class->name = name;
+     class->flags = JSCLASS_HAS_PRIVATE;
+     class->addProperty = JS_PropertyStub;
+     class->delProperty = JS_PropertyStub;  
+     class->getProperty = PCB_GetProperty;  
+     class->setProperty = PCB_SetProperty;
+     class->enumerate = JS_EnumerateStub;
+     class->resolve = JS_ResolveStub;
+     class->convert = JS_ConvertStub;
+     //class->finalize = JS_FinalizeStub;
+     class->finalize = PCB_FinalizeStub;
+     return(class);
+ }
+ 
+ static JSBool
+ PCB_UniversalStub (JSContext *cx, JSObject *obj, uintN argc, 
+                    jsval *argv, jsval *rval) {
+     JSFunction *fun;
+     PerlObjectItem *po;
+     PerlCallbackItem *cbk;
+     int i, cnt;
+     I32 ax;
+     SV* sv;
+     dSP;
+ 
+     fun = JS_ValueToFunction(cx, argv[-2]);
+     if (! (po = PCB_FindObject(cx, obj)))
+         croak("Couldn't find stub for object");
+     if (! (cbk = PCB_FindCallback(po, JS_GetFunctionName(fun))))
+         croak("Couldn't find perl callback");
+     /* start of perl call stuff */
+     ENTER;
+     SAVETMPS;
+     PUSHMARK(SP);
+     XPUSHs(po->pObject); /* self for perl object method */
+     for (i = 0; i < argc; i++) {
+         JSVALToSV(cx, obj, argv[i], &sv);
+         XPUSHs(sv);
+     }
+     PUTBACK;
+     cnt = perl_call_sv(SvRV(cbk->perl_proc), G_ARRAY | G_KEEPERR | G_EVAL);
+ 
+     SPAGAIN;
+     /* adjust stack for use of ST macro (see perlcall) */
+     SP -= cnt;
+     ax = (SP - PL_stack_base) + 1;
+ 
+     /* read value(s) */
+     if (cnt == 1) {
+         SVToJSVAL(cx, obj, ST(0), rval);
+     } else {
+         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;
+ 
+     /* this solution is not perfect, but usefull when nested call happens */
+     return(checkError(cx) && !JS_IsExceptionPending(cx));
+ };
+ 
+ /* __PH__END */
+ 
+ 
+ /* Helper functions needed for most JS API routines */
+ /*
+ static JSRuntime *
+ getRuntime()
+ {
+     return (JSRuntime *)SvIV((SV*)SvRV(perl_get_sv("JS::Runtime::rt", FALSE)));
+ }
+ 
+ static JSContext *
+ getContext()
+ {
+     return (JSContext *)SvIV((SV*)SvRV(perl_get_sv("JS::Context::this", FALSE)));
+ }
+  */ /* commented as obsolete by __PH__ */
+ 
+ /*
+     The following packages are defined below:
+     JS -- main container for all JS functionality
+         JS::Runtime -- wrapper around JSRuntime *
+         JS::Context -- wrapper around JSContext *
+         JS::Object  -- wrapper around JSObject *
+  */
+ 
+ MODULE = JS  PACKAGE = JS   PREFIX = JS_
+ PROTOTYPES:  DISABLE
+  # package JS
+ 
+  #   Most of the functions below have names coinsiding with those of the
+  #   corresponding JS API functions. Thus, they are not commented.
+ JSRuntime *
+ JS_NewRuntime(maxbytes)
+     int maxbytes
+     OUTPUT:
+     RETVAL
+ 
+ void
+ JS_DestroyRuntime(rt)
+     JSRuntime *rt
+     CODE:
+     /*
+         Make sure that the reference count to the runtime is zero.
+         O.w. this sequence of commands will cause double-deallocation:
+             $rt = new JS::Runtime(10_000);
+             $rt1 = $rt;
+             [exit here]
+         So both $rt->DESTROY and $rt1->DESTROY will cause runtime destruction.
+ 
+         _PH_ That's not true, I guess. At least for Perl 5.
+      */
+      /* warn("===> before runtime check\n"); */
+     if(SvREFCNT(ST(0)) == 1){
+         /* warn("===> really runtime destroing"); */
+         /* __PH__ */
+         /*__PH__END */
+         JS_DestroyRuntime(rt);
+     }
+ 
+ 
+  # package JS::Runtime
+ MODULE = JS    PACKAGE = JS::Runtime   PREFIX = JS_
+ 
+ int
+ JS_NewContext(rt, stacksize)
+     JSRuntime *rt
+     int        stacksize
+     PREINIT:
+     JSContextItem *cxitem;
+     CODE:
+     {
+         JSObject *obj;
+         /* jsval v; comment out unused var __PH__*/
+         JSContext *cx;
+         cx = JS_NewContext(rt, stacksize);
+         cxitem = PCB_NewContextItem();
+         cxitem->cx = cx;
+         cxitem->next = context_list;
+         context_list = cxitem;
+         /* __PH__ set the error reporter */
+         JS_SetErrorReporter(cx, PCB_ErrorReporter); 
+         obj = JS_NewObject(cx, &global_class, NULL, NULL);
+         JS_SetGlobalObject(cx, obj);
+         JS_InitStandardClasses(cx, obj);
+         RETVAL = (int)cx;
+     }
+     OUTPUT:
+     RETVAL
+ 
+ void
+ JS_DestroyContext(cx)
+     JSContext *cx
+     CODE:
+     /* See the comment about ref. count above */
+     /* warn("===> before context check\n"); */
+     if(SvREFCNT(ST(0)) == 1){
+         /* warn("===> really destroing context"); */
+         if (JS_IsExceptionPending(cx)) {
+             JS_ClearPendingException(cx);
+         }
+         JS_SetErrorReporter(cx, NULL);
+         JS_GC(cx); //important
+         JS_DestroyContext(cx);
+         PCB_FreeContextItem(cx);
+     }
+ 
+ 
+  # package JS::Context
+ MODULE = JS    PACKAGE = JS::Context   PREFIX = JS_
+ 
+ jsval
+ JS_eval(cx, bytes, ...)
+     JSContext *cx
+     char *bytes
+     PREINIT:
+     JSContextItem *cxitem;
+     char *filename = NULL;
+     CODE:
+     {
+         jsval rval;
+         if (items > 2) { filename = SvPV(ST(2), PL_na); };
+         /* Call on the global object */
+         if(!JS_EvaluateScript(cx, JS_GetGlobalObject(cx), 
+                               bytes, strlen(bytes), 
+                               filename ? filename : "Perl", 
+                               0, &rval)){
+             cxitem = PCB_FindContextItem(cx);
+             if (!cxitem || cxitem->dieFromErrors)
+                 croak("JS script evaluation failed");
+        
+             clearException(cx);
+             XSRETURN_UNDEF;
+         } 
+         RETVAL = rval; 
+     }
+     clearException(cx);
+     OUTPUT:
+     RETVAL
+ 
+ 
+ jsval
+ JS_exec_(cx, script)
+     JSContext *cx
+     SV    *script
+     PREINIT:
+     JSContextItem *cxitem;
+     JSScript *handle;
+     CODE:
+     {
+         jsval rval;
+         handle = (JSScript*)SvIV(*hv_fetch((HV*)SvRV(script), "_script", 7, 0));
+         /* Call on the global object */
+         if(!JS_ExecuteScript(cx, JS_GetGlobalObject(cx), 
+                              handle, &rval)) {
+             cxitem = PCB_FindContextItem(cx);
+             if (!cxitem || cxitem->dieFromErrors)
+                 croak("JS script evaluation failed");
+ 
+             clearException(cx);
+             XSRETURN_UNDEF;
+         }
+         clearException(cx);
+         RETVAL = rval;
+     }
+     OUTPUT:
+     RETVAL
+ 
+ #void
+ #JS_destroyScript(cx, script)
+ #     JSContext *cx
+ #     JSScript *script
+ #    CODE:
+ #    JS_DestroyScript(cx, script);
+ 
+ # __PH__
+ void
+ JS_setErrorReporter(cx, reporter)
+     JSContext *cx
+     SV* reporter
+     PREINIT:
+     JSContextItem *cxitem;
+     CODE:
+     cxitem = PCB_FindContextItem(cx);
+     SvREFCNT_inc(reporter);
+     if ( cxitem ) cxitem->errorReporter = reporter;
+ 
+ void
+ JS_unsetErrorReporter(cx)
+     JSContext *cx
+     PREINIT:
+     JSContextItem *cxitem;
+     CODE:
+     cxitem = PCB_FindContextItem(cx);
+     if ( cxitem ) {
+         if ( cxitem->errorReporter ) 
+             SvREFCNT_dec(cxitem->errorReporter);
+         cxitem->errorReporter = NULL;
+     }
+ 
+ int
+ JS_hasException(cx)
+     JSContext *cx
+     CODE:
+     RETVAL = ! JS_IsExceptionPending(cx);
+     OUTPUT:
+     RETVAL
+ 
+ void 
+ JS_reportError(cx, msg)
+     JSContext *cx
+     char *msg
+     CODE:
+     JS_ReportError(cx, msg);
+ 
+ void 
+ JS_errorFromPrivate(cx, msg, ex)
+      JSContext *cx
+      char *msg
+      JSObject *ex
+      PREINIT:
+      JSErrorReport *rep;
+      CODE:
+      rep = (JSErrorReport*) JS_GetPrivate(cx, ex);
+      if (rep)
+        PCB_ErrorReporter(cx, msg, ((JSExnPrivate*)rep)->errorReport);
+ 
+ void
+ JS_setDieFromErrors(cx, value)
+      JSContext *cx
+      int value
+      PREINIT:
+      JSContextItem *cxitem;
+      CODE:
+      cxitem = PCB_FindContextItem(cx);
+      if ( cxitem ) cxitem->dieFromErrors = value;
+ 
+ void
+ JS_createObject(cx, object, name,  methods)
+     JSContext *cx 
+     SV *object
+     char *name
+     SV *methods
+     PREINIT:
+     JSObject *jso;
+     HV *m_hash;
+     I32 len;   
+     HE *he;
+     int i;
+     PerlObjectItem *po;
+     JSClass *object_class;
+     PerlCallbackItem *pcbitem;
+     CODE:
+     if (SvTYPE(SvRV(methods)) != SVt_PVHV) {
+         croak("Second parameter has to be HASHREF");
+     }
+     /* create js object in given context */
+     object_class = PCB_NewStdJSClass(name);
+     //jso = JS_NewObject(cx, object_class, NULL, 0);
+ 
+     jso = JS_DefineObject(cx, JS_GetGlobalObject(cx), name, 
+                           object_class, NULL, 
+                           JSPROP_ENUMERATE | JSPROP_READONLY | 
+                           JSPROP_PERMANENT);
+ 
+ 
+     if (!jso) croak("Unable create JS object");
+     /* create callback info */
+     po = PCB_AddObject(name, object, cx, jso, object_class);
+     m_hash = (HV*)SvRV(methods);
+     hv_iterinit(m_hash);
+     while ((he = hv_iternext(m_hash))) {
+        PCB_AddCallback(po, hv_iterkey(he, &len), hv_iterval(m_hash, he), 0);
+     }
+     /* set js object methods */
+     /* HERE _PH_ */
+     pcbitem = po->vector;
+     while ( pcbitem ) {
+         if (! JS_DefineFunction(cx, jso, pcbitem->name, 
+                                 PCB_UniversalStub, 0, 0)) 
+             croak("Unable create JS function");
+         pcbitem = pcbitem->next;
+     }
+ 
+ # __PH__END
+ 
+ 
+  # package JS::Object
+ MODULE = JS    PACKAGE = JS::Object   PREFIX = JS_
+ 
+  #
+  #   The methods below get used when hash is tied.
+  #
+ SV *
+ JS_TIEHASH(class, obj)
+     char *class
+     SV *obj
+     PREINIT:
+     JSContext* cx;
+     CODE:
+         RETVAL = SvREFCNT_inc(obj);
+     OUTPUT:
+     RETVAL
+ 
+ SV *
+ JS_TIEARRAY(class, obj)
+     char *class
+     SV *obj
+     PREINIT:
+     JSContext* cx;
+     CODE:
+         RETVAL = SvREFCNT_inc(obj);
+     OUTPUT:
+     RETVAL
+ 
+ jsval
+ JS_FETCH(obj, key)
+     JSObject *obj
+     char *key
+     PREINIT:
+     JSContext* cx;
+     jsval rval;
+     MAGIC *magic;
+     CODE:
+     {
+         /* printf("+++++++++> FETCH\n"); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }
+         JS_GetProperty(cx, obj, key, &rval);
+         RETVAL = rval;
+     }
+     OUTPUT:
+     RETVAL
+ 
+ int
+ JS_FETCHSIZE(obj)
+     JSObject *obj
+     PREINIT:
+     JSContext* cx;
+     MAGIC *magic;
+     CODE:
+     {
+         /* printf("+++++++++> FETCHSIZE: %d\n", ST(0)); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }
+         JS_IsArrayObject(cx, obj);
+         JS_GetArrayLength(cx, obj, &RETVAL);
+     }
+     OUTPUT:
+     RETVAL
+ 
+ void
+ JS_STORE(obj, key, value)
+     JSObject *obj
+     char *key
+     jsval value
+     PREINIT:
+     JSContext* cx;
+     MAGIC *magic;
+     {
+         /* printf("+++++++++> STORE\n"); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }
+     }
+     CODE:
+     {
+         JS_SetProperty(cx, obj, key, &value);
+     }
+ 
+ void
+ JS_DELETE(obj, key)
+     JSObject *obj
+     char *key
+     PREINIT:
+     JSContext* cx;
+     MAGIC *magic;
+     CODE:
+     {
+         /* printf("+++++++++> DELETE\n"); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }      
+         JS_DeleteProperty(cx, obj, key);
+     }
+ 
+ void
+ JS_CLEAR(obj)
+     JSObject *obj
+     PREINIT:
+     JSContext* cx;
+     MAGIC *magic;
+     CODE:
+     {
+         /* printf("+++++++++> CLEAR\n"); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }
+         JS_ClearScope(cx, obj);
+     }
+ 
+ int
+ JS_EXISTS(obj, key)
+     JSObject *obj
+     char *key
+     PREINIT:
+     JSContext* cx;
+     MAGIC *magic;
+     CODE:
+     {
+         jsval v;
+         /* printf("+++++++++> EXISTS\n"); */
+         magic = mg_find(SvRV(ST(0)), '~');
+         if (magic) {
+             cx = (JSContext *)SvIV(magic->mg_obj);
+         } else {
+             warn("Tied object has no magic\n");
+         }
+         JS_LookupProperty(cx, obj, key, &v);
+         RETVAL = !JSVAL_IS_VOID(v);
+     }
+     OUTPUT:
+     RETVAL
+ 
+ #script
+ MODULE = JS    PACKAGE = JS::Script   PREFIX = JS_
+ 
+ int
+ JS_compileScript(object, cx, bytes, ...)
+     SV *object
+     JSContext *cx
+     char *bytes
+     PREINIT:
+     JSContextItem *cxitem;
+     char *filename = NULL;
+     CODE:
+     {
+         if (items > 2) { filename = SvPV(ST(2), PL_na); };
+         /* Call on the global object */
+         if(!(RETVAL = (int)JS_CompileScript(cx, JS_GetGlobalObject(cx), 
+                                        bytes, strlen(bytes), 
+                                        filename ? filename : "Perl", 
+                                        0)))
+             {
+                 cxitem = PCB_FindContextItem(cx);
+                 if (!cxitem || cxitem->dieFromErrors)
+                     croak("JS script compilation failed");
+                 XSRETURN_UNDEF;
+             }
+     }
+     OUTPUT:
+     RETVAL
+ 
+ int 
+ JS_rootScript(object, cx, name)
+     SV *object
+     JSContext *cx
+     char *name
+     PREINIT:
+     JSObject **scrobj;
+     JSScript *handle;
+     CODE:
+     handle = (JSScript*)SvIV(*hv_fetch((HV*)SvRV(object), "_script", 7, 0));
+     scrobj = malloc(sizeof(JSObject*));
+     *scrobj = JS_NewScriptObject(cx, handle);
+     JS_AddNamedRoot(cx, scrobj, name);
+     RETVAL = (int)scrobj;
+     OUTPUT:
+     RETVAL
+ 
+ void 
+ JS_destroyScript(object, cx)
+     SV *object
+     JSContext *cx
+     PREINIT:
+     JSObject **scrobj;
+     JSScript *handle;
+     CODE:
+     handle = (JSScript*)SvIV(*hv_fetch((HV*)SvRV(object), "_script", 7, 0));
+     scrobj = (JSObject**)SvIV(*hv_fetch((HV*)SvRV(object), "_root", 5, 0));
+     JS_RemoveRoot(cx, scrobj);
+ 


ossp-pkg/js/src/perlconnect/JS.xs 1.1 -> 1.1.1.1


CVSTrac 2.0.1