[libinline-java-perl] 23/398: Initial revision
Jonas Smedegaard
dr at jones.dk
Thu Feb 26 11:42:38 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 9d0e56772a50ab4aaf4ba78cd01523057956c8ea
Author: patrick <>
Date: Thu Mar 8 21:33:09 2001 +0000
Initial revision
---
Java/Array.pm | 447 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 447 insertions(+)
diff --git a/Java/Array.pm b/Java/Array.pm
new file mode 100644
index 0000000..d36889c
--- /dev/null
+++ b/Java/Array.pm
@@ -0,0 +1,447 @@
+package Inline::Java::Array ;
+ at Inline::Java::Array::ISA = qw(Tie::StdArray) ;
+
+
+use strict ;
+
+$Inline::Java::Array::VERSION = '0.01' ;
+
+use Inline::Java::Object ;
+use Tie::Array ;
+use Carp ;
+
+
+# This class is instantiated to do the conversion between a perl
+# array and a Java array. It can take a Perl array, validate it, fill it
+# and flatten it or order to send to Java to get an object created.
+#
+# In the reverse sense, it takes a flattened array from Java and constructs
+# a structure of blessed perl arrays that serves as an interface to the
+# array.
+#
+# This class in not meant to be instantiated by the user.
+
+
+# Here we will store each of the arrays in order to be able
+# to add extra data.
+my $ARRAYS = {} ;
+
+sub new {
+ my $class = shift ;
+ my $java_class = shift ;
+ my $inline = shift ;
+
+ if (! Inline::Java::Class::ClassIsArray($java_class)){
+ croak "Can't create Inline::Java::Array object for non-array class $java_class" ;
+ }
+
+ my @this = [] ;
+ tie @this, 'Inline::Java::Array' ;
+ bless (\@this, $class) ;
+
+ my $this = \@this ;
+ $ARRAYS->{$this} = {
+ array => $this,
+ class => $class,
+ java_class => $java_class,
+ module => $inline->{modfname},
+ map => {},
+ } ;
+
+ # The first thing we want to do is figure out what kind of array we want,
+ # and how many dimensions it should have.
+ $this->__analyze_array_class() ;
+
+ # Inline::Java::debug_obj($ARRAYS->{$this}) ;
+
+ return $this ;
+}
+
+
+sub __init_from_array {
+ my $this = shift ;
+ my $ref = shift ;
+ my $inline = shift ;
+ my $level = shift ;
+
+ $this->__validate_array($ref, 1) ;
+
+ # Now that we now that this array is valid, we need to carry
+ # over the stuff in $ref into ourselves.
+ # sub arrays into array_objects
+ $this->__import_from_array($ref, $inline, $level) ;
+
+ if (! $level){
+ Inline::Java::debug_obj($ARRAYS->{$this}) ;
+ }
+}
+
+
+sub __import_from_array {
+ my $this = shift ;
+ my $ref = shift ;
+ my $inline = shift ;
+ my $level = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+
+ for (my $i = 0 ; $i < scalar(@{$ref}) ; $i++){
+ my $elem = $ref->[$i] ;
+
+ if (UNIVERSAL::isa($elem, "ARRAY")){
+ my $java_class = $extra->{java_class} ;
+
+ # We need top drop the array by 1 dimension
+ $java_class =~ s/^\[// ;
+ my $obj = new Inline::Java::Array($java_class, $inline) ;
+ $obj->__init_from_array($elem, $inline, $level + 1) ;
+ $elem = $obj ;
+ }
+ my $nb = scalar(@{$this}) ;
+ $this->[$nb] = $elem ;
+ }
+}
+
+
+# Checks if the contents of the Array match the ones prescribed
+# by the Java prototype.
+sub __analyze_array_class {
+ my $this = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+ my $java_class = $extra->{java_class} ;
+
+ my ($depth_str, $type, $class) = Inline::Java::Class::ValidateClassSplit($java_class) ;
+ $depth_str =~ /^(\[+)/ ;
+ my $depth = length($depth_str) ;
+
+ my %map = (
+ B => 'byte',
+ S => 'short',
+ I => 'int',
+ J => 'long',
+ F => 'float',
+ D => 'double',
+ C => 'char',
+ Z => 'boolean',
+ L => $class,
+ ) ;
+
+ my $pclass = $map{$type} ;
+ if (! $pclass){
+ croak "Can't determine array type for $java_class" ;
+ }
+
+ $extra->{req_element_class} = $pclass ;
+ $extra->{req_nb_dim} = $depth ;
+
+ return ;
+}
+
+
+# This method makes sure that we have a valid array that
+# can be used in a Java function. It will return an array
+# That contains either all scalars or all object references
+# at the lowest level.
+sub __validate_array {
+ my $this = shift ;
+ my $ref = shift ;
+ my $fill = shift ;
+ my $level = shift || 0 ;
+
+ if (! UNIVERSAL::isa($ref, "ARRAY")){
+ # We must start with an array of some kind...
+ croak "$ref is not an array reference" ;
+ }
+
+ $this->__validate_elements($ref, $level) ;
+
+ foreach my $elem (@{$ref}){
+ if (UNIVERSAL::isa($elem, "ARRAY")){
+ $this->__validate_array($elem, $fill, $level + 1) ;
+ }
+ }
+
+ if ($fill){
+ $this->__fill_array($ref, $level) ;
+ }
+
+ my $extra = $ARRAYS->{$this} ;
+ my $map = $extra->{map} ;
+ if (! $level){
+ my @levels = (sort {$a <=> $b} keys %{$map}) ;
+ my $nbl = scalar(@levels) ;
+
+ my $last = $levels[$nbl - 1] ;
+ my @dims = () ;
+ my $max_cells = 1 ;
+ foreach my $l (@levels){
+ push @dims, ($map->{$l}->{max} || 0) ;
+ $max_cells *= $map->{$l}->{max} ;
+ }
+ my $nb_cells = ($map->{$last}->{count} || 0) ;
+ # Inline::Java::debug("array is [" . join("][", @dims) . "]") ;
+ # Inline::Java::debug("array has $nb_cells declared cells") ;
+ # Inline::Java::debug("array should have $max_cells declared cells") ;
+ $extra->{dim} = \@dims ;
+ $extra->{nb_dim} = scalar(@dims) ;
+
+ if ($extra->{nb_dim} != $extra->{req_nb_dim}){
+ croak "Java array should have $extra->{req_nb_dim} instead of " .
+ "$extra->{nb_dim} dimensions" ;
+ }
+
+ # Inline::Java::debug_obj($extra) ;
+ }
+}
+
+
+# Makes sure that all the elements are of the same type.
+sub __validate_elements {
+ my $this = shift ;
+ my $ref = shift ;
+ my $level = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+ my $map = $extra->{map} ;
+
+ my $cnt = scalar(@{$ref}) ;
+ my $max = $map->{$level}->{max} || 0 ;
+
+ if ($cnt > $max){
+ $map->{$level}->{max} = $cnt ;
+ }
+
+ foreach my $elem (@{$ref}){
+ if (defined($elem)){
+ if (ref($elem)){
+ if (UNIVERSAL::isa($elem, "ARRAY")){
+ $this->__check_map("ARRAY", $level) ;
+ }
+ elsif (UNIVERSAL::isa($elem, "Inline::Java::Object")){
+ $this->__check_map("Inline::Java::Object", $level) ;
+ $this->__cast_array_argument($elem) ;
+ push @{$map->{$level}->{list}}, $elem ;
+ }
+ else{
+ croak "A Java array can only contain scalars, Java objects or array references" ;
+ }
+ }
+ else{
+ $this->__check_map("SCALAR", $level) ;
+ $this->__cast_array_argument($elem) ;
+ push @{$map->{$level}->{list}}, $elem ;
+ }
+ }
+ }
+}
+
+
+sub __check_map {
+ my $this = shift ;
+ my $type = shift ;
+ my $level = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+ my $map = $extra->{map} ;
+
+ if (! exists($map->{$level}->{type})){
+ $map->{$level}->{type} = $type ;
+ }
+ elsif ($map->{$level}->{type} ne $type){
+ croak "Java array contains mixed types in dimension $level ($type != $map->{$level}->{type})" ;
+ }
+ $map->{$level}->{count}++ ;
+}
+
+
+sub __cast_array_argument {
+ my $this = shift ;
+ my $ref = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+ my $element_class = $extra->{req_element_class} ;
+
+ Inline::Java::Class::CastArgument($ref, $element_class) ;
+}
+
+
+# Makes sure that all the dimensions of the array have the same number of elements
+sub __fill_array {
+ my $this = shift ;
+ my $ref = shift ;
+ my $level = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+ my $map = $extra->{map} ;
+
+ my $max = $map->{$level}->{max} ;
+ my $nb = scalar(@{$ref}) ;
+
+ foreach my $elem (@{$ref}){
+ if ($map->{$level}->{type} eq "ARRAY"){
+ if (! defined($elem)){
+ $elem = [] ;
+ }
+ }
+ }
+
+ if ($nb < $max){
+ # We must stuff...
+ for (my $i = $nb ; $i < $max ; $i++){
+ if ($map->{$level}->{type} eq "ARRAY"){
+ my $elem = [] ;
+ push @{$ref}, $elem ;
+ push @{$map->{$level}->{list}}, $elem ;
+ }
+ else{
+ push @{$ref}, undef ;
+ push @{$map->{$level}->{list}}, undef ;
+ }
+ }
+ }
+}
+
+
+sub __flatten_array {
+ my $this = shift ;
+ my $level = shift ;
+
+ my $extra = $ARRAYS->{$this} ;
+
+
+}
+
+
+sub AUTOLOAD {
+ my $this = shift ;
+ my @args = @_ ;
+
+ 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("$func_name") ;
+
+ croak "Can't call method $func_name on Java arrays (can't call any methods for that matter)" ;
+}
+
+
+sub DESTROY {
+ my $this = shift ;
+
+ # I think here we should to something similar to Object, to get the object
+ # destroyed.
+}
+
+
+
+######################## Array methods ########################
+
+
+sub TIEARRAY {
+ my $class = shift ;
+
+ return $class->SUPER::TIEARRAY(@_) ;
+}
+
+
+sub FETCHSIZE {
+ my $this = shift ;
+
+ return $this->SUPER::FETCHSIZE() ;
+}
+
+
+sub STORE {
+ my $this = shift ;
+ my $idx = shift ;
+ my $s = shift ;
+
+ return $this->SUPER::STORE($idx, $s) ;
+}
+
+
+sub FETCH {
+ my $this = shift ;
+ my $idx = shift ;
+
+ return $this->SUPER::FETCH($idx) ;
+}
+
+
+sub EXISTS {
+ my $this = shift ;
+ my $idx = shift ;
+
+ return $this->SUPER::EXISTS($idx) ;
+}
+
+
+sub STORESIZE {
+ my $this = shift ;
+ my $size = shift ;
+
+ croak "Operation STORESIZE not supported on Java array" ;
+}
+
+
+sub CLEAR {
+ my $this = shift ;
+
+ croak "Operation CLEAR not supported on Java array" ;
+}
+
+
+sub POP {
+ my $this = shift ;
+
+ croak "Operation POP not supported on Java array" ;
+}
+
+
+sub PUSH {
+ my $this = shift ;
+ my @list = @_ ;
+
+ croak "Operation PUSH not supported on Java array" ;
+}
+
+
+sub SHIFT {
+ my $this = shift ;
+
+ croak "Operation SHIFT not supported on Java array" ;
+}
+
+
+sub UNSHIFT {
+ my $this = shift ;
+ my @list = @_ ;
+
+ croak "Operation UNSHIFT not supported on Java array" ;
+}
+
+
+sub DELETE {
+ my $this = shift ;
+ my $idx = shift ;
+
+ croak "Operation DELETE not supported on Java array" ;
+}
+
+# sub TIEARRAY { bless [], $_[0] }
+# sub FETCHSIZE { scalar @{$_[0]} }
+#sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+#sub STORE { $_[0]->[$_[1]] = $_[2] }
+#sub FETCH { $_[0]->[$_[1]] }
+#sub CLEAR { @{$_[0]} = () }
+#sub POP { pop(@{$_[0]}) }
+#sub PUSH { my $o = shift; push(@$o, at _) }
+#sub SHIFT { shift(@{$_[0]}) }
+#sub UNSHIFT { my $o = shift; unshift(@$o, at _) }
+#sub EXISTS { exists $_[0]->[$_[1]] }
+#sub DELETE { delete $_[0]->[$_[1]] }
+
--
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