[libinline-java-perl] 63/398: *** empty log message ***
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:42:47 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 87307096ce567111f7c75046185d7a4a7f1e34bd
Author: patrick <>
Date: Mon Apr 16 16:09:10 2001 +0000
*** empty log message ***
---
Java.pm | 233 +++++++++++++++++++++++++++++++------------------------
Java/Array.pm | 2 +-
Java/Class.pm | 2 +-
Java/Init.pm | 2 +-
Java/JNI.pm | 2 +-
Java/JVM.pm | 2 +-
Java/Object.pm | 2 +-
Java/Protocol.pm | 2 +-
TODO | 36 ---------
9 files changed, 139 insertions(+), 144 deletions(-)
diff --git a/Java.pm b/Java.pm
index 0761939..204e4c2 100644
--- a/Java.pm
+++ b/Java.pm
@@ -1,10 +1,13 @@
package Inline::Java ;
- at Inline::Java::ISA = qw(Inline) ;
+ at Inline::Java::ISA = qw(Inline Exporter) ;
+
+# Export the cast function if wanted
+ at EXPORT_OK = qw(cast) ;
use strict ;
-$Inline::Java::VERSION = '0.10' ;
+$Inline::Java::VERSION = '0.20' ;
# DEBUG is set via the DEBUG config
@@ -12,6 +15,9 @@ if (! defined($Inline::Java::DEBUG)){
$Inline::Java::DEBUG = 0 ;
}
+# Set DEBUG stream
+*DEBUG = *STDERR ;
+
require Inline ;
use Carp ;
@@ -104,6 +110,11 @@ $SIG{__DIE__} = sub {
} ;
+# To export the cast function.
+sub import {
+ Inline::Java->export_to_level(1, at _) ;
+}
+
######################## Inline interface ########################
@@ -388,6 +399,7 @@ sub compile {
# to be copied, and if not will exit the script.
foreach my $cmd (
"\"$pjavac\" InlineJavaServer.java $modfname.java > cmd.out $predir",
+ ["copy_pattern", $o, "InlineJavaServer*.class"],
["copy_pattern", $o, "*.class"],
["touch_file", $o, "$install/$modfname.jdat"],
) {
@@ -494,11 +506,11 @@ sub load {
# Now we read up the symbols and bind them to Perl.
$o->load_jdat(@lines) ;
+
+ $INLINES->{$modfname} = $o ;
$o->bind_jdat() ;
$o->{Java}->{loaded} = 1 ;
-
- $INLINES->{$modfname} = $o ;
}
@@ -535,7 +547,7 @@ sub load_jdat {
my $o = shift ;
my @lines = @_ ;
- Inline::Java::debug(@lines) ;
+ Inline::Java::debug(join("\n", @lines)) ;
$o->{Java}->{data} = {} ;
my $d = $o->{Java}->{data} ;
@@ -550,21 +562,18 @@ sub load_jdat {
$current_class = $1 ;
$current_class =~ s/[\$.]/::/g ;
$d->{classes}->{$current_class} = {} ;
- $d->{classes}->{$current_class}->{constructors} = undef ;
+ $d->{classes}->{$current_class}->{constructors} = {} ;
$d->{classes}->{$current_class}->{methods} = {} ;
- $d->{classes}->{$current_class}->{methods}->{static} = {} ;
- $d->{classes}->{$current_class}->{methods}->{instance} = {} ;
$d->{classes}->{$current_class}->{fields} = {} ;
- $d->{classes}->{$current_class}->{fields}->{static} = {} ;
- $d->{classes}->{$current_class}->{fields}->{instance} = {} ;
}
elsif ($line =~ /^constructor \((.*)\)$/){
my $signature = $1 ;
- if (! defined($d->{classes}->{$current_class}->{constructors})){
- $d->{classes}->{$current_class}->{constructors} = [] ;
- }
- push @{$d->{classes}->{$current_class}->{constructors}}, [split(", ", $signature)] ;
+ $d->{classes}->{$current_class}->{constructors}->{$signature} =
+ {
+ SIGNATURE => [split(", ", $signature)],
+ STATIC => 1,
+ } ;
}
elsif ($line =~ /^method (\w+) ($re) (\w+)\((.*)\)$/){
my $static = $1 ;
@@ -572,10 +581,15 @@ sub load_jdat {
my $method = $3 ;
my $signature = $4 ;
- if (! defined($d->{classes}->{$current_class}->{methods}->{$static}->{$method})){
- $d->{classes}->{$current_class}->{methods}->{$static}->{$method} = [] ;
+ if (! defined($d->{classes}->{$current_class}->{methods}->{$method})){
+ $d->{classes}->{$current_class}->{methods}->{$method} = {} ;
}
- push @{$d->{classes}->{$current_class}->{methods}->{$static}->{$method}}, [split(", ", $signature)] ;
+
+ $d->{classes}->{$current_class}->{methods}->{$method}->{$signature} =
+ {
+ SIGNATURE => [split(", ", $signature)],
+ STATIC => ($static eq "static" ? 1 : 0),
+ } ;
}
elsif ($line =~ /^field (\w+) ($re) (\w+) ($re)$/){
my $static = $1 ;
@@ -583,10 +597,15 @@ sub load_jdat {
my $field = $3 ;
my $type = $4 ;
- if (! defined($d->{classes}->{$current_class}->{fields}->{$static}->{$field})){
- $d->{classes}->{$current_class}->{fields}->{$static}->{$field} = [] ;
+ if (! defined($d->{classes}->{$current_class}->{fields}->{$field})){
+ $d->{classes}->{$current_class}->{fields}->{$field} = {} ;
}
- push @{$d->{classes}->{$current_class}->{fields}->{$static}->{$field}}, $type ;
+
+ $d->{classes}->{$current_class}->{fields}->{$field} =
+ {
+ TYPE => $type,
+ STATIC => ($static eq "static" ? 1 : 0),
+ } ;
}
}
@@ -601,24 +620,44 @@ sub bind_jdat {
my $d = $o->{Java}->{data} ;
my $modfname = $o->{modfname} ;
- my $c = ":" ;
my %classes = %{$d->{classes}} ;
foreach my $class (sort keys %classes) {
my $java_class = $class ;
$java_class =~ s/::/\$/g ;
my $class_name = $class ;
$class_name =~ s/^(.*)::// ;
+
+ my $colon = ":" ;
+ my $dash = "-" ;
+
my $code = <<CODE;
package $o->{pkg}::$class ;
-\@$o->{pkg}::$class$c:ISA = qw(Inline::Java::Object) ;
-\$$o->{pkg}::$class$c:EXISTS = 1 ;
-\$$o->{pkg}::$class$c:JAVA_CLASS = '$java_class' ;
+use vars qw(\@ISA \$EXISTS \$JAVA_CLASS \$DUMMY_OBJECT) ;
+
+\@ISA = qw(Inline::Java::Object) ;
+\$EXISTS = 1 ;
+\$JAVA_CLASS = '$java_class' ;
+\$DUMMY_OBJECT = $o->{pkg}::$class$dash>__new(
+ \$JAVA_CLASS,
+ Inline::Java::get_INLINE('$modfname'),
+ 0) ;
use Carp ;
CODE
- if (defined($d->{classes}->{$class}->{constructors})){
+ while (my ($field, $sign) = each %{$d->{classes}->{$class}->{fields}}){
+ if ($sign->{STATIC}){
+ $code .= <<CODE;
+tie \$$o->{pkg}::$class$colon:$field, "Inline::Java::Object::StaticMember",
+ \$DUMMY_OBJECT,
+ '$field' ;
+CODE
+ }
+ }
+
+
+ if (scalar(keys %{$d->{classes}->{$class}->{constructors}})){
my $pkg = $o->{pkg} ;
$code .= <<CODE;
@@ -629,11 +668,11 @@ sub new {
my \$o = Inline::Java::get_INLINE('$modfname') ;
my \$d = \$o->{Java}->{data} ;
my \$signatures = \$d->{classes}->{'$class'}->{constructors} ;
- my (\$proto, \$new_args) = \$class->__validate_prototype('new', [\@args], \$signatures, \$o) ;
+ my (\$proto, \$new_args, \$static) = \$class->__validate_prototype('new', [\@args], \$signatures, \$o) ;
my \$ret = undef ;
eval {
- \$ret = \$class->__new('$java_class', \$o, -1, \$proto, \$new_args) ;
+ \$ret = \$class->__new(\$JAVA_CLASS, \$o, -1, \$proto, \$new_args) ;
} ;
croak \$@ if \$@ ;
@@ -648,47 +687,29 @@ sub $class_name {
CODE
}
+ while (my ($method, $sign) = each %{$d->{classes}->{$class}->{methods}}){
+ $code .= $o->bind_method($class, $method) ;
+ }
- while (my ($method, $sign) = each %{$d->{classes}->{$class}->{methods}->{static}}){
- my @sign = @{$sign->[0]} ;
- my $signature = '' ;
- if (scalar(@sign)){
- $signature = "'" . join("', '", @sign). "'" ;
- }
- my $pkg = $o->{pkg} ;
- $code .= <<CODE;
-
-sub $method {
- my \$class = shift ;
- my \@args = \@_ ;
-
- my \$o = Inline::Java::get_INLINE('$modfname') ;
- my \$d = \$o->{Java}->{data} ;
- my \$signatures = \$d->{classes}->{'$class'}->{methods}->{static}->{'$method'} ;
- my (\$proto, \$new_args) = \$class->__validate_prototype('$method', [\@args], \$signatures, \$o) ;
-
- my \$pc = new Inline::Java::Protocol(undef, \$o) ;
+ Inline::Java::debug($code) ;
- my \$ret = undef ;
- eval {
- \$ret = \$pc->CallStaticJavaMethod('$java_class', '$method', \$proto, \$new_args) ;
- } ;
- croak \$@ if \$@ ;
+ eval $code ;
- return \$ret ;
+ croak $@ if $@ ;
+ }
}
-CODE
- }
+sub bind_method {
+ my $o = shift ;
+ my $class = shift ;
+ my $method = shift ;
+ my $static = shift ;
- while (my ($method, $sign) = each %{$d->{classes}->{$class}->{methods}->{instance}}){
- my @sign = @{$sign->[0]} ;
- my $signature = '' ;
- if (scalar(@sign)){
- $signature = "'" . join("', '", @sign). "'" ;
- }
- $code .= <<CODE;
+ my $modfname = $o->{modfname} ;
+ my $pkg = $o->{pkg} ;
+
+ my $code = <<CODE;
sub $method {
my \$this = shift ;
@@ -696,8 +717,12 @@ sub $method {
my \$o = Inline::Java::get_INLINE('$modfname') ;
my \$d = \$o->{Java}->{data} ;
- my \$signatures = \$d->{classes}->{'$class'}->{methods}->{instance}->{'$method'} ;
- my (\$proto, \$new_args) = \$this->__validate_prototype('$method', [\@args], \$signatures, \$o) ;
+ my \$signatures = \$d->{classes}->{'$class'}->{methods}->{'$method'} ;
+ my (\$proto, \$new_args, \$static) = \$this->__validate_prototype('$method', [\@args], \$signatures, \$o) ;
+
+ if ((\$static)&&(! ref(\$this))){
+ \$this = \$DUMMY_OBJECT ;
+ }
my \$ret = undef ;
eval {
@@ -709,14 +734,8 @@ sub $method {
}
CODE
- }
-
- # Inline::Java::debug($code) ;
-
- eval $code ;
- croak $@ if $@ ;
- }
+ return $code ;
}
@@ -727,10 +746,7 @@ sub get_fields {
my $fields = {} ;
my $d = $o->{Java}->{data} ;
- while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{static}}){
- $fields->{$field} = $value ;
- }
- while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}->{instance}}){
+ while (my ($field, $value) = each %{$d->{classes}->{$class}->{fields}}){
$fields->{$field} = $value ;
}
@@ -759,34 +775,30 @@ sub info {
my %classes = %{$d->{classes}} ;
$info .= "The following Java classes have been bound to Perl:\n" ;
foreach my $class (sort keys %classes) {
- $info .= "\tclass $class:\n" ;
-
- if (defined($d->{classes}->{$class}->{constructors})){
- foreach my $const (@{$d->{classes}->{$class}->{constructors}}) {
- my $sign = $const ;
- my $name = $class ;
- $name =~ s/^(.*)::// ;
- $info .= "\t\tpublic $name(" . join(", ", @{$sign}) . ")\n" ;
- }
- }
- foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{static}}) {
- my $sign = $d->{classes}->{$class}->{methods}->{static}->{$method} ;
- if (defined($sign)){
- foreach my $s (@{$sign}){
- $info .= "\t\tpublic static $method(" . join(", ", @{$s}) . ")\n" ;
- }
- }
+ $info .= "\n class $class:\n" ;
+
+ $info .= " public methods:\n" ;
+ while (my ($k, $v) = each %{$d->{classes}->{$class}->{constructors}}){
+ my $name = $class ;
+ $name =~ s/^(.*)::// ;
+ $info .= " $name($k)\n" ;
}
- foreach my $method (sort keys %{$d->{classes}->{$class}->{methods}->{instance}}) {
- my $sign = $d->{classes}->{$class}->{methods}->{instance}->{$method} ;
- if (defined($sign)){
- foreach my $s (@{$sign}){
- $info .= "\t\tpublic $method(" . join(", ", @{$s}) . ")\n" ;
- }
+
+ while (my ($k, $v) = each %{$d->{classes}->{$class}->{methods}}){
+ while (my ($k2, $v2) = each %{$d->{classes}->{$class}->{methods}->{$k}}){
+ my $static = ($v2->{STATIC} ? "static " : "") ;
+ $info .= " $static$k($k2)\n" ;
}
}
- }
+ $info .= " public member variables:\n" ;
+ while (my ($k, $v) = each %{$d->{classes}->{$class}->{fields}}){
+ my $static = ($v->{STATIC} ? "static " : "") ;
+ my $type = $v->{TYPE} ;
+
+ $info .= " $static$type $k\n" ;
+ }
+ }
return $info ;
}
@@ -908,7 +920,7 @@ sub debug {
if ($Inline::Java::DEBUG){
my $str = join("", @_) ;
while (chomp($str)) {}
- print STDERR "perl $$: $str\n" ;
+ print DEBUG "perl $$: $str\n" ;
}
}
@@ -918,10 +930,10 @@ sub debug_obj {
my $pre = shift || "perl: " ;
if ($Inline::Java::DEBUG){
- print STDERR $pre . Dumper($obj) ;
+ print DEBUG $pre . Dumper($obj) ;
if (UNIVERSAL::isa($obj, "Inline::Java::Object")){
# Print the guts as well...
- print STDERR $pre . Dumper($obj->__get_private()) ;
+ print DEBUG $pre . Dumper($obj->__get_private()) ;
}
}
}
@@ -999,6 +1011,25 @@ sub portable {
}
+######################## Public Functions ########################
+
+
+sub cast {
+ my $type = shift ;
+ my $val = shift ;
+ my $array_type = shift ;
+
+ my $o = undef ;
+ eval {
+ $o = new Inline::Java::Class::Cast($type, $val, $array_type) ;
+ } ;
+ croak $@ if $@ ;
+
+ return $o ;
+}
+
+
+
1 ;
__END__
diff --git a/Java/Array.pm b/Java/Array.pm
index b7fbcc0..9205c0f 100644
--- a/Java/Array.pm
+++ b/Java/Array.pm
@@ -4,7 +4,7 @@ package Inline::Java::Array ;
use strict ;
-$Inline::Java::Array::VERSION = '0.10' ;
+$Inline::Java::Array::VERSION = '0.20' ;
use Carp ;
diff --git a/Java/Class.pm b/Java/Class.pm
index b3f037f..904d774 100644
--- a/Java/Class.pm
+++ b/Java/Class.pm
@@ -3,7 +3,7 @@ package Inline::Java::Class ;
use strict ;
-$Inline::Java::Class::VERSION = '0.10' ;
+$Inline::Java::Class::VERSION = '0.20' ;
use Carp ;
diff --git a/Java/Init.pm b/Java/Init.pm
index 0b7f9ea..1fcf8e8 100644
--- a/Java/Init.pm
+++ b/Java/Init.pm
@@ -3,7 +3,7 @@ package Inline::Java::Init ;
use strict ;
-$Inline::Java::Init::VERSION = '0.10' ;
+$Inline::Java::Init::VERSION = '0.20' ;
my $DATA = join('', <DATA>) ;
my $OBJECT_DATA = join('', <Inline::Java::Object::DATA>) ;
diff --git a/Java/JNI.pm b/Java/JNI.pm
index 99f9759..1068f5c 100644
--- a/Java/JNI.pm
+++ b/Java/JNI.pm
@@ -4,7 +4,7 @@ package Inline::Java::JNI ;
use strict ;
-$Inline::Java::JNI::VERSION = '0.10' ;
+$Inline::Java::JNI::VERSION = '0.20' ;
use Carp ;
diff --git a/Java/JVM.pm b/Java/JVM.pm
index 80b3d40..f67c285 100644
--- a/Java/JVM.pm
+++ b/Java/JVM.pm
@@ -3,7 +3,7 @@ package Inline::Java::JVM ;
use strict ;
-$Inline::Java::JVM::VERSION = '0.10' ;
+$Inline::Java::JVM::VERSION = '0.20' ;
use Carp ;
diff --git a/Java/Object.pm b/Java/Object.pm
index 6fcf047..a6bee0c 100644
--- a/Java/Object.pm
+++ b/Java/Object.pm
@@ -3,7 +3,7 @@ package Inline::Java::Object ;
use strict ;
-$Inline::Java::Object::VERSION = '0.10' ;
+$Inline::Java::Object::VERSION = '0.20' ;
use Inline::Java::Protocol ;
use Carp ;
diff --git a/Java/Protocol.pm b/Java/Protocol.pm
index 99e1673..48d8e2f 100644
--- a/Java/Protocol.pm
+++ b/Java/Protocol.pm
@@ -3,7 +3,7 @@ package Inline::Java::Protocol ;
use strict ;
-$Inline::Java::Protocol::VERSION = '0.10' ;
+$Inline::Java::Protocol::VERSION = '0.20' ;
use Inline::Java::Object ;
use Inline::Java::Array ;
diff --git a/TODO b/TODO
index 76e02b0..7fc35b9 100644
--- a/TODO
+++ b/TODO
@@ -1,40 +1,4 @@
CODE:
-- Member variables
- - In Java, when calling instance methods, change protocol to get
- class_name from object instead of getting it from what Perl sends.
- - Code in objects to send read/write to Java.
-
-- Arrays
- - Add support for arrays in Class::CastArgument
- > # Java expects an object but we don't have one. Maybe it's an array ?
- > if (UNIVERSAL::isa($elem, "ARRAY")){
- > my $array = new Inline::Java::Array($proto, ) ;
- > }
- > else{
- > if (ref($arg)){
- > # We got some other type of ref...
- > croak "Can't convert $arg to object $proto" ;
- > }
- > else{
- > # Here we got a scalar
- > # Here we allow scalars to be passed in place of java.lang.Object
- > # They will wrapped on the Java side.
- > if ($proto ne "java.lang.Object"){
- > croak "Can't convert $arg to object $proto" ;
- > }
- > }
- - Class::CastArgument will call Java to create the array.
- create_array [[I 2,2 scalar:0 scalar:1 scalar:2 scalar:3
- - Add support for arrays in Protocol::ValidateArgs
- - Create protocol to pass arrays in methods:
- array:[[I:3
- - Add Java code to create support for arrays in Protocol::ValidateArgs
-
-- Multiple signatures
- - load_jdat to grab all signatures
- - bind_jdat to create proxy methods, Java should not have to choose the
- method, Perl will choose it and send Java the signature to call.
-
TEST:
- Add test script for configuration options (other than BIN)
--
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