use strict;

package W3C::JVM::ConstantPoolEntry::iReferrer; # interface - getRefs
package W3C::JVM::ConstantPoolEntry::iResolver; # interface - resolve
package W3C::JVM::ConstantPoolEntry::Entry; # functions for all entries
package W3C::JVM::ConstantPoolEntry::_Const; # functions for const entries

package W3C::JVM::ConstantPoolEntry::Entry;
use W3C::Util::Exception;

sub new {
    my ($proto, $pool, $index) = @_;
    my $class = ref($proto) || $proto;
    my $self = {POOL => $pool, DATA => undef, INDEX => $index};
    bless ($self, $class);
    return $self;
}

sub p_classString {
    my ($self, $line) = @_;
    my $ref = ref $self;
    $ref =~ s/W3C::JVM::ConstantPoolEntry:://;
    return "$self->{INDEX}: $ref $line";
}

sub toString {
    &throw(new W3C::Util::MethodNotImplementedException(-object => $_[0]));
}

sub toPerl {
    &throw(new W3C::Util::MethodNotImplementedException(-object => $_[0]));
}

package W3C::JVM::ConstantPoolEntry::_Const;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry);
use W3C::Util::Exception;

sub getConst {
    &throw(new W3C::Util::MethodNotImplementedException(-object => $_[0]));
}

sub getString {
    my ($self) = @_;
    return $self->{TO_STRING};
}

package W3C::JVM::ConstantPoolEntry::Utf8;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::_Const);

sub new {
    my ($proto, $pool, $index, $string) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    $self->{STRING} = $string;
    return $self;
}

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    my $length;
    ($length, $$pBits) = unpack('na*', $$pBits);
    ($self->{STRING}, $$pBits) = unpack("a${length}a*", $$pBits);
    $self->{TO_STRING} = "\"$self->{STRING}\"";
    return $self;
}

sub getConst {
    my ($self) = @_;
    return $self->{STRING};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    if ($flags->{-fat}) {
	return $self->p_classString($self->{STRING});
    } else {
	return $self->{STRING};
    }
}

package W3C::JVM::ConstantPoolEntry::Integer;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::_Const);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{INTEGER}, $$pBits) = unpack('Na*', $$pBits);
    $self->{TO_STRING} = $self->{INTEGER};
    return $self;
}

sub getConst {
    my ($self) = @_;
    return $self->{INTEGER};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    if ($flags->{-fat}) {
	return $self->p_classString($self->{INTEGER});
    } else {
	return $self->{INTEGER};
    }
}

package W3C::JVM::ConstantPoolEntry::Float;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::_Const);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{FLOAT}, $$pBits) = unpack('a5a*', $$pBits);
    $self->{TO_STRING} = $self->{FLOAT};
    return $self;
}

sub getConst {
    my ($self) = @_;
    return $self->{FLOAT};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    if ($flags->{-fat}) {
	return $self->p_classString($self->{FLOAT});
    } else {
	return $self->{FLOAT};
    }
}

package W3C::JVM::ConstantPoolEntry::Long;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::_Const);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{LONG}, $$pBits) = unpack('Qa*', $$pBits);
    $self->{TO_STRING} = $self->{LONG};
    return $self;
}

sub getConst {
    my ($self) = @_;
    return $self->{LONG};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    if ($flags->{-fat}) {
	return $self->p_classString($self->{LONG});
    } else {
	return $self->{LONG};
    }
}

package W3C::JVM::ConstantPoolEntry::Double;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::_Const);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{DOUBLE}, $$pBits) = unpack('Qa*', $$pBits);
    $self->{TO_STRING} = $self->{DOUBLE};
    return $self;
}


sub getConst {
    my ($self) = @_;
    return $self->{DOUBLE};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    if ($flags->{-fat}) {
	return $self->p_classString($self->{DOUBLE});
    } else {
	return $self->{DOUBLE};
    }
}

