[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