[libinline-java-perl] 53/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 1f50ee8ae4384351e3e5e36aa9f2abfc58c75463
Author: patrick <>
Date: Wed Apr 4 20:05:07 2001 +0000
*** empty log message ***
---
Java/Array.pm | 46 +++++++-------------
Java/Object.pm | 126 +++++++++++++++++++++++++++++--------------------------
Java/Protocol.pm | 43 ++++++++++---------
Makefile.PL | 7 ----
4 files changed, 104 insertions(+), 118 deletions(-)
diff --git a/Java/Array.pm b/Java/Array.pm
index 33fbbff..c3fbab4 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -1,4 +1,5 @@
package Inline::Java::Array ;
+ at Inline::Java::Array::ISA = qw(Inline::Java::Array::Tie) ;
use strict ;
@@ -20,7 +21,7 @@ sub new {
my $knot = tie @this, 'Inline::Java::Array::Tie' ;
my $this = bless (\@this, $class) ;
- $OBJECTS->{$knot} = [$this, $object] ;
+ $OBJECTS->{$knot} = $object ;
Inline::Java::debug("this = $this") ;
Inline::Java::debug("knot = $knot") ;
@@ -32,14 +33,14 @@ sub new {
sub __get_object {
my $this = shift ;
- my $knot = tied @{$this} ;
+ my $knot = tied @{$this} || $this ;
my $ref = $OBJECTS->{$knot} ;
- if ((! defined($ref))||(! defined($ref->[1]))){
+ if (! defined($ref)){
croak "Unknown Java array reference" ;
}
- return $ref->[1] ;
+ return $ref ;
}
@@ -50,7 +51,7 @@ sub length {
my $ret = undef ;
eval {
- $ret = $obj->{private}->{proto}->CallJavaMethod('getLength', [], []) ;
+ $ret = $obj->__get_private()->{proto}->CallJavaMethod('getLength', [], []) ;
} ;
croak $@ if $@ ;
@@ -71,7 +72,7 @@ sub __get_element {
my $ret = undef ;
eval {
- $ret = $obj->{private}->{proto}->GetJavaMember($idx, ['java.lang.Object'], [undef]) ;
+ $ret = $obj->__get_private()->{proto}->GetJavaMember($idx, ['java.lang.Object'], [undef]) ;
} ;
croak $@ if $@ ;
@@ -93,7 +94,7 @@ sub __set_element {
# Now we need to find out if what we are trying to set matches
# the array.
- my $java_class = $obj->{private}->{java_class} ;
+ my $java_class = $obj->__get_private()->{java_class} ;
my $elem_class = $java_class ;
my $an = new Inline::Java::ArrayNorm($java_class) ;
if ($an->{req_nb_dim} > 1){
@@ -105,8 +106,8 @@ sub __set_element {
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) ;
+ my ($new_args, $score) = Inline::Java::Class::CastArguments([$s], [$elem_class], $obj->__get_private()->{module}) ;
+ $ret = $obj->__get_private()->{proto}->SetJavaMember($idx, [$elem_class], $new_args) ;
} ;
croak $@ if $@ ;
@@ -132,10 +133,13 @@ sub AUTOLOAD {
sub DESTROY {
my $this = shift ;
+
+ untie @{$this} ;
}
+
######################## Array methods ########################
package Inline::Java::Array::Tie ;
@Inline::Java::Array::Tie::ISA = qw(Tie::StdArray) ;
@@ -152,24 +156,10 @@ 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 ;
- my $array = $this->__get_array() ;
-
- return $array->length() ;
+ my $array = $this->length() ;
}
@@ -178,9 +168,7 @@ sub STORE {
my $idx = shift ;
my $s = shift ;
- my $array = $this->__get_array() ;
-
- return $array->__set_element($idx, $s) ;
+ return $this->__set_element($idx, $s) ;
}
@@ -188,9 +176,7 @@ sub FETCH {
my $this = shift ;
my $idx = shift ;
- my $array = $this->__get_array() ;
-
- return $array->__get_element($idx) ;
+ return $this->__get_element($idx) ;
}
diff --git a/Java/Object.pm b/Java/Object.pm
index 7d21997..78efe56 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -1,5 +1,5 @@
package Inline::Java::Object ;
-
+ at Inline::Java::Object::ISA = qw(Inline::Java::Object::Tie) ;
use strict ;
@@ -9,8 +9,8 @@ use Inline::Java::Protocol ;
use Carp ;
-# Here we store as keys the knots and as values our blessed objects
-my $OBJECTS = {} ;
+# Here we store as keys the knots and as values our blessed private objects
+my $PRIVATES = {} ;
# Bogus constructor. We fall here if no public constructor is defined
@@ -34,26 +34,20 @@ sub __new {
my %this = () ;
- my $knot = tie %this, 'Inline::Java::Object::Tie' ;
+ my $knot = tie %this, $class ;
my $this = bless(\%this, $class) ;
- $OBJECTS->{$knot} = $this ;
-
- $this->{private} = {} ;
- $this->{private}->{class} = $class ;
- $this->{private}->{java_class} = $java_class ;
- $this->{private}->{module} = $inline->{modfname} ;
- $this->{private}->{known_to_perl} = 1 ;
- $this->{private}->{proto} = new Inline::Java::Protocol($this->{private}, $inline) ;
+ my $priv = Inline::Java::Object::Private->new($java_class, $inline) ;
+ $PRIVATES->{$knot} = $priv ;
if ($objid <= 0){
eval {
- $this->{private}->{proto}->CreateJavaObject($java_class, $proto, $args) ;
+ $this->__get_private()->{proto}->CreateJavaObject($java_class, $proto, $args) ;
} ;
croak "In method new of class $class: $@" if $@ ;
}
else{
- $this->{private}->{id} = $objid ;
+ $this->__get_private()->{id} = $objid ;
Inline::Java::debug("Object created in java ($class):") ;
}
@@ -63,6 +57,20 @@ sub __new {
}
+sub __get_private {
+ my $this = shift ;
+
+ my $knot = tied(%{$this}) || $this ;
+
+ my $priv = $PRIVATES->{$knot} ;
+ if (! defined($priv)){
+ croak "Unknown Java object reference" ;
+ }
+
+ return $priv ;
+}
+
+
# Checks to make sure all the arguments can be "cast" to prototype
# types.
sub __validate_prototype {
@@ -95,7 +103,7 @@ sub __validate_prototype {
}
if (! scalar(@{$matched_protos})){
- my $name = (ref($class) ? $class->{private}->{class} : $class) ;
+ 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" ;
@@ -121,21 +129,21 @@ sub __get_member {
Inline::Java::debug("fetching member variable $key") ;
- my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
- my $fields = $inline->get_fields($this->{private}->{java_class}) ;
+ my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ my $fields = $inline->get_fields($this->__get_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] ;
- my $ret = $this->{private}->{proto}->GetJavaMember($key, [$proto], [undef]) ;
+ my $ret = $this->__get_private()->{proto}->GetJavaMember($key, [$proto], [undef]) ;
Inline::Java::debug("returning member ($ret)") ;
return $ret ;
}
else{
- croak "No public member variable $key defined for class $this->{private}->{class}" ;
+ croak "No public member variable $key defined for class $this->__get_private()->{class}" ;
}
}
@@ -145,8 +153,8 @@ sub __set_member {
my $key = shift ;
my $value = shift ;
- my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
- my $fields = $inline->get_fields($this->{private}->{java_class}) ;
+ my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
if ($fields->{$key}){
my $list = $fields->{$key} ;
@@ -158,7 +166,7 @@ sub __set_member {
my $new_args = undef ;
my $score = undef ;
eval {
- ($new_args, $score) = Inline::Java::Class::CastArguments([$value], [$f], $this->{private}->{module}) ;
+ ($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
@@ -172,7 +180,7 @@ sub __set_member {
}
if (! scalar(@{$matched_protos})){
- my $name = $this->{private}->{class} ;
+ 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" ;
foreach my $f (@{$list}){
@@ -186,10 +194,10 @@ sub __set_member {
# highest score. For now, the last one will do.
my $nb = scalar(@{$matched_protos}) ;
- $this->{private}->{proto}->SetJavaMember($key, $matched_protos->[$nb - 1], $new_arguments->[$nb - 1]) ;
+ $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->{private}->{class}" ;
+ croak "No public member variable $key defined for class $this->__get_private()->{class}" ;
}
}
@@ -206,7 +214,7 @@ sub AUTOLOAD {
Inline::Java::debug("$func_name") ;
- croak "No public method $func_name defined for class $this->{private}->{class}" ;
+ croak "No public method $func_name defined for class $this->__get_private()->{class}" ;
}
@@ -217,17 +225,19 @@ sub DESTROY {
my $this = shift ;
if (! $Inline::Java::DONE){
- if (! $this->{private}->{deleted}){
- $this->{private}->{deleted} = 1 ;
+ if (! $this->__get_private()->{deleted}){
+ $this->__get_private()->{deleted} = 1 ;
eval {
- $this->{private}->{proto}->DeleteJavaObject($this) ;
+ $this->__get_private()->{proto}->DeleteJavaObject($this) ;
} ;
- croak "In method DESTROY of class $this->{private}->{class}: $@" if $@ ;
+ croak "In method DESTROY of class $this->__get_private()->{class}: $@" if $@ ;
}
else{
Inline::Java::debug("Object destructor called more than once!") ;
}
}
+
+ untie %{$this} ;
}
@@ -241,18 +251,6 @@ 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 {
my $class = shift ;
@@ -265,13 +263,7 @@ sub STORE {
my $key = shift ;
my $value = shift ;
- if ($key eq "private"){
- return $this->SUPER::STORE($key, $value) ;
- }
-
- my $obj = $this->__get_object() ;
-
- return $obj->__set_member($key, $value) ;
+ return $this->__set_member($key, $value) ;
}
@@ -279,13 +271,7 @@ sub FETCH {
my $this = shift ;
my $key = shift ;
- if ($key eq "private"){
- return $this->SUPER::FETCH($key) ;
- }
-
- my $obj = $this->__get_object() ;
-
- return $obj->__get_member($key) ;
+ return $this->__get_member($key) ;
}
@@ -307,8 +293,8 @@ sub EXISTS {
my $this = shift ;
my $key = shift ;
- my $inline = $Inline::Java::INLINE->{$this->{private}->{module}} ;
- my $fields = $inline->get_fields($this->{private}->{java_class}) ;
+ my $inline = $Inline::Java::INLINE->{$this->__get_private()->{module}} ;
+ my $fields = $inline->get_fields($this->__get_private()->{java_class}) ;
if ($fields->{$key}){
return 1 ;
@@ -336,11 +322,33 @@ sub CLEAR {
sub DESTROY {
my $this = shift ;
- $OBJECTS->{$this} = undef ;
+ $PRIVATES->{$this} = undef ;
}
+
+######################## Private Object ########################
+package Inline::Java::Object::Private ;
+
+sub new {
+ my $class = shift ;
+ my $java_class = shift ;
+ my $inline = shift ;
+
+ my $this = {} ;
+ $this->{class} = $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) ;
+
+ return $this ;
+}
+
+
package Inline::Java::Object ;
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index 45ae16f..15d487c 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -215,8 +215,8 @@ sub ValidateArgs {
if (UNIVERSAL::isa($arg, "Inline::Java::Array")){
$arg = $arg->__get_object() ;
}
- my $class = $arg->{private}->{java_class} ;
- my $id = $arg->{private}->{id} ;
+ my $class = $arg->__get_private()->{java_class} ;
+ my $id = $arg->__get_private()->{id} ;
push @ret, "object:$class:$id" ;
}
else{
@@ -278,32 +278,31 @@ sub Send {
my $id = $1 ;
my $class = $2 ;
- 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!") ;
- }
- }
-
if ($const){
$this->{obj_priv}->{java_class} = $class ;
$this->{obj_priv}->{id} = $id ;
- $this->{obj_priv}->{known_to_perl} = $known ;
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...") ;
@@ -314,8 +313,8 @@ sub Send {
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 ;
}
- $obj->{private}->{known_to_perl} = $known ;
Inline::Java::debug("checking if stub is array...") ;
if (Inline::Java::Class::ClassIsArray($class)){
diff --git a/Makefile.PL b/Makefile.PL
index 00bf57e..1b6be30 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,12 +6,5 @@ WriteMakefile(
PREREQ_PM => {
Inline => 0.31
},
- INC => join(" ",
- '-I/usr/java1.2/include',
- '-I/usr/java1.2/include/solaris'
- ),
- LIBS => [
- '-L/usr/java1.2/jre/lib/sparc -ljvm'
- ],
clean => {FILES => '_Inline_test/'},
) ;
--
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