# TODO: think about how to represent RENAMING tables, etc.?

package Schema;

use strict;
use XML;

use Database;
use Message;
use POSIX;

use methods;

use members index => 'databases';

sub sql_create {
	my ($this) = @_;
	return $this->recurse;
}

sub sql_drop {
	my ($this) = @_;
	return $this->recurse;
}

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

	my @commands;

	push @commands, $old->database($_)->sql_drop for $diff->removed_databases;

	my $changed = $diff->changed_databases;
	while (my ($name, $_diff) = each %$changed) {
		push @commands, $old->database($name)->sql_alter($_diff, $new->database($name));
	}

	push @commands, $new->database($_)->sql_create for $diff->added_databases;

	my $renamed = $diff->renamed_databases;
	while (my ($old_name, $new_name) = each %$renamed) {
		push @commands, $old->database($old_name)->sql_rename($new_name);
	}

	return wantarray ? @commands : \@commands;
}

sub sql_parse {
	my ($this, $sql) = @_;
	$sql =~ s/`/"/g;
	$this = $this->new unless ref $this;
	while (1) {
		$$sql =~ s/^\s+//s;
		return if $$sql eq '';
		if ($$sql =~ s/^create\s+database\s+"?(\w+)"?\s*;//si) {
			debug("SQL: create database $1");
			my $name = $1;
			my $database = Database->new(name => $name);
			$this->add_database($database);
			if ($$sql =~ s/^\s*\\connect\s+"?$name"?\s*;//si) {
				$database->sql_parse($sql)
			}
		} else {
			last;
		}
	}
	return $this;
}

sub data_src {
	my ($this, $database, $data_src, $host) = @_;
	if ($host and $data_src !~ /host=/) {
		$data_src .= ($data_src =~ /:/) ? ";" : ":";
		$data_src .= "host=$host";
	}

	my $database_word = $this->data_src_database_word;

	$data_src =~ s/$database_word=(?:[^:;, ]+)/$database_word=$database/ or
		$data_src =~ s/(:|$)/:$database_word=$database$1/;
	return "dbi:$data_src";
}

sub execute {
	my ($this, $dbms, $data_src, $user, $pass, $host, $sql, $dir, $schema_file) = @_;

	my $problem = 0;

	unless ($dir) {
		fatal "you must specify a working directory";
	}
	
	mkdir $dir, 0700;

	unless (-d $dir) {
		fatal(qq{cannot create directory "$dir"});
	}

	my $eval_substitution = sub {
		my ($fn, @args) = split /\s+/, shift;
		if ($fn eq 'workdir') {
			return $dir;
		} elsif ($fn eq 'dump-options') {
			my $ret = "--quiet --dir $dir -d $dbms";
			$ret .= " -h $host" if defined $host;
			$ret .= " -u $user" if defined $user;
			$ret .= " -p $pass" if defined $pass;
			# TODO -P for port?
			return $ret;
		} elsif ($fn eq 'restore-options') {
			my $ret = "--quiet --log --dir $dir -d $dbms";
			$ret .= " --coerce-nulls --schema $schema_file" if defined $schema_file;
			$ret .= " -h $host" if defined $host;
			$ret .= " -u $user" if defined $user;
			$ret .= " -p $pass" if defined $pass;
			# TODO -P for port?
			return $ret;
		} else {
			fatal("unknown substitution %$fn ...%");
		}
	};

	my $dbh;
	my $db;

	while ($$sql =~ s/^\s*(.*?);(?:\n\n|\n?$)//s) {
		my $statement = $1;
		comment("$statement\n\n");

		if (($db) = $statement =~ /^create database ["`]?([^"`]+)["`]?$/) {
			$this->create_database($db, $data_src, $host, $user, $pass) || fatal(qq{cannot create database "$db"});
		} elsif (($db) = $statement =~ /^drop database ["`]?([^"`]+)["`]?$/) {
			$this->drop_database($db, $data_src, $host, $user, $pass) || fatal(qq{cannot drop database "$db"});
		} elsif (($db) = $statement =~ /^\\connect ["`]?([^"`]+)["`]?$/) { #"
			if ($dbh) { $dbh->disconnect }
			$dbh = DBI->connect($this->data_src($db, $data_src, $host), $user, $pass) or fatal(qq{cannot connect to database "$db"});
		} elsif (my ($command) = $statement =~ /^!(.*)/) {
			$command =~ s/%([^%]+)%/$eval_substitution->($1)/eg;
			my $exit = system $command; $exit /= 256;
			if ($exit == 1) {
				if ($dbh) { $dbh->disconnect };
				fatal($Message::quiet ? "command failed:\n$command\n" : "command failed.");
			}
			if ($exit) {
				error($Message::quiet ? "command had problems:\n$command\n" : "command had problems.");
				$problem = 1;
			}
		} else {
			# it's ordinary SQL!
			fatal(qq{cannot execute SQL because not connected to database}) unless $dbh;
			$dbh->do($statement) or fatal($Message::quiet ? "SQL failed:\n$statement\n" : "SQL failed.");
		}
	}
	
	if ($dbh) { $dbh->disconnect }

	return $problem;
}

sub dump {
	my ($this, $dbname, $user, $pass, $host) = splice @_, 0, 5;

	my $out = '';

	my $tmpfile = POSIX::tmpnam();

	if (defined $_[0]) {
		for my $table (sort @_) {
			my $dump_command = $this->dump_command($host, $dbname, $user, $pass, $table);
			comment "$dump_command";
			if (system("$dump_command > $tmpfile")) {
				return undef;
			}

			_filter_dump(\$out, IO::File->new($tmpfile));
		}
	} else {
		my $dump_command = $this->dump_command($host, $dbname, $user, $pass);
		comment "$dump_command";
		if (system("$dump_command > $tmpfile")) {
			return undef;
		}

		_filter_dump(\$out, IO::File->new($tmpfile));
	}

	$out = <<End . $out;
CREATE DATABASE "$dbname";
\\connect "$dbname";

End

	unlink $tmpfile;

	return $out;
}

sub _filter_dump {
	my ($out, $file) = @_;

	while (my $line = <$file>) {
		next if $line =~ m{^(#|--|/\*)};  # dodgy, assumes /* */ comments are single line and whole line.

		next if $line =~ m{^DROP TABLE IF EXISTS }i;          # mysql
		$line =~ s/\) ENGINE=\S+ DEFAULT CHARSET=\S+;/\);/i;  # mysql

		$line =~ s/ \\g$/;/;
		$line =~ s/`/"/g;  # mysql has taken to quoting things with backticks!
		                   # fix that here! this is perhaps a bit dodgy
		$$out .= $line;
	}
	close $file;
}

sub data_sources {
	my ($package, $driver) = @_;
	my @data_sources;
	eval {
		for my $db (DBI->data_sources($driver)) {
			next unless defined $db;
			$db =~ s/^dbi:$driver:((dbname|database)=)?//i;
			push @data_sources, $db;
		}
	};
	if ($@) {
		return undef;
	}
	return \@data_sources;
}

sub data_src_database_word {
	fatal("do not know how to connect to this DBMS");
}

sub create_database {
	fatal("create_database is not implemented for this DBMS");
}

sub drop_database {
	fatal("drop_database is not implemented for this DBMS");
}

sub dump_command {
	fatal("dump_command is not implemented for this DBMS");
}

1
