package Pg::Scheme;

use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;


use Exporter   ();
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

$VERSION	= 1.00;
@ISA		= qw(Exporter);
@EXPORT		= qw(&func1 &func2 &func4);
%EXPORT_TAGS	= ( );     # eg: TAG => [ qw!name1 name2! ],
               
@EXPORT_OK	= qw(
				&list_tables
				&get_table_oid
				&explain
				&pg_attribute
				&cols
				&cols_notnull
				&cols_null
				&cols_pk
				&cols_notpk
		);

my $debug;

sub new {
	my ($class, %args) = @_;
	my $self = {};
	bless($self, $class);
	$debug = $args{'DEBUG'};
	$self->{dbh} = $args{'dbh'} || croak "new needs to be called with 'dbh' which is handle to opened database";
	@{$self->{tables}} = ();
	$self ? return $self : return undef;
	# XXX begin transaction?
}

sub list_tables {
	my $self = shift;
	my $tables = shift;

	my @tables;

	if ($tables) {
		@tables = split(/,/,$tables);
	} else {
		# take all tables
		#$sql="select tablename from pg_tables where tablename not like 'pg_%' and tablename not like '_rserv_%'";
		# show tables (based on psql \dt)
		my $sql = "
		SELECT c.relname as table
		FROM pg_catalog.pg_class c
			LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
		WHERE c.relkind = 'r'
			AND n.nspname NOT IN ('pg_catalog', 'pg_toast')
			AND pg_catalog.pg_table_is_visible(c.oid)
			and c.relname not like '_rserv_%'
		";
		foreach my $table (@tables) {
			$sql .= " and c.relname like '$table' x";
		}
		my $sth = $self->{'dbh'}->prepare($sql) || croak "can't prepare '$sql': ".$self->{'dbh'}->errstr;
		$sth->execute() || croak "can't execute '$sql': ".$sth->errstr;
		while(my $row = $sth->fetchrow_hashref()) {
			push @tables,$row->{table};
		}
	}
	#@{$self->{'tables'}} = @tables;
	return @tables;
}

sub get_table_oid {
	my $self = shift;
	my $table = shift;

	# find table oid
	my $sql = "
	SELECT c.oid, n.nspname, c.relname
	FROM pg_catalog.pg_class c
	LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
	WHERE pg_catalog.pg_table_is_visible(c.oid)
	AND c.relname = '$table'
	ORDER BY 2, 3
	";

	my $sth = $self->{'dbh'}->prepare($sql);
	$sth->execute() || die;
	my $row = $sth->fetchrow_hashref();
	croak "Can't find OID of table '$table'\n" if (! $row);
	$sth->finish();

	return $row->{oid};
}

