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 3dd1db2f73a2827dd1a7e284aed9aa63d74ac211
Author: Patrick LeBoutillier <p...@cpan.org>
Date: Tue Jan 15 13:28:06 2002 +0000
Fixed callbacks for JNI.
---
Java/Callback.pm | 8 +++++++-
Java/JNI.xs | 42 +++++++++++++++++++++++++++++++++++-------
Java/JVM.pm | 7 +++++--
3 files changed, 47 insertions(+), 10 deletions(-)
diff --git a/Java/Callback.pm b/Java/Callback.pm
index 4d8c9e7..de02183 100644
--- a/Java/Callback.pm
+++ b/Java/Callback.pm
@@ -9,6 +9,9 @@ $Inline::Java::Callback::VERSION = '0.31' ;
use Carp ;
+$Inline::Java::Callback::OBJECT_HOOK = undef ;
+
+
sub InterceptCallback {
my $inline = shift ;
my $resp = shift ;
@@ -80,6 +83,10 @@ sub ProcessCallback {
}
+
+1 ;
+
+
__DATA__
/*
@@ -140,4 +147,3 @@ public class InlineJavaPerlCaller {
}
}
-
diff --git a/Java/JNI.xs b/Java/JNI.xs
index cee60d3..141c139 100644
--- a/Java/JNI.xs
+++ b/Java/JNI.xs
@@ -46,12 +46,12 @@ void check_exception(JNIEnv *env, char *msg){
jstring JNICALL jni_callback(JNIEnv *env, jobject obj, jstring cmd){
-
dSP ;
- jstring resp = NULL ;
+ jstring resp ;
char *c = (char *)((*(env))->GetStringUTFChars(env, cmd, NULL)) ;
char *r = NULL ;
int count = 0 ;
+ SV *hook = NULL ;
ENTER ;
SAVETMPS ;
@@ -63,14 +63,31 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj,
jstring cmd){
(*(env))->ReleaseStringUTFChars(env, cmd, c) ;
count = perl_call_pv("Inline::Java::Callback::InterceptCallback",
- G_SCALAR) ;
+ G_ARRAY|G_EVAL) ;
SPAGAIN ;
- if (count != 1){
- croak("Invalid return value from
Inline::Java::Callback::InterceptCallback: %d",
- count) ;
+ /* Check the eval */
+ if (SvTRUE(ERRSV)){
+ STRLEN n_a ;
+ croak(SvPV(ERRSV, n_a)) ;
}
+ else{
+ if (count != 2){
+ croak("Invalid return value from
Inline::Java::Callback::InterceptCallback: %d",
+ count) ;
+ }
+ }
+
+ /*
+ The first thing to pop is a reference to the returned object,
+ which we must keep around long enough so that it is not deleted
+ before control gets back to Java. This is because this object
+ may be returned be the callback, and when it gets back to Java
+ it will already be deleted.
+ */
+ hook = get_sv("Inline::Java::Callback::OBJECT_HOOK", FALSE) ;
+ sv_setsv(hook, POPs) ;
r = (char *)POPp ;
resp = (*(env))->NewStringUTF(env, r) ;
@@ -79,7 +96,6 @@ jstring JNICALL jni_callback(JNIEnv *env, jobject obj,
jstring cmd){
FREETMPS ;
LEAVE ;
-
return resp ;
}
@@ -101,6 +117,7 @@ new(CLASS, classpath, debug)
JavaVMInitArgs vm_args ;
JavaVMOption options[2] ;
JNIEnv *env ;
+ JNINativeMethod nm ;
jint res ;
char *cp ;
@@ -143,6 +160,13 @@ new(CLASS, classpath, debug)
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") ;
+ /* 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") ;
+
OUTPUT:
RETVAL
@@ -190,6 +214,7 @@ process_command(this, data)
JNIEnv *env ;
jstring cmd ;
jstring resp ;
+ SV *hook = NULL ;
CODE:
env = get_env(this) ;
@@ -199,6 +224,9 @@ process_command(this, data)
resp = (*(env))->CallObjectMethod(env, this->ijs,
this->process_command_mid, cmd) ;
check_exception(env, "Can't call ProcessCommand in InlineJavaServer") ;
+ hook = get_sv("Inline::Java::Callback::OBJECT_HOOK", FALSE) ;
+ sv_setsv(hook, &PL_sv_undef) ;
+
RETVAL = (char *)((*(env))->GetStringUTFChars(env, resp, NULL)) ;
OUTPUT:
diff --git a/Java/JVM.pm b/Java/JVM.pm
index 2bc0b09..8f0cd8b 100644
--- a/Java/JVM.pm
+++ b/Java/JVM.pm
@@ -269,7 +269,6 @@ sub process_command {
my $inline = shift ;
my $data = shift ;
- my $ref = undef ;
my $resp = undef ;
while (1){
Inline::Java::debug(" packet sent is $data") ;
@@ -283,6 +282,10 @@ sub process_command {
if (! $resp){
croak "Can't receive packet from JVM: $!" ;
}
+
+ # Release the reference since the object has been sent
back
+ # to Java.
+ $Inline::Java::Callback::OBJECT_HOOK = undef ;
}
if ($this->{JNI}){
$Inline::Java::JNI::INLINE_HOOK = $inline ;
@@ -293,7 +296,7 @@ sub process_command {
# We got an answer from the server. Is it a callback?
if ($resp =~ /^callback/){
- ($data, $ref) =
Inline::Java::Callback::InterceptCallback($inline, $resp) ;
+ ($data, $Inline::Java::Callback::OBJECT_HOOK) =
Inline::Java::Callback::InterceptCallback($inline, $resp) ;
next ;
}
else{
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libinline-java-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
