From b99526dfbb20aeaea58c3d4e4a351c68d128cd92 Mon Sep 17 00:00:00 2001 From: "mccabe%netscape.com" Date: Mon, 28 Sep 1998 22:05:39 +0000 Subject: [PATCH] Initial checkin of PerlConnect, migrated from the private tree. Perlconnect is a set of facilities for controlling and interacting with a perl interpreter from javascript, and vice versa. It supplies several mechanisms for transparently reflecting perl scalars, hashes and arrays as the corresponding types in javascript. Currently maintained by Vladimir Livshits, val4@cornell.edu git-svn-id: svn://10.0.0.236/trunk@11282 18797224-902f-48f8-a5cc-f745e15eee43 --- mozilla/js/src/perlconnect/JS.def | 6 + mozilla/js/src/perlconnect/JS.dsp | 98 ++ mozilla/js/src/perlconnect/JS.pm | 241 +++++ mozilla/js/src/perlconnect/JS.xs | 224 +++++ mozilla/js/src/perlconnect/PerlConnect.dsp | 104 +++ mozilla/js/src/perlconnect/PerlConnect.dsw | 59 ++ .../js/src/perlconnect/PerlConnectShell.dsp | 90 ++ mozilla/js/src/perlconnect/README.html | 321 +++++++ mozilla/js/src/perlconnect/bg.jpg | Bin 0 -> 1149 bytes mozilla/js/src/perlconnect/jsperl.c | 875 ++++++++++++++++++ mozilla/js/src/perlconnect/jsperl.h | 30 + mozilla/js/src/perlconnect/jsperlpvt.h | 36 + mozilla/js/src/perlconnect/test.js | 53 ++ mozilla/js/src/perlconnect/test.pl | 56 ++ mozilla/js/src/perlconnect/typemap | 79 ++ 15 files changed, 2272 insertions(+) create mode 100644 mozilla/js/src/perlconnect/JS.def create mode 100644 mozilla/js/src/perlconnect/JS.dsp create mode 100644 mozilla/js/src/perlconnect/JS.pm create mode 100644 mozilla/js/src/perlconnect/JS.xs create mode 100644 mozilla/js/src/perlconnect/PerlConnect.dsp create mode 100644 mozilla/js/src/perlconnect/PerlConnect.dsw create mode 100644 mozilla/js/src/perlconnect/PerlConnectShell.dsp create mode 100644 mozilla/js/src/perlconnect/README.html create mode 100644 mozilla/js/src/perlconnect/bg.jpg create mode 100644 mozilla/js/src/perlconnect/jsperl.c create mode 100644 mozilla/js/src/perlconnect/jsperl.h create mode 100644 mozilla/js/src/perlconnect/jsperlpvt.h create mode 100644 mozilla/js/src/perlconnect/test.js create mode 100644 mozilla/js/src/perlconnect/test.pl create mode 100644 mozilla/js/src/perlconnect/typemap diff --git a/mozilla/js/src/perlconnect/JS.def b/mozilla/js/src/perlconnect/JS.def new file mode 100644 index 00000000000..8e079e8defc --- /dev/null +++ b/mozilla/js/src/perlconnect/JS.def @@ -0,0 +1,6 @@ +LIBRARY "JS" +DESCRIPTION "JS library for Perl <-> JS communications" +CODE LOADONCALL +DATA LOADONCALL NONSHARED MULTIPLE +EXPORTS + boot_JS diff --git a/mozilla/js/src/perlconnect/JS.dsp b/mozilla/js/src/perlconnect/JS.dsp new file mode 100644 index 00000000000..fcd1e61d4f5 --- /dev/null +++ b/mozilla/js/src/perlconnect/JS.dsp @@ -0,0 +1,98 @@ +# Microsoft Developer Studio Project File - Name="JS" - Package Owner=<4> +# Microsoft Developer Studio Generated Build File, Format Version 5.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +CFG=JS - Win32 Debug +!MESSAGE This is not a valid makefile. To build this project using NMAKE, +!MESSAGE use the Export Makefile command and run +!MESSAGE +!MESSAGE NMAKE /f "JS.mak". +!MESSAGE +!MESSAGE You can specify a configuration when running NMAKE +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "JS.mak" CFG="JS - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "JS - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE "JS - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library") +!MESSAGE + +# Begin Project +# PROP Scc_ProjName "" +# PROP Scc_LocalPath "" +CPP=cl.exe +MTL=midl.exe +RSC=rc.exe + +!IF "$(CFG)" == "JS - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Release" +# PROP BASE Intermediate_Dir "Release" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /FD /c +# ADD CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /FD /c +# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /o NUL /win32 +# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /o NUL /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 + +!ELSEIF "$(CFG)" == "JS - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /FD /c +# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "d:\opc\ns\js\ref" /I "$(PERL_SRC)" /I "$(PERL_SRC)\win32" /I "$(PERL_SRC)\win32\include" /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /FD /c +# SUBTRACT CPP /Gy +# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /o NUL /win32 +# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /o NUL /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386 /pdbtype:sept +# ADD LINK32 js32.lib PerlConnect.lib perl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:"c:\perl\lib\auto\JS\JS.dll" /pdbtype:sept /libpath:"..\Debug" /libpath:"$(PERL_SRC)" + +!ENDIF + +# Begin Target + +# Name "JS - Win32 Release" +# Name "JS - Win32 Debug" +# Begin Source File + +SOURCE=.\JS.c +# End Source File +# Begin Source File + +SOURCE=.\JS.def +# End Source File +# End Target +# End Project diff --git a/mozilla/js/src/perlconnect/JS.pm b/mozilla/js/src/perlconnect/JS.pm new file mode 100644 index 00000000000..ab60bf508fa --- /dev/null +++ b/mozilla/js/src/perlconnect/JS.pm @@ -0,0 +1,241 @@ +# +# The contents of this file are subject to the Netscape Public License +# Version 1.0 (the "NPL"); you may not use this file except in +# compliance with the NPL. You may obtain a copy of the NPL at +# http://www.mozilla.org/NPL/ +# +# Software distributed under the NPL is distributed on an "AS IS" basis, +# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL +# for the specific language governing rights and limitations under the +# NPL. +# +# The Initial Developer of this code under the NPL is Netscape +# Communications Corporation. Portions created by Netscape are +# Copyright (C) 1998 Netscape Communications Corporation. All Rights +# Reserved. +# + +# +# PerlConnect support package. +# + +############################################################################ +# PerlConnect support package. 8/3/98 2:50PM +# See README.html and JS.xs for information about this module. +############################################################################ + +package JS; +require Exporter; +require DynaLoader; +@ISA = qw(Exporter DynaLoader); +@EXPORT_OK = qw(perl_eval perl_resolve perl_call $js $ver); +$VERSION = '0.02'; + +# version string for the interpreter +$ver = "[Perl Interpreter: Version $] compiled under $^O]\n"; +$DEBUG = undef; + +############################################################################ +# TODO: This will be added +############################################################################ +sub AUTOLOAD #7/28/98 8:24PM +{ + print "\nJS::AUTOLOAD: $AUTOLOAD, not implemented yet\n" if $DEBUG; +} ##AUTOLOAD + +############################################################################ +# Evaluates the parameter and returns the return result of eval() as a +# reference +############################################################################ +sub perl_eval #7/15/98 5:13PM +{ + my($stmt) = shift; + package main; + my(@_js) = eval($stmt); + package JS; + my($_js) = (scalar(@_js)==1)?$_js[0]:\@_js; + undef $js; + $js = (ref $_js) ? $_js: \$_js; + print "Failure in perl_call!" unless ref $js; +} ##perl_eval + +############################################################################ +# Calls the procesure passed as the first parameter and passes the rest of +# the arguments to it. The return result is converted to a reference as +# before +############################################################################ +sub perl_call #7/21/98 2:16PM +{ + my($proc) = shift; + my($_js); + + $proc =~ s/main:://g; + #print "Calling $proc\n"; + package main; + my(@_js) = &$proc(@_); + package JS; + #print "here: ", @_js, "\n"; + $_js = (scalar(@_js)==1)?$_js[0]:\@_js; + undef $js; + $js = (ref $_js) ? $_js: \$_js; + #print ref $js; + print "Failure in perl_call!" unless ref $js; +} ##perl_call + +############################################################################ +# Takes the first parameter and tries to retrieve this variable +############################################################################ +sub perl_resolve #7/22/98 10:08AM +{ + my($name) = shift; + my(@parts) = split('::', $name); + my($last_part) = pop(@parts); + + # variable lookup -- variables must start with $, @, or % + if($last_part =~ /^([\$\@\%])(.+)/){ + my($resolved_name) = "$1".join('::', @parts)."::$2"; + package main; + my(@_js) = eval($resolved_name); + package JS; + my($_js) = (scalar(@_js)==1)?$_js[0]:\@_js; + undef $js; + $js = (ref $_js) ? $_js: \$_js; + }else{ + $name =~ s/main:://g; + # if this function exists + # function -- set $js to 1 to indicate this + if(eval "return defined(&main::$name)"){ + print "function $name\n" if $DEBUG; + $js = 1; + # module + }else{ + print "must be a module\n" if $DEBUG; + $js=2; + return; + # defined module -- try to do an eval and check $@ to trap errors + # as a result, the module is automatically pre-use'd if it exists + $name =~ s/main:://g; + if(eval "use $name; return !(defined($@));"){ + $js = 2; + # o.w. this module is undefined + }else{ + $js = 3; + } + } + } +} ##perl_resolve + +############################################################################ +# Validates package name +############################################################################ +sub perl_validate_package #7/22/98 10:15AM +{ + print "perl_validate_package\n" if $DEBUG; + my($name) = shift; + print $name if $DEBUG; + $js = $name?1:undef; +} ##perl_validate_package + +# test procedure +sub c{ + print "da!\n" if wantarray; + print "Called!\n"; + return @_; +} + +############################################################################ +# Duplicates JS::Context::new is a way +############################################################################ +sub new #7/31/98 5:32PM +{ + print "JS::new" if $DEBUG; + my $rt = new JS::Runtime(10_000); + return $this = new JS::Context($rt, 1_024); +} ##new + +############################################################################ +# Uses DynaLoader to load JS support DLL, performs the initialization +############################################################################ +sub boot #7/31/98 5:28PM +{ + # this is to load the JS DLL at run-time + bootstrap JS $VERSION; + push @dl_library_path, $ENV{'LD_LIBRARY_PATH'}; +} ##boot + +############################################################################ +package JS::Runtime; +@EXPORT = qw($this); + +sub AUTOLOAD #7/28/98 8:24PM +{ + print "\nJS::Runtime::AUTOLOAD: $AUTOLOAD, not implemented yet\n" if $DEBUG; +} ##AUTOLOAD + +############################################################################ +# Constructor. Calls NewRuntime and saves the returned value in this +############################################################################ +sub new #7/31/98 3:39PM +{ + print "JS::Runtime::new\n" if $DEBUG; + my($class, $maxbytes) = @_; + $this = JS::NewRuntime(scalar($maxbytes)); + return $this; +} ##new + +############################################################################ +# Destructor for Runtimes +############################################################################ +sub DESTROY #7/31/98 4:54PM +{ + my $self = shift; + print "JS::Runtime::DESTROY\n" if $DEBUG; + JS::DestroyRuntime($self); + undef $this; +} ##DESTROY + +############################################################################ +package JS::Context; +@EXPORT = qw($this); + +sub AUTOLOAD #7/28/98 8:24PM +{ + print "\nJS::Context::AUTOLOAD: $AUTOLOAD, not implemented yet\n" if $DEBUG; +} ##AUTOLOAD + +############################################################################ +# Constructor. Calls NewContext and saves the returned value in this +############################################################################ +sub new #7/31/98 3:39PM +{ + print "JS::Context::new\n" if $DEBUG; + my($class, $rt, $stacksize) = @_; + $this = JS::Runtime::NewContext($rt, $stacksize); + return $this; +} ##new + +############################################################################ +# Destructor for Contexts +############################################################################ +sub DESTROY #7/31/98 4:54PM +{ + my $self = shift; + print "JS::Contexts::DESTROY\n" if $DEBUG; + JS::Runtime::DestroyContext($self); + undef $this; +} ##DESTROY + +############################################################################ + +package JS::Object; + +sub AUTOLOAD #7/28/98 8:24PM +{ + $_ = $AUTOLOAD; + $_ =~ s/.*://; + print "\nJS::Object::AUTOLOAD: $_, not implemented yet\n" if $DEBUG; +} ##AUTOLOAD + +&JS::boot(); + +1; diff --git a/mozilla/js/src/perlconnect/JS.xs b/mozilla/js/src/perlconnect/JS.xs new file mode 100644 index 00000000000..9113e3bc6e8 --- /dev/null +++ b/mozilla/js/src/perlconnect/JS.xs @@ -0,0 +1,224 @@ +/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*- + * + * The contents of this file are subject to the Netscape Public License + * Version 1.0 (the "NPL"); you may not use this file except in + * compliance with the NPL. You may obtain a copy of the NPL at + * http://www.mozilla.org/NPL/ + * + * Software distributed under the NPL is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL + * for the specific language governing rights and limitations under the + * NPL. + * + * The Initial Developer of this code under the NPL is Netscape + * Communications Corporation. Portions created by Netscape are + * Copyright (C) 1998 Netscape Communications Corporation. All Rights + * Reserved. + */ + +/* + * 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" + +static +JSClass global_class = { + "Global", 0, + JS_PropertyStub, JS_PropertyStub, JS_PropertyStub, JS_PropertyStub, + JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub +}; + +/* 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))); +} + +/* + 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 + +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. + */ + if(SvREFCNT(ST(0))==0){ + JS_DestroyRuntime(rt); + } + + # package JS::Runtime +MODULE = JS PACKAGE = JS::Runtime PREFIX = JS_ + +JSContext * +JS_NewContext(rt, stacksize) + JSRuntime *rt + int stacksize + + CODE: + { + JSObject *obj; + jsval v; + /* Here we are creating the globals object ourselves. */ + JSContext *cx = JS_NewContext(rt, stacksize); + obj = JS_NewObject(cx, &global_class, NULL, NULL); + JS_InitStandardClasses(cx, obj); + RETVAL = cx; + } + OUTPUT: + RETVAL + +void +JS_DestroyContext(cx) + JSContext *cx + CODE: + /* See the comment about ref. count above */ + if(SvREFCNT(ST(0))==0){ + JS_DestroyContext(cx); + } + + + # package JS::Context +MODULE = JS PACKAGE = JS::Context PREFIX = JS_ + +jsval +JS_eval(cx, bytes) + JSContext *cx + char *bytes + + CODE: + { + jsval rval; + JSObject *obj; + /* Call on the global object */ + if(!JS_EvaluateScript(cx, JS_GetGlobalObject(cx), bytes, strlen(bytes), "Perl", 0, &rval)){ + croak("Perl eval failed"); + XSRETURN_UNDEF; + } + RETVAL = rval; + } + OUTPUT: + RETVAL + + # package JS::Object +MODULE = JS PACKAGE = JS::Object PREFIX = JS_ + + # + # The methods below get used when hash is tied. + # +JSObject * +JS_TIEHASH(class, obj) + char *class + JSObject *obj + CODE: + RETVAL = obj; + OUTPUT: + RETVAL + +jsval +JS_FETCH(obj, key) + JSObject *obj + char *key + PREINIT: + jsval rval; + CODE: + { + /*printf("in FETCH\n");*/ + JS_GetProperty(getContext(), obj, key, &rval); + RETVAL = rval; + } + OUTPUT: + RETVAL + +void +JS_STORE(obj, key, value) + JSObject *obj + char *key + jsval value + CODE: + { + /*printf("In STORE\n");*/ + JS_SetProperty(getContext(), obj, key, &value); + } + +void +JS_DELETE(obj, key) + JSObject *obj + char *key + CODE: + { + /*printf("In DELETE\n");*/ + JS_DeleteProperty(getContext(), obj, key); + } + +void +JS_CLEAR(obj) + JSObject *obj + CODE: + { + /*printf("In CLEAR\n");*/ + JS_ClearScope(getContext(), obj); + } + +int +JS_EXISTS(obj, key) + JSObject *obj + char *key + CODE: + { + jsval v; + + /*printf("In EXISTS\n");*/ + JS_LookupProperty(getContext(), obj, key, &v); + RETVAL = !JSVAL_IS_VOID(v); + } + OUTPUT: + RETVAL diff --git a/mozilla/js/src/perlconnect/PerlConnect.dsp b/mozilla/js/src/perlconnect/PerlConnect.dsp new file mode 100644 index 00000000000..6885bcf7927 --- /dev/null +++ b/mozilla/js/src/perlconnect/PerlConnect.dsp @@ -0,0 +1,104 @@ +# Microsoft Developer Studio Project File - Name="PerlConnect" - Package Owner=<4> +# Microsoft Developer Studio Generated Build File, Format Version 5.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 + +CFG=PerlConnect - Win32 Debug +!MESSAGE This is not a valid makefile. To build this project using NMAKE, +!MESSAGE use the Export Makefile command and run +!MESSAGE +!MESSAGE NMAKE /f "PerlConnect.mak". +!MESSAGE +!MESSAGE You can specify a configuration when running NMAKE +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "PerlConnect.mak" CFG="PerlConnect - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "PerlConnect - Win32 Release" (based on\ + "Win32 (x86) Dynamic-Link Library") +!MESSAGE "PerlConnect - Win32 Debug" (based on\ + "Win32 (x86) Dynamic-Link Library") +!MESSAGE + +# Begin Project +# PROP Scc_ProjName "" +# PROP Scc_LocalPath "" +CPP=cl.exe +MTL=midl.exe +RSC=rc.exe + +!IF "$(CFG)" == "PerlConnect - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Release" +# PROP BASE Intermediate_Dir "Release" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /FD /c +# ADD CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /FD /c +# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /o NUL /win32 +# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /o NUL /win32 +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386 + +!ELSEIF "$(CFG)" == "PerlConnect - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /FD /c +# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "d:\opc\ns\js\ref" /I "$(PERL_SRC)" /I "$(PERL_SRC)\win32" /I "$(PERL_SRC)\win32\include" /I "." /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "PERLCONNECT" /D "JSFILE" /D "XP_PC" /FR /YX /FD /c +# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /o NUL /win32 +# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /o NUL /win32 +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386 /pdbtype:sept +# ADD LINK32 js32.lib perl.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /subsystem:windows /dll /pdb:none /debug /machine:I386 /out:"C:\DLLs\PerlConnect.dll" /implib:"PerlConnect.lib" /libpath:"d:\opc\ns\js\ref\Debug" /libpath:"$(PERL_SRC)" +# SUBTRACT LINK32 /verbose + +!ENDIF + +# Begin Target + +# Name "PerlConnect - Win32 Release" +# Name "PerlConnect - Win32 Debug" +# Begin Source File + +SOURCE=.\jsperl.c +# End Source File +# Begin Source File + +SOURCE=.\jsperl.h +# End Source File +# Begin Source File + +SOURCE=.\jsperlpvt.h +# End Source File +# End Target +# End Project diff --git a/mozilla/js/src/perlconnect/PerlConnect.dsw b/mozilla/js/src/perlconnect/PerlConnect.dsw new file mode 100644 index 00000000000..0f45a629454 --- /dev/null +++ b/mozilla/js/src/perlconnect/PerlConnect.dsw @@ -0,0 +1,59 @@ +Microsoft Developer Studio Workspace File, Format Version 5.00 +# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! + +############################################################################### + +Project: "JS"=.\JS.dsp - Package Owner=<4> + +Package=<5> +{{{ +}}} + +Package=<4> +{{{ + Begin Project Dependency + Project_Dep_Name PerlConnect + End Project Dependency +}}} + +############################################################################### + +Project: "PerlConnect"=.\PerlConnect.dsp - Package Owner=<4> + +Package=<5> +{{{ +}}} + +Package=<4> +{{{ +}}} + +############################################################################### + +Project: "PerlConnectShell"=.\PerlConnectShell.dsp - Package Owner=<4> + +Package=<5> +{{{ +}}} + +Package=<4> +{{{ + Begin Project Dependency + Project_Dep_Name PerlConnect + End Project Dependency +}}} + +############################################################################### + +Global: + +Package=<5> +{{{ +}}} + +Package=<3> +{{{ +}}} + +############################################################################### + diff --git a/mozilla/js/src/perlconnect/PerlConnectShell.dsp b/mozilla/js/src/perlconnect/PerlConnectShell.dsp new file mode 100644 index 00000000000..e93c37b1ccf --- /dev/null +++ b/mozilla/js/src/perlconnect/PerlConnectShell.dsp @@ -0,0 +1,90 @@ +# Microsoft Developer Studio Project File - Name="PerlConnectShell" - Package Owner=<4> +# Microsoft Developer Studio Generated Build File, Format Version 5.00 +# ** DO NOT EDIT ** + +# TARGTYPE "Win32 (x86) Console Application" 0x0103 + +CFG=PerlConnectShell - Win32 Debug +!MESSAGE This is not a valid makefile. To build this project using NMAKE, +!MESSAGE use the Export Makefile command and run +!MESSAGE +!MESSAGE NMAKE /f "PerlConnectShell.mak". +!MESSAGE +!MESSAGE You can specify a configuration when running NMAKE +!MESSAGE by defining the macro CFG on the command line. For example: +!MESSAGE +!MESSAGE NMAKE /f "PerlConnectShell.mak" CFG="PerlConnectShell - Win32 Debug" +!MESSAGE +!MESSAGE Possible choices for configuration are: +!MESSAGE +!MESSAGE "PerlConnectShell - Win32 Release" (based on\ + "Win32 (x86) Console Application") +!MESSAGE "PerlConnectShell - Win32 Debug" (based on\ + "Win32 (x86) Console Application") +!MESSAGE + +# Begin Project +# PROP Scc_ProjName "" +# PROP Scc_LocalPath "" +CPP=cl.exe +RSC=rc.exe + +!IF "$(CFG)" == "PerlConnectShell - Win32 Release" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 0 +# PROP BASE Output_Dir "Release" +# PROP BASE Intermediate_Dir "Release" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 0 +# PROP Output_Dir "Release" +# PROP Intermediate_Dir "Release" +# PROP Target_Dir "" +# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c +# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c +# ADD BASE RSC /l 0x409 /d "NDEBUG" +# ADD RSC /l 0x409 /d "NDEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 +# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /machine:I386 + +!ELSEIF "$(CFG)" == "PerlConnectShell - Win32 Debug" + +# PROP BASE Use_MFC 0 +# PROP BASE Use_Debug_Libraries 1 +# PROP BASE Output_Dir "Debug" +# PROP BASE Intermediate_Dir "Debug" +# PROP BASE Target_Dir "" +# PROP Use_MFC 0 +# PROP Use_Debug_Libraries 1 +# PROP Output_Dir "Debug" +# PROP Intermediate_Dir "Debug" +# PROP Ignore_Export_Lib 0 +# PROP Target_Dir "" +# ADD BASE CPP /nologo /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c +# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "D:\OPC\ns\js\ref" /I "D:\OPC\ns\js\ref\perlconnect" /I "$(PERL_SRC)" /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /D "PERLCONNECT" /D "JSFILE" /D "_WIN32" /D "XP_PC" /FR /YX /FD /c +# ADD BASE RSC /l 0x409 /d "_DEBUG" +# ADD RSC /l 0x409 /d "_DEBUG" +BSC32=bscmake.exe +# ADD BASE BSC32 /nologo +# ADD BSC32 /nologo +LINK32=link.exe +# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept +# ADD LINK32 js32.lib PerlConnect.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:console /debug /machine:I386 /out:"PerlConnectShell.exe" /pdbtype:sept /libpath:"d:\opc\ns\js\ref\Debug" /libpath:"d:\opc\perl_src" /libpath:"." + +!ENDIF + +# Begin Target + +# Name "PerlConnectShell - Win32 Release" +# Name "PerlConnectShell - Win32 Debug" +# Begin Source File + +SOURCE=..\js.c +# End Source File +# End Target +# End Project diff --git a/mozilla/js/src/perlconnect/README.html b/mozilla/js/src/perlconnect/README.html new file mode 100644 index 00000000000..edc74729aa3 --- /dev/null +++ b/mozilla/js/src/perlconnect/README.html @@ -0,0 +1,321 @@ + + + + + + PerlConnect Documentation + + + + +
+

