package Table;

use strict;
use vars qw($QUOTE);

use XML;

use Field;
use Constraint;
use Message;

use methods;

use members scalar => [ 'name',
			'title',
			'old',
		        'report' ],
	      text => 'description',
	      list => 'fields',
	     index => [ 'constraints',
			'indices index',
			'grants' ];

$QUOTE = '"';

sub sql_create {
	my ($this) = @_;
	my $table = qq{create table $QUOTE$this->{name}$QUOTE (\n\t} .

		(join ",\n\t", $this->recurse( 'fields',
					       'constraints' ) ) . " )";

	return $table,
		map { $_->sql_create($this) } $this->indices, $this->grants;
}

sub sql_drop {
	my ($this) = @_;
	return (map { $_->sql_drop($this) } $this->indices, $this->grants),
		qq{drop table $QUOTE$this->{name}$QUOTE};
}

#  sub sql_rename {
#  	my ($package, $from, $to) = @_;
#  	return qq{alter table "$from" rename to "$to"};
#  }

#  sub sql_copy_data {
#  	my ($package, $from, $to) = @_;
#  	return qq{select * into table "$to" from "$from"};
#  }

sub alter_must_rebuild {
	my ($this, $diff, $new) = @_;
	my $must_rebuild = @{[$diff->removed_fields,
			      $diff->changed_fields,
		              $diff->added_fields,
			      $diff->renamed_fields,
		              $diff->removed_constraints,
		              $diff->changed_constraints,
		              $diff->added_constraints,
			      $diff->renamed_constraints]} ||
		              $diff->{order}{fields};
	return $must_rebuild;
}

sub sql_alter {
	my ($old, $diff, $new, $dbname) = @_;

	my @commands;

	my $must_rebuild = $old->alter_must_rebuild($diff, $new);

#	print ">>". ($diff->{order}{fields}). "\n";

	if ($must_rebuild) {
		#push @commands, $old->sql_dump, $old->sql_drop, $new->sql_create, $new->sql_restore;

		my $name = $old->name; # better be the same! can't rename yet

		my @fields = map qq{"$_"}, $new->field_names;

		push @commands, qq{!dbidump %dump-options% dump $dbname -t "$old->{name}"},
				$old->sql_drop,
				$new->sql_create,
				qq{!dbidump %restore-options% restore $dbname -t "$old->{name}"}
			# dbidump can now rename tables and fields when given a schema
	} else {
		push @commands, qq{alter table $QUOTE$old->{name}$QUOTE add column } . $new->field($_)->sql_create for $diff->added_fields;

#		print STDERR join " ", $diff->changed_fields, "\n";
		
		die "internal error: cannot change a field (must rebuild)" if %{$diff->changed_fields};
		push @commands, qq{alter table $QUOTE$old->{name}$QUOTE remove column } . $new->field($_)->sql_remove for $diff->removed_fields;
		die "internal error: cannot rename fields (must rebuild)" if %{$diff->renamed_fields};

		push @commands, $old->index($_)->sql_drop($old) for $diff->removed_indices;
		my $changed = $diff->changed_indices;
		while (my ($name, $_diff) = each %$changed) {
			push @commands, $old->index($name)->sql_alter($_diff, $new->index($name), $old);
		}
		push @commands, $new->index($_)->sql_create($new) for $diff->added_indices;
		my $renamed = $diff->renamed_indices;
		while (my ($old_name, $new_name) = each %$renamed) {
			push @commands, $old->index($old_name)->sql_rename($new_name, $old);
		}
		
		push @commands, $old->grant($_)->sql_drop($old) for $diff->removed_grants;
		die "internal error: it is nonsensical to change a grant" for $diff->changed_grants; 
		push @commands, $new->grant($_)->sql_create($new) for $diff->added_grants;
		die "internal error: it is nonsensical to rename a grant" for $diff->renamed_grants; 
	}

	return wantarray ? @commands : \@commands;
}

sub sql_rename {
	my ($this, $new_name, $dbname) = @_;
	my $old_name = $this->name;
	my @commands;

	push @commands, qq{!dbidump %dump-options% dump $dbname -t "$old_name"},
		$this->sql_drop;
	$this->name($new_name);
	push @commands, $this->sql_create,
		qq{!dbidump %restore-options% restore $dbname -t "$old_name"};
		# dbidump can now rename tables and fields, given a schema

	$this->name($old_name);
	return @commands;
}

sub sql_parse {
	my ($this, $sql) = @_;
	$this = $this->new unless ref $this;
	while (1) {
		$$sql =~ s/^\s+//s;
		return if $$sql eq '';
		if ($$sql =~ s/^constraint\s+"?(\w+)"?//si) {
			debug("  SQL: constraint $1");
			my $name = $1;
			my $constraint = Constraint->new(name => $name);
			$this->add_constraint($constraint);
			$constraint->sql_parse($sql);
			last unless $$sql =~ s/^\s*,//;
		} elsif ($$sql =~ s/^(primary key|fulltext key|key|unique(?: key)?)\s+"?(\w*)?"?\s*\(//si) {
			debug("  SQL: $1 $2");
			my $unique = lc $1 eq "unique" || lc $1 eq "unique key" || lc $1 eq "primary key";
			my $fulltext = lc $1 eq "fulltext key";
			my $name0 = $2;
			my $name = $name0 || $this->name."_index";
			my $index = Index->new(name => $name, $unique ? (unique => '1') : (), $fulltext ? (fulltext => '1') : ());
			$index->sql_parse($sql);
			
			# check that this is not a mysql autoincrement field, which cannot be handled in the normal dbischema way (ugh)
			my $is_mysql_autoinc;
			if ($name0 eq "") {
				my @fieldnames = $index->field_names;
				$is_mysql_autoinc =
					@fieldnames == 1 && 
					$this->field(@fieldnames)->autoincrement;
			}
			$this->add_index($index) unless $is_mysql_autoinc;

			$$sql =~ s/^\s*\)\s*,?//s or die "parse error, missing )";
		} elsif ($$sql =~ s/^"?(\w+)"?//si) {
			debug("  SQL: field $1");
			my $name = $1;
			my $field = Field->new(name => $name);
			$this->add_field($field);
			$field->sql_parse($sql);
			last unless $$sql =~ s/^\s*,//;
		} else {
			last;
		}
	}
	return $this;
}

sub realize {
	my ($this) = @_;
	$this->$_(undef) for qw(description title report);
	$this->recurse();
}

1
