[libinline-java-perl] 262/398: Added all the stuff for PerlNatives
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:43:12 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 4c6cbb92b9a57f577084e3716fd8a3c35c40b640
Author: patrick_leb <>
Date: Thu Jan 8 19:17:27 2004 +0000
Added all the stuff for PerlNatives
---
Java/JNI.xs | 180 +++++++++++++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 155 insertions(+), 25 deletions(-)
diff --git a/Java/JNI.xs b/Java/JNI.xs
index 80701a9..b9a89b4 100644
--- a/Java/JNI.xs
+++ b/Java/JNI.xs
@@ -1,6 +1,7 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include "stdarg.h"
/* Include the JNI header file */
@@ -38,14 +39,52 @@ JNIEnv *get_env(InlineJavaJNIVM *this){
}
-void check_exception(JNIEnv *env, char *msg){
+/*
+ This is only used to trap exceptions from Perl.
+*/
+void check_exception_from_perl(JNIEnv *env, char *msg){
if ((*(env))->ExceptionCheck(env)){
(*(env))->ExceptionDescribe(env) ;
+ (*(env))->ExceptionClear(env) ;
croak(msg) ;
}
}
+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) ;
+}
+
+
+/*
+ Here we simply check if an exception is pending an re-throw it
+*/
+int check_exception_from_java(JNIEnv *env){
+ jthrowable exc ;
+ int ret = 0 ;
+
+ exc = (*(env))->ExceptionOccurred(env) ;
+ if (exc != NULL){
+ /* (*(env))->ExceptionDescribe(env) ; */
+ (*(env))->ExceptionClear(env) ;
+ if ((*(env))->Throw(env, exc)){
+ (*(env))->FatalError(env, "Throw if InlineJava*Exception failed: exiting...") ;
+ }
+ ret = 1 ;
+ }
+
+ return ret ;
+}
+
+
jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
dSP ;
jstring resp ;
@@ -53,6 +92,7 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
char *r = NULL ;
int count = 0 ;
SV *hook = NULL ;
+ char msg[128] ;
ENTER ;
SAVETMPS ;
@@ -68,23 +108,16 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
SPAGAIN ;
- /*
- Here is is important to understand that we cannot croak,
- because our caller is Java and not Perl. Croaking here
- screws up the Java stack royally and causes crashes.
- */
-
/* Check the eval */
if (SvTRUE(ERRSV)){
STRLEN n_a ;
- fprintf(stderr, "Exception caught in JNI callback: %s", SvPV(ERRSV, n_a)) ;
- exit(-1) ;
+ throw_ije(env, SvPV(ERRSV, n_a)) ;
}
else{
if (count != 2){
- fprintf(stderr, "%s", "Invalid return value from Inline::Java::Callback::InterceptCallback: %d",
+ sprintf(msg, "%s", "Invalid return value from Inline::Java::Callback::InterceptCallback: %d",
count) ;
- exit(-1) ;
+ throw_ije(env, msg) ;
}
}
@@ -109,6 +142,103 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
}
+/*
+ This is the generic native function that callback java to call the proper
+ perl method.
+*/
+jobject JNICALL generic_perl_native(JNIEnv *env, jobject obj, ...){
+ va_list list ;
+ jclass cls ;
+ jmethodID mid ;
+ jstring jfmt ;
+ char *fmt ;
+ int fmt_len ;
+ jclass obj_cls ;
+ jobjectArray obj_array ;
+ jobject arg ;
+ int i ;
+ jobject ret = NULL ;
+
+ cls = (*(env))->GetObjectClass(env, obj) ;
+ mid = (*(env))->GetMethodID(env, cls, "LookupMethod", "()Ljava/lang/String;") ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ /* Call obj.LookupMethod to get the format string */
+ jfmt = (*(env))->CallObjectMethod(env, obj, mid) ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ fmt = (char *)((*(env))->GetStringUTFChars(env, jfmt, NULL)) ;
+ fmt_len = strlen(fmt) ;
+
+ obj_cls = (*(env))->FindClass(env, "java/lang/Object") ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ obj_array = (*(env))->NewObjectArray(env, fmt_len, obj_cls, NULL) ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ (*(env))->SetObjectArrayElement(env, obj_array, 0, obj) ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+ va_start(list, obj) ;
+ for (i = 1 ; i < fmt_len ; i++){
+ arg = va_arg(list, jobject) ;
+ (*(env))->SetObjectArrayElement(env, obj_array, i, arg) ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+ }
+ va_end(list) ;
+
+ /* Call obj.InvokePerlMethod and grab the returned object and return it */
+ mid = (*(env))->GetMethodID(env, cls, "InvokePerlMethod", "([Ljava/lang/Object;)Ljava/lang/Object;") ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ ret = (*(env))->CallObjectMethod(env, obj, mid, obj_array) ;
+ if (check_exception_from_java(env)){
+ return NULL ;
+ }
+
+ return ret ;
+}
+
+
+/*
+ This function is used to register the specified native method and associate it with our magic
+ method that trap and redirects all the Perl native calls.
+*/
+JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlNatives_RegisterMethod(JNIEnv *env, jobject obj, jclass cls, jstring name, jstring signature){
+ JNINativeMethod nm ;
+
+ /* Register the function */
+ nm.name = (char *)((*(env))->GetStringUTFChars(env, name, NULL)) ;
+ nm.signature = (char *)((*(env))->GetStringUTFChars(env, signature, NULL)) ;
+ nm.fnPtr = generic_perl_native ;
+
+ (*(env))->RegisterNatives(env, cls, &nm, 1) ;
+ (*(env))->ReleaseStringUTFChars(env, name, nm.name) ;
+ (*(env))->ReleaseStringUTFChars(env, signature, nm.signature) ;
+ if (check_exception_from_java(env)){
+ return ;
+ }
+}
+
+
+
+
+/*****************************************************************************/
+
+
MODULE = Inline::Java::JNI PACKAGE = Inline::Java::JNI
@@ -116,7 +246,7 @@ MODULE = Inline::Java::JNI PACKAGE = Inline::Java::JNI
PROTOTYPES: DISABLE
-InlineJavaJNIVM *
+InlineJavaJNIVM *
new(CLASS, classpath, args, embedded, debug)
char * CLASS
char * classpath
@@ -185,25 +315,25 @@ new(CLASS, classpath, args, embedded, debug)
/* Load the classes that we will use */
RETVAL->ijs_class = (*(env))->FindClass(env, "org/perl/inline/java/InlineJavaServer") ;
- check_exception(env, "Can't find class InlineJavaServer") ;
+ check_exception_from_perl(env, "Can't find class InlineJavaServer") ;
RETVAL->string_class = (*(env))->FindClass(env, "java/lang/String") ;
- check_exception(env, "Can't find class java.lang.String") ;
-
+ check_exception_from_perl(env, "Can't find class java.lang.String") ;
+
/* Get the method ids that are needed later */
- RETVAL->jni_main_mid = (*(env))->GetStaticMethodID(env, RETVAL->ijs_class, "jni_main",
+ RETVAL->jni_main_mid = (*(env))->GetStaticMethodID(env, RETVAL->ijs_class, "jni_main",
"(I)Lorg/perl/inline/java/InlineJavaServer;") ;
- check_exception(env, "Can't find method jni_main in class InlineJavaServer") ;
- RETVAL->process_command_mid = (*(env))->GetMethodID(env, RETVAL->ijs_class, "ProcessCommand",
+ check_exception_from_perl(env, "Can't find method jni_main in class InlineJavaServer") ;
+ RETVAL->process_command_mid = (*(env))->GetMethodID(env, RETVAL->ijs_class, "ProcessCommand",
"(Ljava/lang/String;)Ljava/lang/String;") ;
- check_exception(env, "Can't find method ProcessCommand in class InlineJavaServer") ;
+ check_exception_from_perl(env, "Can't find method ProcessCommand in class InlineJavaServer") ;
/* Register the callback function */
nm.name = "jni_callback" ;
nm.signature = "(Ljava/lang/String;)Ljava/lang/String;" ;
nm.fnPtr = jni_callback ;
- (*(env))->RegisterNatives(env, RETVAL->ijs_class, &nm, 1) ;
- check_exception(env, "Can't register method jni_callback in class InlineJavaServer") ;
-
+ (*(env))->RegisterNatives(env, RETVAL->ijs_class, &nm, 1) ;
+ check_exception_from_perl(env, "Can't register method jni_callback in class InlineJavaServer") ;
+
OUTPUT:
RETVAL
@@ -238,7 +368,7 @@ create_ijs(this)
CODE:
env = get_env(this) ;
this->ijs = (*(env))->CallStaticObjectMethod(env, this->ijs_class, this->jni_main_mid, this->debug) ;
- check_exception(env, "Can't call jni_main in class InlineJavaServer") ;
+ check_exception_from_perl(env, "Can't call jni_main in class InlineJavaServer") ;
@@ -256,13 +386,13 @@ process_command(this, data)
CODE:
env = get_env(this) ;
cmd = (*(env))->NewStringUTF(env, data) ;
- check_exception(env, "Can't create java.lang.String") ;
+ check_exception_from_perl(env, "Can't create java.lang.String") ;
resp = (*(env))->CallObjectMethod(env, this->ijs, this->process_command_mid, cmd) ;
/* Thanks Dave Blob for spotting this. This is necessary since this codes never really returns to Java
It simply calls into Java and comes back. */
(*(env))->DeleteLocalRef(env, cmd);
- check_exception(env, "Can't call ProcessCommand in InlineJavaServer") ;
+ check_exception_from_perl(env, "Can't call ProcessCommand in class InlineJavaServer") ;
hook = perl_get_sv("Inline::Java::Callback::OBJECT_HOOK", FALSE) ;
sv_setsv(hook, &PL_sv_undef) ;
--
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