Bommels05/Mozilla
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial checkin of PerlConnect, migrated from the private tree.

Browse Source 
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
This commit is contained in:
mccabe%netscape.com
1998-09-28 22:05:39 +00:00
parent 590829240e
commit b99526dfbb
15 changed files with 2272 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
mozilla/js/src/perlconnect/JS.def Normal file
View File

@@ -0,0 +1,6 @@
LIBRARY "JS"
DESCRIPTION "JS library for Perl <-> JS communications"
CODE LOADONCALL
DATA LOADONCALL NONSHARED MULTIPLE
EXPORTS
boot_JS

98
mozilla/js/src/perlconnect/JS.dsp Normal file
View File

@@ -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

241
mozilla/js/src/perlconnect/JS.pm Normal file
View File

@@ -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;

224
mozilla/js/src/perlconnect/JS.xs Normal file
View File

@@ -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

104
mozilla/js/src/perlconnect/PerlConnect.dsp Normal file
View File

@@ -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

59
mozilla/js/src/perlconnect/PerlConnect.dsw Normal file
View File

@@ -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>
{{{
}}}
###############################################################################

90
mozilla/js/src/perlconnect/PerlConnectShell.dsp Normal file
View File

@@ -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

321
mozilla/js/src/perlconnect/README.html Normal file
View File

