[libinline-java-perl] 51/398: *** empty log message ***
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:42:44 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 d663876867e937032929be02ea03a047ddce752d
Author: patrick <>
Date: Mon Apr 2 18:37:13 2001 +0000
*** empty log message ***
---
Java.pm | 255 +++++++++++++++++++++++++++++++++++++++----------------
Java/Array.pm | 78 +++++++++++------
Java/Object.pm | 60 ++++++++++---
Java/Protocol.pm | 16 +++-
4 files changed, 293 insertions(+), 116 deletions(-)
diff --git a/Java.pm b/Java.pm
index 36f0648..68df578 100644
--- a/Java.pm
+++ b/Java.pm
@@ -14,6 +14,7 @@ if (! defined($Inline::Java::DEBUG)){
# This hash will store the $o objects...
$Inline::Java::INLINE = {} ;
+$Inline::Java::BOUND_CLASSES = {} ;
require Inline ;
@@ -204,6 +205,23 @@ sub boot_jni {
}
+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} ;
+}
+
+
sub set_classpath {
my $o = shift ;
my $path = shift ;
@@ -398,7 +416,7 @@ sub write_java {
my $modfname = $o->{modfname} ;
my $code = $o->{code} ;
- $o->mkpath($o->{build_dir}) ;
+ $o->mymkpath($o->{build_dir}) ;
open(JAVA, ">$build_dir/$modfname.java") or
croak "Can't open $build_dir/$modfname.java: $!" ;
@@ -414,6 +432,70 @@ 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) ;
+ Inline::Java::debug($class_str) ;
+
+ 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 ;
@@ -424,7 +506,7 @@ sub compile {
my $install_lib = $o->{install_lib} ;
my $install = "$install_lib/auto/$modpname" ;
- $o->mkpath($install) ;
+ $o->mymkpath($install) ;
my $javac = $o->{Java}->{BIN} . "/javac" . portable("EXE_EXTENSION") ;
my $java = $o->{Java}->{BIN} . "/java" . portable("EXE_EXTENSION") ;
@@ -449,11 +531,11 @@ sub compile {
# to be copied, and if not will exit the script.
foreach my $cmd (
"\"$pjavac\" $modfname.java > cmd.out $predir",
- ["copy_pattern", $build_dir, "*.class", $pinstall, $o->{config}->{UNTAINT} || 0],
+ ["copy_pattern", $o, "*.class"],
"\"$pjavac\" InlineJavaServer.java > cmd.out $predir",
- ["copy_pattern", $build_dir, "*.class", $pinstall, $o->{config}->{UNTAINT} || 0],
- "\"$pjava\" InlineJavaServer report $debug $modfname *.class > cmd.out $predir",
- ["copy_pattern", $build_dir, "*.jdat", $pinstall, $o->{config}->{UNTAINT} || 0],
+ ["copy_pattern", $o, "*.class"],
+ ["report", $o, "*.class"],
+ ["copy_pattern", $o, "*.jdat", ],
) {
if ($cmd){
@@ -490,7 +572,7 @@ sub compile {
if ($o->{config}->{CLEAN_AFTER_BUILD} and
not $o->{config}->{REPORTBUG}){
- $o->rmpath($o->{config}->{DIRECTORY} . 'build/', $modpname) ;
+ $o->myrmpath($o->{config}->{DIRECTORY} . 'build/', $modpname) ;
}
Inline::Java::debug("compile done.") ;
@@ -569,46 +651,53 @@ sub load {
my $pjava = portable("RE_FILE", $java) ;
Inline::Java::debug(" cwd is: " . Cwd::getcwd()) ;
- 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 (! $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++ ;
- if ($pid){
- # parent here
- Inline::Java::debug(" parent here.") ;
+ my $port = $o->{Java}->{PORT} + ($CHILD_CNT - 1) ;
- push @CHILDREN, $pid ;
+ if ($pid){
+ # parent here
+ Inline::Java::debug(" parent here.") ;
- my $socket = $o->setup_socket($port) ;
- $o->{Java}->{socket} = $socket ;
- $Inline::Java::INLINE->{$modfname} = $o ;
+ push @CHILDREN, $pid ;
- $o->{Java}->{loaded} = 1 ;
- Inline::Java::debug("load done.") ;
- }
- else{
- # child here
- Inline::Java::debug(" child here.") ;
+ my $socket = $o->setup_socket($port) ;
+ $o->{Java}->{socket} = $socket ;
+ Inline::Java::debug("load done.") ;
+ }
+ else{
+ # child here
+ Inline::Java::debug(" child here.") ;
- my $debug = ($Inline::Java::DEBUG ? "true" : "false") ;
+ my $debug = ($Inline::Java::DEBUG ? "true" : "false") ;
- my @cmd = ($pjava, 'InlineJavaServer', 'run', $debug, $port) ;
- Inline::Java::debug(join(" ", @cmd)) ;
+ my @cmd = ($pjava, 'InlineJavaServer', 'run', $debug, $port) ;
+ Inline::Java::debug(join(" ", @cmd)) ;
- if ($o->{config}->{UNTAINT}){
- foreach my $cmd (@cmd){
- ($cmd) = $cmd =~ /(.*)/ ;
+ if ($o->{config}->{UNTAINT}){
+ foreach my $cmd (@cmd){
+ ($cmd) = $cmd =~ /(.*)/ ;
+ }
}
- }
- exec(@cmd)
- or croak "Can't exec Java interpreter" ;
+ exec(@cmd)
+ or croak "Can't exec Java interpreter" ;
+ }
}
+ else{
+ # This will create the JNI object if it is not already created.
+ $o->get_jni() ;
+ }
+
+ $Inline::Java::INLINE->{$modfname} = $o ;
+ $o->{Java}->{loaded} = 1 ;
}
@@ -869,10 +958,69 @@ sub setup_socket {
}
+sub copy_pattern {
+ my $o = shift ;
+ my $pattern = shift ;
+
+ my $build_dir = $o->{build_dir} ;
+ my $modpname = $o->{modpname} ;
+ my $install_lib = $o->{install_lib} ;
+ my $install = "$install_lib/auto/$modpname" ;
+ my $pinstall = portable("RE_FILE", $install) ;
+
+ my $src_dir = $build_dir ;
+ my $dest_dir = $pinstall ;
+
+ chdir($src_dir) ;
+
+ my @flist = glob($pattern) ;
+
+ if (portable('COMMAND_COM')){
+ if (! scalar(@flist)){
+ croak "No files to copy. Previous command failed under command.com?" ;
+ }
+ foreach my $file (@flist){
+ if (! (-s $file)){
+ croak "File $file has size zero. Previous command failed under WIN9x?" ;
+ }
+ }
+ }
+
+ foreach my $file (@flist){
+ if ($o->{config}->{UNTAINT}){
+ ($file) = $file =~ /(.*)/ ;
+ }
+ Inline::Java::debug("copy_pattern: $file, $dest_dir/$file") ;
+ if (! File::Copy::copy($file, "$dest_dir/$file")){
+ return "Can't copy $src_dir/$file to $dest_dir/$file: $!" ;
+ }
+ }
+
+ return '' ;
+}
+
######################## General Functions ########################
+sub mymkpath {
+ my $o = shift ;
+ my $path = shift ;
+
+ my $sub = \&Inline::mkpath ;
+ return $o->$sub($path) ;
+}
+
+sub myrmpath {
+ my $o = shift ;
+ my $path = shift ;
+
+ my $sub = \&Inline::rmpath ;
+
+ return $o->$sub($path) ;
+}
+
+
sub debug {
if ($Inline::Java::DEBUG){
my $str = join("", @_) ;
@@ -956,41 +1104,6 @@ sub portable {
}
-sub copy_pattern {
- my $src_dir = shift ;
- my $pattern = shift ;
- my $dest_dir = shift ;
- my $untaint = shift ;
-
- chdir($src_dir) ;
-
- my @flist = glob($pattern) ;
-
- if (portable('COMMAND_COM')){
- if (! scalar(@flist)){
- croak "No files to copy. Previous command failed under command.com?" ;
- }
- foreach my $file (@flist){
- if (! (-s $file)){
- croak "File $file has size zero. Previous command failed under WIN9x?" ;
- }
- }
- }
-
- foreach my $file (@flist){
- if ($untaint){
- ($file) = $file =~ /(.*)/ ;
- }
- Inline::Java::debug("copy_pattern: $file, $dest_dir/$file") ;
- if (! File::Copy::copy($file, "$dest_dir/$file")){
- return "Can't copy $src_dir/$file to $dest_dir/$file: $!" ;
- }
- }
-
- return '' ;
-}
-
-
1 ;
__END__
diff --git a/Java/Array.pm b/Java/Array.pm
index 50a6052..33fbbff 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -1,16 +1,14 @@
package Inline::Java::Array ;
- at Inline::Java::Array::ISA = qw(Tie::StdArray) ;
use strict ;
$Inline::Java::Array::VERSION = '0.10' ;
-use Tie::Array ;
use Carp ;
-# Here we store the objects that corresponds to the arrays.
+# Here we store as keys the knots and as values our blessed objects
my $OBJECTS = {} ;
@@ -19,10 +17,10 @@ sub new {
my $object = shift ;
my @this = () ;
- my $knot = tie @this, 'Inline::Java::Array' ;
+ my $knot = tie @this, 'Inline::Java::Array::Tie' ;
my $this = bless (\@this, $class) ;
- $OBJECTS->{$knot} = $object ;
+ $OBJECTS->{$knot} = [$this, $object] ;
Inline::Java::debug("this = $this") ;
Inline::Java::debug("knot = $knot") ;
@@ -31,6 +29,20 @@ sub new {
}
+sub __get_object {
+ my $this = shift ;
+
+ my $knot = tied @{$this} ;
+
+ my $ref = $OBJECTS->{$knot} ;
+ if ((! defined($ref))||(! defined($ref->[1]))){
+ croak "Unknown Java array reference" ;
+ }
+
+ return $ref->[1] ;
+}
+
+
sub length {
my $this = shift ;
@@ -102,23 +114,6 @@ sub __set_element {
}
-sub __get_object {
- my $this = shift ;
-
- my $knot = tied @{$this} || $this ;
- Inline::Java::debug("this = $this") ;
- Inline::Java::debug("knot = $knot") ;
-
- my $obj = $OBJECTS->{$knot} ;
- if (! defined($obj)){
- croak "Unknown Java array reference" ;
- }
-
- return $obj ;
-}
-
-
-
sub AUTOLOAD {
my $this = shift ;
my @args = @_ ;
@@ -137,13 +132,17 @@ sub AUTOLOAD {
sub DESTROY {
my $this = shift ;
-
- $OBJECTS->{$this} = undef ;
}
######################## Array methods ########################
+package Inline::Java::Array::Tie ;
+ at Inline::Java::Array::Tie::ISA = qw(Tie::StdArray) ;
+
+
+use Tie::Array ;
+use Carp ;
sub TIEARRAY {
@@ -153,10 +152,24 @@ sub TIEARRAY {
}
+sub __get_array {
+ my $this = shift ;
+
+ my $ref = $OBJECTS->{$this} ;
+ if ((! defined($ref))||(! defined($ref->[0]))){
+ croak "Unknown Java array reference" ;
+ }
+
+ return $ref->[0] ;
+}
+
+
sub FETCHSIZE {
my $this = shift ;
- return $this->length() ;
+ my $array = $this->__get_array() ;
+
+ return $array->length() ;
}
@@ -165,7 +178,9 @@ sub STORE {
my $idx = shift ;
my $s = shift ;
- return $this->__set_element($idx, $s) ;
+ my $array = $this->__get_array() ;
+
+ return $array->__set_element($idx, $s) ;
}
@@ -173,7 +188,9 @@ sub FETCH {
my $this = shift ;
my $idx = shift ;
- return $this->__get_element($idx) ;
+ my $array = $this->__get_array() ;
+
+ return $array->__get_element($idx) ;
}
@@ -238,6 +255,13 @@ sub DELETE {
}
+sub DESTROY {
+ my $this = shift ;
+
+ $OBJECTS->{$this} = undef ;
+}
+
+
######################## Inline::Java::Array::Normalizer ########################
package Inline::Java::Array::Normalizer ;
diff --git a/Java/Object.pm b/Java/Object.pm
index 8159046..7d21997 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -1,5 +1,4 @@
package Inline::Java::Object ;
- at Inline::Java::Object::ISA = qw(Tie::StdHash) ;
use strict ;
@@ -7,10 +6,13 @@ use strict ;
$Inline::Java::Object::VERSION = '0.10' ;
use Inline::Java::Protocol ;
-use Tie::Hash ;
use Carp ;
+# Here we store as keys the knots and as values our blessed objects
+my $OBJECTS = {} ;
+
+
# Bogus constructor. We fall here if no public constructor is defined
# in the Java class.
sub new {
@@ -32,9 +34,11 @@ sub __new {
my %this = () ;
- my $knot = tie %this, 'Inline::Java::Object' ;
+ my $knot = tie %this, 'Inline::Java::Object::Tie' ;
my $this = bless(\%this, $class) ;
+ $OBJECTS->{$knot} = $this ;
+
$this->{private} = {} ;
$this->{private}->{class} = $class ;
$this->{private}->{java_class} = $java_class ;
@@ -115,10 +119,6 @@ sub __get_member {
my $this = shift ;
my $key = shift ;
- if ($key eq "private"){
- return $this->SUPER::FETCH($key) ;
- }
-
Inline::Java::debug("fetching member variable $key") ;
my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
@@ -137,7 +137,6 @@ sub __get_member {
else{
croak "No public member variable $key defined for class $this->{private}->{class}" ;
}
-
}
@@ -146,10 +145,6 @@ sub __set_member {
my $key = shift ;
my $value = shift ;
- if ($key eq "private"){
- return $this->SUPER::STORE($key, $value) ;
- }
-
my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
my $fields = $inline->get_fields($this->{private}->{java_class}) ;
@@ -238,7 +233,24 @@ sub DESTROY {
######################## Hash Methods ########################
+package Inline::Java::Object::Tie ;
+ at Inline::Java::Object::Tie::ISA = qw(Tie::StdHash) ;
+
+
+use Tie::Hash ;
+use Carp ;
+
+
+sub __get_object {
+ my $this = shift ;
+ my $obj = $OBJECTS->{$this} ;
+ if (! defined($obj)){
+ croak "Unknown Java object reference" ;
+ }
+
+ return $obj ;
+}
sub TIEHASH {
@@ -253,7 +265,13 @@ sub STORE {
my $key = shift ;
my $value = shift ;
- return $this->__set_member($key, $value) ;
+ if ($key eq "private"){
+ return $this->SUPER::STORE($key, $value) ;
+ }
+
+ my $obj = $this->__get_object() ;
+
+ return $obj->__set_member($key, $value) ;
}
@@ -261,7 +279,13 @@ sub FETCH {
my $this = shift ;
my $key = shift ;
- return $this->__get_member($key) ;
+ if ($key eq "private"){
+ return $this->SUPER::FETCH($key) ;
+ }
+
+ my $obj = $this->__get_object() ;
+
+ return $obj->__get_member($key) ;
}
@@ -309,6 +333,14 @@ sub CLEAR {
}
+sub DESTROY {
+ my $this = shift ;
+
+ $OBJECTS->{$this} = undef ;
+}
+
+
+
package Inline::Java::Object ;
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index c96ff6b..45ae16f 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -244,12 +244,18 @@ sub Send {
my $data = shift ;
my $const = shift ;
+ my $resp = undef ;
my $inline = $Inline::Java::INLINE->{$this->{module}} ;
- my $sock = $inline->{Java}->{socket} ;
- print $sock $data . "\n" or
- croak "Can't send packet over socket: $!" ;
+ if (! $inline->{Java}->{USE_JNI}){
+ my $sock = $inline->{Java}->{socket} ;
+ print $sock $data . "\n" or
+ croak "Can't send packet over socket: $!" ;
- my $resp = <$sock> ;
+ $resp = <$sock> ;
+ }
+ else{
+ $resp = $inline->{Java}->{JNI}->process_command($data) ;
+ }
Inline::Java::debug(" packet recv is $resp") ;
@@ -690,6 +696,8 @@ class InlineJavaProtocol {
// Now we check if the signatures match
String sign = ijs.CreateSignature(params, ",") ;
+ ijs.debug(sign + " = " + signature + "?") ;
+
if (signature.equals(sign)){
ijs.debug(" has matching signature " + sign) ;
ml.add(ml.size(), m) ;
--
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