package A2B::Table;

use TSV::Reader;
use TSV::Writer;

use strict;
use vars qw($WARN_NO_INDEX);

$WARN_NO_INDEX = 1;

my $class_gen = 0;

sub new {
	my $package = shift;
	my %args = @_;
	my $self = bless {
		field_names => [],
		fields => {},	# field name -> numerical index
		rows => [],
		indexes => [],
		index_index => {},
		name => $package,
	}, $package;

	if (my $file = delete $args{file}) {
		$self->read_tsv($file);
	} elsif (my $fields = delete $args{fields}) {
		$self->_fields($fields);
	}

	%args and die "invalid args @{[%args]}";
	
	return $self;
}

use overload '""' => \&name;

sub name {
	my $self = shift;
	return $self->{name};
};

sub rows {
	my $self = shift;
	return $self->{rows};
}

sub field {
	my $self = shift;
	my $field_name = shift;
	return $self->{field}{$field_name};
}

sub _fields {
	my $self = shift;
	my $fields = shift;
	$self->{field_names} = $fields;
	for (0..$#$fields) {
		$self->{fields}{$fields->[$_]} = $_;
	}
	my $package = ref $self;
	no strict 'refs';
	my $element_type = ${"${package}::ELEMENT_TYPE"} || "A2B::Table::Element";
	use strict 'refs';
	my $element_type_real = $element_type."::".$class_gen++;

	$self->{element_type} = $element_type_real;
	
	eval qq{
		package $element_type_real;
		
		use strict;
		use vars qw(\@ISA \$TABLE \$FIELDS);

		\@ISA = qw($element_type);

		\$TABLE = \$self;
		\$FIELDS = \$self->{fields};
	} . join "", map qq{
		sub $_ {
			my \$self = shift;
			return \$self->[$self->{fields}{$_}];
		}
	}, @$fields;
	die "internal error" if $@;
}

sub read_tsv {
	my $self = shift;
	my $file = shift;
	($self->{name} = $file) =~ s|.*/||;
	my $reader = TSV::Reader->new($file);
	my $fields = $reader->read or
		die "supposed tsv file is empty";
	$self->_fields($fields);
	while (defined (my $row = $reader->read)) {
		$self->add_row($row);
	}
}

sub write_tsv {
	my $self = shift;
	my $file = shift;

	my $writer = TSV::Writer->new($file);
	$writer->write($self->{field_names});
	for my $row (@{$self->{rows}}) {
		$writer->write($row);
	}
	$writer->close;
}

sub add_row {
	my $self = shift;
	my $package = ref $self;
	my $row = shift;

	bless $row, $self->{element_type};

	push @{$self->{rows}}, $row;
	for my $index (@{$self->{indexes}}) {
		$index->add_row($row);
	}
}

sub _add_index {
	my $self = shift;
	my $index = shift;
	push @{$self->{indexes}}, $index;
	for my $row (@{$self->{rows}}) {
		$index->add_row($row);
	}
	my $index_name = $index->name;
	do {
		my $sorted_index_name = join '-', sort split /-/, $index_name;
		$self->{index_index}{$sorted_index_name} = $index;
	} while $index_name =~ s/-[^-]+$// && !exists $self->{index_index}{$index_name};
}

sub index {
	my $self = shift;
	my @fields = sort @_;
	my $index_name = join '-', @fields;
	return $self->{index_index}{$index_name};
}

sub values {
	my $self = shift;

	my $field = shift;
	if (my $index = $self->index($field)) {
		return $index->keys(1);
	}

	my %values;
	
	warn "warning - no index for $field" if $WARN_NO_INDEX;

	defined (my $field_i = $self->{fields}{$field}) or
		die "bad field `$field'";

	for my $row (@{$self->{rows}}) {
		$values{$row->[$field_i]} = undef;
	}
	
	return [keys %values];
}

sub query {
	my $self = shift;
	my %args = @_;
	my @field_names = sort keys %args;

	if (my $index = $self->index(@field_names)) {
		# hooray, we can use an index
		my @row; $row[$self->{fields}{$_}] = $args{$_} for keys %args;
		return $index->query(\@row);
	}
	
	# bummer, no index
	# TODO automatically make needed indexes?
	# TODO use partial indexes?

	warn "warning - no index for [@field_names]" if $WARN_NO_INDEX;

	# do an exhaustive search

	my $looking_for = join "\0", CORE::values %args;
	my @fields = @{$self->{fields}}{keys %args};
	
	my @list;
	for my $row (@{$self->{rows}}) {
		if ($looking_for eq join "\0", @$row[@fields]) {
			push @list, $row;
		}
	}
	return \@list;
}

sub bind_foreign_key {
	my ($self, $field, $foreign_table, $foreign_key) = @_;
	my $field_i = $self->{fields}{$field};

	for my $row (@{$self->{rows}}) {
		my $value = $row->[$field_i];
		my $results = $foreign_table->query($foreign_key => $value);
		my $n = @$results;
#		$n > 1 and die "bind_foreign_key: `$foreign_key' is not a unique key to `$foreign_table': $value occurs $n times";
		$n == 0 and die "bind_foreign_key: value `$value' does not occur in `$foreign_table:$foreign_key'";
		$row->[$field_i] = $results->[0];
	}
}

1