use strict;

use DBI;
use IO::File;

package Schema;

sub dump_command {
	my ($this, $host, $dbname, $user, $pass, $table) = @_;

	message('You must type the password interactively') if $pass;
	$user = ($user || $pass) ? "-U $user" : "";
	$pass = $pass ? "-W" : "";
	# not sure if old versions of pg_dump will work with this...
	$host = $host ? "-h $host" : '';
	return defined $table ? qq{pg_dump $host $user -s -t "$table" "$dbname"} :
		qq{pg_dump $host $user -s "$dbname"};
}

sub _filter_dump {
	my ($out, $file) = @_;
	my $in_grant_section;
	while (my $line = <$file>) {
		# this dodgily assumes that the SQL statements are on distinct lines...
		next if $line =~ /^--/;
		next if $line =~ /^\\connect/;
		next if $line =~ /^REVOKE/ and ! $in_grant_section;
		next if $line =~ /^SELECT nextval/;
		next if $line =~ /^SET /;
		next if $line =~ /^COMMENT /;
		next if $line =~ /^GRANT .*? ON SCHEMA /;
		$in_grant_section = $line =~ /^(REVOKE|GRANT)/;

		# fix problems with old pg_dump
		while ($line =~ s/\)\s*CONSTRAINT\s+(\S+)\s+(.*?)(,|(?=;))/, CONSTRAINT $1 $2)/) {}
	        while ($line =~ s/CHECK ([^(][^,)]+)([,)])/CHECK ($1)$2/) {}

		$$out .= $line;
	}
	close $file;
}

sub data_src_database_word {
	return "dbname";
}

sub create_database {
	my ($this, $database, $data_src, $host, $user, $pass) = @_;

	message('You must type the password interactively') if $pass;
	$user = ($user || $pass) ? "-U $user" : "";
	$pass = $pass ? "-W" : "";
	$host = $host ? "-h $host" : "";
	return ! system(qq{createdb $host $user "$database"});
}

sub drop_database {
	my ($this, $database, $data_src, $host, $user, $pass) = @_;

	message('You must type the password interactively') if $pass;
	$user = ($user || $pass) ? "-U $user" : "";
	$pass = $pass ? "-W" : "";
	$host = $host ? "-h $host" : "";
	if (`which dropdb`) {
		return ! system(qq{dropdb $host $user "$database"});
	} else {
		return ! system(qq{destroydb $host $user "$database"});
	}
}

package Field;

my %abstract_types = (
		 'character' => 'char',
		 'character varying' => 'varchar',
		 'double precision' => 'double',
		 'float8' => 'float',
		 'float8' => 'float',
		 'timespan' => 'interval',
		 'timestamp with time zone' => 'datetimetz',
		 'timestamp without time zone' => 'datetime',
		 'time with time zone' => 'timetz',
		 'time without time zone' => 'time',
		 'boolean' => 'bool',
		 'numeric' => 'decimal',
		 'bytea' => 'blob',
);

my %real_types = map { $abstract_types{$_}, $_ } keys %abstract_types;

$real_types{"char binary"} = 'bytea';
$real_types{"varchar binary"} = 'bytea';

# support for postgres 6 type name
# delete $real_types{datetime}; $real_types{timestamp} = 'datetime';
#delete $real_types{timestamp}; $real_types{datetime} = 'timestamp';

sub _abstract {
	my ($this, $type, $size) = @_;
#	$size = 1 if $type eq 'character' && ! defined $size;
	if ($type eq "int4" || $type eq "integer") {
		return "int";
	}
	if ($type eq "int2" || $type eq "smallint") {
		return "int", 2;
	}
	if ($type eq "int8" || $type eq "bigint") {
		return "int", 8;
	}
	if ($type eq "serial") {
		$this->autoincrement(1);
		return "int";
	}
	if ($type eq "bigserial") {
		$this->autoincrement(1);
		return "int", 8;
	}
	my $abstract_type = $abstract_types{$type};
	return $abstract_type, $size if $abstract_type;
	return;
}

my $warned_enum = 0;
my $warned_timestamp = 0;
sub _realize {
	my ($this, $type, $size) = @_;
	if ($this->autoincrement) {
		$this->autoincrement(undef);
		if ($size && $size > 4) {
			return "bigserial";
		} else {
			return "serial";
		}
# design problems prevent doing this the right way, i.e. actually creating a sequence in the real schema.
#   1. we need to have separate access to the "real" and "abstract" schemas in these mapping functions
#   2. we need to be able to access "parent" nodes
#     (will have to pass a list of "ancestors" as an argument;
#     if we reference the parent from each child, garbage collection won't work.)
#		my $seq_name = "${tablename}_${colname}_$seq";
#		$this->default(qq{nextval("$seq_name")});
#
# actually, PostgreSQL's serial type dumps as a serial type, it does the right
# thing, thanks PostgreSQL!
	}
	if ($type eq 'int') {
		if (defined $size) {
			if ($size <= 2) {
				return "smallint";
			} elsif ($size <= 4) {
				return "integer";
			}
			return "bigint";
		} else {
			return "integer";
		}
	}
#	undef $size if $type eq 'char' && $size == 1;
	my $real_type = $real_types{$type};
	return $real_type, $size if $real_type;
	if ($type eq 'enum') {
		comment(qq{PostgreSQL doesn't support "enum" types.
  I will use a varchar instead.}) unless $warned_enum ++;
  		$this->range(undef);
		return "character varying";
	}
	if ($type eq 'timestamp') {
		comment(qq{PostgreSQL doesn't support automatic timestamps.
  I will use a non-automatic timestamp instead.}) unless $warned_timestamp ++;
  		return "timestamp without time zone";
	}
	return;
}

package Table;

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

package FieldRef;

sub realize {
        my ($this) = @_;
        $this->size(undef) if $this->size;
}

package Index;

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

1
