use strict;

package W3C::JVM::ClassFile;
use W3C::Util::Exception;
use W3C::JVM::ConstantPool;
use W3C::JVM::Field;
use W3C::JVM::Method;
use W3C::JVM::Access;

sub new {
    my ($proto, $pBits, $jvm, $flags) = @_;
    $flags ||= {};
    my $class = ref($proto) || $proto;
    my $self = {FLAGS => $flags};
    bless ($self, $class);
    ($self->{MAGIC}, $$pBits) = unpack('Na*', $$pBits);
    if ($self->{MAGIC} != 0xcafebabe) {
	&throw(new W3C::Util::ProgramFlowException());
    }
    ($self->{MINOR}, $self->{MAJOR}, $$pBits) = unpack('n2a*', $$pBits);
    if ($self->{MAJOR} != 45 && $self->{MAJOR} != 46) {
	&throw(new W3C::Util::ProgramFlowException());
    }
    $self->{CONST_POOL} = new W3C::JVM::ConstantPool($self, $pBits);
    my ($interfaces, $fields, $methods, $attributes);
    ($self->{ACCESS}, $self->{THIS_CLASS}, $self->{SUPER_CLASS}, $$pBits) = unpack('n3a*', $$pBits);
    $self->{THIS_CLASS_REF} = $self->{CONST_POOL}->getEntry($self->{THIS_CLASS});
    $self->{SUPER_CLASS_REF} = $self->{CONST_POOL}->getEntry($self->{SUPER_CLASS}); 

    # interfaces
    ($interfaces, $$pBits) = unpack('na*', $$pBits);
    for (my $i = 0; $i < $interfaces; $i++) {
	my $interface = new_unpack W3C::JVM::Definition($i, $pBits, $self->{CONST_POOL});
	$interface->fixupRefs($self->{CONST_POOL}, $self->{THIS_CLASS_REF});
	push (@{$self->{INTERFACES}}, $interface);
    }

    # fields
    ($fields, $$pBits) = unpack('na*', $$pBits);
    for (my $i = 0; $i < $fields; $i++) {
	my $field = new_unpack W3C::JVM::Field($i, $pBits, $self->{CONST_POOL});
	$field->fixupRefs($self->{CONST_POOL}, $self->{THIS_CLASS_REF});
	push (@{$self->{FIELDS}}, $field);
    }

    # methods
    ($methods, $$pBits) = unpack('na*', $$pBits);
    for (my $i = 0; $i < $methods; $i++) {
	my $method = new_unpack W3C::JVM::Method($i, $pBits, $self->{CONST_POOL}, $jvm);
	$method->fixupRefs($self->{CONST_POOL}, $self->{THIS_CLASS_REF});
	push (@{$self->{METHODS}}, $method);
	$self->{METHODS_BY_NAME}{$method->getName()->toString()} = $method;
    }

    # attributes
    ($attributes, $$pBits) = unpack('na*', $$pBits);
    for (my $i = 0; $i < $attributes; $i++) {
	my $attribute = new_unpack W3C::JVM::Attribute($i, $pBits, $self->{CONST_POOL}, $jvm);
	$attribute->fixupRefs($self->{CONST_POOL}, $self->{THIS_CLASS_REF});
	push (@{$self->{ATTRIBUTES}}, $attribute);
#	$self->{ATTRIBUTES_BY_NAME}{$attribute->getName()->toString()} = $attribute;
    }


    if (length $$pBits) {
	&throw(new W3C::Util::ProgramFlowException());
    }
    $self->{REFERENCED_GLOBALS} = {};
    $jvm->registerClass($self);
    return $self;
}

sub getClassName {
    my ($self, $flags) = @_;
    return $self->{CONST_POOL}->getEntry($self->{THIS_CLASS})->toString($flags);
}

sub getConstantPool {
    my ($self) = @_;
    return $self->{CONST_POOL};
}

sub getMethod {
    my ($self, $methodStr) = @_;
    return $self->{METHODS_BY_NAME}{$methodStr};
}

sub getMethods {
    my ($self, $methodStr) = @_;
    return values %{$self->{METHODS_BY_NAME}};
}

sub referenceGlobal {
    my ($self, $globalName, $fieldName) = @_;
    $self->{REFERENCED_GLOBALS}{$globalName}++;
    if (1 || ($self->{FLAGS}{-resolveLocal} && !eval "defined $globalName")) {
	eval "require $globalName";
    }
    return "\$${globalName}->{'$fieldName'}";
}

sub getUseStrings {
    my ($self) = @_;
    my $ret = [];
    foreach my $global (keys %{$self->{REFERENCED_GLOBALS}}) {
	push (@$ret, "use $global;");
    }
    return @$ret;
#    return join ("\n", $ret);
}

sub toString {
    my ($self, $flags) = @_;
    $flags ||= {};
    my @ret; # = "$self";
    push (@ret, $self->{CONST_POOL}->toString({%$flags, -fat => 1}));
    push (@ret, &RenderAccess($self->{ACCESS}, \%ACC_2STR_class, 'access_flags'));
    push (@ret, "class: ".$self->{CONST_POOL}->getEntry($self->{THIS_CLASS})->toString($flags));
    push (@ret, "super: ".$self->{CONST_POOL}->getEntry($self->{SUPER_CLASS})->toString($flags));
    push (@ret, "Interfaces:");
    foreach my $interface (@{$self->{INTERFACES}}) {
	push (@ret, $interface->toString({%$flags, -fat => 1}));
    }
    push (@ret, "Fields:");
    foreach my $field (@{$self->{FIELDS}}) {
	push (@ret, $field->toString({%$flags, -fat => 1}));
    }
    push (@ret, "Methods:");
    foreach my $method (@{$self->{METHODS}}) {
	push (@ret, $method->toString({%$flags, -fat => 1}));
    }
    push (@ret, "Attributes:");
    foreach my $attribute (@{$self->{ATTRIBUTES}}) {
	push (@ret, $attribute->toString({%$flags, -fat => 1}));
    }
    return join ("\n", @ret);
}

1;

