--- Pg/Scheme.pm	2003/08/12 18:45:06	1.1
+++ Pg/Scheme.pm	2003/10/31 11:19:47	1.5
@@ -16,6 +16,14 @@
                
 @EXPORT_OK	= qw(
 				&list_tables
+				&get_table_oid
+				&explain
+				&pg_attribute
+				&cols
+				&cols_notnull
+				&cols_null
+				&cols_pk
+				&cols_notpk
 		);
 
 my $debug;
@@ -88,31 +96,248 @@
 	return $row->{oid};
 }
 
-sub explain_table {
+sub explain {
 	my $self = shift;
 	my $table = shift;
 
-	my @explain;
+	# 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),
+	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 @explain, $row;
+		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 @explain;
+	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;