[libinline-java-perl] 282/398: PerlInterpreter stuff

Jonas Smedegaard dr at jones.dk
Thu Feb 26 11:43:14 UTC 2015


This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.55
in repository libinline-java-perl.

commit 79770ded1ee2b27d825310a8132d6dfdb70a01bf
Author: patrick_leb <>
Date:   Sun Feb 8 16:53:51 2004 +0000

    PerlInterpreter stuff
---
 Java/PerlInterpreter/Makefile.PL                   |  16 ++
 Java/PerlInterpreter/PerlInterpreter.pm            |   7 +
 Java/PerlInterpreter/PerlInterpreter.xs            | 187 +++++++++++++++++++++
 Java/PerlInterpreter/dougm/PerlInterpreter.tar.gz  | Bin 0 -> 3116 bytes
 Java/PerlInterpreter/dougm/build.xml               |  19 +++
 Java/PerlInterpreter/dougm/inline.pat              |  55 ++++++
 .../dougm/src/jni/PerlInterpreter.c                | 147 ++++++++++++++++
 .../dougm/src/org/perl/PerlException.java          |  12 ++
 .../dougm/src/org/perl/PerlInterpreter.java        |  34 ++++
 Java/PerlInterpreter/dougm/test.pl                 |  41 +++++
 Java/PerlInterpreter/dougm/test.sh                 |   5 +
 11 files changed, 523 insertions(+)

