[libinline-java-perl] 57/398: *** empty log message ***
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:42:45 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 f2f6fcbb45501f29fbc25804b3509b6f0bdcf90c
Author: patrick <>
Date: Tue Apr 10 18:45:35 2001 +0000
*** empty log message ***
---
Java.pm | 549 +++++++++++++++++++++++--------------------------------
Java/Array.pm | 36 +++-
Java/Class.pm | 124 ++++++++-----
Java/Init.pm | 115 ++----------
Java/JNI.pm | 15 +-
Java/JNI.xs | 2 +-
Java/Makefile.PL | 1 -
Java/Object.pm | 115 ++++++++----
Java/Protocol.pm | 225 +++++++++++++++++------
9 files changed, 621 insertions(+), 561 deletions(-)
diff --git a/Java.pm b/Java.pm
index cdd909e..0761939 100644
--- a/Java.pm
+++ b/Java.pm
@@ -12,10 +12,6 @@ if (! defined($Inline::Java::DEBUG)){
$Inline::Java::DEBUG = 0 ;
}
-# This hash will store the $o objects...
-$Inline::Java::INLINE = {} ;
-$Inline::Java::BOUND_CLASSES = {} ;
-
require Inline ;
use Carp ;
@@ -33,12 +29,18 @@ use Inline::Java::Array ;
use Inline::Java::Protocol ;
# Must be last.
use Inline::Java::Init ;
+use Inline::Java::JVM ;
+
+# This is set when the script is over.
+my $DONE = 0 ;
-# Stores a list of the Java interpreters running
-my @CHILDREN = () ;
-my $CHILD_CNT = 0 ;
-$Inline::Java::DONE = 0 ;
+
+# This is set when at least one JVM is loaded.
+my $JVM = undef ;
+
+# This hash will store the $o objects...
+my $INLINES = {} ;
# Here is some code to figure out if we are running on command.com
# shell under Windows.
@@ -60,7 +62,7 @@ my $COMMAND_COM =
sub done {
my $signal = shift ;
- $Inline::Java::DONE = 1 ;
+ $DONE = 1 ;
my $ec = 0 ;
if (! $signal){
@@ -71,23 +73,10 @@ sub done {
$ec = 1 ;
}
- # Ask the children to die and close the sockets
- foreach my $o (values %{$Inline::Java::INLINE}){
- if (! $o->{Java}->{USE_JNI}){
- my $sock = $o->{Java}->{socket} ;
- # This asks the Java server to stop and die.
- if ($sock->connected()){
- print $sock "die\n" ;
- }
- close($sock) ;
- }
- }
-
- foreach my $pid (@CHILDREN){
- my $ok = kill 9, $pid ;
- Inline::Java::debug("killing $pid...", ($ok ? "ok" : "failed")) ;
+ if ($JVM){
+ undef $JVM ;
}
-
+
Inline::Java::debug("exiting with $ec") ;
# In Windows, it is possible that the process will hang here if
@@ -97,14 +86,24 @@ sub done {
END {
- if (! $Inline::Java::DONE){
+ if ($DONE < 1){
done() ;
}
}
+# Signal stuff, not really needed with USE_JNI
use sigtrap 'handler', \&done, 'normal-signals' ;
+$SIG{__DIE__} = sub {
+ # Setting this to -1 will prevent Inline::Java::Object::DESTROY
+ # from executing it's code for object destruction, since the state
+ # in possibly unstable.
+ $DONE = -1 ;
+ die @_ ;
+} ;
+
+
######################## Inline interface ########################
@@ -118,7 +117,7 @@ sub register {
aliases => ['JAVA', 'java'],
type => 'interpreted',
suffix => 'jdat',
- };
+ } ;
}
@@ -148,10 +147,6 @@ sub _validate {
$o->{Java}->{CLASSPATH} = '' ;
}
- my $install_lib = $o->{install_lib} ;
- my $modpname = $o->{modpname} ;
- my $install = "$install_lib/auto/$modpname" ;
-
while (@_) {
my ($key, $value) = (shift, shift) ;
if ($key eq 'BIN'){
@@ -190,34 +185,19 @@ sub _validate {
$o->{Java}->{USE_JNI} = 1 ;
}
- if ($o->{Java}->{USE_JNI}){
- require Inline::Java::JNI ;
- }
+ my $install_lib = $o->{install_lib} ;
+ my $modpname = $o->{modpname} ;
+ my $install = "$install_lib/auto/$modpname" ;
$o->set_classpath($install) ;
+
$o->set_java_bin() ;
Inline::Java::debug("validate done.") ;
}
-sub get_jni {
- my $o = shift ;
-
- if (! defined($o->{Java}->{JNI})){
- my $jni = new Inline::Java::JNI(
- $ENV{CLASSPATH} || "",
- ($Inline::Java::DEBUG ? 1 : 0),
- ) ;
- $jni->create_ijs() ;
- $o->{Java}->{JNI} = $jni ;
- }
-
- Inline::Java::debug_obj($o->{Java}->{JNI}) ;
- return $o->{Java}->{JNI} ;
-}
-
-
+# This function builds the CLASSPATH environment variable
sub set_classpath {
my $o = shift ;
my $path = shift ;
@@ -234,9 +214,7 @@ sub set_classpath {
}
my $sep = portable("ENV_VAR_PATH_SEP") ;
-
my @cp = split(/$sep/, join($sep, @list)) ;
-
my %cp = map { ($_ !~ /^\s*$/ ? ($_, 1) : ()) } @cp ;
$ENV{CLASSPATH} = join($sep, keys %cp) ;
@@ -354,56 +332,6 @@ sub build {
}
-# Return a small report about the Java code.
-sub info {
- my $o = shift;
-
- if (! $o->{Java}->{built}){
- $o->build ;
- }
- if (! $o->{Java}->{loaded}){
- $o->load ;
- }
-
- my $info = '' ;
- my $d = $o->{Java}->{data} ;
-
- my %classes = %{$d->{classes}} ;
- $info .= "The following Java classes have been bound to Perl:\n" ;
- foreach my $class (sort keys %classes) {
- $info .= "\tclass $class:\n" ;
-
- if (defined($d->{classes}->{$class}->{constructors})){
- foreach my $const (@{$d->{classes}->{$class}->{constructors}}) {
- my $sign = $const ;
- my $name = $class ;
- $name =~ s/^(.*)::// ;
- $info .= "\t\tpublic $name(" . join(", ", @{$sign}) . ")\n" ;
- }
- }
- foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{static}}) {
- my $sign = $d->{classes}->{$class}->{methods}->{static}->{$method} ;
- if (defined($sign)){
- foreach my $s (@{$sign}){
- $info .= "\t\tpublic static $method(" . join(", ", @{$s}) . ")\n" ;
- }
- }
- }
- foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{instance}}) {
- my $sign = $d->{classes}->{$class}->{methods}->{instance}->{$method} ;
- if (defined($sign)){
- foreach my $s (@{$sign}){
- $info .= "\t\tpublic $method(" . join(", ", @{$s}) . ")\n" ;
- }
- }
- }
- }
-
-
- return $info ;
-}
-
-
# Writes the java code.
sub write_java {
my $o = shift ;
@@ -428,69 +356,6 @@ sub write_java {
}
-sub report {
- my $o = shift ;
- my $pattern = shift ;
- my $other_classes = shift || [] ;
-
- if (! $o->{Java}->{loaded}){
- my $modfname = $o->{modfname} ;
- my $java = $o->{Java}->{BIN} . "/java" . portable("EXE_EXTENSION") ;
- my $pjava = portable("RE_FILE", $java) ;
- my $predir = portable("IO_REDIR") ;
- my $debug = ($Inline::Java::DEBUG ? "true" : "false") ;
-
- my @classes = ($pattern) ;
- foreach my $class (@{$other_classes}){
- if (! $Inline::Java::BOUND_CLASSES->{$class}){
- $Inline::Java::BOUND_CLASSES->{$class} = 1 ;
- $class .= ".class" ;
- push @classes, $class ;
- }
- else{
- carp "Java class $class already bound to Perl!" ;
- }
- }
-
- if (! $o->{Java}->{USE_JNI}){
- my $class_str = join(" ", @classes) ;
-
- my $cmd = "\"$pjava\" InlineJavaServer report $debug $modfname $class_str > cmd.out $predir" ;
- if ($o->{config}->{UNTAINT}){
- ($cmd) = $cmd =~ /(.*)/ ;
- }
- return $cmd ;
- }
- else{
- # Here we need to expand the pattern.
- my $build_dir = $o->{build_dir} ;
- my @cl = glob("$build_dir/$pattern") ;
- foreach my $class (@cl){
- $class =~ s/^$build_dir\/// ;
- }
-
- shift @classes ;
- unshift @classes, @cl ;
-
- my $class_str = join(" ", @classes) ;
- Inline::Java::debug($class_str) ;
-
- my $jni = $o->get_jni() ;
- $jni->report($modfname, $class_str, scalar(@classes)) ;
-
- return "" ;
- }
- }
- else{
- # On-the-fly class reporting and binding...
- if (! $o->{Java}->{USE_JNI}){
- }
- else{
- }
- }
-}
-
-
# Run the build process.
sub compile {
my $o = shift ;
@@ -504,12 +369,9 @@ sub compile {
$o->mkpath($install) ;
my $javac = $o->{Java}->{BIN} . "/javac" . portable("EXE_EXTENSION") ;
- my $java = $o->{Java}->{BIN} . "/java" . portable("EXE_EXTENSION") ;
- my $pinstall = portable("RE_FILE", $install) ;
my $predir = portable("IO_REDIR") ;
my $pjavac = portable("RE_FILE", $javac) ;
- my $pjava = portable("RE_FILE", $java) ;
my $cwd = Cwd::cwd() ;
if ($o->{config}->{UNTAINT}){
@@ -525,12 +387,9 @@ sub compile {
# copy_pattern will take care of checking whether there are actually files
# to be copied, and if not will exit the script.
foreach my $cmd (
- "\"$pjavac\" $modfname.java > cmd.out $predir",
- {CMD => ["copy_pattern", $o, "*.class"]},
- "\"$pjavac\" InlineJavaServer.java > cmd.out $predir",
- {CMD => ["copy_pattern", $o, "*.class"]},
- {CMD => ["report", $o, "*.class"], RET_IS_CMD => (! $o->{Java}->{USE_JNI})},
- {CMD => ["copy_pattern", $o, "*.jdat"]},
+ "\"$pjavac\" InlineJavaServer.java $modfname.java > cmd.out $predir",
+ ["copy_pattern", $o, "*.class"],
+ ["touch_file", $o, "$install/$modfname.jdat"],
) {
if ($cmd){
@@ -538,36 +397,30 @@ sub compile {
chdir $build_dir ;
if (ref($cmd)){
Inline::Java::debug_obj($cmd) ;
- my $func = shift @{$cmd->{CMD}} ;
- my @args = @{$cmd->{CMD}} ;
+ my $func = shift @{$cmd} ;
+ my @args = @{$cmd} ;
Inline::Java::debug("$func" . "(" . join(", ", @args) . ")") ;
no strict 'refs' ;
my $ret = $func->(@args) ;
- if (! $cmd->{RET_IS_CMD}){
- if ($ret){
- croak $ret ;
- }
- chdir $cwd ;
- next ;
- }
- else{
- $cmd = $ret ;
+ if ($ret){
+ croak $ret ;
}
}
+ else{
+ if ($o->{config}->{UNTAINT}){
+ ($cmd) = $cmd =~ /(.*)/ ;
+ }
- if ($o->{config}->{UNTAINT}){
- ($cmd) = $cmd =~ /(.*)/ ;
+ Inline::Java::debug("$cmd") ;
+ my $res = system($cmd) ;
+ $res and do {
+ $o->error_copy ;
+ croak $o->compile_error_msg($cmd, $cwd) ;
+ } ;
}
- Inline::Java::debug("$cmd") ;
- my $res = system($cmd) ;
- $res and do {
- $o->error_copy ;
- croak $o->compile_error_msg($cmd, $cwd) ;
- } ;
-
chdir $cwd ;
}
}
@@ -620,94 +473,70 @@ sub load {
return ;
}
- if ($o->{mod_exists}){
- # In this case, the options are not rechecked, and therefore
- # the defaults not registered. We must force it
- $o->_validate(1, %{$o->{config}}) ;
- }
-
- my $install_lib = $o->{install_lib} ;
- my $modpname = $o->{modpname} ;
my $modfname = $o->{modfname} ;
- my $install = "$install_lib/auto/$modpname" ;
- my $class = $modfname ;
+ # Make sure the default options are set.
+ $o->_validate(1, %{$o->{config}}) ;
- # Now we must open the jdat file and read it's contents.
- if (! open(JDAT, "$install/$class.jdat")){
- croak "Can't open $install/$class.jdat code information file" ;
+ # If the JVM is not running, we need to start it here.
+ if (! $JVM){
+ $JVM = new Inline::Java::JVM($o) ;
}
- my @lines = <JDAT> ;
- close(JDAT) ;
+
+ # Now that the JVM is running, we make sure it knows where all
+ # the classes are.
+ my $pc = new Inline::Java::Protocol(undef, $o) ;
+ $pc->SetClassPath($ENV{CLASSPATH}) ;
- Inline::Java::debug(@lines) ;
- my $contents = join("", @lines) ;
- if ($contents =~ /^\s*$/){
- croak "Corrupted code information file $install/$class.jdat" ;
- }
+ # Then we ask it to give us the public symbols from the classes
+ # that we got.
+ my @lines = $o->report() ;
+ # Now we read up the symbols and bind them to Perl.
$o->load_jdat(@lines) ;
$o->bind_jdat() ;
- my $java = $o->{Java}->{BIN} . "/java" . portable("EXE_EXTENSION") ;
- my $pjava = portable("RE_FILE", $java) ;
-
- Inline::Java::debug(" cwd is: " . Cwd::cwd()) ;
-
- if (! $o->{Java}->{USE_JNI}){
- Inline::Java::debug(" load is forking.") ;
- my $pid = fork() ;
- if (! defined($pid)){
- croak "Can't fork to start Java interpreter" ;
- }
- $CHILD_CNT++ ;
-
- my $port = $o->{Java}->{PORT} + ($CHILD_CNT - 1) ;
-
- if ($pid){
- # parent here
- Inline::Java::debug(" parent here.") ;
-
- push @CHILDREN, $pid ;
+ $o->{Java}->{loaded} = 1 ;
- my $socket = $o->setup_socket($port) ;
- $o->{Java}->{socket} = $socket ;
- Inline::Java::debug("load done.") ;
- }
- else{
- # child here
- Inline::Java::debug(" child here.") ;
+ $INLINES->{$modfname} = $o ;
+}
- my $debug = ($Inline::Java::DEBUG ? "true" : "false") ;
- my @cmd = ($pjava, 'InlineJavaServer', 'run', $debug, $port) ;
- Inline::Java::debug(join(" ", @cmd)) ;
+# This function asks the JVM what are the public symbols for the specified
+# classes
+sub report {
+ my $o = shift ;
+ my $classes = shift ;
- if ($o->{config}->{UNTAINT}){
- foreach my $cmd (@cmd){
- ($cmd) = $cmd =~ /(.*)/ ;
- }
- }
+ my $install_lib = $o->{install_lib} ;
+ my $modpname = $o->{modpname} ;
+ my $install = "$install_lib/auto/$modpname" ;
+ my $pinstall = portable("RE_FILE", $install) ;
- exec(@cmd)
- or croak "Can't exec Java interpreter" ;
+ if (! defined($classes)){
+ # We need to take the classes that are in the directory...
+ my @cl = glob("$pinstall/*.class") ;
+ foreach my $class (@cl){
+ $class =~ s/^\Q$pinstall\E\/(.*)\.class$/$1/ ;
}
- }
- else{
- # This will create the JNI object if it is not already created.
- $o->get_jni() ;
+ $classes = \@cl ;
}
- $Inline::Java::INLINE->{$modfname} = $o ;
- $o->{Java}->{loaded} = 1 ;
+ my $pc = new Inline::Java::Protocol(undef, $o) ;
+ my $resp = $pc->Report(join(" ", @{$classes})) ;
+
+ return split("\n", $resp) ;
}
+
# Load the jdat code information file.
sub load_jdat {
my $o = shift ;
my @lines = @_ ;
+ Inline::Java::debug(@lines) ;
+
$o->{Java}->{data} = {} ;
my $d = $o->{Java}->{data} ;
@@ -761,25 +590,7 @@ sub load_jdat {
}
}
- # Inline::Java::debug_obj($d) ;
-}
-
-
-sub get_fields {
- my $o = shift ;
- my $class = shift ;
-
- my $fields = {} ;
- my $d = $o->{Java}->{data} ;
-
- while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{static}}){
- $fields->{$field} = $value ;
- }
- while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{instance}}){
- $fields->{$field} = $value ;
- }
-
- return $fields ;
+ Inline::Java::debug_obj($d) ;
}
@@ -815,7 +626,7 @@ sub new {
my \$class = shift ;
my \@args = \@_ ;
- my \$o = \$Inline::Java::INLINE->{'$modfname'} ;
+ my \$o = Inline::Java::get_INLINE('$modfname') ;
my \$d = \$o->{Java}->{data} ;
my \$signatures = \$d->{classes}->{'$class'}->{constructors} ;
my (\$proto, \$new_args) = \$class->__validate_prototype('new', [\@args], \$signatures, \$o) ;
@@ -851,7 +662,7 @@ sub $method {
my \$class = shift ;
my \@args = \@_ ;
- my \$o = \$Inline::Java::INLINE->{'$modfname'} ;
+ my \$o = Inline::Java::get_INLINE('$modfname') ;
my \$d = \$o->{Java}->{data} ;
my \$signatures = \$d->{classes}->{'$class'}->{methods}->{static}->{'$method'} ;
my (\$proto, \$new_args) = \$class->__validate_prototype('$method', [\@args], \$signatures, \$o) ;
@@ -883,7 +694,7 @@ sub $method {
my \$this = shift ;
my \@args = \@_ ;
- my \$o = \$Inline::Java::INLINE->{'$modfname'} ;
+ my \$o = Inline::Java::get_INLINE('$modfname') ;
my \$d = \$o->{Java}->{data} ;
my \$signatures = \$d->{classes}->{'$class'}->{methods}->{instance}->{'$method'} ;
my (\$proto, \$new_args) = \$this->__validate_prototype('$method', [\@args], \$signatures, \$o) ;
@@ -909,54 +720,75 @@ CODE
}
-# Sets up the communication socket to the Java program
-sub setup_socket {
+sub get_fields {
my $o = shift ;
- my $port = shift ;
+ my $class = shift ;
+
+ my $fields = {} ;
+ my $d = $o->{Java}->{data} ;
- my $timeout = $o->{Java}->{STARTUP_DELAY} ;
+ while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{static}}){
+ $fields->{$field} = $value ;
+ }
+ while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{instance}}){
+ $fields->{$field} = $value ;
+ }
- my $modfname = $o->{modfname} ;
- my $socket = undef ;
+ return $fields ;
+}
- my $last_words = "timeout\n" ;
- eval {
- local $SIG{ALRM} = sub { die($last_words) ; } ;
- my $got_alarm = portable("GOT_ALARM") ;
+# Return a small report about the Java code.
+sub info {
+ my $o = shift;
- if ($got_alarm){
- alarm($timeout) ;
- }
+ # Make sure the default options are set.
+ $o->_validate(1, %{$o->{config}}) ;
- while (1){
- $socket = new IO::Socket::INET(
- PeerAddr => 'localhost',
- PeerPort => $port,
- Proto => 'tcp') ;
- if ($socket){
- last ;
- }
- }
+ if ((! $o->{mod_exists})&&(! $o->{Java}->{built})){
+ $o->build ;
+ }
+
+ if (! $o->{Java}->{loaded}){
+ $o->load ;
+ }
- if ($got_alarm){
- alarm(0) ;
+ my $info = '' ;
+ my $d = $o->{Java}->{data} ;
+
+ my %classes = %{$d->{classes}} ;
+ $info .= "The following Java classes have been bound to Perl:\n" ;
+ foreach my $class (sort keys %classes) {
+ $info .= "\tclass $class:\n" ;
+
+ if (defined($d->{classes}->{$class}->{constructors})){
+ foreach my $const (@{$d->{classes}->{$class}->{constructors}}) {
+ my $sign = $const ;
+ my $name = $class ;
+ $name =~ s/^(.*)::// ;
+ $info .= "\t\tpublic $name(" . join(", ", @{$sign}) . ")\n" ;
+ }
}
- } ;
- if ($@){
- if ($@ eq $last_words){
- croak "Java program taking more than $timeout seconds to start, or died before Perl could connect. Increase config STARTUP_DELAY if necessary." ;
+ foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{static}}) {
+ my $sign = $d->{classes}->{$class}->{methods}->{static}->{$method} ;
+ if (defined($sign)){
+ foreach my $s (@{$sign}){
+ $info .= "\t\tpublic static $method(" . join(", ", @{$s}) . ")\n" ;
+ }
+ }
}
- else{
- croak $@ ;
+ foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{instance}}) {
+ my $sign = $d->{classes}->{$class}->{methods}->{instance}->{$method} ;
+ if (defined($sign)){
+ foreach my $s (@{$sign}){
+ $info .= "\t\tpublic $method(" . join(", ", @{$s}) . ")\n" ;
+ }
+ }
}
- }
- if (! $socket){
- croak "Can't connect to Java program: $!" ;
- }
+ }
+
- $socket->autoflush(1) ;
- return $socket ;
+ return $info ;
}
@@ -973,8 +805,6 @@ sub copy_pattern {
my $src_dir = $build_dir ;
my $dest_dir = $pinstall ;
- chdir($src_dir) ;
-
my @flist = glob($pattern) ;
if (portable('COMMAND_COM')){
@@ -1002,9 +832,78 @@ sub copy_pattern {
}
+sub touch_file {
+ my $o = shift ;
+ my $file = shift ;
+
+ my $pfile = portable("RE_FILE", $file) ;
+
+ if (! open(TOUCH, ">$pfile")){
+ croak "Can't create file $pfile for writing" ;
+ }
+ close(TOUCH) ;
+
+ return '' ;
+}
+
+
+
######################## General Functions ########################
+sub get_JVM {
+ return $JVM ;
+}
+
+
+sub get_INLINE {
+ my $module = shift ;
+
+ return $INLINES->{$module} ;
+}
+
+
+sub get_DEBUG {
+ return $Inline::Java::DEBUG ;
+}
+
+
+sub get_DONE {
+ return $DONE ;
+}
+
+
+sub java2perl {
+ my $jclass = shift ;
+
+ $jclass =~ s/[.\$]/::/g ;
+
+ return $jclass ;
+}
+
+
+sub known_to_perl {
+ my $pkg = shift ;
+ my $jclass = shift ;
+
+ $jclass =~ s/[.\$]/::/g ;
+
+ my $perl_class = java2perl($jclass) ;
+ $perl_class = $pkg . "::" . $perl_class ;
+
+ no strict 'refs' ;
+ if (defined(${$perl_class . "::" . "EXISTS"})){
+ Inline::Java::debug(" returned class exists!") ;
+ return $perl_class ;
+ }
+ else{
+ Inline::Java::debug(" returned class doesn't exist!") ;
+ }
+
+ return undef ;
+}
+
+
sub debug {
if ($Inline::Java::DEBUG){
my $str = join("", @_) ;
@@ -1016,13 +915,25 @@ sub debug {
sub debug_obj {
my $obj = shift ;
+ my $pre = shift || "perl: " ;
if ($Inline::Java::DEBUG){
- print STDERR "perl: " . Dumper($obj) ;
+ print STDERR $pre . Dumper($obj) ;
+ if (UNIVERSAL::isa($obj, "Inline::Java::Object")){
+ # Print the guts as well...
+ print STDERR $pre . Dumper($obj->__get_private()) ;
+ }
}
}
+sub dump_obj {
+ my $obj = shift ;
+
+ return debug_obj($obj, "Java Object Dump:\n") ;
+}
+
+
sub portable {
my $key = shift ;
my $val = shift ;
diff --git a/Java/Array.pm b/Java/Array.pm
index c3fbab4..3ca2071 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -18,7 +18,7 @@ sub new {
my $object = shift ;
my @this = () ;
- my $knot = tie @this, 'Inline::Java::Array::Tie' ;
+ my $knot = tie @this, $class ;
my $this = bless (\@this, $class) ;
$OBJECTS->{$knot} = $object ;
@@ -44,6 +44,19 @@ sub __get_object {
}
+sub __isa {
+ my $this = shift ;
+ my $proto = shift ;
+
+ eval {
+ my $obj = $this->__get_object() ;
+ $obj->__get_private()->{proto}->ISA($proto) ;
+ } ;
+
+ return $@ ;
+}
+
+
sub length {
my $this = shift ;
@@ -134,7 +147,17 @@ sub AUTOLOAD {
sub DESTROY {
my $this = shift ;
- untie @{$this} ;
+ my $knot = tied @{$this} ;
+ if (! $knot){
+ Inline::Java::debug("Destroying Inline::Java::Array::Tie") ;
+
+ $OBJECTS->{$this} = undef ;
+ }
+ else{
+ # Here we can't untie because we still have a reference in $OBJECTS
+ # untie @{$this} ;
+ Inline::Java::debug("Destroying Inline::Java::Array") ;
+ }
}
@@ -243,8 +266,6 @@ sub DELETE {
sub DESTROY {
my $this = shift ;
-
- $OBJECTS->{$this} = undef ;
}
@@ -686,7 +707,12 @@ class InlineJavaArray {
Object o = ijc.CastArgument(elem, arg) ;
Array.set(array, i, o) ;
- ijs.debug(" setting array element " + String.valueOf(i) + " to " + o.toString()) ;
+ if (o != null){
+ ijs.debug(" setting array element " + String.valueOf(i) + " to " + o.toString()) ;
+ }
+ else{
+ ijs.debug(" setting array element " + String.valueOf(i) + " to " + o) ;
+ }
}
}
catch (InlineJavaCastException e){
diff --git a/Java/Class.pm b/Java/Class.pm
index e95362c..211c068 100644
--- a/Java/Class.pm
+++ b/Java/Class.pm
@@ -29,18 +29,26 @@ my $RANGE = {
},
'java.lang.Long' => {
REGEXP => $INT_RE,
- MAX => 9223372036854775807,
- MIN => -9223372036854775808,
+ MAX => 2147483647,
+ MIN => -2147483648,
+ # MAX => 9223372036854775807,
+ # MIN => -9223372036854775808,
},
'java.lang.Float' => {
REGEXP => $FLOAT_RE,
MAX => 3.4028235e38,
- MIN => 1.4e-45,
+ MIN => -3.4028235e38,
+ POS_MIN => 1.4e-45,
+ NEG_MAX => -1.4e-45,
},
'java.lang.Double' => {
REGEXP => $FLOAT_RE,
- MAX => 1.7976931348623157e308,
- MIN => 4.9e-324,
+ MAX => 3.4028235e38,
+ MIN => -3.4028235e38,
+ # MAX => 1.7976931348623157e308,
+ # MIN => -1.7976931348623157e308,
+ POS_MIN => 4.9e-324,
+ NEG_MAX => -4.9e-324,
},
} ;
$RANGE->{byte} = $RANGE->{'java.lang.Byte'} ;
@@ -111,33 +119,35 @@ sub CastArgument {
if ((ClassIsReference($proto))&&(! UNIVERSAL::isa($arg, "Inline::Java::Object"))){
# Here we allow scalars to be passed in place of java.lang.Object
# 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($proto, $arg) ;
- my $flat = $an->FlattenArray() ;
- my $inline = $Inline::Java::INLINE->{$module} ;
- my $obj = Inline::Java::Object->__new($proto, $inline, -1, $flat->[0], $flat->[1]) ;
-
- # We need to create the array on the Java side, and then grab
- # the returned object.
- $arg = new Inline::Java::Array($obj) ;
- }
- else{
- Inline::Java::debug("argument is already an Inline::Java array") ;
- }
- }
- else{
- if (ref($arg)){
- # We got some other type of ref...
- croak "Can't convert $arg to object $proto" ;
+ if (defined($arg)){
+ if (UNIVERSAL::isa($arg, "ARRAY")){
+ if (! UNIVERSAL::isa($arg, "Inline::Java::Array")){
+ my $an = new Inline::Java::Array::Normalizer($proto, $arg) ;
+ my $flat = $an->FlattenArray() ;
+ my $inline = Inline::Java::get_INLINE($module) ;
+ my $obj = Inline::Java::Object->__new($proto, $inline, -1, $flat->[0], $flat->[1]) ;
+
+ # We need to create the array on the Java side, and then grab
+ # the returned object.
+ $arg = new Inline::Java::Array($obj) ;
+ }
+ else{
+ Inline::Java::debug("argument is already an Inline::Java array") ;
+ }
}
else{
- # Here we got a scalar
- # Here we allow scalars to be passed in place of java.lang.Object
- # They will wrapped on the Java side.
- if ($proto ne "java.lang.Object"){
+ if (ref($arg)){
+ # We got some other type of ref...
croak "Can't convert $arg to object $proto" ;
}
+ else{
+ # Here we got a scalar
+ # Here we allow scalars to be passed in place of java.lang.Object
+ # They will wrapped on the Java side.
+ if ($proto ne "java.lang.Object"){
+ croak "Can't convert $arg to object $proto" ;
+ }
+ }
}
}
}
@@ -171,20 +181,33 @@ sub CastArgument {
croak "Can't convert $arg to $proto" ;
}
elsif (ClassIsBool($proto)){
- if ($arg){
- return (1, 0) ;
+ if ((! defined($arg))||(! $arg)){
+ return (0, 0) ;
}
else{
- return (0, 0) ;
+ return (1, 0) ;
}
}
elsif (ClassIsString($proto)){
if (! defined($arg)){
- return ("", 0) ;
+ return (undef, 0) ;
}
return ($arg, 0) ;
}
else{
+ if (! defined($arg)){
+ return ($arg, 0) ;
+ }
+ # Here the prototype calls for an object of type $proto
+ # We must ask Java if our object extends $proto
+ if (ref($arg)){
+ my $msg = $arg->__isa($proto) ;
+ if ($msg){
+ croak $msg ;
+ }
+ Inline::Java::debug("$arg is a $proto") ;
+ }
+
return ($arg, 0) ;
}
}
@@ -392,12 +415,14 @@ class InlineJavaClass {
if (num){
ijs.debug(" args is undef -> forcing to " + p.getName() + " 0") ;
ret = ijp.CreateObject(p, new Object [] {"0"}, new Class [] {String.class}) ;
+ ijs.debug(" result is " + ret.toString()) ;
}
else{
- ijs.debug(" args is undef -> forcing to " + p.getName() + " ''") ;
- ret = ijp.CreateObject(p, new Object [] {""}, new Class [] {String.class}) ;
+ ret = null ;
+ ijs.debug(" args is undef -> forcing to " + p.getName() + " " + ret) ;
+ ijs.debug(" result is " + ret) ;
+ // ijp.CreateObject(p, new Object [] {""}, new Class [] {String.class}) ;
}
- ijs.debug(" result is " + ret.toString()) ;
}
else if (type.equals("scalar")){
String arg = ijp.pack((String)tokens.get(1)) ;
@@ -485,19 +510,8 @@ class InlineJavaClass {
String objid = (String)tokens.get(2) ;
Class c = ValidateClass(c_name) ;
- // We need to check if c extends p
- Class parent = c ;
- boolean got_it = false ;
- while (parent != null){
- ijs.debug(" parent is " + parent.getName()) ;
- if (parent == p){
- got_it = true ;
- break ;
- }
- parent = parent.getSuperclass() ;
- }
- if (got_it){
+ if (DoesExtend(c, p)){
ijs.debug(" " + c.getName() + " is a kind of " + p.getName()) ;
// get the object from the hash table
Integer oid = new Integer(objid) ;
@@ -517,6 +531,22 @@ class InlineJavaClass {
}
+ boolean DoesExtend(Class a, Class b){
+ // We need to check if a extends b
+ Class parent = a ;
+ boolean got_it = false ;
+ while (parent != null){
+ ijs.debug(" parent is " + parent.getName()) ;
+ if (parent == b){
+ got_it = true ;
+ break ;
+ }
+ parent = parent.getSuperclass() ;
+ }
+
+ return got_it ;
+ }
+
/*
Finds the wrapper class for the passed primitive type.
diff --git a/Java/Init.pm b/Java/Init.pm
index f674c47..0b7f9ea 100644
--- a/Java/Init.pm
+++ b/Java/Init.pm
@@ -71,41 +71,31 @@ public class InlineJavaServer {
// This constructor is used in server mode
InlineJavaServer(String[] argv) {
- String mode = argv[0] ;
- debug = new Boolean(argv[1]).booleanValue() ;
+ debug = new Boolean(argv[0]).booleanValue() ;
- if (mode.equals("report")){
- Report(argv, 2) ;
- }
- else if (mode.equals("run")){
- int port = Integer.parseInt(argv[2]) ;
+ int port = Integer.parseInt(argv[1]) ;
- try {
- ss = new ServerSocket(port) ;
- Socket client = ss.accept() ;
+ try {
+ ss = new ServerSocket(port) ;
+ Socket client = ss.accept() ;
- BufferedReader br = new BufferedReader(
- new InputStreamReader(client.getInputStream())) ;
- BufferedWriter bw = new BufferedWriter(
- new OutputStreamWriter(client.getOutputStream())) ;
+ BufferedReader br = new BufferedReader(
+ new InputStreamReader(client.getInputStream())) ;
+ BufferedWriter bw = new BufferedWriter(
+ new OutputStreamWriter(client.getOutputStream())) ;
- while (true){
- String cmd = br.readLine() ;
+ while (true){
+ String cmd = br.readLine() ;
- String resp = ProcessCommand(cmd) ;
- bw.write(resp) ;
- bw.flush() ;
- }
- }
- catch (IOException e){
- System.err.println("Can't open server socket on port " + String.valueOf(port)) ;
+ String resp = ProcessCommand(cmd) ;
+ bw.write(resp) ;
+ bw.flush() ;
}
- System.exit(1) ;
}
- else{
- System.err.println("Invalid startup mode " + mode) ;
- System.exit(1) ;
+ catch (IOException e){
+ System.err.println("Can't open server socket on port " + String.valueOf(port)) ;
}
+ System.exit(1) ;
}
@@ -135,77 +125,6 @@ public class InlineJavaServer {
/*
- Returns a report on the Java classes, listing all public methods
- and members
- */
- void Report(String [] class_list, int idx) {
- String module = class_list[idx] ;
- idx++ ;
-
- // First we must open the file
- try {
- File dat = new File(module + ".jdat") ;
- PrintWriter pw = new PrintWriter(new FileWriter(dat)) ;
-
- String data = ProcessReport(class_list, idx) ;
- pw.print(data) ;
- pw.close() ;
- }
- catch (IOException e){
- System.err.println("Problems writing to " + module + ".jdat file: " + e.getMessage()) ;
- System.exit(1) ;
- }
- }
-
-
- String ProcessReport(String [] class_list, int idx){
- StringBuffer pw = new StringBuffer() ;
-
- try {
- for (int i = idx ; i < class_list.length ; i++){
- if (! class_list[i].startsWith("InlineJavaServer")){
- StringBuffer name = new StringBuffer(class_list[i]) ;
- name.replace(name.length() - 6, name.length(), "") ;
- Class c = Class.forName(name.toString()) ;
-
- pw.append("class " + c.getName() + "\n") ;
- Constructor constructors[] = c.getConstructors() ;
- Method methods[] = c.getMethods() ;
- Field fields[] = c.getFields() ;
-
- for (int j = 0 ; j < constructors.length ; j++){
- Constructor x = constructors[j] ;
- String sign = CreateSignature(x.getParameterTypes()) ;
- Class decl = x.getDeclaringClass() ;
- pw.append("constructor" + " " + sign + "\n") ;
- }
- for (int j = 0 ; j < methods.length ; j++){
- Method x = methods[j] ;
- String stat = (Modifier.isStatic(x.getModifiers()) ? " static " : " instance ") ;
- String sign = CreateSignature(x.getParameterTypes()) ;
- Class decl = x.getDeclaringClass() ;
- pw.append("method" + stat + decl.getName() + " " + x.getName() + sign + "\n") ;
- }
- for (int j = 0 ; j < fields.length ; j++){
- Field x = fields[j] ;
- String stat = (Modifier.isStatic(x.getModifiers()) ? " static " : " instance ") ;
- Class decl = x.getDeclaringClass() ;
- Class type = x.getType() ;
- pw.append("field" + stat + decl.getName() + " " + x.getName() + " " + type.getName() + "\n") ;
- }
- }
- }
- }
- catch (ClassNotFoundException e){
- System.err.println("Can't find class: " + e.getMessage()) ;
- System.exit(1) ;
- }
-
- return pw.toString() ;
- }
-
-
- /*
Creates a string representing a method signature
*/
String CreateSignature(Class param[]){
diff --git a/Java/JNI.pm b/Java/JNI.pm
index 3ac200e..99f9759 100644
--- a/Java/JNI.pm
+++ b/Java/JNI.pm
@@ -6,5 +6,16 @@ use strict ;
$Inline::Java::JNI::VERSION = '0.10' ;
-require DynaLoader ;
-Inline::Java::JNI->bootstrap($Inline::Java::JNI::VERSION) ;
+use Carp ;
+
+
+eval {
+ Inline::Java::JNI->bootstrap($Inline::Java::JNI::VERSION) ;
+} ;
+if ($@){
+ croak "Can't load JNI module: $@" ;
+}
+
+
+
+1 ;
diff --git a/Java/JNI.xs b/Java/JNI.xs
index de93fed..0c08db0 100644
--- a/Java/JNI.xs
+++ b/Java/JNI.xs
@@ -61,7 +61,7 @@ new(CLASS, classpath, debug)
/* Create the Java VM */
res = JNI_CreateJavaVM(&(RETVAL->jvm), (void **)&(RETVAL->env), &vm_args) ;
if (res < 0) {
- croak("Can't create Java interpreter using JNI\n") ;
+ croak("Can't create Java interpreter using JNI") ;
}
free(cp) ;
diff --git a/Java/Makefile.PL b/Java/Makefile.PL
index 6e2bd46..e9a4036 100644
--- a/Java/Makefile.PL
+++ b/Java/Makefile.PL
@@ -10,5 +10,4 @@ WriteMakefile(
LIBS => [
'-L/usr/java1.2/jre/lib/sparc -ljvm'
],
- clean => {FILES => '_Inline_test/'},
) ;
diff --git a/Java/Object.pm b/Java/Object.pm
index 78efe56..232a33f 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -37,7 +37,7 @@ sub __new {
my $knot = tie %this, $class ;
my $this = bless(\%this, $class) ;
- my $priv = Inline::Java::Object::Private->new($java_class, $inline) ;
+ my $priv = Inline::Java::Object::Private->new($class, $java_class, $inline) ;
$PRIVATES->{$knot} = $priv ;
if ($objid <= 0){
@@ -84,6 +84,8 @@ sub __validate_prototype {
my $new_arguments = [] ;
my $scores = [] ;
+ my $nb_proto = scalar(@{$prototypes}) ;
+ my @errors = () ;
foreach my $proto (@{$prototypes}){
my $new_args = undef ;
my $score = undef ;
@@ -91,11 +93,15 @@ sub __validate_prototype {
($new_args, $score) = Inline::Java::Class::CastArguments($args, $proto, $inline->{modfname}) ;
} ;
if ($@){
- # We croaked, so we assume that we were not able to cast
- # the arguments to the prototype
- Inline::Java::debug("Rescued from death: $@") ;
+ if ($nb_proto == 1){
+ # Here we have only 1 prototype, so we return the error.
+ croak $@ ;
+ }
+ push @errors, $@ ;
+ Inline::Java::debug("Error trying to fit args to prototype: $@") ;
next ;
}
+
# We passed!
push @{$matched_protos}, $proto ;
push @{$new_arguments}, $new_args ;
@@ -106,10 +112,13 @@ sub __validate_prototype {
my $name = (ref($class) ? $class->__get_private()->{class} : $class) ;
my $sa = Inline::Java::Protocol->CreateSignature($args) ;
my $msg = "In method $method of class $name: Can't find any signature that matches " .
- "the arguments passed $sa. Available signatures are:\n" ;
+ "the arguments passed $sa.\nAvailable signatures are:\n" ;
+ my $i = 0 ;
foreach my $proto (@{$prototypes}){
my $s = Inline::Java::Protocol->CreateSignature($proto) ;
$msg .= "\t$method$s\n" ;
+ $msg .= "\t\terror was: $errors[$i]" ;
+ $i++ ;
}
chomp $msg ;
croak $msg ;
@@ -123,13 +132,29 @@ sub __validate_prototype {
}
+sub __isa {
+ my $this = shift ;
+ my $proto = shift ;
+
+ eval {
+ $this->__get_private()->{proto}->ISA($proto) ;
+ } ;
+
+ return $@ ;
+}
+
+
sub __get_member {
my $this = shift ;
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" ;
+ }
+
Inline::Java::debug("fetching member variable $key") ;
- my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ my $inline = Inline::Java::get_INLINE($this->__get_private()->{module}) ;
my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
if ($fields->{$key}){
@@ -138,12 +163,13 @@ sub __get_member {
my $proto = $fields->{$key}->[0] ;
my $ret = $this->__get_private()->{proto}->GetJavaMember($key, [$proto], [undef]) ;
- Inline::Java::debug("returning member ($ret)") ;
+ Inline::Java::debug("returning member (" . ($ret || '') . ")") ;
return $ret ;
}
else{
- croak "No public member variable $key defined for class $this->__get_private()->{class}" ;
+ my $name = $this->__get_private()->{class} ;
+ croak "No public member variable $key defined for class $name" ;
}
}
@@ -153,7 +179,11 @@ sub __set_member {
my $key = shift ;
my $value = shift ;
- my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ if ($this->__get_private()->{class} eq "Inline::Java::Object"){
+ 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()->{java_class}) ;
if ($fields->{$key}){
@@ -169,10 +199,10 @@ sub __set_member {
($new_args, $score) = Inline::Java::Class::CastArguments([$value], [$f], $this->__get_private()->{module}) ;
} ;
if ($@){
- # We croaked, so we assume that we were not able to cast
- # the arguments to the prototype
+ Inline::Java::debug("Error trying to assign member: $@") ;
next ;
}
+
# We passed!
push @{$matched_protos}, [$f] ;
push @{$new_arguments}, $new_args ;
@@ -181,8 +211,8 @@ sub __set_member {
if (! scalar(@{$matched_protos})){
my $name = $this->__get_private()->{class} ;
- my $msg = "For member $key of class $name: Can't assign passed value to variable " .
- "this variable can accept:\n" ;
+ my $msg = "For member $key of class $name: Can't assign passed value $value to variable $key. " .
+ "This variable can accept:\n" ;
foreach my $f (@{$list}){
$msg .= "\t$f\n" ;
}
@@ -197,7 +227,8 @@ sub __set_member {
$this->__get_private()->{proto}->SetJavaMember($key, $matched_protos->[$nb - 1], $new_arguments->[$nb - 1]) ;
}
else{
- croak "No public member variable $key defined for class $this->__get_private()->{class}" ;
+ my $name = $this->__get_private()->{class} ;
+ croak "No public member variable $key defined for class $name" ;
}
}
@@ -214,30 +245,43 @@ sub AUTOLOAD {
Inline::Java::debug("$func_name") ;
- croak "No public method $func_name defined for class $this->__get_private()->{class}" ;
+ 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 that is not bound to Perl" ;
+ }
+
+ croak "No public method $func_name defined for class $name" ;
}
-# Here an object in destroyed. this function seems to be called twice
-# for each object. I think it's because the $this reference is both blessed
-# and tied to the same package.
sub DESTROY {
my $this = shift ;
- if (! $Inline::Java::DONE){
- if (! $this->__get_private()->{deleted}){
- $this->__get_private()->{deleted} = 1 ;
+ my $knot = tied %{$this} ;
+ if (! $knot){
+ Inline::Java::debug("Destroying Inline::Java::Object::Tie") ;
+
+ if (! Inline::Java::get_DONE()){
eval {
$this->__get_private()->{proto}->DeleteJavaObject($this) ;
} ;
- croak "In method DESTROY of class $this->__get_private()->{class}: $@" if $@ ;
- }
- else{
- Inline::Java::debug("Object destructor called more than once!") ;
+ my $name = $this->__get_private()->{class} ;
+ croak "In method DESTROY of class $name: $@" if $@ ;
}
+
+ # 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{
+ # Here we can't untie because we still have a reference in $PRIVATES
+ # untie %{$this} ;
+ Inline::Java::debug("Destroying Inline::Java::Object") ;
}
-
- untie %{$this} ;
}
@@ -293,7 +337,7 @@ sub EXISTS {
my $this = shift ;
my $key = shift ;
- my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ my $inline = Inline::Java::get_INLINE($this->__get_private()->{module}) ;
my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
if ($fields->{$key}){
@@ -321,8 +365,6 @@ sub CLEAR {
sub DESTROY {
my $this = shift ;
-
- $PRIVATES->{$this} = undef ;
}
@@ -333,14 +375,14 @@ package Inline::Java::Object::Private ;
sub new {
my $class = shift ;
+ my $obj_class = shift ;
my $java_class = shift ;
my $inline = shift ;
my $this = {} ;
- $this->{class} = $class ;
+ $this->{class} = $obj_class ;
$this->{java_class} = $java_class ;
$this->{module} = $inline->{modfname} ;
- $this->{known_to_perl} = 1 ;
$this->{proto} = new Inline::Java::Protocol($this, $inline) ;
bless($this, $class) ;
@@ -349,6 +391,15 @@ sub new {
}
+sub DESTROY {
+ my $this = shift ;
+
+ Inline::Java::debug("Destroying Inline::Java::Object::Private") ;
+}
+
+
+
+
package Inline::Java::Object ;
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index 15d487c..3801b23 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -24,6 +24,55 @@ sub new {
}
+sub SetClassPath {
+ my $this = shift ;
+ my $classpath = shift ;
+
+ Inline::Java::debug("setting classpath") ;
+
+ my $data = join(" ",
+ "set_classpath",
+ $this->ValidateArgs([$classpath]),
+ ) ;
+
+ return $this->Send($data, 1) ;
+}
+
+
+sub Report {
+ my $this = shift ;
+ my $classes = shift ;
+
+ Inline::Java::debug("reporting on $classes") ;
+
+ my $data = join(" ",
+ "report",
+ $this->ValidateArgs([$classes]),
+ ) ;
+
+ return $this->Send($data, 1) ;
+}
+
+
+sub ISA {
+ my $this = shift ;
+ my $proto = shift ;
+
+ Inline::Java::debug("checking if $this is a $proto") ;
+
+ my $id = $this->{obj_priv}->{id} ;
+ my $class = $this->{obj_priv}->{java_class} ;
+ my $data = join(" ",
+ "isa",
+ $id,
+ Inline::Java::Class::ValidateClass($class),
+ Inline::Java::Class::ValidateClass($proto),
+ ) ;
+
+ return $this->Send($data, 1) ;
+}
+
+
# Called to create a Java object
sub CreateJavaObject {
my $this = shift ;
@@ -40,8 +89,6 @@ sub CreateJavaObject {
$this->ValidateArgs($args),
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
return $this->Send($data, 1) ;
}
@@ -64,8 +111,6 @@ sub CallStaticJavaMethod {
$this->ValidateArgs($args),
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
return $this->Send($data) ;
}
@@ -90,8 +135,6 @@ sub CallJavaMethod {
$this->ValidateArgs($args),
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
return $this->Send($data) ;
}
@@ -105,7 +148,7 @@ sub SetJavaMember {
my $id = $this->{obj_priv}->{id} ;
my $class = $this->{obj_priv}->{java_class} ;
- Inline::Java::debug("setting object($id)->{$member} = $arg->[0]") ;
+ Inline::Java::debug("setting object($id)->{$member} = " . ($arg->[0] || '')) ;
my $data = join(" ",
"set_member",
$id,
@@ -115,8 +158,6 @@ sub SetJavaMember {
$this->ValidateArgs($arg),
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
return $this->Send($data) ;
}
@@ -140,8 +181,6 @@ sub GetJavaMember {
"undef:",
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
return $this->Send($data) ;
}
@@ -162,8 +201,6 @@ sub DeleteJavaObject {
$id,
) ;
- Inline::Java::debug(" packet sent is $data") ;
-
$this->Send($data) ;
}
}
@@ -233,7 +270,9 @@ sub CreateSignature {
my $proto = shift ;
my $del = shift || ", " ;
- return "(" . join($del, @{$proto}) . ")" ;
+ my @p = map {$_ || ''} @{$proto} ;
+
+ return "(" . join($del, @p) . ")" ;
}
@@ -244,25 +283,9 @@ sub Send {
my $data = shift ;
my $const = shift ;
- my $resp = undef ;
- my $inline = $Inline::Java::INLINE->{$this->{module}} ;
- if (! $inline->{Java}->{USE_JNI}){
- my $sock = $inline->{Java}->{socket} ;
- print $sock $data . "\n" or
- croak "Can't send packet over socket: $!" ;
-
- $resp = <$sock> ;
- }
- else{
- $resp = $inline->{Java}->{JNI}->process_command($data) ;
- }
-
- Inline::Java::debug(" packet recv is $resp") ;
+ my $resp = Inline::Java::get_JVM()->process_command($data) ;
- if (! $resp){
- croak "Can't receive packet over socket: $!" ;
- }
- elsif ($resp =~ /^error scalar:([\d.]*)$/){
+ if ($resp =~ /^error scalar:([\d.]*)$/){
my $msg = pack("C*", split(/\./, $1)) ;
Inline::Java::debug(" packet recv error: $msg") ;
croak $msg ;
@@ -285,35 +308,15 @@ sub Send {
return undef ;
}
else{
- my $perl_class = $class ;
- $perl_class =~ s/[.\$]/::/g ;
- my $pkg = $inline->{pkg} ;
- $perl_class = $pkg . "::" . $perl_class ;
- Inline::Java::debug($perl_class) ;
-
- my $known = 0 ;
- {
- no strict 'refs' ;
- if (defined(${$perl_class . "::" . "EXISTS"})){
- Inline::Java::debug(" returned class exists!") ;
- $known = 1 ;
- }
- else{
- Inline::Java::debug(" returned class doesn't exist!") ;
- }
- }
-
my $obj = undef ;
- if ($known){
- Inline::Java::debug("creating stub for known object...") ;
+ my $inline = Inline::Java::get_INLINE($this->{module}) ;
+
+ my $perl_class = Inline::Java::known_to_perl($inline->{pkg}, $class) ;
+ if ($perl_class){
$obj = $perl_class->__new($class, $inline, $id) ;
- Inline::Java::debug("stub created ($obj)...") ;
}
else{
- Inline::Java::debug("creating stub for unknown object...") ;
$obj = Inline::Java::Object->__new($class, $inline, $id) ;
- Inline::Java::debug("stub created ($obj)...") ;
- $obj->__get_private()->{known_to_perl} = 0 ;
}
Inline::Java::debug("checking if stub is array...") ;
@@ -331,6 +334,14 @@ sub Send {
}
+sub DESTROY {
+ my $this = shift ;
+
+ Inline::Java::debug("Destroying Inline::Java::Protocol") ;
+}
+
+
+
1 ;
@@ -377,6 +388,15 @@ class InlineJavaProtocol {
else if (c.equals("get_member")){
GetJavaMember(st) ;
}
+ else if (c.equals("report")){
+ Report(st) ;
+ }
+ else if (c.equals("isa")){
+ ISA(st) ;
+ }
+ else if (c.equals("set_classpath")){
+ SetClassPath(st) ;
+ }
else if (c.equals("create_object")){
CreateJavaObject(st) ;
}
@@ -392,6 +412,99 @@ class InlineJavaProtocol {
}
}
+ /*
+ Returns a report on the Java classes, listing all public methods
+ and members
+ */
+ void Report(StringTokenizer st){
+ StringBuffer pw = new StringBuffer() ;
+
+ StringTokenizer st2 = new StringTokenizer(st.nextToken(), ":") ;
+ st2.nextToken() ;
+
+ StringTokenizer st3 = new StringTokenizer(pack(st2.nextToken()), " ") ;
+
+ ArrayList class_list = new ArrayList() ;
+ while (st3.hasMoreTokens()){
+ String c = st3.nextToken() ;
+ ijs.debug("reporting for " + c) ;
+ class_list.add(class_list.size(), c) ;
+ }
+
+ try {
+ for (int i = 0 ; i < class_list.size() ; i++){
+ String name = (String)class_list.get(i) ;
+ if (! name.startsWith("InlineJavaServer")){
+ Class c = Class.forName(name) ;
+
+ pw.append("class " + c.getName() + "\n") ;
+ Constructor constructors[] = c.getConstructors() ;
+ Method methods[] = c.getMethods() ;
+ Field fields[] = c.getFields() ;
+
+ for (int j = 0 ; j < constructors.length ; j++){
+ Constructor x = constructors[j] ;
+ String sign = CreateSignature(x.getParameterTypes()) ;
+ Class decl = x.getDeclaringClass() ;
+ pw.append("constructor" + " " + sign + "\n") ;
+ }
+ for (int j = 0 ; j < methods.length ; j++){
+ Method x = methods[j] ;
+ String stat = (Modifier.isStatic(x.getModifiers()) ? " static " : " instance ") ;
+ String sign = CreateSignature(x.getParameterTypes()) ;
+ Class decl = x.getDeclaringClass() ;
+ pw.append("method" + stat + decl.getName() + " " + x.getName() + sign + "\n") ;
+ }
+ for (int j = 0 ; j < fields.length ; j++){
+ Field x = fields[j] ;
+ String stat = (Modifier.isStatic(x.getModifiers()) ? " static " : " instance ") ;
+ Class decl = x.getDeclaringClass() ;
+ Class type = x.getType() ;
+ pw.append("field" + stat + decl.getName() + " " + x.getName() + " " + type.getName() + "\n") ;
+ }
+ }
+ }
+ }
+ catch (ClassNotFoundException e){
+ System.err.println("Can't find class: " + e.getMessage()) ;
+ System.exit(1) ;
+ }
+
+ SetResponse(pw.toString()) ;
+ }
+
+
+ void SetClassPath(StringTokenizer st) throws InlineJavaException {
+ String classpath = st.nextToken() ;
+ StringTokenizer st2 = new StringTokenizer(classpath, ":") ;
+ st2.nextToken() ;
+
+ String prop = pack(st2.nextToken()) ;
+ System.out.println(prop) ;
+ System.setProperty("java.class.path", prop) ;
+
+ SetResponse(null) ;
+ }
+
+
+ void ISA(StringTokenizer st) throws InlineJavaException {
+ int id = Integer.parseInt(st.nextToken()) ;
+
+ String class_name = st.nextToken() ;
+ Class c = ijc.ValidateClass(class_name) ;
+
+ String is_it_a = st.nextToken() ;
+ Class d = ijc.ValidateClass(is_it_a) ;
+
+ Integer oid = new Integer(id) ;
+ Object o = ijs.objects.get(oid) ;
+ if (o == null){
+ throw new InlineJavaException("Object " + oid.toString() + " is not in HashMap!") ;
+ }
+
+ SetResponse(new Boolean(ijc.DoesExtend(c, d))) ;
+ }
+
/*
Creates a Java Object with the specified arguments.
--
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