@@ -0,0 +1,321 @@
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=koi8-r">
<META NAME="Author" CONTENT="Vladimir Livshits">
<META NAME="GENERATOR" CONTENT="Mozilla/4.05 [en]C-NSCP (WinNT; U) [Netscape]">
<TITLE>PerlConnect Documentation</TITLE>
<STYLE>
A:link {text-decoration: none}
A:visited {text-decoration: none}
</STYLE>
</HEAD>
<BODY BACKGROUND="bg.jpg">
<CENTER>
<H3>
P<FONT SIZE=-1>ERL</FONT>C<FONT SIZE=-1>ONNECT AND</FONT><FONT SIZE=+0>
</FONT>JS<FONT SIZE=-1>.pm</FONT></H3></CENTER>
<CENTER>U<FONT SIZE=-1>SER-LEVEL </FONT><FONT SIZE=+1>D</FONT><FONT SIZE=-1>OCUMENTATION</FONT></CENTER>
<CENTER><A HREF="mailto:val4@cornell.edu">Vladimir Livshits</A></CENTER>
<CENTER>&nbsp;
<HR SIZE=1 NOSHADE WIDTH="100%"></CENTER>
<OL>
<LI>
<A HREF="#Overview">Overview</A></LI>
<LI>
<A HREF="#Features">Features</A></LI>
<LI>
<A HREF="#Design">Design</A></LI>
<LI>
<A HREF="#Installation">Installation</A></LI>
<LI>
<A HREF="#Limitations">Current Limitations and Futher Work</A></LI>
</OL>
<H4>
<A NAME="Overview"></A>Overview</H4>
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 (<I>tentative name</I>), 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.
<H4>
<A NAME="Features"></A>PerlConnect Features</H4>
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:
<BLOCKQUOTE><TT>p = new Perl('Sys::Hostname', 'Test::Harness')</TT></BLOCKQUOTE>
In addition to creating an interpreter, this will also include the libraries
you&nbsp; pass to the Perl constructor, which is equivalent to <TT>use
Sys::Hostname; use Test::Harness</TT>. You can always include libraries
explicitly by using <TT>p.eval('use Sys::Hostname; use Test::Harness')</TT>.
There is also another way to do this: <TT>p.use('Sys::Hostname', 'Test::Harness')</TT>.
As you can see, TMTOWTDI. Natura&nbsp;&nbsp;&nbsp; lly, you will want to
look at the result of your function calls and <TT>eval</TT> statements.
Suppose, you do something like this:
<BLOCKQUOTE><TT>line = p.eval("'-' x 80")</TT></BLOCKQUOTE>
Perl's eval returns the last statement evaluated, unless you explicitly
say <TT>return</TT>. So now <TT>line</TT> contains 80 dashes. You can do
similar things with non-scalar data types:
<BLOCKQUOTE><TT>p.use('Time::gmtime');</TT>
<BR><TT>t = p.eval('Time::gmtime::gmtime')&nbsp;&nbsp;&nbsp; // returns
[49,0,4,24,6,98,5,204,0]</TT></BLOCKQUOTE>
assigns a Perl array to <TT>t</TT>. You can print <TT>t</TT>, use the <TT>for/in</TT>
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 <TT>t.reverse()</TT> to work. Hashes can also
be returned from Perl:
<BLOCKQUOTE><TT>info=p.eval("{ver=>$], pid=>$$}")</TT></BLOCKQUOTE>
Now you can look at individual hash keys like this:
<BLOCKQUOTE><TT>info["ver"]</TT> or <TT>info.pid</TT></BLOCKQUOTE>
Suppose you want to use Perl to perform pattern-based string replacement.
Here's how you can do it from JavaScript:
<BLOCKQUOTE><TT>p.eval("\</TT>
<BR><TT>&nbsp;&nbsp;&nbsp; sub perl_replace(){\</TT>
<BR><TT>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; my($string, $find, $replace)
= @_;\</TT>
<BR><TT>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; eval(\"\\$string =~
s/$find/$replace/g;\");\</TT>
<BR><TT>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return $string;\</TT>
<BR><TT>&nbsp;&nbsp;&nbsp; }"</TT>
<BR><TT>);</TT></BLOCKQUOTE>
and now
<BLOCKQUOTE><TT>p.perl_replace('Quick brown fox jumped over a lazy dog',
'dog', 'rhino')</TT></BLOCKQUOTE>
produces what you'd expect.
<P>You can use the same syntax to call procedures defined in modules other
than<TT> main. </TT>The example with<TT> gmtime </TT>can be rewritten like
this:
<BLOCKQUOTE><TT>p.use('Time::gmtime');</TT>
<BR><TT>t = p.Time.gmtime.gmtime()&nbsp;&nbsp;&nbsp; // returns [49,0,4,24,6,98,5,204,0]</TT></BLOCKQUOTE>
&nbsp;You can reference variables exported by modules others than <TT>main</TT>
like this:
<BLOCKQUOTE><TT>a=p.Foo.$bar </TT>or<TT> a=p.Foo["$bar"] </TT>or
<BR><TT>a=p.Foo["@bar"]</TT>or<TT> a=p.Foo["%bar"]</TT></BLOCKQUOTE>
Each of the stetements above returns a either an immediate JS value, for
scalar types, or a PerlValue for compound types. <TT>a.type </TT>contains
the type of the PerlValue in <TT>a</TT>. <I>This may change because we
may end up separating Perl hashes and arrays into separate classes.</I>
<H4>
JS.pm Features</H4>
<I>JS.pm is much less tested then PerlConnect.</I> You should be able to
do similar things from Perl. Just say
<BLOCKQUOTE><TT>use JS;</TT>
<BR><TT>$js = <B>new</B> JS();</TT></BLOCKQUOTE>
and now you can do something like this:
<BLOCKQUOTE><TT>$js-><B>eval</B>(q/</TT>
<BLOCKQUOTE><TT>Object o = {};</TT>
<BR><TT>o.a = 'p';</TT>
<BR><TT>o.b = 'q';</TT>
<BR><TT>return o;</TT></BLOCKQUOTE>
<TT>/);</TT></BLOCKQUOTE>
<B>//TODO: more features and examples</B>
<H4>
<A NAME="Design"></A>PerlConnect Design</H4>
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:
<BR>&nbsp;
<CENTER><TABLE BORDER COLS=2 WIDTH="80%" >
<TR ALIGN=CENTER BGCOLOR="#CCCCCC">
<TD ALIGN=CENTER VALIGN=CENTER WIDTH="20%"><B>Object</B></TD>
<TD><B>What it does</B></TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD WIDTH="30"><TT>Perl</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Perl Interpreter Object. It's prototype type
is PerlModule, it corresponds to <TT>main::</TT>. Supports <TT>eval</TT>,
<TT>call</TT>, <TT>use</TT>.</TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD><TT>PerlModule</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Implements JS-like syntax for Perl modules. Doesn't
export provide any methods. <TT>path</TT> property shown the name of the
Perl module the object represents.</TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD><TT>PerlValue</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Represents a value returned from <TT>eval</TT>,
<TT>call</TT>, or obtained by using the subscript notation (<TT>p.Foo["@bar"]</TT>).
Its Perl type is stored in the <TT>type</TT> property.</TD>
</TR>
</TABLE></CENTER>
&nbsp;
<BR>See comments in the code, <TT>jsperl.c</TT> and <TT>JS.pm</TT> for
more info.
<BR>&nbsp;
<H4>
JS.pm Design</H4>
JSConnect is written using XSUBs, the language in which Perl extentions
are implemented. The source files are <TT>JS.xs</TT> and <TT>typemap</TT>.
After processing them using the XSUBs compiler, <TT>xsubpp</TT>, the resulting
C file should be compiled into a DLL. <TT>JS.pm</TT> provides bootstraping
mechanism to load this DLL. See <TT>perlxs</TT> and <TT>perlxsstut</TT>
man pages for more info. The following Perl packages (objects) are implemented:
<BR>&nbsp;
<CENTER><TABLE BORDER COLS=2 WIDTH="80%" >
<TR ALIGN=CENTER BGCOLOR="#CCCCCC">
<TD ALIGN=CENTER VALIGN=CENTER WIDTH="20%"><B>Package</B></TD>
<TD><B>What it contains</B></TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD><TT>JS</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Doesn't not do anything in particular at this
point except defining a constuctor. So one can say <TT>$js = <B>new</B>
JS()</TT>, 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 <TT>@EXPORT_OK</TT>
array instead.</TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD><TT>JS::Runtime</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Corresponds to <TT>JSRuntime*</TT> 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: <TT>$rt = <B>new</B> JS::Runtime(10_000)</TT>, where
the parameter is the same number you pass to <TT>JS_NewRuntime</TT>. There
are many private functions created in <TT>JS.xs</TT> that are not exported
by default.</TD>
</TR>
<TR ALIGN=CENTER VALIGN=CENTER>
<TD><TT>JS::Context</TT></TD>
<TD ALIGN=LEFT VALIGN=TOP>Corresponds to <TT>JSContext*</TT> 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: <TT>$rt = <B>new</B> JS::Context($rt, 1_000)</TT>, where
the parameter is the same number you pass to <TT>JS_NewContext</TT>. There
are many private functions created in <TT>JS.xs</TT> that are not exported
by default.</TD>
</TR>
<TR>
<TD ALIGN=CENTER><TT>JS::Object</TT></TD>
<TD>Corresponds to <TT>JSObject*</TT> struct. There is not that much here
yet. This object is intended as a wrapper around the <TT>JSObject* stuct</TT>.
Support for tying hashes and possibly arrays with <TT>JS::Objects</TT>
is coming.</TD>
</TR>
<TR>
<TD ALIGN=CENTER><I><TT><FONT COLOR="#000000">[JS::Array]</FONT></TT></I></TD>
<TD><I>I am not quite sure if this is needed. One might probably get away
with just <TT>JS::Object</TT> defined. If it's implemented, it will be
very much similar to <TT>JS::Object</TT> above.</I></TD>
</TR>
</TABLE></CENTER>
&nbsp;
<P>All the modules above follow the convention of storing the variable
they return in the <TT>$this</TT> variable of the current class. So <TT>$JS::Context::this</TT>
will always be the last context created. <I>Currently, this is where JS
API function that require contexts get it.</I>
<H4>
<A NAME="Installation"></A>PerlConnect Installation</H4>
PerlConnect requires <TT>js/ref</TT> and the Perl libraries and headers.
The only <TT>js/ref</TT> file that must be included in <TT>jsapi.h</TT>.
You need to compile it together with Perl libraries. Referer to the <TT>perlembed</TT>
man page for more details.
<BR><B>On WINNT:</B>
<BR>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.
<BR><B>On UNIX:</B>
<BR>Currently, you can use PerlConnect with the <TT>js.c</TT> shell. To
compile it on UNIX, you need to set the PERLCONNECT environment variable.
Then you can use the Makefile in <TT>js/ref</TT> directory. The makefile
should read the variable from the current environment. Id this doesn't
happent, you can try using <TT>gmake PERLCONNECT=1</TT>. This will compile
PerlConnect into <TT>js</TT>.
<H4>
JS.pm Installation</H4>
The following source files are distributed: <TT>JS.pm</TT>, <TT>JS.xs</TT>,
<TT>JS.c</TT> (produced from <TT>JS.xs</TT> by <TT>xsubpp</TT>) and <TT>JS.def</TT>
(required by the Visual C compiler).
<BR><B>On WINNT:</B>
<BR>There is also a project file, <TT>JS.dsp</TT>. It automatically belongs
to the PerlConnect workspace. This project file builds a DLL, <TT>JS.dll</TT>
which is supposed to reside where Perl's DynaLoader can find it. On my
machine I put it under <TT>c:\perl\lib\auto\JS\JS.dll</TT>. You can also
put it in <TT>c:\perl\lib\</TT>. See DynaLoader documentation for more
info on how dynamic libraries are found.
<BR><B>On UNIX:</B>
<BR><B>//TODO:</B> <B>details of the makefiles</B>
<BR>&nbsp;
<H4>
<A NAME="Limitations"></A>Current Limitations of the Package and Futher
Work</H4>
<OL>
<LI>
Perl variables currently can't be assigned to, that is, <TT>p["$a"]=100</TT>
doesn't do anything.</LI>
<LI>
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 <TT>Safe.pm</TT> to implement independent
namespaces.</LI>
<LI>
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
<TT>p.Foo.Bar.Var</TT> and <TT>For</TT> or <TT>Bar</TT> don't exist, it
will only complain that p.Foo.Bar.Var is not a valid variable. Perl 5.005
provides <TT>exists Foo::{Bar::}</TT> to check if Foo::Bar is a valid package.</LI>
<LI>
Dynamic loading of the Perl interpreter only if it is required.</LI>
<LI>
Recursive printing of Perl's arrays and hashes can be added. See Data::Dumper.pm</LI>
<LI>
Full support for tied hashes and arrays in Perl</LI>
<LI>
Calling JavaScript functions and accessing variables from Perl. JavaScript
calling syntax support using AUTOLOADing.</LI>
<LI>
JS can be made a directory with <TT>Object.pm</TT>, <TT>Context.pm</TT>,
etc. in it. See how C or Tk are organized on CPAN</LI>
<LI>
Distribution model for JS.pm. Perl provides something by default. See <TT>h2xs</TT>
man page, for example.</LI>
</OL>
</BODY>
</HTML>

BIN
mozilla/js/src/perlconnect/bg.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

875
mozilla/js/src/perlconnect/jsperl.c Normal file
View File

@@ -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 <string.h>
/*---------------------------------------------------------------------------*/
/* 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(;i<argc;i++){
JSVALToSV(cx, obj, argv[i], &sv);
XPUSHs(sv);
}
PUTBACK;
count = perl_call_sv(newSVpv("JS::perl_call", 0), G_KEEPERR|G_SCALAR|G_EVAL|G_DISCARD);
if(count!=0){
fprintf(stderr, "Implementation error: count=%d, must be 0!\n", count);
return JS_FALSE;
}
ok = processReturn(cx, obj, rval);
return ok;
}
/*
Loads Perl libraries specified as arguments.
*/
static JSBool
perl_use(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval)
{
return use(cx, obj, argc, argv, NULL);
}
/*
Utility function used by perl_use and Perl's constructor.
Executes use lib1; use lib2, etc. in the current interpreter.
*/
static JSBool
use(JSContext *cx, JSObject *obj, int argc, jsval *argv, const char* t){
char *evalStr = JS_malloc(cx, t?strlen(t)+1:1);
int i;
strcpy(evalStr, t?t:"");
for(i=0;i<argc;i++){
char *arg = JS_GetStringBytes(JS_ValueToString(cx, argv[i])), *tmp, old[256];
/* call use() on every parameter */
strcpy(old, evalStr);
free(evalStr);
tmp = JS_malloc(cx, strlen(old)+strlen(arg)+6);
sprintf(tmp, "%suse %s;", old, arg);
evalStr = tmp;
}
perl_eval_sv(newSVpv(evalStr, 0), G_KEEPERR);
checkError(cx);
JS_free(cx, evalStr);
return JS_TRUE;
}
/*
Looks at $@ to see if there was an error. Used by
perl_eval, perl_call, etc.
*/
static JSBool
checkError(JSContext *cx)
{
if(SvTRUE(GvSV(errgv))){
JS_ReportError(cx, "perl eval failed: %s",
SvPV(GvSV(errgv), 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;
}
/*
Take the value of $JS::js and convert in to a jsval. It's stotred
in *rval. perl_eval and perl_call use $JS::js to store return results.
*/
static JSBool
processReturn(JSContext *cx, JSObject *obj, jsval* rval)
{
SV *js;
js = perl_get_sv("JS::js", FALSE);
if(!js || !SvOK(js)){
*rval = JSVAL_VOID;
return JS_FALSE;
}else if(!SvROK(js)){
JS_ReportError(cx, "$js (%s) must be of reference type", SvPV(js,na));
return JS_FALSE;
}
checkError(cx);
return SVToJSVAL(cx, obj, js, rval);
}
/*
Implements namespace-like syntax that maps Perl packages to
JS objects. One can say
p = new Perl('Foo::Bar')
and then call
a = p.Foo.Bar.f()
or access variables exported from those packages like this:
a = p.Foo.Bar["$var"]
this syntax will also work:
a = p.Foo.Bar.$var
but if you want to access non-scalar values, you must use the subscript syntax:
p.Foo.Bar["@arr"]
and
p.Foo.Bar["%hash"]
*/
static JSBool
PMGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
{
char *last = JS_GetStringBytes(JS_ValueToString(cx, name)), *path, package[256];
char *args[] = {NULL, NULL};
char *predefined_methods[] = {"toString", "eval", "call", "use", "path"};
int count;
SV *js;
jsval v;
int i;
for(i=0;i<sizeof(predefined_methods)/sizeof(char*);i++){
if(!strcmp(predefined_methods[i], last)){
return JS_TRUE;
}
}
JS_GetProperty(cx, obj, "path", &v);
path = JS_GetStringBytes(JS_ValueToString(cx, v));
sprintf(package, "%s::%s", path, last);
args[0] = package;
count = perl_call_argv("JS::perl_resolve", G_KEEPERR|G_SCALAR|G_EVAL|G_DISCARD, args);
if(count!=0){
fprintf(stderr, "Implementation error: count=%d, must be 0!\n", count);
return JS_FALSE;
}
checkError(cx);
js = perl_get_sv("JS::js", FALSE);
if(js && SvOK(js)){
if(SvROK(js)){
SVToJSVAL(cx, obj, js, rval);
}else{
/* defined function */
if(SvIV(js) == 1){
JSFunction *f = JS_NewFunction(cx, (JSNative)perl_call, 0, 0, NULL, package);
*rval = OBJECT_TO_JSVAL(JS_GetFunctionObject(f));
}else
if(SvIV(js) == 2){
JSObject *module;
module = JS_NewObject(cx, &perlModuleClass, NULL, obj);
v = (js && SvTRUE(js))?STRING_TO_JSVAL(JS_NewStringCopyZ(cx,package)):JSVAL_VOID;
JS_SetProperty(cx, module, "path", &v);
*rval = OBJECT_TO_JSVAL(module);
}else{
JS_ReportError(cx, "Symbol %s is not defined", package);
*rval = JSVAL_VOID;
}
}
return JS_TRUE;
}else{
puts("failure");
return JS_FALSE;
}
}
/*
Gets called when a Perl value gets assigned to like this:
p.Foo.Bar["$var"] = 100
*/
static JSBool
PMSetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
{
/* TODO: just call SVToJSVAL() and make the assignment. */
return JS_TRUE;
}
/*
toString() for PerlModule. Prints the path the module represents.
Note that the path doesn't necessarily have to be valid. We don't
have a way to check that until we call a function from that package.
TODO: In 5.005 exists Foo::{Bar::} checks is Foo::{Bar::} exists.
We can use this to validate package names.
*/
static JSBool
PMToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval){
char str[256];
JSString *s;
jsval v;
JS_GetProperty(cx, obj, "path", &v);
s = JSVAL_TO_STRING(v);
sprintf(str, "[PerlModule %s]", JS_GetStringBytes(s));
*rval = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, str));
return JS_TRUE;
}
/*
Helped method. Retrieves the Perl reference stored
in PerlValue object as private data.
*/
static SV*
PVGetRef(JSContext *cx, JSObject *obj)
{
SV* ref;
ref = (SV*)JS_GetInstancePrivate(cx, obj, &perlValueClass, NULL);
if(!ref || !SvOK(ref) || !SvROK(ref)){
JS_ReportError(cx, "Can't extract ref");
return NULL;
}
return ref;
}
/*
Retrieve property from PerlValue object by its name. Tries
to look at the PerlValue object both as a hash and array.
If the index is numerical, then it looks at the array part
first. *rval contains the result.
*/
static JSBool
PVGetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
{
char* str;
if(JSVAL_IS_INT(name)){
int32 ip;
JS_ValueToInt32(cx, name, &ip);
PVGetElement(cx, obj, ip, rval);
if(*rval!=JSVAL_VOID){
return JS_TRUE;
}
}
str = JS_GetStringBytes(JS_ValueToString(cx, name));
if(!strcmp(str, "length")){
SV* sv = SvRV(PVGetRef(cx, obj));
if(SvTYPE(sv)==SVt_PVAV){
*rval = INT_TO_JSVAL(av_len((AV*)sv)+1);
return JS_TRUE;
}else
if(SvTYPE(sv)==SVt_PVHV){
*rval = INT_TO_JSVAL(av_len((AV*)sv)+1);
return JS_TRUE;
}else{
*rval = INT_TO_JSVAL(0);
return JS_TRUE;
}
}else{
int i;
for(i=0;i<sizeof(predefined_methods)/sizeof(char*);i++){
if(!strcmp(predefined_methods[i], str)){
return JS_TRUE;
}
}
PVGetKey(cx, obj, str, rval);
if(*rval!=JSVAL_VOID){
return JS_TRUE;
}else{
char* str = JS_GetStringBytes(JS_ValueToString(cx, name));
JS_ReportError(cx, "Perl: can't get property '%s'", str);
return JS_FALSE;
}
}
return JS_TRUE;
}
/*
Set property of PerlValue object. Like GetProperty is looks at
both array and hash components.
*/
static JSBool
PVSetProperty(JSContext *cx, JSObject *obj, jsval name, jsval *rval)
{
char* str = JS_GetStringBytes(JS_ValueToString(cx, name));
if(JSVAL_IS_INT(name)){
int32 ip;
JS_ValueToInt32(cx, name, &ip);
if(PVSetElement(cx, obj, ip, *rval)) return JS_TRUE;
}
return PVSetKey(cx, obj, str, *rval);
}
/*
Retrieve numerical property of a PerlValue object.
If the object doesn't contain an array, or the
property doesn't exist, NULL is returned.
*/
static JSBool
PVGetElement(JSContext *cx, JSObject *obj, jsint index, jsval *rval)
{
SV *ref, **sv;
AV *list;
*rval = JSVAL_VOID;
ref = PVGetRef(cx, obj);
if(SvTYPE(SvRV(ref)) != SVt_PVAV){
return JS_FALSE;
}
list = (AV*)SvRV(ref);
if(!list){
return JS_FALSE;
}
sv = av_fetch(list, (I32)index, 0);
if(!sv){
return JS_FALSE;
}
return SVToJSVAL(cx, obj, newRV_inc(*sv), rval);
}
/*
Set a numeric property of a PerlValue object.
If the object doesn't contain an array or the
index doesn't exist, JS_FALSE is returned.
*/
static JSBool
PVSetElement(JSContext *cx, JSObject *obj, jsint index, jsval v)
{
SV *ref, **sv, *s;
AV *list;
ref = PVGetRef(cx, obj);
if(SvTYPE(SvRV(ref)) != SVt_PVAV){
return JS_FALSE;
}
list = (AV*)SvRV(ref);
if(!list) return JS_FALSE;
JSVALToSV(cx, obj, v, &s);
sv = av_store(list, (I32)index, s);
if(!sv) return JS_FALSE;
return JS_TRUE;
}
/*
Retrieve property. If the object doesn't contain an hash, or the
property doesn't exist, NULL is returned.
*/
static JSBool
PVGetKey(JSContext *cx, JSObject *obj, char* name, jsval *rval)
{
SV *ref, **sv;
HV *hash;
*rval = JSVAL_VOID;
ref = PVGetRef(cx, obj);
if(SvTYPE(SvRV(ref)) != SVt_PVHV){
return JS_FALSE;
}
hash = (HV*)SvRV(ref);
if(!hash){
return JS_FALSE;
}
sv = hv_fetch(hash, name, strlen(name), 0);
if(!sv){
return JS_FALSE;
}
return SVToJSVAL(cx, obj, newRV_inc(*sv), rval);
}
/*
Get property of a PerlValue object.
If the object doesn't contain a hash or the
property doesn't exist, JS_FALSE is returned.
*/
static JSBool
PVSetKey(JSContext *cx, JSObject *obj, char* name, jsval v)
{
SV *ref, **sv, *s;
HV *hash;
ref = PVGetRef(cx, obj);
if(SvTYPE(SvRV(ref)) != SVt_PVHV){
return JS_FALSE;
}
hash = (HV*)SvRV(ref);
if(!hash) return JS_FALSE;
JSVALToSV(cx, obj, v, &s);
sv = hv_store(hash, name, strlen(name), s, 0);
if(!sv) return JS_FALSE;
else return JS_TRUE;
}
/*
toString() method for PerlValue. For arrays uses array's methods.
If this fails, the type of the value gets returned. TODO: It's actually
better to use a Perl module like Data::Dumpvar.pm to print complex
data structures recursively.
*/
static JSBool
PVToString(JSContext *cx, JSObject *obj, int argc, jsval *argv, jsval* rval)
{
SV* ref = PVGetRef(cx, obj);
SV* sv = SvRV(ref);
svtype type = SvTYPE(sv);
/*jsval args[]= {STRING_TO_JSVAL(JS_NewStringCopyZ(cx, "JS::Object::toString")),
OBJECT_TO_JSVAL(obj)};*/
jsval v;
/*return perl_call(cx, obj, 2, args, rval);*/
if(type==SVt_PVAV){
JSObject *arrayObject = JS_NewArrayObject(cx,0,NULL);
JSFunction *fun;
JS_GetProperty(cx, arrayObject, "toString", &v);
fun = JS_ValueToFunction(cx, v);
JS_CallFunction(cx, obj, fun, 0, NULL, rval);
}else{
char out[256];
JS_GetProperty(cx, obj, "type", &v);
if(!JSVAL_IS_VOID(v))
sprintf(out, "[%s]", JS_GetStringBytes(JSVAL_TO_STRING(v)));
else
strcpy(out, "[PerlValue]");
*rval = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, out));
}
return JS_TRUE;
}
static JSBool
PVConvert(JSContext *cx, JSObject *obj, JSType type, jsval *rval)
{
*rval = OBJECT_TO_JSVAL(obj);
return JS_TRUE;
}
/*
Takes care of GC in Perl: we need to decrement Perl's
reference count when PV goes out of scope.
*/
static JSBool
PVFinalize(JSContext *cx, JSObject *obj)
{
SV* sv = SvRV(PVGetRef(cx, obj));
/* TODO: GC */
if(SvREFCNT(sv)>0){
/*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;
}

30
mozilla/js/src/perlconnect/jsperl.h Normal file
View File

@@ -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);

36
mozilla/js/src/perlconnect/jsperlpvt.h Normal file
View File

@@ -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);

53
mozilla/js/src/perlconnect/test.js Normal file
View File

@@ -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

56
mozilla/js/src/perlconnect/test.pl Normal file
View File

@@ -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";

79
mozilla/js/src/perlconnect/typemap Normal file
View File

@@ -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;
}