[libinline-java-perl] 50/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 f377499450d52758e9634149d91c500c724321c2
Author: patrick <>
Date:   Thu Mar 29 20:36:28 2001 +0000

    *** empty log message ***
---
 Java/Array.pm    |  99 +++++++++++++++++++++++-----------------
 Java/Object.pm   | 134 +++++++++++++++++++++++++++++++------------------------
 Java/Protocol.pm |   5 +++
 3 files changed, 139 insertions(+), 99 deletions(-)

diff --git a/Java/Array.pm b/Java/Array.pm
index 4fb8765..50a6052 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -46,6 +46,62 @@ sub length {
 }
 
 
+sub __get_element {
+ 	my $this = shift ;
+ 	my $idx = shift ;
+
+	my $max = $this->length() - 1 ;
+	if ($idx > $max){
+		croak("Java array index out of bounds ($idx > $max)")
+	}
+
+	my $obj = $this->__get_object() ; 
+
+	my $ret = undef ;
+	eval {
+		$ret = $obj->{private}->{proto}->GetJavaMember($idx, ['java.lang.Object'], [undef]) ;
+	} ;
+	croak $@ if $@ ;
+
+	return $ret ;
+}
+
+
+sub __set_element {
+ 	my $this = shift ;
+ 	my $idx = shift ;
+ 	my $s = shift ;
+
+	my $max = $this->length() - 1 ;
+	if ($idx > $max){
+		croak("Java array index out of bounds ($idx > $max)")
+	}
+
+	my $obj = $this->__get_object() ; 
+
+	# Now we need to find out if what we are trying to set matches
+	# the array.
+	my $java_class = $obj->{private}->{java_class} ;
+	my $elem_class = $java_class ;
+	my $an = new Inline::Java::ArrayNorm($java_class) ;
+	if ($an->{req_nb_dim} > 1){
+		$elem_class =~ s/^\[// ;
+	}
+	else{
+		$elem_class = $an->{req_element_class} ;
+	}
+
+	my $ret = undef ;
+	eval {
+		my ($new_args, $score) = Inline::Java::Class::CastArguments([$s], [$elem_class], $obj->{private}->{module}) ;
+		$ret = $obj->{private}->{proto}->SetJavaMember($idx, [$elem_class], $new_args) ;
+	} ;
+	croak $@ if $@ ;
+
+	return $ret ;
+}
+
+
 sub __get_object {
 	my $this = shift ;
 
@@ -109,33 +165,7 @@ sub STORE {
  	my $idx = shift ;
  	my $s = shift ;
 
-	my $max = $this->length() - 1 ;
-	if ($idx > $max){
-		croak("Java array index out of bounds ($idx > $max)")
-	}
-
-	my $obj = $this->__get_object() ; 
-
-	# Now we need to find out if what we are trying to set matches
-	# the array.
-	my $java_class = $obj->{private}->{java_class} ;
-	my $elem_class = $java_class ;
-	my $an = new Inline::Java::ArrayNorm($java_class) ;
-	if ($an->{req_nb_dim} > 1){
-		$elem_class =~ s/^\[// ;
-	}
-	else{
-		$elem_class = $an->{req_element_class} ;
-	}
-
-	my $ret = undef ;
-	eval {
-		my ($new_args, $score) = Inline::Java::Class::CastArguments([$s], [$elem_class], $obj->{private}->{module}) ;
-		$ret = $obj->{private}->{proto}->SetJavaMember($idx, [$elem_class], $new_args) ;
-	} ;
-	croak $@ if $@ ;
-
-	return $ret ;
+	return $this->__set_element($idx, $s) ;
 } 
 
 
@@ -143,20 +173,7 @@ sub FETCH {
  	my $this = shift ;
  	my $idx = shift ;
 
-	my $max = $this->length() - 1 ;
-	if ($idx > $max){
-		croak("Java array index out of bounds ($idx > $max)")
-	}
-
-	my $obj = $this->__get_object() ; 
-
-	my $ret = undef ;
-	eval {
-		$ret = $obj->{private}->{proto}->GetJavaMember($idx, ['java.lang.Object'], [undef]) ;
-	} ;
-	croak $@ if $@ ;
-
-	return $ret ;
+	return $this->__get_element($idx) ;
 }
 
 
diff --git a/Java/Object.pm b/Java/Object.pm
index 844d79b..8159046 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -33,7 +33,7 @@ sub __new {
 	my %this = () ;
 
 	my $knot = tie %this, 'Inline::Java::Object' ;
-	my $this = bless (\%this, $class) ;
+	my $this = bless(\%this, $class) ;
 
 	$this->{private} = {} ;
 	$this->{private}->{class} = $class ;
@@ -111,56 +111,37 @@ sub __validate_prototype {
 }
 
 
-sub AUTOLOAD {
+sub __get_member {
 	my $this = shift ;
-	my @args = @_ ;
+	my $key = shift ;
 
-	use vars qw($AUTOLOAD) ;
-	my $func_name = $AUTOLOAD ;
-	# Strip package from $func_name, Java will take of finding the correct
-	# method.
-	$func_name =~ s/^(.*)::// ;
+ 	if ($key eq "private"){
+ 		return $this->SUPER::FETCH($key) ;
+	}
 
-	Inline::Java::debug("$func_name") ;
+	Inline::Java::debug("fetching member variable $key") ;
 
-	croak "No public method $func_name defined for class $this->{private}->{class}" ;	
-}
+	my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
+	my $fields = $inline->get_fields($this->{private}->{java_class}) ;
 
+	if ($fields->{$key}){
+		# Here when the user is requesting a field, we can't know which
+		# one the user wants, so we select the first one.
+		my $proto = $fields->{$key}->[0] ;
 
-# 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 ;
+		my $ret = $this->{private}->{proto}->GetJavaMember($key, [$proto], [undef]) ;
+		Inline::Java::debug("returning member ($ret)") ;
 	
-	if (! $Inline::Java::DONE){
-		if (! $this->{private}->{deleted}){
-			$this->{private}->{deleted} = 1 ;
-			eval {
-				$this->{private}->{proto}->DeleteJavaObject($this) ;
-			} ;
-			croak "In method DESTROY of class $this->{private}->{class}: $@" if $@ ;
-		}
-		else{
-			Inline::Java::debug("Object destructor called more than once!") ;
-		}
+		return $ret ;
+	}
+	else{
+		croak "No public member variable $key defined for class $this->{private}->{class}" ;
 	}
-}
-
-
-
-######################## Hash Methods ########################
-
-
-
-sub TIEHASH {
-	my $class = shift ;
 
-	return $class->SUPER::TIEHASH(@_) ;
 }
 
 
-sub STORE {
+sub __set_member {
 	my $this = shift ;
 	my $key = shift ;
 	my $value = shift ;
@@ -218,35 +199,72 @@ sub STORE {
 }
 
 
-sub FETCH {
- 	my $this = shift ;
- 	my $key = shift ;
+sub AUTOLOAD {
+	my $this = shift ;
+	my @args = @_ ;
 
- 	if ($key eq "private"){
- 		return $this->SUPER::FETCH($key) ;
-	}
+	use vars qw($AUTOLOAD) ;
+	my $func_name = $AUTOLOAD ;
+	# Strip package from $func_name, Java will take of finding the correct
+	# method.
+	$func_name =~ s/^(.*)::// ;
 
-	Inline::Java::debug("fetching member variable $key") ;
+	Inline::Java::debug("$func_name") ;
 
-	my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
-	my $fields = $inline->get_fields($this->{private}->{java_class}) ;
+	croak "No public method $func_name defined for class $this->{private}->{class}" ;	
+}
 
-	if ($fields->{$key}){
-		# Here when the user is requesting a field, we can't know which
-		# one the user wants, so we select the first one.
-		my $proto = $fields->{$key}->[0] ;
 
-		my $ret = $this->{private}->{proto}->GetJavaMember($key, [$proto], [undef]) ;
-		Inline::Java::debug("returning member ($ret)") ;
+# 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 ;
 	
-		return $ret ;
-	}
-	else{
-		croak "No public member variable $key defined for class $this->{private}->{class}" ;
+	if (! $Inline::Java::DONE){
+		if (! $this->{private}->{deleted}){
+			$this->{private}->{deleted} = 1 ;
+			eval {
+				$this->{private}->{proto}->DeleteJavaObject($this) ;
+			} ;
+			croak "In method DESTROY of class $this->{private}->{class}: $@" if $@ ;
+		}
+		else{
+			Inline::Java::debug("Object destructor called more than once!") ;
+		}
 	}
 }
 
 
+
+######################## Hash Methods ########################
+
+
+
+sub TIEHASH {
+	my $class = shift ;
+
+	return $class->SUPER::TIEHASH(@_) ;
+}
+
+
+sub STORE {
+	my $this = shift ;
+	my $key = shift ;
+	my $value = shift ;
+
+	return $this->__set_member($key, $value) ;
+}
+
+
+sub FETCH {
+ 	my $this = shift ;
+ 	my $key = shift ;
+
+	return $this->__get_member($key) ;
+}
+
+
 sub FIRSTKEY { 
 	my $this = shift ;
 
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index 2a1d423..c96ff6b 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -5,6 +5,7 @@ use strict ;
 
 $Inline::Java::Protocol::VERSION = '0.10' ;
 
+use Inline::Java::Object ;
 use Inline::Java::Array ;
 use Carp ;
 
@@ -249,6 +250,7 @@ sub Send {
 		croak "Can't send packet over socket: $!" ;
 
 	my $resp = <$sock> ;
+
 	Inline::Java::debug("  packet recv is $resp") ;
 
 	if (! $resp){
@@ -292,6 +294,8 @@ sub Send {
 			$this->{obj_priv}->{java_class} = $class ;
 			$this->{obj_priv}->{id} = $id ;
 			$this->{obj_priv}->{known_to_perl} = $known ;
+			
+			return undef ;
 		}
 		else{
 			my $obj = undef ;
@@ -315,6 +319,7 @@ sub Send {
 			}
 
 			Inline::Java::debug("returning stub...") ;
+
 			return $obj ;
 		}
 	}

-- 
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