sub explain {
	my $self = shift;
	my $table = shift;

	# XXX if explained, return just results
	# return $self->{'explained'}->{$table}->{'pg_attribute'} if ($self->{'explained'}->{$table}->{'pg_attribute'});
	my @pg_attribute;

	my $oid = $self->get_table_oid($table);

	# get table description
	my $sql="
	SELECT a.attname,
	pg_catalog.format_type(a.atttypid, a.atttypmod) as format_type,
	a.attnotnull, a.atthasdef, a.attnum
	FROM pg_catalog.pg_attribute a
	WHERE a.attrelid = ? AND a.attnum > 0 AND NOT a.attisdropped
	ORDER BY a.attnum
	";

	# get default value
	my $sql_def="
	SELECT adsrc as def FROM pg_catalog.pg_attrdef
	WHERE adrelid = ? and adnum=?
	";

	my @cols;	# all columns (for insert)
	my @cols_null;	# columns compared by a=b or a is null and b is null
	my @cols_notnull;# columns compared by a=b

	my $sth = $self->{'dbh'}->prepare($sql);
	my $sth_def = $self->{'dbh'}->prepare($sql_def);
	$sth->execute($oid) || die;
	while(my $row = $sth->fetchrow_hashref()) {
		# attname | format_type | attnotnull | atthasdef | attnum
		push @cols,$row->{attname};

		if ($row->{attnotnull}) {
			push @cols_notnull,$row->{attname};
		} else {
			push @cols_null,$row->{attname};
		}

		if ($row->{atthasdef}) {
			$sth_def->execute($oid,$row->{attnum}) || die;
			my $row_def = $sth_def->fetchrow_hashref() || die "can't get attribute '",$row->{attname},"' default value!";
			$row->{default} = $row_def->{def};
		}

		push @pg_attribute, $row;
	}

	@{$self->{'explained'}->{$table}->{'pg_attribute'}} = @pg_attribute;
	@{$self->{'explained'}->{$table}->{'cols'}} = @cols;
	@{$self->{'explained'}->{$table}->{'cols_notnull'}} = @cols_notnull;
	@{$self->{'explained'}->{$table}->{'cols_null'}} = @cols_null;

	# all, just for safe keeping
	@{$self->{'explained'}->{$table}->{'cols_notpk'}} = @cols;

	# now, try to find primary key

	my @cols_pk;	# columns which are primary key
	my @cols_notpk;
	my %in_pk;

	$sql="
SELECT
	i.indexrelid as indexrelid, i.indrelid as indrelid,
	count(a.attname) as cols_in_pk
FROM
	pg_catalog.pg_class c,
	pg_catalog.pg_index i,
	pg_catalog.pg_attribute a
WHERE
	c.oid = i.indrelid
	and i.indisunique
	and c.relname = '$table'
	and a.attrelid = i.indexrelid
GROUP BY
	i.indexrelid, i.indrelid, c.relname, i.indisprimary, i.indisunique
ORDER BY
	cols_in_pk ASC, i.indisprimary DESC, i.indisunique DESC, c.relname DESC
";
	print STDERR "DEBUG: $sql\n" if ($debug);
	$sth = $self->{'dbh'}->prepare($sql);
	$sth->execute() || die;
	my $row = $sth->fetchrow_hashref();
	if ($row) {
		$sql="
		select a1.attname as attname from pg_attribute a1, pg_attribute a2 where a1.attrelid = ".$row->{indexrelid}." and a2.attrelid=".$row->{indrelid}." and a1.attname = a2.attname and a2.attnotnull";
		
		my $sth2 = $self->{'dbh'}->prepare($sql);
		print STDERR "DEBUG: $sql\n" if ($debug);
		$sth2->execute() || die;
		while (my $row2 = $sth2->fetchrow_hashref()) {
			push @cols_pk,$row2->{attname};
			$in_pk{$row2->{attname}}++;
		}
		
	}

	foreach my $col (@cols) {
		push @cols_notpk,$col if (! $in_pk{$col});
	}

	@{$self->{'explained'}->{$table}->{cols_pk}} = @cols_pk;
	@{$self->{'explained'}->{$table}->{cols_notpk}} = @cols_notpk;

	# find triggers

	my @triggers;

	$sql ="
SELECT t.tgname
FROM pg_catalog.pg_trigger t
WHERE t.tgrelid = ? and (not tgisconstraint  OR NOT EXISTS  (SELECT 1 FROM pg_catalog.pg_depend d JOIN
 pg_catalog.pg_constraint c ON (d.refclassid = c.tableoid AND d.refobjid = c.oid)    WHERE d.classid = t.tableoid AND d.objid =
  t.oid AND d.deptype = 'i' AND c.contype = 'f'))
  	";

	$sth = $self->{'dbh'}->prepare($sql);
	$sth->execute($oid) || die;
	while(my $row = $sth->fetchrow_hashref()) {
		push @triggers,$row;
	}

	@{$self->{'explained'}->{$table}->{'triggers'}} = @triggers;

	return @pg_attribute;
}

# return all rows in PostgreSQL format
# attname | format_type | attnotnull | atthasdef | attnum
#
# somewhat internal function, but still usefull if you want to
# do tweaking of columns your way
#
sub pg_attribute {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{pg_attribute};
}

# return columns in given table
sub cols {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{cols};
}

# return not null columns in given table
sub cols_notnull {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{cols_notnull};
}

# return columns which *can* be null in given table
sub cols_null {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{cols_null};
}

# return primary key columns
sub cols_pk {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{cols_pk};
}

# return columns not in primary key
sub cols_notpk {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{cols_notpk};
}

# get active triggers
sub get_activetriggers {
	my $self = shift;

	# find table oid
	my $sql = "
	SELECT tgname FROM pg_trigger
		WHERE tgname not like 'pg_%' and tgenabled IS TRUE
	";

	my $sth = $self->{'dbh'}->prepare($sql);
	$sth->execute() || die;

	my @triggers;

	while (my ($tr) = $sth->fetchrow_array()) {
		push @triggers,$tr;
	}
	$sth->finish();

	return @triggers;
}

# return triggers
sub triggers {
	my $self = shift;
	my $table = shift;

	if (! $self->{'explained'}->{$table}) {
		$self->explain($table);
	}

	return $self->{'explained'}->{$table}->{triggers};
}

1;