+PERLCONNECT AND +JS.pm

+ +
USER-LEVEL DOCUMENTATION
+ +
Vladimir Livshits
+ +
  +
+ +
    +
  1. +Overview
    2. + +
  2. +Features
    3. + +
  3. +Design
    4. + +
  4. +Installation
    5. + +
  5. +Current Limitations and Futher Work
    6. +
+ +

+Overview

+PerlConnect and JS.pm provide glue for the developer between JavaScript +and Perl languages. It currently consists of two parts, PerlConnect implemented +in C and JS.pm (tentative name), a Perl module written using XSUBs. +PerlConnect and JS.pm allow calling Perl from JS and JS from Perl, respectively. +Whenever possible, it is attempted to archieve the maximum level of transparency +for calling one language from the other. This is done by converting values +between the two languages, creating wrappers around objects, and emulating +the standard syntax. +

+PerlConnect Features

+PerlConnect allows running a Perl interpreter concurrently with your JavaScript +embedding and executing Perl commands from JavaScript. You usually need +to create a Perl interpreter by saysing something like this: +
p = new Perl('Sys::Hostname', 'Test::Harness')
+In addition to creating an interpreter, this will also include the libraries +you  pass to the Perl constructor, which is equivalent to use +Sys::Hostname; use Test::Harness. You can always include libraries +explicitly by using p.eval('use Sys::Hostname; use Test::Harness'). +There is also another way to do this: p.use('Sys::Hostname', 'Test::Harness'). +As you can see, TMTOWTDI. Natura    lly, you will want to +look at the result of your function calls and eval statements. +Suppose, you do something like this: +
line = p.eval("'-' x 80")
+Perl's eval returns the last statement evaluated, unless you explicitly +say return. So now line contains 80 dashes. You can do +similar things with non-scalar data types: +
p.use('Time::gmtime'); +
t = p.eval('Time::gmtime::gmtime')    // returns +[49,0,4,24,6,98,5,204,0]
+assigns a Perl array to t. You can print t, use the for/in +syntax to walk through it, compute its lenght, etc. You can read and assign +to individual elements using the standard syntax. However, PerlValues, +that is, the value we get from Perl, don't support all the standard operations, +for isntance, don't expect t.reverse() to work. Hashes can also +be returned from Perl: +
info=p.eval("{ver=>$], pid=>$$}")
+Now you can look at individual hash keys like this: +
info["ver"] or info.pid
+Suppose you want to use Perl to perform pattern-based string replacement. +Here's how you can do it from JavaScript: +
p.eval("\ +
    sub perl_replace(){\ +
        my($string, $find, $replace) += @_;\ +
        eval(\"\\$string =~ +s/$find/$replace/g;\");\ +
        return $string;\ +
    }" +
);
+and now +
p.perl_replace('Quick brown fox jumped over a lazy dog', +'dog', 'rhino')
+produces what you'd expect. + +

You can use the same syntax to call procedures defined in modules other +than main. The example with gmtime can be rewritten like +this: +

p.use('Time::gmtime'); +
t = p.Time.gmtime.gmtime()    // returns [49,0,4,24,6,98,5,204,0]
+ You can reference variables exported by modules others than main +like this: +
a=p.Foo.$bar or a=p.Foo["$bar"] or +
a=p.Foo["@bar"]or a=p.Foo["%bar"]
+Each of the stetements above returns a either an immediate JS value, for +scalar types, or a PerlValue for compound types. a.type contains +the type of the PerlValue in a. This may change because we +may end up separating Perl hashes and arrays into separate classes. +

+JS.pm Features

+JS.pm is much less tested then PerlConnect. You should be able to +do similar things from Perl. Just say +
use JS; +
$js = new JS();
+and now you can do something like this: +
$js->eval(q/ +
Object o = {}; +
o.a = 'p'; +
o.b = 'q'; +
return o;
+/);
+//TODO: more features and examples +

+PerlConnect Design

+PerlConnect is written in C. It uses both JavaScript and Perl APIs and +implements a mapping between the two. The are the following JavaScript +objects implemented by PerlConnect: +
  +
+ + + + + + + + + + + + + + + + + + + + + + + +
ObjectWhat it does
PerlPerl Interpreter Object. It's prototype type +is PerlModule, it corresponds to main::. Supports eval, +call, use.
PerlModuleImplements JS-like syntax for Perl modules. Doesn't +export provide any methods. path property shown the name of the +Perl module the object represents.
PerlValueRepresents a value returned from eval, +call, or obtained by using the subscript notation (p.Foo["@bar"]). +Its Perl type is stored in the type property.
+  +
See comments in the code, jsperl.c and JS.pm for +more info. +
  +

+JS.pm Design

+JSConnect is written using XSUBs, the language in which Perl extentions +are implemented. The source files are JS.xs and typemap. +After processing them using the XSUBs compiler, xsubpp, the resulting +C file should be compiled into a DLL. JS.pm provides bootstraping +mechanism to load this DLL. See perlxs and perlxsstut +man pages for more info. The following Perl packages (objects) are implemented: +
  +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
PackageWhat it contains
JSDoesn't not do anything in particular at this +point except defining a constuctor. So one can say $js = new +JS(), which will create a new runtime, add a context to it and return +that Context. JS also defines a bunch of private functions called from +C by PerlConnect. They are not exposed by default, but pushed onto @EXPORT_OK +array instead.
JS::RuntimeCorresponds to JSRuntime* struct. Provides +a constructor and destructor. The destructor is invoked automatically, +so you don't have to worry about Runtime deallocation. Constructor syntax +is the following: $rt = new JS::Runtime(10_000), where +the parameter is the same number you pass to JS_NewRuntime. There +are many private functions created in JS.xs that are not exported +by default.
JS::ContextCorresponds to JSContext* struct. Provides +a constructor and destructor. The destructor is invoked automatically, +so you don't have to worry about Context deallocation. Constructor syntax +is the following: $rt = new JS::Context($rt, 1_000), where +the parameter is the same number you pass to JS_NewContext. There +are many private functions created in JS.xs that are not exported +by default.
JS::ObjectCorresponds to JSObject* struct. There is not that much here +yet. This object is intended as a wrapper around the JSObject* stuct. +Support for tying hashes and possibly arrays with JS::Objects +is coming.
[JS::Array]I am not quite sure if this is needed. One might probably get away +with just JS::Object defined. If it's implemented, it will be +very much similar to JS::Object above.
+  + +

All the modules above follow the convention of storing the variable +they return in the $this variable of the current class. So $JS::Context::this +will always be the last context created. Currently, this is where JS +API function that require contexts get it. +

+PerlConnect Installation

+PerlConnect requires js/ref and the Perl libraries and headers. +The only js/ref file that must be included in jsapi.h. +You need to compile it together with Perl libraries. Referer to the perlembed +man page for more details. +
On WINNT: +
There are MSDEV Workspace and project files in the main PerlConnect +directory. There are two projects included in the PerlConnect workspace: +PerlConnect and PerlConnect shell. You can use the latter to test PerlConnect. +You will probably need to adjust the library and include paths. In particular, +set PERL_SRC environment variable to point to the directory where you unpacked +and compiled Perl sources. +
On UNIX: +
Currently, you can use PerlConnect with the js.c shell. To +compile it on UNIX, you need to set the PERLCONNECT environment variable. +Then you can use the Makefile in js/ref directory. The makefile +should read the variable from the current environment. Id this doesn't +happent, you can try using gmake PERLCONNECT=1. This will compile +PerlConnect into js. +

+JS.pm Installation

+The following source files are distributed: JS.pm, JS.xs, +JS.c (produced from JS.xs by xsubpp) and JS.def +(required by the Visual C compiler). +
On WINNT: +
There is also a project file, JS.dsp. It automatically belongs +to the PerlConnect workspace. This project file builds a DLL, JS.dll +which is supposed to reside where Perl's DynaLoader can find it. On my +machine I put it under c:\perl\lib\auto\JS\JS.dll. You can also +put it in c:\perl\lib\. See DynaLoader documentation for more +info on how dynamic libraries are found. +
On UNIX: +
//TODO: details of the makefiles +
  +

+Current Limitations of the Package and Futher +Work

+ +
    +
  1. +Perl variables currently can't be assigned to, that is, p["$a"]=100 +doesn't do anything.
    2. + +
  2. +You can only have one interpreter running at a time. Despite the fact that +you can create multiple Perl objects on JavaScript, they all share the +same namespace. We can probably use Safe.pm to implement independent +namespaces.
    3. + +
  3. +Module names resolution reports an error only when you try to evaluate +the last element of the resolution chain. Here is what I mean: if you reference +p.Foo.Bar.Var and For or Bar don't exist, it +will only complain that p.Foo.Bar.Var is not a valid variable. Perl 5.005 +provides exists Foo::{Bar::} to check if Foo::Bar is a valid package.
    4. + +
  4. +Dynamic loading of the Perl interpreter only if it is required.
    5. + +
  5. +Recursive printing of Perl's arrays and hashes can be added. See Data::Dumper.pm
    6. + +
  6. +Full support for tied hashes and arrays in Perl
    7. + +
  7. +Calling JavaScript functions and accessing variables from Perl. JavaScript +calling syntax support using AUTOLOADing.
    8. + +
  8. +JS can be made a directory with Object.pm, Context.pm, +etc. in it. See how C or Tk are organized on CPAN
    9. + +
  9. +Distribution model for JS.pm. Perl provides something by default. See h2xs +man page, for example.
    10. +
+ + + diff --git a/mozilla/js/src/perlconnect/bg.jpg b/mozilla/js/src/perlconnect/bg.jpg new file mode 100644 index 0000000000000000000000000000000000000000..ba8a02f6748f6ba711f8d8c65998fe2dd21544a4 GIT binary patch literal 1149 zcmex=HEAm;@P_1sVSzVUS{AWMBrl76F);Sr}P4fO7f*49pBnjLghT zKzBpr8JU;`6ovakJa zjmVX&cN7OvMg@NSMqe(QtHY~@{9LHGXDh&0*<{kFEAHGd<>p_6udd%e`(lrEk7 z_R~2AmPK=dmOd3^sH%7yqaF98rqi<>3hD?fzQPNY~yJOnFw~Wt(kM?bfn)>+e-|k;` zij7T;HS_&FHZPj8;d}LErk7KVmW55S0-DY?IjUyyx%2&(PdvYU%2rrDZvIOBn`;?o z$a-#HGP^z{wte~T>Lt%=zdzw(T)pDur0ErZ_bk=`Ig5dNSB}5x+w}+bG|E^q3h6AL^?5&u}vSN(RUxhN5MeS(CD#$^x1E);1ca zgZAjNy}9=B(Q5Bpx!TLSO8#t6if?9L&A0pOxjiD%Rs1LGudviN|7QsPr=Gq1xWua2 zxl5n!FZP_g_SCnJs>gRo`qr}AhP>{#Hj>_@@%HGQ>!$x19OA$>F@#3EzV?3F?x?HF z-$gO>*%bGha(n)n#K2{>2c0j}g_$4&QTKb#KJjFV>ne-i+k CYqKB# literal 0 HcmV?d00001 diff --git a/mozilla/js/src/perlconnect/jsperl.c b/mozilla/js/src/perlconnect/jsperl.c new file mode 100644 index 00000000000..8912024baa6 --- /dev/null +++ b/mozilla/js/src/perlconnect/jsperl.c @@ -0,0 +1,875 @@ +/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*- + * + * The contents of this file are subject to the Netscape Public License + * Version 1.0 (the "NPL"); you may not use this file except in + * compliance with the NPL. You may obtain a copy of the NPL at + * http://www.mozilla.org/NPL/ + * + * Software distributed under the NPL is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL + * for the specific language governing rights and limitations under the + * NPL. + * + * The Initial Developer of this code under the NPL is Netscape + * Communications Corporation. Portions created by Netscape are + * Copyright (C) 1998 Netscape Communications Corporation. All Rights + * Reserved. + */ + +/* + * PerlConnect module. + */ + +/* + The first two headers are from the Perl distribution. + Play with "perl -MExtUtils::Embed -e ccopts -e ldopts" + to find out which directories should be included. Refer + to perlembed man page for more info. +*/ +#include "EXTERN.h" +#include "perl.h" + +#include "jsapi.h" +#include + +/*---------------------------------------------------------------------------*/ +/* PerlConnect. Provides means for OO JS <==> Perl communications */ +/* See README.html for more info on PerlConnect. Look for TODO in this file */ +/* for things that are bogus or not completely implemented. Has been tested */ +/* with 5.004 only */ +/*---------------------------------------------------------------------------*/ + +/* Forward declarations */ +static JSBool PerlConstruct(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *v); +static JSBool PerlFinilize(JSContext *cx, JSObject *obj); +static JSBool perl_eval(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static JSBool perl_call(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static JSBool perl_use(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static JSBool use(JSContext *cx, JSObject *obj, int argc, jsval *argv, const char* t); +static JSBool PMGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval* rval); +static JSBool PMSetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval); +static JSBool PerlToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static JSBool processReturn(JSContext *cx, JSObject *obj, jsval* rval); +static JSBool checkError(JSContext *cx); +static JSBool PMToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static JSBool PVToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval); +static SV* PVGetRef(JSContext *cx, JSObject *obj); +static JSBool PVGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval); +static JSBool PVSetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval); +static JSBool PVGetElement(JSContext *cx, JSObject *obj, jsint index, jsval *rval); +static JSBool PVSetElement(JSContext *cx, JSObject *obj, jsint index, jsval v); +static JSBool PVGetKey(JSContext *cx, JSObject *obj, char* name, jsval *rval); +static JSBool PVSetKey(JSContext *cx, JSObject *obj, char* name, jsval v); +static JSBool PVConvert(JSContext *cx, JSObject *obj, JSType type, jsval *v); +static JSBool PVFinalize(JSContext *cx, JSObject *obj); +/* Exported functions */ +PR_PUBLIC_API(JSObject*) JS_InitPerlClass(JSContext *cx, JSObject *obj); +PR_PUBLIC_API(JSBool) JSVALToSV(JSContext *cx, JSObject *obj, jsval v, SV** sv); +PR_PUBLIC_API(JSBool) SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval); + +/* + The following is required by the Perl dynamic loading mechanism to + link with modules that use C properly. See perlembed man page for details. + This allows things like sockets to be called via PerlConnect. +*/ +#ifdef __cplusplus +# define EXTERN_C extern "C" +#else +# define EXTERN_C extern +#endif + +EXTERN_C void boot_DynaLoader _((CV* cv)); +EXTERN_C void +xs_init() +{ + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); +} + +/* These properties are not processed by the getter for PerlValue */ +static char* predefined_methods[] = {"toString", "valueOf", "type", "length"}; + +/* Represents a perl interpreter */ +JSClass perlClass = { + "Perl", JSCLASS_HAS_PRIVATE, + JS_PropertyStub, JS_PropertyStub, PMGetProperty, /*PMSetProperty*/JS_PropertyStub, + JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, PerlFinilize +}; + +JSFunctionSpec perlMethods[] = { + {"toString", PerlToString, 0}, + {"eval", perl_eval, 0}, + {"call", perl_call, 0}, + {"use", perl_use, 0}, + { NULL, NULL,0 } +}; + + +/* Represents a Perl module */ +JSClass perlModuleClass = { + "PerlModule", JSCLASS_HAS_PRIVATE, + JS_PropertyStub, JS_PropertyStub, PMGetProperty, JS_PropertyStub, + JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub +}; + +JSFunctionSpec perlModuleMethods[] = { + {"toString", PMToString, 0}, + { NULL, NULL,0 } +}; + + +/* Represents a value returned from Perl */ +JSClass perlValueClass = { + "PerlValue", JSCLASS_HAS_PRIVATE, + JS_PropertyStub, JS_PropertyStub, PVGetProperty, PVSetProperty, + JS_EnumerateStub, JS_ResolveStub, PVConvert, PVFinalize +}; + +JSFunctionSpec perlValueMethods[] = { + {"toString", PVToString, 0}, + { NULL, NULL, 0} +}; + +/* + Initializes Perl class. Should be called by applications that + want to enable PerlConnect. This will probably preload the Perl + DLL even though Perl might not actually be used. We may postpone + this and load the DLL at runtime after the constructor is called. +*/ +static JSObject* +js_InitPerlClass(JSContext *cx, JSObject *obj) +{ + jsval v = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, "main")); + JSObject *module = JS_NewObject(cx, &perlModuleClass, NULL, obj); + + JS_DefineFunctions(cx, module, perlModuleMethods); + JS_SetProperty(cx, module, "path", &v); + + return JS_InitClass(cx, obj, module, &perlClass, PerlConstruct, 0, + NULL, NULL, NULL, NULL); +} + +/* Public wrapper for the function above */ +PR_PUBLIC_API(JSObject*) +JS_InitPerlClass(JSContext *cx, JSObject *obj) +{ + return js_InitPerlClass(cx, obj); +} + +/* + Perl constructor. Allocates a new interpreter and defines methods on it. + The constuctor is sort of bogus in that it doesn't create a new namespace + and all the variables defined in one instance of the Perl object will be + visible in others. In the future, I think it may be a good idea to use + Safe.pm to provide independent contexts for different Perl objects and + prohibit certain operations (like exit(), alarm(), die(), etc.). Or we + may simple disallow calling the constuctor more than once. +*/ +static JSBool +PerlConstruct(JSContext *cx, JSObject *obj, uintN argc, jsval *argv, jsval *v) +{ + PerlInterpreter *perl; + JSObject *perlObject; + JSBool ok; + char *embedding[] = {"", "-e", "0"}; + char *t = "use JS qw(perl_eval perl_resolve perl_call $js $ver);"; + + /* create a new interpreter */ + perl = perl_alloc(); + + if(perl==NULL){ + fputs("Can't allocate a new interpreter", stderr); + return 1; + } + + perl_construct(perl); + perl_parse(perl, xs_init, 3, embedding, NULL); + perl_run(perl); + + ok = use(cx, obj, argc, argv, t); + + /* make it into an object */ + perlObject = JS_NewObject(cx, &perlClass, NULL, NULL); + JS_DefineFunctions(cx, perlObject, perlMethods); + JS_SetPrivate(cx, perlObject, perl); + *v = OBJECT_TO_JSVAL(perlObject); + return ok; +} + +/* Destructor. Deallocates the interpreter */ +static JSBool +PerlFinilize(JSContext *cx, JSObject *obj) +{ + PerlInterpreter *perl = JS_GetPrivate(cx, obj); + + perl_destruct(perl); + perl_free(perl); + return JS_TRUE; +} + +/* + Returns a string representation of the Perl interpreter. + Can add printing of the Perl version, @ISA, etc., like the + output produced by perl -V. Can also make certain variables + available off the Perl object, like Perl.version, etc. +*/ +static JSBool +PerlToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval){ + SV* sv = perl_get_sv("JS::ver", FALSE); + *rval = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, SvPV(sv, na))); + return JS_TRUE; +} + +/* + Evaluates the first parameter in Perl and put the eval's + return value into *rval. The return value is of type PerlValue. + This procedure uses JS::perl_eval. Example of use of perl.eval(): + p = new Perl(); + str = p.eval("'-' x 80"); // str contains 80 dashes +*/ +static JSBool +perl_eval(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval) +{ + char *statement; + char *args[] = {NULL, NULL}; /* two elements */ + + if(argc!=1){ + JS_ReportError(cx, "Perl.eval expects one parameter"); + return JS_FALSE; + } + statement = JS_GetStringBytes(JS_ValueToString(cx, argv[0])); + + args[0] = statement; + perl_call_argv("JS::perl_eval", G_SCALAR|G_KEEPERR|G_EVAL, args); + return processReturn(cx, obj, rval); +} + +/* + Call the perl procedure specified as the first argument and + pass all the other arguments as parameters. The return value + is returned in *rval. Example of use of perl.call(): + p = new Perl('Time::gmtime'); + time = p.call("Time::gmtime::gmtime"); // time is now the following array: + // [40,42,1,22,6,98,3,202,0] + NB: The full function name has to be supplied, i.e. Time::gmtime::gmtime + instead of gmtime unless gmtime is exported into the current package. + + This method is also used when one uses the full package name syntax like + this: + p = new Perl("Sys::Hostname", "JS") + result = p.JS.c(1, 2, 4) + p.hostname() + + This gets called from PMGetProperty, which creates a + function whose native method is perl_call. Also see + JS::perl_call. +*/ +static JSBool +perl_call(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval) +{ + JSBool ok; + int count, i; + char* fun_name; + SV *sv; + dSP; + + /* Differetiate between direct and method-like call */ + if((JS_TypeOfValue(cx, argv[-2]) == JSTYPE_FUNCTION) && + strcmp("call", JS_GetFunctionName(JS_ValueToFunction(cx, argv[-2])))){ + fun_name = JS_GetFunctionName(JS_GetPrivate(cx, JSVAL_TO_OBJECT(argv[-2]))); + i=0; + }else{ + fun_name = JS_GetStringBytes(JS_ValueToString(cx, argv[0])); + i=1; + } + + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVpv(fun_name,0))); + + for(;i0){ + /*fprintf(stderr, "Finilization: %d references left", SvREFCNT(sv));*/ + SvREFCNT_dec(sv); + /*fprintf(stderr, "Finilization: %d references left", SvREFCNT(sv));*/ + } + + return JS_TRUE; +} + +/* + Convert a jsval to a SV* (scalar value pointer). + Used for parameter passing. This function is also + used by the Perl part of PerlConnect. +*/ +PR_PUBLIC_API(JSBool) +JSVALToSV(JSContext *cx, JSObject *obj, jsval v, SV** sv) +{ + *sv = &sv_undef; + if(JSVAL_IS_PRIMITIVE(v)){ + /* printf("Primitive\n"); */ + if(JSVAL_IS_NULL(v) || JSVAL_IS_VOID(v)){ + *sv = newSVsv(&sv_undef); + }else + if(JSVAL_IS_INT(v)){ + *sv = newSViv(JSVAL_TO_INT(v)); + }else + if(JSVAL_IS_DOUBLE(v)){ + *sv = newSVnv(*JSVAL_TO_DOUBLE(v)); + }else + if(JSVAL_IS_STRING(v)){ + *sv = newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(v)), 0); + /* printf("string %s\n", SvPV(*sv,na)); */ + }else{ + warn("Unknown primitive type"); + } + }else{ + if(JSVAL_IS_OBJECT(v)){ + JSObject *object = JSVAL_TO_OBJECT(v); + + if(JS_InstanceOf(cx, object, &perlValueClass, NULL)){ + /* printf("Converting PerlValue\n"); */ + newSVsv(SvRV(PVGetRef(cx, object))); + }else{ + if(JS_IsArrayObject(cx, object)){ + /* printf("Converting Array\n"); */ + sv_setref_pv(*sv, "JSArray", (void*)object); + }else{ + /* printf("Converting Object\n"); */ + sv_setref_pv(*sv, "JS::Object", (void*)object); + } + } + }else{ + warn("Type conversion is not supported"); + *sv = &sv_undef; + return JS_FALSE; + } + } + + return JS_TRUE; +} + +/* + Converts a reference Perl value to a jsval. If ref points + to an immediate value, the value itself is returned in rval. + O.w. a PerlValue object is returned. This function is also + used by the Perl part of PerlConnect. +*/ +PR_PUBLIC_API(JSBool) +SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval){ + SV *sv; + char* name=NULL; + + if(!SvRV(ref) || !SvROK(ref)){ + warn("Not a reference passed to SVToJS"); + sv = ref; + }else{ + sv = SvRV(ref); + } + + /* printf("In SVToJSVAL value %s, type=%d\n", SvPV(sv, na), SvTYPE(sv)); */ + + /* Scalars */ + /* Weird way to check that we are dealing with undef here. */ + if(SvANY(sv) == SvANY(&sv_undef)){ + /*printf("undef %s, %p, %p\n", SvPV(sv, na), sv, &sv_undef);*/ + *rval = JSVAL_VOID; + }else + if(SvIOK(sv)){ + /*printf("int\n");*/ + *rval = INT_TO_JSVAL(SvIV(sv)); + }else + if(SvNOK(sv)){ + /*printf("double\n");*/ + JS_NewDoubleValue(cx, SvNV(sv), rval); + }else + if(SvPOK(sv)){ + /*printf("string\n");*/ + *rval = STRING_TO_JSVAL((JS_NewStringCopyZ(cx, SvPV(sv, na)))); + }else{ + JSObject *perlValue; + + /*svtype type = SvTYPE(sv); + switch(type){ + case SVt_RV: name = "Perl Reference"; break; + case SVt_PVAV: name = "Perl Array"; break; + case SVt_PVHV: name = "Perl Hash"; break; + case SVt_PVCV: name = "Perl Code Reference"; break; + case SVt_PVMG: name = "Perl Magic"; break; + default: + warn("Unsupported type in SVToJSVAL: %d", type); + *rval = JSVAL_VOID; + return JS_FALSE; + }*/ + + /*printf("default\n");*/ + name = "Perl Value"; + perlValue = JS_DefineObject(cx, obj, "PerlValue", + &perlValueClass, NULL, JSPROP_ENUMERATE); + JS_SetPrivate(cx, perlValue, ref); + JS_DefineFunctions(cx, perlValue, perlValueMethods); + JS_DefineProperty(cx, perlValue, "type", + name?STRING_TO_JSVAL(JS_NewStringCopyZ(cx, name)):JSVAL_VOID, + NULL, NULL, JSPROP_PERMANENT|JSPROP_READONLY); + *rval = OBJECT_TO_JSVAL(perlValue); + } + + return JS_TRUE; +} diff --git a/mozilla/js/src/perlconnect/jsperl.h b/mozilla/js/src/perlconnect/jsperl.h new file mode 100644 index 00000000000..40fe79db030 --- /dev/null +++ b/mozilla/js/src/perlconnect/jsperl.h @@ -0,0 +1,30 @@ +/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*- + * + * The contents of this file are subject to the Netscape Public License + * Version 1.0 (the "NPL"); you may not use this file except in + * compliance with the NPL. You may obtain a copy of the NPL at + * http://www.mozilla.org/NPL/ + * + * Software distributed under the NPL is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL + * for the specific language governing rights and limitations under the + * NPL. + * + * The Initial Developer of this code under the NPL is Netscape + * Communications Corporation. Portions created by Netscape are + * Copyright (C) 1998 Netscape Communications Corporation. All Rights + * Reserved. + */ + +/* This is the public header, which means that this is the only thing one */ +/* needs to include to enable the Perl object. See README.html for more */ +/* documentation */ + +#include "jsapi.h" + +/* + This is the only function that must be called by an + application that wants to use PerlConnect. +*/ +extern PR_PUBLIC_API(JSObject*) +JS_InitPerlClass(JSContext *cx, JSObject *obj); diff --git a/mozilla/js/src/perlconnect/jsperlpvt.h b/mozilla/js/src/perlconnect/jsperlpvt.h new file mode 100644 index 00000000000..d4af67145b7 --- /dev/null +++ b/mozilla/js/src/perlconnect/jsperlpvt.h @@ -0,0 +1,36 @@ +/* -*- Mode: C; tab-width: 8; indent-tabs-mode: nil; c-basic-offset: 4 -*- + * + * The contents of this file are subject to the Netscape Public License + * Version 1.0 (the "NPL"); you may not use this file except in + * compliance with the NPL. You may obtain a copy of the NPL at + * http://www.mozilla.org/NPL/ + * + * Software distributed under the NPL is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL + * for the specific language governing rights and limitations under the + * NPL. + * + * The Initial Developer of this code under the NPL is Netscape + * Communications Corporation. Portions created by Netscape are + * Copyright (C) 1998 Netscape Communications Corporation. All Rights + * Reserved. + */ + +#include "EXTERN.h" +#include "perl.h" +#include "jsperl.h" +/* Copyright © 1998 Netscape Communications Corporation, All Rights Reserved.*/ +/* This is the private header, which means that it shouldn't be included */ +/* unless you need to use some of the jsval<->SV* conversion functions */ +/* provided by PerlConnect needs to include to enable the Perl object. See */ +/* README.html for more documentation */ + +/* + This and the following function are used to convert + between Perl's "SV*" and JS's "jsval" types. +*/ +extern SV* +JSVALToSV(JSContext *cx, JSObject *obj, jsval v, SV** sv); + +extern JSBool +SVToJSVAL(JSContext *cx, JSObject *obj, SV *ref, jsval *rval); diff --git a/mozilla/js/src/perlconnect/test.js b/mozilla/js/src/perlconnect/test.js new file mode 100644 index 00000000000..da42842a7c8 --- /dev/null +++ b/mozilla/js/src/perlconnect/test.js @@ -0,0 +1,53 @@ +/* + * The contents of this file are subject to the Netscape Public License + * Version 1.0 (the "NPL"); you may not use this file except in + * compliance with the NPL. You may obtain a copy of the NPL at + * http://www.mozilla.org/NPL/ + * + * Software distributed under the NPL is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL + * for the specific language governing rights and limitations under the + * NPL. + * + * The Initial Developer of this code under the NPL is Netscape + * Communications Corporation. Portions created by Netscape are + * Copyright (C) 1998 Netscape Communications Corporation. All Rights + * Reserved. + */ + +/******************************************************************************* +* PerlConnect test file. Some primitive testing in "silent mode" -- that is, +* you should be able to run +* perlconnectshell test.js +* without any error messages. See README.html for more info. +*******************************************************************************/ + +// Init +assert(p = new Perl('Sys::Hostname', 'Time::gmtime'), "Perl initialization failed"); +// Simple eval +assert(p.eval("'-' x 3") == '---', "Wrong value returned from eval"); + +assert(p.eval("undef()")==undefined, "Wrong value returned from eval"); +// Arrays +assert(a=p.eval("(1, 2, 3);"), "eval failed, 1"); +assert(a[1]==2, "Wrong value"); +assert(a.length==3, "Wrong length"); +// Hashes +assert(h=p.eval("{'one'=>1, 'two'=>2};"), "eval failed, 2"); +assert(h["two"]==2, "Wrong value"); +// Func. call +assert(p.eval("&hostname()") == p.call("hostname"), "Wrong value returned from eval or call"); +// Complex call +assert(b=p.Time.gmtime.gmtime(), "call failed"); +assert(b.length==9, "Wrong length") +// Variables +// Scalars +assert(p.eval("$a = 100; $b = 'abc';"), "eval failed, 3"); +assert(p.$a ==100, "Wrong variable value, 1"); +assert(p["$b"] == 'abc', "Wrong variable value, 2"); + +/* Auxilary function */ +function assert(cond, msg) +{ + cond || print("Error: " + msg+"\n"); +} // assert diff --git a/mozilla/js/src/perlconnect/test.pl b/mozilla/js/src/perlconnect/test.pl new file mode 100644 index 00000000000..aeac133d342 --- /dev/null +++ b/mozilla/js/src/perlconnect/test.pl @@ -0,0 +1,56 @@ +# +# The contents of this file are subject to the Netscape Public License +# Version 1.0 (the "NPL"); you may not use this file except in +# compliance with the NPL. You may obtain a copy of the NPL at +# http://www.mozilla.org/NPL/ +# +# Software distributed under the NPL is distributed on an "AS IS" basis, +# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL +# for the specific language governing rights and limitations under the +# NPL. +# +# The Initial Developer of this code under the NPL is Netscape +# Communications Corporation. Portions created by Netscape are +# Copyright (C) 1998 Netscape Communications Corporation. All Rights +# Reserved. +# + +# +# Test file for JS.pm +# + +use JS; +# create new JS context +($js = new JS()) or warn "new JS() failed"; +# eval for simple scalar cases +# int +($js->eval("100") == 100) or warn "Wrong value returned from eval()"; +# and string +($js->eval("'test string'") == 'test string') or warn "Wrong value returned from eval()"; +# double TODO: double comparison? +($js->eval("1.25") == 1.25) or warn "Wrong value returned from eval()"; +# more complex eval: +# return an object +$obj = $js->eval(q/ + x = new Object(); + x.t='a'; + x; +/) or warn "eval failed"; +# tie this object to a hash +tie %hash, "JS::Object", $obj; +# try retrieving and manipulating values +$hash{foo} = 1200; +$_ = $hash{foo}; +($_ == 1200) or warn "Wrong value returned from hash"; +# +$hash{bar} = 'abcdef'; +$_ = $hash{bar}; +($_ eq 'abcdef') or warn "Wrong value returned from hash"; +# exists/delete +(exists $hash{bar}) or warn "\$hash{bar} should exist"; +delete $hash{bar}; +(!exists $hash{bar}) or warn "\$hash{bar} should be deleted"; +# exists/clear +(exists $hash{foo}) or warn "\$hash{foo} should exist"; +undef %hash; +(!exists $hash{foo}) or warn "\$hash{foo} should be deleted"; diff --git a/mozilla/js/src/perlconnect/typemap b/mozilla/js/src/perlconnect/typemap new file mode 100644 index 00000000000..dc798492255 --- /dev/null +++ b/mozilla/js/src/perlconnect/typemap @@ -0,0 +1,79 @@ +# +# The contents of this file are subject to the Netscape Public License +# Version 1.0 (the "NPL"); you may not use this file except in +# compliance with the NPL. You may obtain a copy of the NPL at +# http://www.mozilla.org/NPL/ +# +# Software distributed under the NPL is distributed on an "AS IS" basis, +# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the NPL +# for the specific language governing rights and limitations under the +# NPL. +# +# The Initial Developer of this code under the NPL is Netscape +# Communications Corporation. Portions created by Netscape are +# Copyright (C) 1998 Netscape Communications Corporation. All Rights +# Reserved. +# + +# +# Typemap for PerlConnect +# + +TYPEMAP +# These types have direct equivalents implemented as Perl packages +JSRuntime * RUNTIME +JSContext * CONTEXT +jsval jsval +# This is an auxilary type. Object serves as a wrapper for it +JSObject * OBJECT + + +OUTPUT +jsval + { + JSContext *cx = getContext(); + JSVALToSV(cx, JS_GetGlobalObject(cx), $var, &$arg); + } + +OBJECT + sv_setref_pv($arg, "JS::Object", (void*)$var); + +CONTEXT + sv_setref_pv($arg, "JS::Context", (void*)$var); + +RUNTIME + sv_setref_pv($arg, "JS::Runtime", (void*)$var); + +#JS_OBJECT +# sv_setref_pv($arg, "JSObject", (void*)$var); + +INPUT +jsval + { + JSContext *cx = getContext(); + SVToJSVAL(cx, JS_GetGlobalObject(cx), newRV($arg), &$var); + } + +OBJECT + if(sv_isa($arg, \"JS::Object\")) + $var = ($type)SvIV((SV*)SvRV($arg)); + else{ + warn(\"${Package}::$func_name() -- $var is not a blessed JS::Object reference\"); + XSRETURN_UNDEF; + } + +CONTEXT + if(sv_isa($arg, \"JS::Context\")) + $var = ($type)SvIV((SV*)SvRV($arg)); + else{ + warn(\"${Package}::$func_name() -- $var is not a blessed JS::Context reference\"); + XSRETURN_UNDEF; + } + +RUNTIME + if(sv_isa($arg, \"JS::Runtime\")) + $var = ($type)SvIV((SV*)SvRV($arg)); + else{ + warn(\"${Package}::$func_name() -- $var is not a blessed JS::Runtime reference\"); + XSRETURN_UNDEF; + }