package W3C::JVM::ConstantPoolEntry::String;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer 
	  W3C::JVM::ConstantPoolEntry::iResolver);

sub new {
    my ($proto, $pool, $index, $utf8Ref) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    $self->{STR_REF} = $utf8Ref;
    $self->{STR_INDEX} = $utf8Ref;
    return $self;
}

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{STR_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{STR_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{STR_REF} = $pool->getEntry($self->{STR_INDEX});
}

sub resolve {
    my ($self) = @_;
}

sub getUtf8 {
    my ($self) = @_;
    return $self->{STR_REF}
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{STR_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

sub toPerl {
    my ($self, $quote) = @_;
    return $quote ? '"'.$self->getUtf8->toString().'"' : $self->getUtf8->toString();
}

package W3C::JVM::ConstantPoolEntry::Classref;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer 
	  W3C::JVM::ConstantPoolEntry::iResolver);

sub new {
    my ($proto, $pool, $index, $classRef) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    $self->{CLASS_REF} = $classRef;
    $self->{CLASS_INDEX} = $classRef;
    return $self;
}

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    ($self->{CLASS_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{CLASS_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{CLASS_REF} = $pool->getEntry($self->{CLASS_INDEX});
}

sub resolve {
    my ($self) = @_;
}

sub getName {
    my ($self) = @_;
    return $self->{CLASS_REF};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{CLASS_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

package W3C::JVM::ConstantPoolEntry::Fieldref;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer 
	  W3C::JVM::ConstantPoolEntry::iResolver);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    my ($d1, $d2);
    ($self->{CLASS_INDEX}, $$pBits) = unpack('na*', $$pBits);
    ($self->{FIELD_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{CLASS_INDEX}:$self->{FIELD_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{CLASS_REF} = $pool->getEntry($self->{CLASS_INDEX});
    $self->{FIELD_REF} = $pool->getEntry($self->{FIELD_INDEX});
}

sub resolve {
    my ($self) = @_;
}

sub getClass {
    my ($self) = @_;
    return $self->{CLASS_REF};
}

sub getField {
    my ($self) = @_;
    return $self->{FIELD_REF}->getName();
}

sub getType {
    my ($self) = @_;
    return $self->{FIELD_REF}->getType();
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{CLASS_REF}->toString().':'.$self->{FIELD_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

sub toPerl {
    my ($self, $quote) = @_;
    return $self->{POOL}->resolveGlobal($self->getClass(), $self->getField());
}

package W3C::JVM::ConstantPoolEntry::Methodref;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer 
	  W3C::JVM::ConstantPoolEntry::iResolver);

sub new {
    my ($proto, $pool, $index, $classRef, $methodRef) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    $self->{CLASS_REF} = $classRef;
    $self->{METHOD_REF} = $methodRef;
    $self->{CLASS_INDEX} = $classRef;
    $self->{METHOD_INDEX} = $methodRef;
    $self->fixupTypes();
    return $self;
}

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    my ($d1, $d2);
    ($self->{CLASS_INDEX}, $$pBits) = unpack('na*', $$pBits);
    ($self->{METHOD_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{CLASS_INDEX}:$self->{METHOD_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{CLASS_REF} = $pool->getEntry($self->{CLASS_INDEX});
    $self->{METHOD_REF} = $pool->getEntry($self->{METHOD_INDEX});
    $self->fixupTypes();
}

sub fixupTypes {
    my ($self) = @_;
    my $type = $self->{METHOD_REF}->getType();
    if ($type->toString !~ m/^\(([^\)]*)\)(.*)$/) {
	&throw(new W3C::Util::Exception());
    }
    ($type, $self->{RETURNS}) = ($1, $2);
    if ($self->{RETURNS} eq 'V') {
	$self->{RETURNS} = undef;
    }
    $self->{TYPES} = [split (';', $type)];
}

sub resolve {
    my ($self) = @_;
}

sub getClass {
    my ($self) = @_;
    return $self->{CLASS_REF};
}

sub getMethod {
    my ($self) = @_;
    return $self->{METHOD_REF}->getName();
}

sub getTypeString {
    my ($self) = @_;
    return $self->{METHOD_REF}->getType();
}

sub getTypes {
    my ($self) = @_;
    return $self->{TYPES};
}

sub getReturnType {
    my ($self) = @_;
    return $self->{RETURNS};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{CLASS_REF}->toString().':'.$self->{METHOD_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

package W3C::JVM::ConstantPoolEntry::InterfaceMethodref;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer 
	  W3C::JVM::ConstantPoolEntry::iResolver);

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    my ($d1, $d2);
    ($self->{CLASS_INDEX}, $$pBits) = unpack('na*', $$pBits);
    ($self->{IMETHOD_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{CLASS_INDEX}:$self->{IMETHOD_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{CLASS_REF} = $pool->getEntry($self->{CLASS_INDEX});
    $self->{IMETHOD_REF} = $pool->getEntry($self->{IMETHOD_INDEX});
}

sub resolve {
    my ($self) = @_;
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{CLASS_REF}->toString().':'.$self->{IMETHOD_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

package W3C::JVM::ConstantPoolEntry::NameAndType;
use vars qw(@ISA);
@ISA = qw(W3C::JVM::ConstantPoolEntry::Entry 
	  W3C::JVM::ConstantPoolEntry::iReferrer);

sub new {
    my ($proto, $pool, $index, $nameRef, $typeRef) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    $self->{NAME_REF} = $nameRef;
    $self->{TYPE_REF} = $typeRef;
    $self->{NAME_INDEX} = $nameRef;
    $self->{TYPE_INDEX} = $typeRef;
    return $self;
}

sub new_unpack {
    my ($proto, $pool, $index, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($pool, $index);
    my ($d1, $d2);
    ($self->{NAME_INDEX}, $$pBits) = unpack('na*', $$pBits);
    ($self->{TYPE_INDEX}, $$pBits) = unpack('na*', $$pBits);
    $self->{TO_STRING} = "unresolved: $self->{NAME_INDEX}:$self->{TYPE_INDEX}";
    return $self;
}

sub fixupRefs {
    my ($self, $pool, $classRef) = @_;
    $self->{NAME_REF} = $pool->getEntry($self->{NAME_INDEX});
    $self->{TYPE_REF} = $pool->getEntry($self->{TYPE_INDEX});
}

sub getName {
    my ($self) = @_;
    return $self->{NAME_REF};
}

sub getType {
    my ($self) = @_;
    return $self->{TYPE_REF};
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my $string = $self->{NAME_REF}->toString().':'.$self->{TYPE_REF}->toString();
    if ($flags->{-fat}) {
	return $self->p_classString($string);
    } else {
	return $string;
    }
}

package W3C::JVM::ConstantPool;
use W3C::Util::Exception;
use W3C::JVM::JVM qw(&javaClass2PerlPackage);

use vars qw(@EXPORT_OK);
use vars qw($CONSTANT_Utf8 
	    $CONSTANT_Integer
	    $CONSTANT_Float
	    $CONSTANT_Long
	    $CONSTANT_Double
	    $CONSTANT_String
	    $CONSTANT_Classref
	    $CONSTANT_Fieldref
	    $CONSTANT_Methodref
	    $CONSTANT_InterfaceMethodref
	    $CONSTANT_NameAndType);

@EXPORT_OK = qw($CONSTANT_Utf8 
		$CONSTANT_Integer
		$CONSTANT_Float
		$CONSTANT_Long
		$CONSTANT_Double
		$CONSTANT_String
		$CONSTANT_Classref
		$CONSTANT_Fieldref
		$CONSTANT_Methodref
		$CONSTANT_InterfaceMethodref
		$CONSTANT_NameAndType);

$CONSTANT_Utf8 = 1;
$CONSTANT_Integer = 3;
$CONSTANT_Float = 4;
$CONSTANT_Long = 5;
$CONSTANT_Double = 6;
$CONSTANT_String = 8;
$CONSTANT_Classref = 7;
$CONSTANT_Fieldref = 9;
$CONSTANT_Methodref = 10;
$CONSTANT_InterfaceMethodref = 11;
$CONSTANT_NameAndType = 12;

use vars qw(@_ResolveRefOrder);
@_ResolveRefOrder = ($CONSTANT_String, 
		     $CONSTANT_Classref, 
		     $CONSTANT_NameAndType, 
		     $CONSTANT_Fieldref, 
		     $CONSTANT_Methodref, 
		     $CONSTANT_InterfaceMethodref);

sub new {
    my ($proto, $classFile, $pBits) = @_;
    my $class = ref($proto) || $proto;
    my $self = {ENTRIES => [], CLASSFILE => $classFile};
    bless ($self, $class);

    my $byType = {};
    foreach my $type (@_ResolveRefOrder) {
	$byType->{$type} = [];
    }

    my $count;
    ($count, $$pBits) = unpack('na*', $$pBits);
    $count--; # !!! 4tf? seems to fit the book, too
    for (my $i = 1; $i < $count+1; $i++) {
	my ($type, $entry);
	($type, $$pBits) = unpack('Ca*', $$pBits);
	if ($type == $CONSTANT_Utf8) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Utf8($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Integer) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Integer($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Float) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Float($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Long) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Long($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Double) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Double($self, $i, $pBits)
	} elsif ($type == $CONSTANT_String) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::String($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Classref) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Classref($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Fieldref) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Fieldref($self, $i, $pBits)
	} elsif ($type == $CONSTANT_Methodref) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::Methodref($self, $i, $pBits)
	} elsif ($type == $CONSTANT_InterfaceMethodref) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::InterfaceMethodref($self, $i, $pBits)
	} elsif ($type == $CONSTANT_NameAndType) {
	    $entry = new_unpack W3C::JVM::ConstantPoolEntry::NameAndType($self, $i, $pBits)
	} else {
	    &throw(new W3C::Util::Exception(-message => "unknown type: $type"));
	}
	push (@{$self->{ENTRIES}}, $entry);
	push (@{$byType->{$type}}, $entry);
    }

    foreach my $type (@_ResolveRefOrder) {
	for (my $i = 0; $i < @{$byType->{$type}}; $i++) {
	    $byType->{$type}[$i]->fixupRefs($self);
	}
    }
    return $self;
}

sub getEntry {
    my ($self, $index) = @_;
    my $ret = $self->{ENTRIES}[$index-1];
    if (!defined $ret) {
	&throw(new W3C::Util::ProgramFlowException());
    }
    return $ret;
}

sub ensureUtf8 { # for argv
    my ($self, $str) = @_;
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	if ($self->{ENTRIES}[$i]->isa('W3C::JVM::ConstantPoolEntry::Utf8') && 
	    $self->{ENTRIES}[$i]->getConst eq $str) {
	    return $self->{ENTRIES}[$i];
	}
    }
    my $ret = new W3C::JVM::ConstantPoolEntry::Utf8($self, scalar @{$self->{ENTRIES}}, $str);
    push (@{$self->{ENTIES}}, $ret);
    return $ret;
}

sub ensureString { # for argv
    my ($self, $str) = @_;
    my $utf8 = $self->ensureUtf8($str);
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	if ($self->{ENTRIES}[$i]->isa('W3C::JVM::ConstantPoolEntry::String') && 
	    $self->{ENTRIES}[$i]->getUtf8 == $utf8) {
	    return $self->{ENTRIES}[$i];
	}
    }
    my $ret = new W3C::JVM::ConstantPoolEntry::String($self, scalar @{$self->{ENTRIES}}, $utf8);
    push (@{$self->{ENTIES}}, $ret);
    return $ret;
}

sub ensureNameAndTypeRef {
    my ($self, $nameRef, $typeRef) = @_;
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	if ($self->{ENTRIES}[$i]->isa('W3C::JVM::ConstantPoolEntry::NameAndType') && 
	    $self->{ENTRIES}[$i]->getName == $nameRef && 
	    $self->{ENTRIES}[$i]->getType == $typeRef) {
	    return $self->{ENTRIES}[$i];
	}
    }
    my $ret = new W3C::JVM::ConstantPoolEntry::NameAndType($self, scalar @{$self->{ENTRIES}}, $nameRef, $typeRef);
    push (@{$self->{ENTIES}}, $ret);
    return $ret;
}

sub ensureClassRef { # for main
    my ($self, $classStr) = @_;
    my $classRef = $self->ensureUtf8($classStr);
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	if ($self->{ENTRIES}[$i]->isa('W3C::JVM::ConstantPoolEntry::Classref') && 
	    $self->{ENTRIES}[$i]->getName == $classRef) {
	    return $self->{ENTRIES}[$i];
	}
    }
    my $ret = new W3C::JVM::ConstantPoolEntry::Classref($self, scalar @{$self->{ENTRIES}}, $classRef);
    push (@{$self->{ENTIES}}, $ret);
    return $ret;
}

sub ensureMethodRef { # for W3C::JVM::Method->{METHOD_REF}
    my ($self, $classRef, $nameRef, $typeRef) = @_;
    my $nameAndTypeRef = $self->ensureNameAndTypeRef($nameRef, $typeRef);
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	if ($self->{ENTRIES}[$i]->isa('W3C::JVM::ConstantPoolEntry::Methodref') && 
	    $self->{ENTRIES}[$i]->getClass == $classRef && 
	    $self->{ENTRIES}[$i]->getNameAndType == $nameAndTypeRef) {
	    return $self->{ENTRIES}[$i];
	}
    }
    my $ret = new W3C::JVM::ConstantPoolEntry::Methodref($self, scalar @{$self->{ENTRIES}}, $classRef, $nameAndTypeRef);
    push (@{$self->{ENTIES}}, $ret);
    return $ret;
}

sub getUtf8Index { # my $idxCode = $pool->getUtf8Index('Code');
    my ($self, $str) = @_;
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	my $entry = $self->{ENTRIES}[$i];
	if ($entry->isa('W3C::JVM::ConstantPoolEntry::Utf8') && $entry->getConst() eq $str) {
	    return $i+1;
	}
    }
    return undef; # @@@ what to use for failure?
}

sub getUtf8Entry {
    my ($self, $str) = @_;
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	my $entry = $self->{ENTRIES}[$i];
	if ($entry->isa('W3C::JVM::ConstantPoolEntry::Utf8') && $entry->getConst() eq $str) {
	    return $entry;
	}
    }
    return undef; # @@@ what to use for failure?
}

sub resolveGlobal {
    my ($self, $class, $field) = @_;
    my $globalName = &W3C::JVM::JVM::javaClass2PerlPackage($class);
    my $fieldName = $field->toString();
    return $self->{CLASSFILE}->referenceGlobal($globalName, $fieldName);
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my @ret;
    my $entries = @{$self->{ENTRIES}};
    if ($flags->{-fat}) {
	push (@ret, "ConstantPool with $entries entries:");
    }
    foreach my $entry (@{$self->{ENTRIES}}) {
	push (@ret, $entry->toString($flags));
    }
    return join ("\n", @ret);
}

#################### private methods

sub _getUtf8Entry {
    my ($self, $str) = @_;
    for (my $i = 0; $i < @{$self->{ENTRIES}}; $i++) {
	my $entry = $self->{ENTRIES}[$i];
	if ($entry->isa('W3C::JVM::ConstantPoolEntry::Utf8') && $entry->getConst() eq $str) {
	    return $entry;
	}
    }
    return undef; # @@@ what to use for failure?
}

1;

