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 1cc565b0102822cdd17a517706b1577a892fceb4 Author: Patrick LeBoutillier <p...@cpan.org> Date: Wed Jan 9 16:08:26 2002 +0000 *** empty log message *** --- Java/Array.pm | 32 +++--- Java/Callback.pm | 33 ++++-- Java/Class.pm | 6 +- Java/Init.pm | 27 +---- Java/JNI.pm | 26 +---- Java/JVM.pm | 130 ++++++++++++++-------- Java/Makefile.PL | 316 ++++++++++++++++++++++++++++++++++-------------------- Java/Object.pm | 95 +++++++++------- Java/Protocol.pm | 37 ++++--- Makefile.PL | 33 ++---- t/01_init.t | 6 +- t/02_primitives.t | 4 +- t/05_arrays.t | 41 +++++-- t/07_polymorph.t | 17 ++- t/13_callbacks.t | 38 +++++-- 15 files changed, 502 insertions(+), 339 deletions(-) diff --git a/Java/Array.pm b/Java/Array.pm index 47c9c2b..fe299c9 100644 --- a/Java/Array.pm +++ b/Java/Array.pm @@ -4,7 +4,7 @@ package Inline::Java::Array ; use strict ; -$Inline::Java::Array::VERSION = '0.20' ; +$Inline::Java::Array::VERSION = '0.31' ; use Carp ; @@ -23,8 +23,8 @@ sub new { $OBJECTS->{$knot} = $object ; - Inline::Java::debug("this = $this") ; - Inline::Java::debug("knot = $knot") ; + Inline::Java::debug("this = '$this'") ; + Inline::Java::debug("knot = '$knot'") ; return $this ; } @@ -37,7 +37,7 @@ sub __get_object { my $ref = $OBJECTS->{$knot} ; if (! defined($ref)){ - croak "Unknown Java array reference $knot" ; + croak "Unknown Java array reference '$knot'" ; } return $ref ; @@ -59,7 +59,15 @@ sub length { my $ret = undef ; eval { - $ret = $obj->__get_private()->{proto}->CallJavaMethod('getLength', [], []) ; + # Check the cached value + $ret = $obj->__get_private()->{array_length} ; + if (! defined($ret)){ + $ret = $obj->__get_private()->{proto}->CallJavaMethod('getLength', [], []) ; + $obj->__get_private()->{array_length} = $ret ; + } + else{ + Inline::Java::debug("Using cached array length $ret") ; + } } ; croak $@ if $@ ; @@ -104,7 +112,7 @@ sub __set_element { # the array. my $java_class = $obj->__get_private()->{java_class} ; my $elem_class = $java_class ; - my $an = new Inline::Java::ArrayNorm($java_class) ; + my $an = Inline::Java::Array::Normalizer->new($java_class) ; if ($an->{req_nb_dim} > 1){ $elem_class =~ s/^\[// ; } @@ -133,9 +141,7 @@ sub AUTOLOAD { # method. $func_name =~ s/^(.*)::// ; - Inline::Java::debug("$func_name") ; - - croak "Can't call method $func_name on Java arrays" ; + croak "Can't call method '$func_name' on Java arrays" ; } @@ -296,7 +302,7 @@ sub new { my $ref = shift ; if (! Inline::Java::Class::ClassIsArray($java_class)){ - croak "Can't create Java array of non-array class $java_class" ; + croak "Can't create Java array of non-array class '$java_class'" ; } my $this = {} ; @@ -369,7 +375,7 @@ sub InitFromFlat { my @dims = @{$dims} ; shift @dims ; - my $obj = new Inline::Java::Array::Normalizer($java_class) ; + my $obj = Inline::Java::Array::Normalizer->new($java_class) ; $obj->InitFromFlat(\@dims, \@sub, $level + 1) ; $elem = $obj->{array} ; } @@ -408,7 +414,7 @@ sub AnalyzeArrayClass { my $pclass = $map{$type} ; if (! $pclass){ - croak "Can't determine array type for $java_class" ; + croak "Can't determine array type for '$java_class'" ; } $this->{req_element_class} = $pclass ; @@ -430,7 +436,7 @@ sub ValidateArray { if (! UNIVERSAL::isa($ref, "ARRAY")){ # We must start with an array of some kind... - croak "$ref is not an array reference" ; + croak "'$ref' is not an array reference" ; } $this->ValidateElements($ref, $array, $level) ; diff --git a/Java/Callback.pm b/Java/Callback.pm index 40c7003..4d8c9e7 100644 --- a/Java/Callback.pm +++ b/Java/Callback.pm @@ -19,11 +19,12 @@ sub InterceptCallback { $inline = $Inline::Java::JNI::INLINE_HOOK ; } - if ($resp =~ s/^callback (.*?) (\w+)//){ + if ($resp =~ s/^callback ([^ ]+) (\w+) ([^ ]+)//){ my $module = $1 ; my $function = $2 ; + my $cast_return = $3 ; my @args = split(' ', $resp) ; - return Inline::Java::Callback::ProcessCallback($inline, $module, $function, @args) ; + return Inline::Java::Callback::ProcessCallback($inline, $module, $function, $cast_return, @args) ; } croak "Malformed callback request from server: $resp" ; @@ -34,13 +35,17 @@ sub ProcessCallback { my $inline = shift ; my $module = shift ; my $function = shift ; + my $cast_return = shift ; my @sargs = @_ ; my $pc = new Inline::Java::Protocol(undef, $inline) ; my $thrown = 'false' ; my $ret = undef ; eval { - my @args = map {$pc->DeserializeObject(0, $_)} @sargs ; + my @args = map { + my $a = $pc->DeserializeObject(0, $_) ; + $a ; + } @sargs ; Inline::Java::debug(" processing callback $module" . "::" . "$function(" . join(", ", @args) . ")") ; @@ -58,9 +63,20 @@ sub ProcessCallback { } } - ($ret) = $pc->ValidateArgs([$ret]) ; + my $proto = 'java.lang.Object' ; + if ($cast_return ne "null"){ + $ret = Inline::Java::cast($proto, $ret, $cast_return) ; + } + + ($ret) = Inline::Java::Class::CastArgument($ret, $proto, $inline->get_api('modfname')) ; + + # Here we must keep a reference to $ret or else it gets deleted + # before the id is returned to Java... + my $ref = $ret ; + + ($ret) = $pc->ValidateArgs([$ret], 1) ; - return "callback $thrown $ret" ; + return ("callback $thrown $ret", $ref) ; } @@ -101,6 +117,11 @@ public class InlineJavaPerlCaller { public Object CallPerl(String pkg, String method, Object args[]) throws InlineJavaException, PerlException { + return CallPerl(pkg, method, args, null) ; + } + + + public Object CallPerl(String pkg, String method, Object args[], String cast) throws InlineJavaException, PerlException { if (InlineJavaServer.instance == null){ System.err.println("Can't use InlineJavaPerlCaller outside of an Inline::Java context") ; System.err.flush() ; @@ -108,7 +129,7 @@ public class InlineJavaPerlCaller { } try { - return InlineJavaServer.instance.Callback(pkg, method, args) ; + return InlineJavaServer.instance.Callback(pkg, method, args, cast) ; } catch (InlineJavaServer.InlineJavaException e){ throw new InlineJavaException(e) ; diff --git a/Java/Class.pm b/Java/Class.pm index b083fb6..d6c69cc 100644 --- a/Java/Class.pm +++ b/Java/Class.pm @@ -3,7 +3,7 @@ package Inline::Java::Class ; use strict ; -$Inline::Java::Class::VERSION = '0.30' ; +$Inline::Java::Class::VERSION = '0.31' ; $Inline::Java::Class::MAX_SCORE = 10 ; @@ -146,14 +146,14 @@ sub CastArgument { # They will wrapped on the Java side. if (UNIVERSAL::isa($arg, "ARRAY")){ if (! UNIVERSAL::isa($arg, "Inline::Java::Array")){ - my $an = new Inline::Java::Array::Normalizer($array_type || $proto, $arg) ; + my $an = Inline::Java::Array::Normalizer->new($array_type || $proto, $arg) ; $array_score = $an->{score} ; my $flat = $an->FlattenArray() ; my $inline = Inline::Java::get_INLINE($module) ; - my $obj = Inline::Java::Object->__new($array_type || $proto, $inline, -1, $flat->[0], $flat->[1]) ; # We need to create the array on the Java side, and then grab # the returned object. + my $obj = Inline::Java::Object->__new($array_type || $proto, $inline, -1, $flat->[0], $flat->[1]) ; $arg = new Inline::Java::Array($obj) ; } else{ diff --git a/Java/Init.pm b/Java/Init.pm index 90e4eac..ab1b232 100644 --- a/Java/Init.pm +++ b/Java/Init.pm @@ -3,7 +3,7 @@ package Inline::Java::Init ; use strict ; -$Inline::Java::Init::VERSION = '0.30' ; +$Inline::Java::Init::VERSION = '0.31' ; my $DATA = join('', <DATA>) ; my $OBJECT_DATA = join('', <Inline::Java::Object::DATA>) ; @@ -36,9 +36,6 @@ sub DumpServerJavaCode { $java =~ s/<INLINE_JAVA_CLASS>/$java_class/g ; $java =~ s/<INLINE_JAVA_PROTOCOL>/$java_proto/g ; - my $so = $Inline::Java::JNI::SO || '' ; - $java =~ s/<INLINE_JAVA_JNI_SO>/$so/g ; - print $fh $java ; } @@ -254,13 +251,13 @@ public class InlineJavaServer { } - public Object Callback(String pkg, String method, Object args[]) throws InlineJavaException, InlineJavaPerlException { + public Object Callback(String pkg, String method, Object args[], String cast) throws InlineJavaException, InlineJavaPerlException { Object ret = null ; try { InlineJavaProtocol ijp = new InlineJavaProtocol(this, null) ; InlineJavaClass ijc = new InlineJavaClass(this, ijp) ; - StringBuffer cmdb = new StringBuffer("callback " + pkg + " " + method) ; + StringBuffer cmdb = new StringBuffer("callback " + pkg + " " + method + " " + cast) ; if (args != null){ for (int i = 0 ; i < args.length ; i++){ cmdb.append(" " + ijp.SerializeObject(args[i])) ; @@ -358,24 +355,6 @@ public class InlineJavaServer { public static InlineJavaServer jni_main(boolean debug) { - String so = "<INLINE_JAVA_JNI_SO>" ; - if (! so.equals("")){ - try { - System.load(so) ; - } - catch (UnsatisfiedLinkError e){ - System.err.println("Can't load shared object '" + so + "' required for callbacks") ; - System.err.flush() ; - System.exit(1) ; - } - } - else{ - System.err.println("JNI shared object not specified (required for callbacks)") ; - System.err.println("Perhaps your Java code was not initially built in JNI mode") ; - System.err.flush() ; - System.exit(1) ; - } - return new InlineJavaServer(debug) ; } diff --git a/Java/JNI.pm b/Java/JNI.pm index 3476a8b..200c62e 100644 --- a/Java/JNI.pm +++ b/Java/JNI.pm @@ -6,6 +6,7 @@ use strict ; $Inline::Java::JNI::VERSION = '0.31' ; +use DynaLoader ; use Carp ; use File::Basename ; @@ -13,38 +14,13 @@ use File::Basename ; # A place to attach the Inline object that is currently in Java land $Inline::Java::JNI::INLINE_HOOK = undef ; -# The full path to the shared object loaded by JNI -$Inline::Java::JNI::SO = '' ; - eval { Inline::Java::JNI->bootstrap($Inline::Java::JNI::VERSION) ; - - if (! $Inline::Java::JNI::SO){ - croak "Can't find JNI shared object!" ; - } - - Inline::Java::debug("JNI shared object is '$Inline::Java::JNI::SO'") ; } ; if ($@){ croak "Can't load JNI module. Did you build it at install time?\nError: $@" ; } -# This is a *NASTY* way to get the shared object file that was loaded -# by DynaLoader -sub dl_load_flags { - my $so = $DynaLoader::file ; - my $dir = dirname($so) ; - my $f = basename($so) ; - my $sep = Inline::Java::portable("PATH_SEP") ; - - $Inline::Java::JNI::SO = Inline::Java::portable("RE_FILE", Cwd::abs_path($dir) . $sep . $f) ; - $Inline::Java::JNI::SO = Inline::Java::portable("RE_FILE_JAVA", $Inline::Java::JNI::SO) ; - - return DynaLoader::dl_load_flags() ; -} - - - 1 ; diff --git a/Java/JVM.pm b/Java/JVM.pm index 77f5b50..2bc0b09 100644 --- a/Java/JVM.pm +++ b/Java/JVM.pm @@ -3,7 +3,7 @@ package Inline::Java::JVM ; use strict ; -$Inline::Java::JVM::VERSION = '0.30' ; +$Inline::Java::JVM::VERSION = '0.31' ; use Carp ; use IPC::Open3 ; @@ -20,6 +20,8 @@ sub new { $this->{JNI} = undef ; $this->{owner} = 1 ; + $this->{destroyed} = 0 ; + Inline::Java::debug("Starting JVM...") ; if ($o->get_java_config('JNI')){ @@ -55,10 +57,10 @@ sub new { } } - my $java = $o->get_java_config('BIN') . "/java" . Inline::Java::portable("EXE_EXTENSION") ; - my $pjava = Inline::Java::portable("RE_FILE", $java) ; + my $java = File::Spec->catfile($o->get_java_config('BIN'), + "java" . Inline::Java::portable("EXE_EXTENSION")) ; - my $cmd = "\"$pjava\" InlineJavaServer $debug $this->{port} $shared_jvm" ; + my $cmd = "\"$java\" InlineJavaServer $debug $this->{port} $shared_jvm" ; Inline::Java::debug($cmd) ; if ($o->get_config('UNTAINT')){ @@ -90,46 +92,59 @@ sub new { sub DESTROY { my $this = shift ; - if ($this->{owner}){ - Inline::Java::debug("JVM owner exiting...") ; + $this->shutdown() ; +} - if ($this->{socket}){ - # This asks the Java server to stop and die. - my $sock = $this->{socket} ; - if ($sock->connected()){ - Inline::Java::debug("Sending 'die' message to JVM...") ; - print $sock "die\n" ; - } - else{ - carp "Lost connection with Java virtual machine" ; + +sub shutdown { + my $this = shift ; + + if (! $this->{destroyed}){ + if ($this->am_owner()){ + Inline::Java::debug("JVM owner exiting...") ; + + if ($this->{socket}){ + # This asks the Java server to stop and die. + my $sock = $this->{socket} ; + if ($sock->connected()){ + Inline::Java::debug("Sending 'die' message to JVM...") ; + print $sock "die\n" ; + } + else{ + carp "Lost connection with Java virtual machine" ; + } + close($sock) ; + + if ($this->{pid}){ + # Here we go ahead and send the signals anyway to be very + # sure it's dead... + # Always be polite first, and then insist. + Inline::Java::debug("Sending 15 signal to JVM...") ; + kill(15, $this->{pid}) ; + Inline::Java::debug("Sending 9 signal to JVM...") ; + kill(9, $this->{pid}) ; + + # Reap the child... + waitpid($this->{pid}, 0) ; + } } - close($sock) ; - - if ($this->{pid}){ - # Here we go ahead and send the signals anyway to be very - # sure it's dead... - # Always be polite first, and then insist. - Inline::Java::debug("Sending 15 signal to JVM...") ; - kill(15, $this->{pid}) ; - Inline::Java::debug("Sending 9 signal to JVM...") ; - kill(9, $this->{pid}) ; - - # Reap the child... - waitpid($this->{pid}, 0) ; + if ($this->{JNI}){ + $this->{JNI}->shutdown() ; } } - } - else{ - # We are not the JVM owner, so we simply politely disconnect - if ($this->{socket}){ - Inline::Java::debug("JVM non-owner exiting...") ; - close($this->{socket}) ; - $this->{socket} = undef ; + else{ + # We are not the JVM owner, so we simply politely disconnect + if ($this->{socket}){ + Inline::Java::debug("JVM non-owner exiting...") ; + close($this->{socket}) ; + $this->{socket} = undef ; + } + + # This should never happen in JNI mode } - } - # For JNI we need to do nothing because the garbage collector will call - # the JNI destructor + $this->{destroyed} = 1 ; + } } @@ -194,13 +209,6 @@ sub setup_socket { } -sub release { - my $this = shift ; - - $this->{owner} = 0 ; -} - - sub reconnect { my $this = shift ; @@ -227,11 +235,41 @@ sub reconnect { } +sub capture { + my $this = shift ; + + if ($this->{JNI}){ + return ; + } + + $this->{owner} = 1 ; +} + + +sub am_owner { + my $this = shift ; + + return $this->{owner} ; +} + + +sub release { + my $this = shift ; + + if ($this->{JNI}){ + return ; + } + + $this->{owner} = 0 ; +} + + sub process_command { my $this = shift ; my $inline = shift ; my $data = shift ; + my $ref = undef ; my $resp = undef ; while (1){ Inline::Java::debug(" packet sent is $data") ; @@ -255,7 +293,7 @@ sub process_command { # We got an answer from the server. Is it a callback? if ($resp =~ /^callback/){ - $data = Inline::Java::Callback::InterceptCallback($inline, $resp) ; + ($data, $ref) = Inline::Java::Callback::InterceptCallback($inline, $resp) ; next ; } else{ diff --git a/Java/Makefile.PL b/Java/Makefile.PL index d7d83be..a15a881 100644 --- a/Java/Makefile.PL +++ b/Java/Makefile.PL @@ -2,159 +2,211 @@ use ExtUtils::MakeMaker ; use File::Find ; use strict ; +use File::Spec ; +require "Portable.pm" ; +Inline::Java::Portable::use_alone() ; -# Inherited from the parent Makefile.PL -if (! defined($main::JNI_BUILD)){ - $main::JNI_BUILD = 0 ; -} -if (! defined($main::JNI_VM)){ - $main::JNI_VM = "classic" ; -} +# Some shortcuts while developing +my $jdk_dir = undef ; +my $build_jni = ($jdk_dir ? 1 : 0) ; + +my $jvm_lib = Inline::Java::Portable::portable('JVM_LIB') ; +my $jvm_so = Inline::Java::Portable::portable('JVM_SO') ; +my @files = ( + 'jni.h', + 'jni_md.h', + $jvm_lib, +) ; +if ($jvm_so ne $jvm_lib){ + push @files, $jvm_so ; +} -my $JNI_BUILD = $main::JNI_BUILD ; -my $JNI_VM = $main::JNI_VM ; +my $files = { + 'jni.h' => { + discard => qr/include-old/, + }, + 'jni_md.h' => { + discard => qr/include-old/, + }, + $jvm_lib => { + discard => qr/green_threads/, + }, + $jvm_so => { + discard => qr/green_threads/, + }, +} ; + +foreach my $f (@files){ + $files->{$f}->{selected} = undef ; + $files->{$f}->{choices} = [] ; +} -# Define these variables with the correct values to bypass the -# rest of the code that looks for them. -my $java_include = undef ; -my $java_include_os = undef ; -my $java_lib = undef ; -my $java_so = undef ; +print "\n" ; +print + "Inline::Java can use a JNI extension that allows the Java Virtual Machine\n" . + "(JVM) to be dynamically linked with Perl instead of running as a separate\n" . + "process. The use of this extension is optional, and building it still\n" . + "allows Inline::Java to run the JVM in the default (separate process)\n" . + "fashion.\n\n" ; +if (($build_jni || AskYN("Do you wish to build the JNI extension?"))){ + print "\nBuilding JNI extension.\n\n" ; -my $jvm_lib = - ((($^O eq "MSWin32")||($^O eq "cygwin")) ? "jvm.lib" : "libjvm.so") ; -my $jvm_so = - ((($^O eq "MSWin32")||($^O eq "cygwin")) ? "jvm.dll" : "libjvm.so") ; + rename("JNI.xs_", "JNI.xs") ; + $jdk_dir = ($jdk_dir || AskSub("Enter the path to your Java 2 SDK installation", + sub {((-d $_[0]) ? 1 : (print("Directory '$_[0]' does not exist.\n") && 0))})) ; + print "\n" ; -if ($JNI_BUILD){ - if ((! defined($java_include))&& - (! defined($java_include_os))&& - (! defined($java_lib))&& - (! defined($java_so))){ - print "\nBuilding JNI extension, $JNI_VM VM.\n" ; + my $type = FindDefaultVMType() ; - # We need to find the files in order to be able to build - my $q = "\nEnter the path to your Java 2 SDK installation" ; - my $jh = Ask($q) ; - chomp($jh) ; - if (! -d $jh){ - die("Directory $jh does not exist.") ; - } - print "\n" ; - find(\&wanted, $jh) ; + find(\&search, $jdk_dir) ; - if (! defined($java_include)){ - die("Couldn't find jni.h.") ; - } - if (! defined($java_include_os)){ - die("Couldn't find jni_md.h.") ; + my $done = 0 ; + foreach my $f (@files){ + my $cnt = scalar(@{$files->{$f}->{choices}}) ; + if ($cnt == 0){ + print "Can't locate file '$f' anywhere under '$jdk_dir'\n" ; + $done = 1 ; + last ; } - if (! defined($java_lib)){ - die("Couldn't find $jvm_lib.") ; + elsif ($cnt == 1){ + $files->{$f}->{selected} = $files->{$f}->{choices}->[0] ; } - if (! defined($java_so)){ - die("Couldn't find $jvm_so.") ; + else{ + Choose($f, $type) ; } } + if (! $done){ + # We have all the required files selected. - my $l = join(" or ", @{$java_so}) ; - if ($^O eq "MSWin32"){ - print "\nNote: You will need to add $l to your PATH environment " . - "variable in order to be able to use the JNI mode.\n" ; - } - else{ - print "\nNote: You will need to add $l (and maybe other Java " . - "directories) to your LD_LIBRARY_PATH environment variable in " . - "order to be able to use the JNI mode. See README.JNI for more " . - "information.\n" ; - } - - print "\nNote: In order for Inline::Java to use the JNI extension, you " . - "will need to use the JNI configuration option or set the " . - "PERL_INLINE_JAVA_JNI environment variable to a true value. " . - "See README.JNI for more information.\n" ; + print "Building with:\n" ; + foreach my $f (@files){ + print File::Spec->catfile($files->{$f}->{selected}, $f) . "\n" ; + } + print "\n" ; - print "\n" ; + $done = WriteBSFile() ; + if (! $done){ + WriteMakefile( + NAME => 'Inline::Java::JNI', + VERSION_FROM => 'JNI.pm', + INC => "-I" . $files->{'jni.h'}->{selected} . " -I" . $files->{'jni_md.h'}->{selected}, + LIBS => ["-L" . $files->{$jvm_lib}->{selected} . " -ljvm"], + ) ; + + print + "\nNote: In order for Inline::Java to use the JNI extension, you\n" . + "will need to use the JNI configuration option or set the\n" . + "PERL_INLINE_JAVA_JNI environment variable to a true value.\n" . + "See README.JNI for more information.\n" ; + + print "\n" ; + } + } } else{ - rename("JNI.xs", "JNI.xs_") ; -} - + print "\n" ; -WriteMakefile( - NAME => 'Inline::Java::JNI', - VERSION_FROM => 'JNI.pm', - INC => (! $JNI_BUILD ? undef : - join(" ", - "-I$java_include", - "-I$java_include_os" - )), - LIBS => (! $JNI_BUILD ? undef : - [ - "-L$java_lib -ljvm" - ]), -) ; + rename("JNI.xs", "JNI.xs_") ; + WriteMakefile( + NAME => 'Inline::Java::JNI', + VERSION_FROM => 'JNI.pm') ; +} ################################################# -sub wanted { +sub search { my $file = $_ ; - if ($file eq "jni.h"){ - print "Found jni.h in $File::Find::dir...\n" ; - $java_include = $File::Find::dir ; - } - if ($file eq "jni_md.h"){ - print "Found jni_md.h in $File::Find::dir...\n" ; - $java_include_os = $File::Find::dir ; - } - if ($file eq $jvm_lib){ - print "Found $jvm_lib in $File::Find::dir...\n" ; - $java_lib = $File::Find::dir ; - } - if ($file eq $jvm_so){ - print "Found $jvm_so in $File::Find::dir...\n" ; - if (! defined($java_so)){ - $java_so = [] ; + foreach my $f (@files){ + if ($file eq $f){ + my $re = $files->{$f}->{discard} ; + if ((! $re)||($File::Find::dir !~ /$re/)){ + push @{$files->{$f}->{choices}}, File::Spec->canonpath($File::Find::dir) ; + } + last ; } - push @{$java_so}, $File::Find::dir ; } } -# Gets yes/no from stdin -sub AskYN { - my $ques = shift ; +sub WriteBSFile { + if (! open(BS, '>JNI_BS')){ + return 1 ; + } - my $str = $ques . " [yn]: " ; - print($str) ; + my $so = File::Spec->catfile($files->{$jvm_so}->{selected}, $jvm_so) ; + print BS <<BS_CODE; +my \$so = '$so' ; +push(\@dl_resolve_using, \$so) ; - my $ans = '' ; - while (<STDIN>){ - $ans = $_ ; - chomp($ans) ; - if ($ans =~ /^(y|n)$/i){ - last ; - } - else{ - print($str) ; +\$bscode = <<CODE ; +dl_load_file('\$so', Inline::Java::JNI->dl_load_flags) or +croak("Can't load '\$so' for module Inline::Java::JNI: " . dl_error()) ; +CODE + +BS_CODE + + close(BS) ; + return 0 ; +} + + +sub FindDefaultVMType { + my $type = undef ; + my $cfg = File::Spec->catfile($jdk_dir, "jre", "lib", "jvm.cfg") ; + if (open(CFG, "<$cfg")){ + while (<CFG>){ + my $line = $_ ; + chomp($line) ; + $line =~ s/^\s+// ; + $line =~ s/\s+$// ; + + if (! $line){ + next ; + } + elsif ($line =~ /^#/){ + next ; + } + else{ + $type = $line ; + $type =~ s/^-// ; + last ; + } } + close(CFG) ; } - if ($ans eq "y"){ - return 1 ; - } - else{ - return 0 ; + return $type ; +} + + +sub Choose { + my $f = shift ; + my $type = shift ; + + my $o = $files->{$f} ; + my $cnt = 0 ; + foreach my $f (@{$o->{choices}}){ + $cnt++ ; + my $hint = '' ; + if ($f =~ /$type/){ + $hint = "[your system default]" ; + } + print "[$cnt] $f $hint\n" ; } + my $idx = AskSub("Please select from the above list which '$f' to use $type [1-$cnt]", + sub {(($_[0] >= 1)&&($_[0] <= $cnt))}) ; + + $o->{selected} = $o->{choices}->[int($idx) - 1] ; + print "\n" ; } @@ -162,11 +214,39 @@ sub AskYN { sub Ask { my $ques = shift ; - my $str = $ques . " : " ; - print($str) ; - my $ans = '' ; - $ans = <STDIN> ; + return AskSub($ques, undef) ; +} - return $ans ; + +# Gets yes/no from stdin +sub AskYN { + my $ques = shift ; + + $ques .= " [yn]" ; + + my $ans = AskSub($ques, sub {$_[0] =~ /^(y|n)$/i}) ; + + return (($ans eq "y") ? 1 : 0) ; } + +sub AskSub { + my $ques = shift ; + my $sub = shift ; + + my $str = $ques . ": " ; + print $str ; + + while (<STDIN>){ + my $ans = $_ ; + chomp($ans) ; + if (! $sub){ + return $ans ; + } + elsif ($sub->($ans)){ + return $ans ; + } + + print $str ; + } +} diff --git a/Java/Object.pm b/Java/Object.pm index 60dd7a1..e3c6c96 100644 --- a/Java/Object.pm +++ b/Java/Object.pm @@ -3,7 +3,7 @@ package Inline::Java::Object ; use strict ; -$Inline::Java::Object::VERSION = '0.22' ; +$Inline::Java::Object::VERSION = '0.31' ; use Inline::Java::Protocol ; use Carp ; @@ -234,16 +234,23 @@ sub __get_member { my $key = shift ; if ($this->__get_private()->{class} eq "Inline::Java::Object"){ - croak "Can't get member $key for an object that is not bound to Perl" ; + croak "Can't get member '$key' for an object that is not bound to Perl" ; } - Inline::Java::debug("fetching member variable $key") ; + Inline::Java::debug("fetching member variable '$key'") ; my $inline = Inline::Java::get_INLINE($this->__get_private()->{module}) ; my $fields = $inline->get_fields($this->__get_private()->{class}) ; - if ($fields->{$key}){ - my $proto = $fields->{$key}->{TYPE} ; + my $types = $fields->{$key} ; + if ($types){ + my @typesk = keys %{$types} ; + + # We take the last one, which is more specific. Eventually + # we should use a scoring method just like for the methods + my $sign = $types->{$typesk[-1]} ; + + my $proto = $sign->{TYPE} ; my $ret = $this->__get_private()->{proto}->GetJavaMember($key, [$proto], [undef]) ; Inline::Java::debug("returning member (" . ($ret || '') . ")") ; @@ -252,7 +259,7 @@ sub __get_member { } else{ my $name = $this->__get_private()->{class} ; - croak "No public member variable $key defined for class $name" ; + croak "No public member variable '$key' defined for class '$name'" ; } } @@ -263,14 +270,21 @@ sub __set_member { my $value = shift ; if ($this->__get_private()->{class} eq "Inline::Java::Object"){ - croak "Can't set member $key for an object that is not bound to Perl" ; + croak "Can't set member '$key' for an object that is not bound to Perl" ; } my $inline = Inline::Java::get_INLINE($this->__get_private()->{module}) ; my $fields = $inline->get_fields($this->__get_private()->{class}) ; - if ($fields->{$key}){ - my $proto = $fields->{$key}->{TYPE} ; + my $types = $fields->{$key} ; + if ($types){ + my @typesk = keys %{$types} ; + + # We take the last one, which is more specific. Eventually + # we should use a scoring method just like for the methods + my $sign = $types->{$typesk[-1]} ; + + my $proto = $sign->{TYPE} ; my $new_args = undef ; my $score = undef ; @@ -279,7 +293,7 @@ sub __set_member { } else{ my $name = $this->__get_private()->{class} ; - croak "No public member variable $key defined for class $name" ; + croak "No public member variable '$key' defined for class '$name'" ; } } @@ -298,10 +312,10 @@ sub AUTOLOAD { my $name = (ref($this) ? $this->__get_private()->{class} : $this) ; if ($name eq "Inline::Java::Object"){ - croak "Can't call method $func_name on an object ($name) that is not bound to Perl" ; + croak "Can't call method '$func_name' on an object ($name) that is not bound to Perl" ; } - croak "No public method $func_name defined for class $name" ; + croak "No public method '$func_name' defined for class '$name'" ; } @@ -313,36 +327,41 @@ sub DESTROY { Inline::Java::debug("Destroying Inline::Java::Object::Tie") ; if (! Inline::Java::get_DONE()){ - # This one is very tricky: - # Here we want to be carefull since this can be called - # at scope end, but the scope end might be triggered - # by another croak, so we need to record and propagate - # the current $@ - my $prev_dollar_at = $@ ; - eval { - $this->__get_private()->{proto}->DeleteJavaObject($this) ; - } ; - if ($@){ - # We croaked here. Was there already a pending $@? - my $name = $this->__get_private()->{class} ; - my $msg = "In method DESTROY of class $name: $@" ; - if ($prev_dollar_at){ - $msg = "$prev_dollar_at\n$msg" ; + if (! $this->__get_private()->{weak_ref}){ + # This one is very tricky: + # Here we want to be carefull since this can be called + # at scope end, but the scope end might be triggered + # by another croak, so we need to record and propagate + # the current $@ + my $prev_dollar_at = $@ ; + eval { + $this->__get_private()->{proto}->DeleteJavaObject($this) ; + } ; + if ($@){ + # We croaked here. Was there already a pending $@? + my $name = $this->__get_private()->{class} ; + my $msg = "In method DESTROY of class $name: $@" ; + if ($prev_dollar_at){ + $msg = "$prev_dollar_at\n$msg" ; + } + croak $msg ; + } + else{ + # Put back the previous $@ + $@ = $prev_dollar_at ; } - croak $msg ; + + # Here we have a circular reference so we need to break it + # so that the memory is collected. + my $priv = $this->__get_private() ; + my $proto = $priv->{proto} ; + $priv->{proto} = undef ; + $proto->{obj_priv} = undef ; + $PRIVATES->{$this} = undef ; } else{ - # Put back the previous $@ - $@ = $prev_dollar_at ; + Inline::Java::debug(" Object marked a weak reference, object destruction not propagated to Java") ; } - - # Here we have a circular reference so we need to break it - # so that the memory is collected. - my $priv = $this->__get_private() ; - my $proto = $priv->{proto} ; - $priv->{proto} = undef ; - $proto->{obj_priv} = undef ; - $PRIVATES->{$this} = undef ; } else{ Inline::Java::debug(" Script marked as DONE, object destruction not propagated to Java") ; diff --git a/Java/Protocol.pm b/Java/Protocol.pm index bc6f006..758aa55 100644 --- a/Java/Protocol.pm +++ b/Java/Protocol.pm @@ -266,7 +266,7 @@ sub Send { my $const = shift ; my $inline = Inline::Java::get_INLINE($this->{module}) ; - my $resp = Inline::Java::get_JVM()->process_command($inline, $data) ; + my $resp = Inline::Java::__get_JVM()->process_command($inline, $data) ; if ($resp =~ /^error scalar:([\d.]*)$/){ my $msg = pack("C*", split(/\./, $1)) ; @@ -323,16 +323,23 @@ sub DeserializeObject { $elem_class = $d[2] ; } - my $perl_class = Inline::Java::java2perl($pkg, $elem_class) ; - if (Inline::Java::Class::ClassIsReference($elem_class)){ - if (! Inline::Java::known_to_perl($pkg, $elem_class)){ - if (($thrown)||($inline->get_java_config('AUTOSTUDY'))){ - $inline->_study([$elem_class]) ; - } - else{ - $perl_class = "Inline::Java::Object" ; - } - } + + my $perl_class = "Inline::Java::Object" ; + if ($elem_class){ + # We have a real class or an array of real classes + $perl_class = Inline::Java::java2perl($pkg, $elem_class) ; + if (Inline::Java::Class::ClassIsReference($elem_class)){ + if (! Inline::Java::known_to_perl($pkg, $elem_class)){ + if (($thrown)||($inline->get_java_config('AUTOSTUDY'))){ + $inline->_study([$elem_class]) ; + } + else{ + # Object is not known to Perl, it lives as a + # Inline::Java::Object + $perl_class = "Inline::Java::Object" ; + } + } + } } else{ # We should only get here if an array of primitives types @@ -899,7 +906,6 @@ class InlineJavaProtocol { if (type.equals(t)){ ijs.debug(" has matching type " + t) ; fl.add(fl.size(), f) ; - break ; } } } @@ -911,10 +917,13 @@ class InlineJavaProtocol { "Member " + name + " of type " + type + " for class " + c.getName() + " not found") ; } - else if (fl.size() == 1){ + else { // Now we need to force the arguments received to match // the methods signature. - Field f = (Field)fl.get(0) ; + + // If we have more that one, we use tha last one, which is the most + // specialized + Field f = (Field)fl.get(fl.size() - 1) ; param = f.getType() ; String msg = "For member " + name + " of class " + c.getName() + ": " ; diff --git a/Makefile.PL b/Makefile.PL index fd8a7bf..77aad23 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,32 +1,11 @@ -use ExtUtils::MakeMaker; +use ExtUtils::MakeMaker ; +use strict ; -# So that the the sub dir Makefile.PL will see it... -$main::JNI_BUILD = 0 ; -$main::JNI_VM = "classic" ; - - -# In case we had built differently a previous time -rename("Java/JNI.xs_", "Java/JNI.xs") ; - - -my $fix_makefile = 0 ; -foreach my $arg (@ARGV){ - my $a = $arg ; - $a =~ s/^\s+// ; - $a =~ s/\s+$// ; - - if ($a =~ /^JNI(:(\w+))?$/i){ - $JNI_BUILD = 1 ; - if ($2){ - $main::JNI_VM = $2 ; - } - } - elsif ($a =~ /^FIX$/i){ - $fix_makefile = 1 ; - } -} +require "Java/Portable.pm" ; +Inline::Java::Portable::use_alone() ; +print "\nWelcome to the Inline::Java installation procedure.\n\n" ; WriteMakefile( NAME => 'Inline::Java', @@ -38,7 +17,7 @@ WriteMakefile( ) ; -if ($fix_makefile){ +if (Inline::Java::Portable::portable('COMMAND_COM')){ print "\nFixing Makefile for Win32...\n" ; open(MAKEFILE, "<Makefile") or die "Can't open Makefile for reading" ; my @lines = <MAKEFILE> ; diff --git a/t/01_init.t b/t/01_init.t index c14cdbe..df86a68 100644 --- a/t/01_init.t +++ b/t/01_init.t @@ -1,10 +1,10 @@ -use strict; -use Test; +use strict ; +use Test ; BEGIN { plan(tests => 1) ; } -mkdir('./_Inline_test', 0777) unless -e './_Inline_test'; +mkdir('./_Inline_test', 0777) unless -e './_Inline_test' ; ok(1) ; diff --git a/t/02_primitives.t b/t/02_primitives.t index c2d4040..faff73f 100644 --- a/t/02_primitives.t +++ b/t/02_primitives.t @@ -2,9 +2,9 @@ use strict ; use Test ; use Inline Config => - DIRECTORY => './_Inline_test'; + DIRECTORY => './_Inline_test' ; -use Inline( +use Inline ( Java => 'DATA' ) ; diff --git a/t/05_arrays.t b/t/05_arrays.t index 87c9103..ee3ace7 100644 --- a/t/05_arrays.t +++ b/t/05_arrays.t @@ -9,48 +9,62 @@ use Inline( ) ; BEGIN { - plan(tests => 42) ; + plan(tests => 50) ; } my $t = new types5() ; { - ok($t->_byte([12, 34, 56])->[0] == 123) ; + ok(++($t->_byte([12, 34, 56])->[0]) == 124) ; ok(eq_array($t->_Byte([12, 34, 56]), [12, 34, 56])) ; - ok($t->_short([12, 34, 56])->[0] == 123) ; + ok(++($t->_short([12, 34, 56])->[0]) == 124) ; ok(eq_array($t->_Short([12, 34, 56]), [12, 34, 56])) ; - ok($t->_int([12, 34, 56])->[0] == 123) ; + ok(++($t->_int([12, 34, 56])->[0]) == 124) ; ok(eq_array($t->_Integer([12, 34, 56]), [12, 34, 56])) ; - ok($t->_long([12, 34, 56])->[0] == 123) ; + ok(++($t->_long([12, 34, 56])->[0]) == 124) ; ok(eq_array($t->_Long([12, 34, 56]), [12, 34, 56])) ; - ok($t->_float([12.34, 5.6, 7])->[0] == 123.456) ; + ok(++($t->_float([12.34, 5.6, 7])->[0]) == 124.456) ; ok(eq_array($t->_Float([12.34, 5.6, 7]), [12.34, 5.6, 7])) ; - ok($t->_double([12.34, 5.6, 7])->[0] == 123.456) ; + ok(++($t->_double([12.34, 5.6, 7])->[0]) == 124.456) ; ok(eq_array($t->_Double([12.34, 5.6, 7]), [12.34, 5.6, 7])) ; ok($t->_boolean([1, 0, "tree"])->[0]) ; ok($t->_Boolean([1, 0])->[0]) ; ok(! $t->_Boolean([1, 0])->[1]) ; ok($t->_char(['a', 'b', 'c'])->[0], "A") ; ok(eq_array($t->_Character(['a', 'b', 'c']), ['a', 'b', 'c'], 1)) ; - ok($t->_String(["bla", "ble", "bli"])->[0], "STRING") ; + my $a = $t->_String(["bla", "ble", "bli"]) ; + ok($a->[0], "STRING") ; + $a->[1] = "wazoo" ; + ok($a->[1], "wazoo") ; ok($t->_StringBuffer(["bla", "ble", "bli"])->[0], "STRINGBUFFER") ; ok($t->_Object(undef), undef) ; - my $a = $t->_Object([1, "two", $t]) ; + $a = $t->_Object([1, "two", $t]) ; ok($a->[0], "1") ; ok($a->[1], "two") ; ok(UNIVERSAL::isa($a->[2], "main::types5")) ; ok($a->[2]->{data}->[1], "a") ; $a->[2]->{data} = ["1", "2"] ; ok($a->[2]->{data}->[1], 2) ; + + $a->[0]++ ; + ok($a->[0], "2") ; + + $a->[1] = "three" ; + ok($a->[1], "three") ; + + $a->[2] = "string" ; + ok($a->[2], "string") ; + + $a->[0] = $t ; + ok(UNIVERSAL::isa($a->[0], "main::types5")) ; # Try some multidimensional arrays. $a = $t->_StringString([ ["00", "01"], ["10", "11"] ]) ; - ok($a->[1]->[0], "10") ; # Try some incomplete multidimensional arrays. $a = $t->_StringString([ @@ -98,6 +112,13 @@ my $t = new types5() ; eval {pop @{$b}} ; ok($@, qr/Operation POP/) ; eval {shift @{$b}} ; ok($@, qr/Operation SHIFT/) ; eval {splice(@{$b}, 0, 1)} ; ok($@, qr/Operation SPLICE/) ; + + # Cool stuff on arrays + $a = $t->_byte([12, 34, 56]) ; + ok(scalar(@{$a}), 3) ; + foreach my $e (@{$a}){ + ok($e =~ /^(123|34|56)$/) ; + } } ok($t->__get_private()->{proto}->ObjectCount(), 1) ; diff --git a/t/07_polymorph.t b/t/07_polymorph.t index c306f59..f42adfc 100644 --- a/t/07_polymorph.t +++ b/t/07_polymorph.t @@ -12,7 +12,7 @@ use Inline::Java qw(cast) ; BEGIN { - plan(tests => 18) ; + plan(tests => 22) ; } @@ -44,6 +44,15 @@ my $t = new types7() ; ok($t2->f($t1), "t2") ; ok($t2->f(cast("t17", $t2)), "t2") ; + ok($t2->f($t1), "t2") ; + + # Here we should always get the more specific stuff + ok($t2->{i}, 7) ; + ok($t2->{j}, 3.1416) ; + + # So this should fail + eval {$t2->{j} = "string"} ; ok($@, qr/Can't convert/) ; + # Interfaces my $al = $t1->get_al() ; ok(0, $t1->count($al)) ; @@ -60,6 +69,9 @@ __Java__ import java.util.* ; class t17 { + public int i = 5 ; + public String j = "toto" ; + public t17(){ } @@ -78,6 +90,9 @@ class t17 { class t27 extends t17 { + public int i = 7 ; + public double j = 3.1416 ; + public t27(){ } diff --git a/t/13_callbacks.t b/t/13_callbacks.t index 1cbee7e..7e26893 100644 --- a/t/13_callbacks.t +++ b/t/13_callbacks.t @@ -14,15 +14,17 @@ use Inline::Java qw(caught) ; BEGIN { - plan(tests => 19) ; + plan(tests => 20) ; } -my $t = new t10() ; +my $t = new t15() ; { eval { ok($t->add(5, 6), 11) ; ok($t->add_via_perl(5, 6), 11) ; + my $a = $t->incr_via_perl([7, 6, 5]) ; + ok($a->[1], 7) ; ok($t->mul(5, 6), 30) ; ok($t->mul_via_perl(5, 6), 30) ; ok($t->silly_mul(3, 2), 6) ; @@ -33,7 +35,7 @@ my $t = new t10() ; ok($t->add_via_perl_via_java(3, 4), 7) ; ok($t->silly_mul_via_perl_via_java(10, 9), 90) ; - ok(t10->add_via_perl_via_java_t($t, 6, 9), 15) ; + ok(t15->add_via_perl_via_java_t($t, 6, 9), 15) ; ok($t->cat_via_perl("Inline", "Java"), "InlineJava") ; @@ -45,7 +47,7 @@ my $t = new t10() ; my $msg = '' ; eval {$t->twister(20, 0, 1)} ; if ($@) { - if (caught('t10$OwnException')){ + if (caught('t15$OwnException')){ $msg = $@->getMessage() ; } else{ @@ -82,6 +84,17 @@ sub add { } +sub incr { + my $ija = shift ; + + for (my $i = 0 ; $i < $ija->length() ; $i++){ + $ija->[$i]++ ; + } + + return $ija ; +} + + sub mul { my $i = shift ; my $j = shift ; @@ -144,6 +157,7 @@ sub dummy { } + __END__ __Java__ @@ -151,7 +165,7 @@ __Java__ import java.io.* ; -class t10 extends InlineJavaPerlCaller { +class t15 extends InlineJavaPerlCaller { class OwnException extends Exception { OwnException(String msg){ super(msg) ; @@ -159,7 +173,7 @@ class t10 extends InlineJavaPerlCaller { } - public t10() { + public t15() { } public int add(int a, int b){ @@ -186,7 +200,6 @@ class t10 extends InlineJavaPerlCaller { return ret ; } - public int add_via_perl(int a, int b) throws InlineJavaException, PerlException { String val = (String)CallPerl("main", "add", new Object [] {new Integer(a), new Integer(b)}) ; @@ -194,12 +207,19 @@ class t10 extends InlineJavaPerlCaller { return new Integer(val).intValue() ; } + public int [] incr_via_perl(int a[]) throws InlineJavaException, PerlException { + int [] r = (int [])CallPerl("main", "incr", + new Object [] {a}, "[I") ; + + return r ; + } + public void death_via_perl() throws InlineJavaException, PerlException { InlineJavaPerlCaller c = new InlineJavaPerlCaller() ; c.CallPerl("main", "death", null) ; } - public void except() throws InlineJavaException, PerlException { + public void except() throws InlineJavaException, PerlException { throw new PerlException("test") ; } @@ -217,7 +237,7 @@ class t10 extends InlineJavaPerlCaller { return new Integer(val).intValue() ; } - static public int add_via_perl_via_java_t(t10 t, int a, int b) throws InlineJavaException, PerlException { + static public int add_via_perl_via_java_t(t15 t, int a, int b) throws InlineJavaException, PerlException { InlineJavaPerlCaller c = new InlineJavaPerlCaller() ; String val = (String)c.CallPerl("main", "add_via_java_t", new Object [] {t, new Integer(a), new Integer(b)}) ; -- 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