[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