package Database;

use strict;
use XML;

use Table;
use Sequence;
use Grant;
use Index;
use Message;

use methods;

use members scalar => [ 'name',
			'title',
		        'old' ],
	      text => 'description' ,
             index => [ 'tables',
			'sequences' ];

sub sql_create {
	my ($this) = @_;
	return qq{create database $Table::QUOTE$this->{name}$Table::QUOTE},
	       qq{\\connect $Table::QUOTE$this->{name}$Table::QUOTE},
	       $this->recurse;
}

sub sql_drop {
	my ($this) = @_;
	return qq{drop database $Table::QUOTE$this->{name}$Table::QUOTE};
}

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

	my $dbname = $new->name;

	my @commands;

	push @commands, qq{\\connect $Table::QUOTE$old->{name}$Table::QUOTE};

	push @commands, $old->sequence($_)->sql_drop for $diff->removed_sequences;
	push @commands, $old->table($_)->sql_drop for $diff->removed_tables;

	my $changed = $diff->changed_sequences;
	while (my ($name, $_diff) = each %$changed) {
		push @commands, $old->sequence($name)->sql_alter($_diff, $new->sequence($name));
	}
	$changed = $diff->changed_tables;
	while (my ($name, $_diff) = each %$changed) {
		push @commands, $old->table($name)->sql_alter($_diff, $new->table($name), $dbname);
	}

	push @commands, $new->sequence($_)->sql_create for $diff->added_sequences;
	push @commands, $new->table($_)->sql_create for $diff->added_tables;

	my $renamed = $diff->renamed_sequences;
	while (my ($old_name, $new_name) = each %$renamed) {
		push @commands, $old->sequence($old_name)->sql_rename($new_name);
	}
	$renamed = $diff->renamed_tables;
	while (my ($old_name, $new_name) = each %$renamed) {
		push @commands, $old->table($old_name)->sql_rename($new_name, $dbname);
	}
	
	return wantarray ? @commands : \@commands;
}

sub sql_rename {
	my ($this, $new_name) = @_;
	my $old_name = $this->name;
	my @commands;
	push @commands, qq{!dbidump %dump-options% dump $old_name},
		$this->sql_drop;
	$this->name($new_name);
	push @commands, $this->sql_create,
		qq{!dbidump %restore-options% restore $new_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 '' || ! $this->_sql_parse_statement($sql);
	}
}

my $body_pattern = q{(?:'(?:\\\\'|[^'])*'|"(?:\\\\"|[^"])*"|.)*?};

sub _sql_parse_statement {
	my ($this, $sql) = @_;

	if ($$sql =~ s/^create\s+table\s+"?(\w+)"?\s*\(//si) {
		debug("SQL: create table $1");
		my $name = $1;
		my $table = Table->new(name => $name);
		$this->add_table($table);
		$table->sql_parse($sql);
		$$sql =~ s/^\s*\)(\s*\w+=\w+)*;//s or do {
			die "parse error, missing );";
		}
	} elsif ($$sql =~ s/^create\s+sequence\s+"?(\w+)"?//si) {
		debug("SQL: create sequence $1");
		my $name = $1;
		my $sequence = Sequence->new(name => $name);
		$this->add_sequence($sequence);
		$sequence->sql_parse($sql);
		$$sql =~ s/^\s*;//s or die "parse error, sequence - missing ; ?";
		
		$$sql =~ s/^\s*select\s+nextval\s*\([^\)]+\)\s*;//si;
	} elsif ($$sql =~ s/^grant\s+([\w,]+)\son\s+(?:table\s+)?"?([^" ]+)"?\s+to\s+"?([^" ]+)"?\s*;//si) {
		debug("SQL: grant $1 on $2 to $3");
		my ($type, $table, $to) = ($1, $2, $3);
		my $grant = Grant->new(type => $type, to => $to);
		$table = $this->table($table) || $this->sequence($table) or die "no such table / sequence for grant";
		$table->add_grant($grant);
	} elsif ($$sql =~ s/^create\s+(unique\s+)?index\s*"?(\w+)"?\s+on\s+"?(\w+)"?(:?\s*using\s+\w+)?\s*\(//si) {
		if (defined $1) { debug("SQL: create $1index $2 on $3"); }
		else  { debug("SQL: create index $2 on $3"); }
		my ($unique, $name, $table) = ($1, $2, $3);
		my $index = Index->new(name => $name, defined $unique ? (unique => $unique ne '') : ());
		$index->sql_parse($sql);
		$table = $this->table($table) or die "no such table for index";
		$table->add_index($index);
		$$sql =~ s/^\s*\)\s*;//s or die "parse error, missing )";
	} elsif ($$sql =~ s/^\\connect\s+-[^\n]+\n//si) {
		debug("SQL: ignoring \\connect");
	} elsif ($$sql =~ s/^create\s+rule\s+$body_pattern;//si) {
		debug("SQL: ignoring create rule ...");
	} elsif ($$sql =~ s/^revoke\s+(\w+)\son\s+"?(\w+)"?\s+from\s+(\w+)\s*;//si) {
		debug("SQL: ignoring revoke ...");
	} elsif ($$sql =~ s/^create\s+function\s+$body_pattern;//sio) {
		debug("SQL: ignoring create function ...");
	} elsif ($$sql =~ s/^create\s+trusted\s+procedural\s+language\s+$body_pattern;//si) {
		debug("SQL: ignoring create trusted procedural language ...");
	} elsif ($$sql =~ s/^create\s+view\s+$body_pattern;//si) {
		debug("SQL: ignoring create view ...");
	} elsif ($$sql =~ s/^create\s+trigger\s+$body_pattern;//si) {
		debug("SQL: ignoring create trigger ...");
	} elsif ($$sql =~ s/^alter\s+table\s+$body_pattern;//si) {
		debug("SQL: ignoring alter table ...");
	} elsif ($$sql =~ s/^alter\s+table\s+$body_pattern;//si) {
		debug("SQL: ignoring alter table ...");
	} elsif ($$sql =~ s/^create\s+constraint\s+$body_pattern;//si) {
		debug("SQL: ignoring create constraint ...");
	} else {
		return 0;
	}
	return 1;
}

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

1
