[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