/* -*- 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"
#ifdef OSSP
#include <stdlib.h>
#else
#include <malloc.h>
#endif

/* __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;
    /* OSSP BUGFIX *//*JSObject *jsStub;*/
    JSObject *jsObject;
    JSClass *jsClass;
    struct PerlCallbackItem* vector;
    struct PerlObjectItem *next;
};

typedef struct PerlObjectItem PerlObjectItem;

/* error reporter */
/* OSSP BUGFIX *//*struct JSContextItem;*/
/* OSSP BUGFIX *//*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;
    /* OSSP BUGFIX */
    /*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); /* OSSP BUGFIX */ /*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);
    /* OSSP BUGFIX */ /* 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);