diff --git a/Java/PerlInterpreter/Makefile.PL b/Java/PerlInterpreter/Makefile.PL
new file mode 100644
index 0000000..3c19b73
--- /dev/null
+++ b/Java/PerlInterpreter/Makefile.PL
@@ -0,0 +1,16 @@
+use ExtUtils::MakeMaker ;
+
+use strict ;
+require "../Portable.pm" ;
+
+my $libperl_dir = Inline::Java::Portable::portable('SUB_FIX_MAKE_QUOTES',
+	"??") ;
+
+WriteMakefile(
+	NAME => 'Inline::Java::PerlInterpreter',
+	VERSION_FROM => 'PerlInterpreter.pm',
+	INC => join(' ', @main::I),
+	LIBS => [join(' ', @main::L) . " -ljvm -L$libperl_dir -lperl"],
+	# CCFLAGS => '-D_REENTRANT',
+) ;
+
diff --git a/Java/PerlInterpreter/PerlInterpreter.pm b/Java/PerlInterpreter/PerlInterpreter.pm
new file mode 100644
index 0000000..3e00e4e
--- /dev/null
+++ b/Java/PerlInterpreter/PerlInterpreter.pm
@@ -0,0 +1,7 @@
+package Inline::Java::PerlInterpreter ;
+
+use strict ;
+
+$Inline::Java::PerlInterpreter::VERSION = '0.50' ;
+
+1 ;
diff --git a/Java/PerlInterpreter/PerlInterpreter.xs b/Java/PerlInterpreter/PerlInterpreter.xs
new file mode 100644
index 0000000..249da32
--- /dev/null
+++ b/Java/PerlInterpreter/PerlInterpreter.xs
@@ -0,0 +1,187 @@
+#include "stdlib.h"
+#include "string.h"
+#include "stdio.h"
+#include "stdarg.h"
+
+
+
+/* Include the JNI header file */
+#include "jni.h"
+
+
+void throw_ije(JNIEnv *env, char *msg){
+	jclass ije ;
+
+	ije = (*(env))->FindClass(env, "org/perl/inline/java/InlineJavaException") ;
+	if ((*(env))->ExceptionCheck(env)){
+		(*(env))->ExceptionDescribe(env) ;
+		(*(env))->ExceptionClear(env) ;
+		(*(env))->FatalError(env, "Can't find class InlineJavaException: exiting...") ;
+	}
+	(*(env))->ThrowNew(env, ije, msg) ;
+}
+
+
+JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlInterpreters_Create(JNIEnv *env, jobject obj){
+}
+
+
+
+/*****************************************************************************/
+
+/*
+XS(boot_Inline__Java__Natives); 
+XS(boot_Inline__Java__Natives)
+{
+    dXSARGS;
+
+    XS_VERSION_BOOTCHECK ;
+
+    XSRETURN_YES;
+}
+*/
+
+/* 
+	xsubpp doesn't like it when we don't specify a MODULE=... PACKAGE=...
+	line. But doing this results in calling function from libperl and we 
+	don't want that or else we will need to laod that to. So we simply let
+	xsubpp do it's substitutions and define macros the cancel out the effect.
+	Anyways that code will NEVER be called.
+*/
+
+void noop(){
+}
+
+#define XS(n)					void n()
+#define dXSARGS					noop()
+#define XS_VERSION_BOOTCHECK	noop()
+#define XSRETURN_YES			noop()
+
+#define PERL_UNUSED_VAR(var)	noop()
+
+MODULE = Inline::Java::PerlInterpreter   PACKAGE = Inline::Java::PerlInterpreter
+
+PROTOTYPES: DISABLE
+
+/* ################## DOUG'S STUFF #################### */
+
+/*
+#include "jni.h"
+#include "EXTERN.h"
+#include "perl.h"
+
+#define JENV (*env)
+
+#define PERL_PACKAGE "org/perl"
+
+void boot_DynaLoader(pTHX_ CV* cv);
+
+static void xs_init(pTHX)
+{
+    char *file = __FILE__;
+    dXSUB_SYS;
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+static void perl_throw_exception(JNIEnv *env, char *msg)
+{
+    jclass errorClass = 
+        JENV->FindClass(env, PERL_PACKAGE "PerlException");
+
+    JENV->ThrowNew(env, errorClass, msg);
+}
+
+static PerlInterpreter *perl_get_pointer(JNIEnv *env, jobject obj) {
+    jfieldID pointer_field;
+    jclass cls;
+      
+    cls = JENV->GetObjectClass(env, obj);
+
+    pointer_field = JENV->GetFieldID(env, cls, "perlInterpreter", "I");
+
+    return (PerlInterpreter *)JENV->GetIntField(env, obj, pointer_field);
+}
+
+static void perl_set_pointer(JNIEnv *env, jobject obj, const void *ptr) {
+    jfieldID pointer_field;
+    int pointer_int;
+    jclass cls;
+    
+    cls = JENV->GetObjectClass(env, obj);
+
+    pointer_field = JENV->GetFieldID(env, cls, "perlInterpreter", "I");
+    pointer_int = (int)ptr;
+
+    JENV->SetIntField(env, obj, pointer_field, pointer_int);
+}
+
+JNIEXPORT jobject JNICALL Java_org_perl_PerlInterpreter_create
+(JNIEnv *env, jobject obj, jobject parent)
+{
+    PerlInterpreter *interp = NULL;
+
+    if (parent) {
+        PerlInterpreter *parent_perl = perl_get_pointer(env, parent);
+        interp = perl_clone(parent_perl, 0);
+    }
+    else {
+        char *args[] = {"java", "-e0"};
+
+        interp = perl_alloc();
+        perl_construct(interp);
+        perl_parse(interp, xs_init, 2, args, NULL);
+        perl_run(interp);
+    }
+
+    perl_set_pointer(env, obj, interp);
+
+    return NULL;
+}
+
+JNIEXPORT void JNICALL Java_org_perl_PerlInterpreter_destroy
+(JNIEnv *env, jobject obj)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+
+    perl_destruct(perl);
+    perl_free(perl);
+}
+
+JNIEXPORT jstring JNICALL Java_org_perl_PerlInterpreter_eval
+(JNIEnv *env, jobject obj, jstring jcode)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+    dTHXa(perl);
+    SV *sv = Nullsv;
+
+    const char *code = JENV->GetStringUTFChars(env, jcode, 0);
+
+    sv = eval_pv(code, FALSE);
+
+    if (SvTRUE(ERRSV)) {
+        perl_throw_exception(env, SvPVX(ERRSV));
+    }
+
+    if (SvTRUE(sv)) {
+        STRLEN n_a;
+        return JENV->NewStringUTF(env, SvPV(sv, n_a));
+    }
+
+    return NULL;
+}
+
+JNIEXPORT jstring JNICALL Java_org_perl_PerlInterpreter_call
+(JNIEnv *env, jobject obj, jstring jfunction, jobjectArray args)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+    dTHXa(perl);
+
+    const char *function = JENV->GetStringUTFChars(env, jfunction, 0);
+
+    if (SvTRUE(ERRSV)) {
+        perl_throw_exception(env, SvPVX(ERRSV));
+    }
+
+    return NULL;
+}
+*/
diff --git a/Java/PerlInterpreter/dougm/PerlInterpreter.tar.gz b/Java/PerlInterpreter/dougm/PerlInterpreter.tar.gz
new file mode 100644
index 0000000..91035e3
Binary files /dev/null and b/Java/PerlInterpreter/dougm/PerlInterpreter.tar.gz differ
diff --git a/Java/PerlInterpreter/dougm/build.xml b/Java/PerlInterpreter/dougm/build.xml
new file mode 100644
index 0000000..5eb6152
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/build.xml
@@ -0,0 +1,19 @@
+<project name="PerlInterpreter" default="dist" basedir=".">
+  <target name="init">
+    <mkdir dir="build/classes"/>
+  </target>
+  
+  <target name="compile" depends="init">
+    <javac srcdir="src" destdir="build/classes"/>
+  </target>
+  
+  <target name="dist" depends="compile">
+    <mkdir dir="dist/lib"/>
+    <jar jarfile="dist/lib/PerlInterpreter.jar" basedir="build/classes"/>
+  </target>
+  
+  <target name="clean">
+    <delete dir="build"/>
+    <delete dir="dist"/>
+  </target>
+</project>
diff --git a/Java/PerlInterpreter/dougm/inline.pat b/Java/PerlInterpreter/dougm/inline.pat
new file mode 100644
index 0000000..3fea73e
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/inline.pat
@@ -0,0 +1,55 @@
+--- Java/JNI.xs~	Mon Jun  3 08:50:57 2002
++++ Java/JNI.xs	Sat Dec 14 18:42:20 2002
+@@ -17,6 +17,7 @@
+ 	jmethodID process_command_mid ;
+ 	jint debug ;
+ 	int destroyed ;
++        int embedded ;
+ } InlineJavaJNIVM ;
+ 
+ 
+@@ -137,6 +138,7 @@
+ 	RETVAL->ijs = NULL ;
+ 	RETVAL->debug = debug ;
+ 	RETVAL->destroyed = 0 ;
++	RETVAL->embedded = SvIV(get_sv("Inline::Java::JVM", TRUE)) == 2 ? 1 : 0;
+ 
+ 	options[0].optionString = ((RETVAL->debug > 5) ? "-verbose" : "-verbose:") ;
+ 	cp = (char *)malloc((strlen(classpath) + 128) * sizeof(char)) ;
+@@ -148,8 +150,23 @@
+ 	vm_args.nOptions = 2 ;
+ 	vm_args.ignoreUnrecognized = JNI_FALSE ;
+ 
+-	/* Create the Java VM */
+-	res = JNI_CreateJavaVM(&(RETVAL->jvm), (void **)&(env), &vm_args) ;
++        if (RETVAL->embedded) {
++            /* we are already inside a JVM */
++            jint n = 0;
++
++            res = JNI_GetCreatedJavaVMs(&(RETVAL->jvm), 1, &n);
++            env = get_env(RETVAL);
++            RETVAL->destroyed = 1; /* do not shutdown */
++
++            if (n <= 0) {
++                /* res == 0 even if no JVMs are alive */
++                res = -1;
++            }
++        }
++        else {
++              /* Create the Java VM */
++              res = JNI_CreateJavaVM(&(RETVAL->jvm), (void **)&(env), &vm_args) ;
++        }
+ 	if (res < 0) {
+ 		croak("Can't create Java interpreter using JNI") ;
+ 	}
+--- Java/JVM.pm~	Thu Jul  4 09:56:25 2002
++++ Java/JVM.pm	Sat Dec 14 18:41:10 2002
+@@ -37,7 +37,7 @@
+ 	Inline::Java::debug(1, "starting JVM...") ;
+ 
+ 	$this->{owner} = 1 ;
+-	if ($o->get_java_config('JNI')){
++	if (($Inline::Java::JVM = $o->get_java_config('JNI'))){
+ 		Inline::Java::debug(1, "JNI mode") ;
+ 
+ 		my $jni = new Inline::Java::JNI(
diff --git a/Java/PerlInterpreter/dougm/src/jni/PerlInterpreter.c b/Java/PerlInterpreter/dougm/src/jni/PerlInterpreter.c
new file mode 100644
index 0000000..5daeacc
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/src/jni/PerlInterpreter.c
@@ -0,0 +1,147 @@
+#include "jni.h"
+#include "EXTERN.h"
+#include "perl.h"
+
+#define JENV (*env)
+
+#define PERL_PACKAGE "org/perl"
+
+void boot_DynaLoader(pTHX_ CV* cv);
+
+static void xs_init(pTHX)
+{
+    char *file = __FILE__;
+    dXSUB_SYS;
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+static void perl_throw_exception(JNIEnv *env, char *msg)
+{
+    jclass errorClass = 
+        JENV->FindClass(env, PERL_PACKAGE "PerlException");
+
+    JENV->ThrowNew(env, errorClass, msg);
+}
+
+static PerlInterpreter *perl_get_pointer(JNIEnv *env, jobject obj) {
+    jfieldID pointer_field;
+    jclass cls;
+      
+    cls = JENV->GetObjectClass(env, obj);
+
+    pointer_field = JENV->GetFieldID(env, cls, "perlInterpreter", "I");
+
+    return (PerlInterpreter *)JENV->GetIntField(env, obj, pointer_field);
+}
+
+static void perl_set_pointer(JNIEnv *env, jobject obj, const void *ptr) {
+    jfieldID pointer_field;
+    int pointer_int;
+    jclass cls;
+    
+    cls = JENV->GetObjectClass(env, obj);
+
+    pointer_field = JENV->GetFieldID(env, cls, "perlInterpreter", "I");
+    pointer_int = (int)ptr;
+
+    JENV->SetIntField(env, obj, pointer_field, pointer_int);
+}
+
+JNIEXPORT jobject JNICALL Java_org_perl_PerlInterpreter_create
+(JNIEnv *env, jobject obj, jobject parent)
+{
+    PerlInterpreter *interp = NULL;
+
+    if (parent) {
+        PerlInterpreter *parent_perl = perl_get_pointer(env, parent);
+        interp = perl_clone(parent_perl, 0);
+    }
+    else {
+        char *args[] = {"java", "-e0"};
+
+        interp = perl_alloc();
+        perl_construct(interp);
+        perl_parse(interp, xs_init, 2, args, NULL);
+        perl_run(interp);
+    }
+
+    perl_set_pointer(env, obj, interp);
+
+    return NULL;
+}
+
+JNIEXPORT void JNICALL Java_org_perl_PerlInterpreter_destroy
+(JNIEnv *env, jobject obj)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+
+    perl_destruct(perl);
+    perl_free(perl);
+}
+
+JNIEXPORT jstring JNICALL Java_org_perl_PerlInterpreter_eval
+(JNIEnv *env, jobject obj, jstring jcode)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+    dTHXa(perl);
+    SV *sv = Nullsv;
+
+    const char *code = JENV->GetStringUTFChars(env, jcode, 0);
+
+    sv = eval_pv(code, FALSE);
+
+    if (SvTRUE(ERRSV)) {
+        perl_throw_exception(env, SvPVX(ERRSV));
+    }
+
+    if (SvTRUE(sv)) {
+        STRLEN n_a;
+        return JENV->NewStringUTF(env, SvPV(sv, n_a));
+    }
+
+    return NULL;
+}
+
+JNIEXPORT jstring JNICALL Java_org_perl_PerlInterpreter_call
+(JNIEnv *env, jobject obj, jstring jfunction, jobjectArray args)
+{
+    PerlInterpreter *perl = perl_get_pointer(env, obj);
+    dTHXa(perl);
+
+    const char *function = JENV->GetStringUTFChars(env, jfunction, 0);
+
+    if (SvTRUE(ERRSV)) {
+        perl_throw_exception(env, SvPVX(ERRSV));
+    }
+
+    return NULL;
+}
+
+/*
+#!perl
+
+use 5.8.0;
+use strict;
+use Config;
+use ExtUtils::Embed;
+
+my $cmodule = 'PerlInterpreter';
+
+chomp(my $ccopts = ccopts());
+chomp(my $ldopts = ldopts());
+
+$ccopts .= " -I$ENV{JAVA_HOME}/include/linux -I$ENV{JAVA_HOME}/include";
+$ldopts .= " $Config{lddlflags}";
+
+my $ar  = "-Wl,--whole-archive";
+my $nar = "-Wl,--no-whole-archive";
+
+run("$Config{cc} -Wall $ar $ccopts $ldopts $nar -o lib$cmodule.so $cmodule.c");
+
+sub run {
+    print "@_\n";
+    system "@_";
+}
+
+__END__
+*/
diff --git a/Java/PerlInterpreter/dougm/src/org/perl/PerlException.java b/Java/PerlInterpreter/dougm/src/org/perl/PerlException.java
new file mode 100644
index 0000000..5f22d74
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/src/org/perl/PerlException.java
@@ -0,0 +1,12 @@
+package org.perl;
+
+public class PerlException extends Exception {
+
+    public PerlException() {
+        super();
+    }
+
+    public PerlException(String msg) {
+        super(msg);
+    }
+}
diff --git a/Java/PerlInterpreter/dougm/src/org/perl/PerlInterpreter.java b/Java/PerlInterpreter/dougm/src/org/perl/PerlInterpreter.java
new file mode 100644
index 0000000..e191680
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/src/org/perl/PerlInterpreter.java
@@ -0,0 +1,34 @@
+package org.perl;
+
+public class PerlInterpreter {
+    int perlInterpreter = 0;
+
+    public PerlInterpreter() {
+        create(null);
+    }
+
+    public int getPerlInterpreter() {
+        return perlInterpreter;
+    }
+
+    private native PerlInterpreter create(PerlInterpreter perl)
+        throws RuntimeException;
+
+    public native String eval(String code) throws PerlException;
+
+    public native void destroy();
+
+    public static void main(String[] args) {
+        try {
+            System.loadLibrary("PerlInterpreter");
+
+            PerlInterpreter perl = new PerlInterpreter();
+            System.setProperty("PERL", "XXX");
+            String val = perl.eval("require 'test.pl'");
+            System.out.println(val);
+            perl.destroy();
+        } catch (Exception e) {
+            e.printStackTrace();
+        }
+    }
+}
diff --git a/Java/PerlInterpreter/dougm/test.pl b/Java/PerlInterpreter/dougm/test.pl
new file mode 100644
index 0000000..e527281
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/test.pl
@@ -0,0 +1,41 @@
+use strict;
+use warnings FATAL => 'all';
+
+use DynaLoader ();
+
+our $code;
+
+BEGIN {
+    use Config;
+    my $libperl = "$Config{installarchlib}/CORE/libperl.so";
+
+    DynaLoader::dl_load_file($libperl, 0x01);
+
+    $Inline::Java::DEBUG = 1;
+
+    $code = <<EOF;
+
+class Jtest {
+
+    public Jtest () { }
+
+    public static void listProps() {
+        System.getProperties().list(System.out);
+    }
+}
+
+EOF
+}
+
+use blib '/home/dougm/build/Inline-Java-0.33';
+
+use Inline Java => $code,
+  AUTOSTUDY => 1, JNI => 2,
+  DIRECTORY => '/home/dougm/covalent/eam/PerlInterpreter/inline',
+  NAME => 'MyStuff';
+
+Jtest->new->listProps();
+
+print "ok\n";
+
+1;
diff --git a/Java/PerlInterpreter/dougm/test.sh b/Java/PerlInterpreter/dougm/test.sh
new file mode 100755
index 0000000..f183745
--- /dev/null
+++ b/Java/PerlInterpreter/dougm/test.sh
@@ -0,0 +1,5 @@
+#! /bin/bash
+
+export LD_LIBRARY_PATH=`pwd`/src/jni
+
+java -cp ./dist/lib/PerlInterpreter.jar:/home/dougm/covalent/eam/PerlInterpreter/inline/lib/auto/MyStuff org.perl.PerlInterpreter

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libinline-java-perl.git



More information about the Pkg-perl-cvs-commits mailing list