| Subject: | [patch] support primary_key_info(), primary_key() |
The attached patch implements DBI-specified method primary_key_info()
(and, by default inheritance, primary_key()) for DBD::InterBase 0.48.
It also adds test cases and POD updates.
| Subject: | dbd-interbase-0_48-primary_key_info.patch |
diff --git a/InterBase.pm b/InterBase.pm
index f25bc97..5637292 100644
--- a/InterBase.pm
+++ b/InterBase.pm
@@ -161,6 +161,35 @@ sub prepare
$sth;
}
+sub primary_key_info
+{
+ my ($dbh, $cat, $schem, $tbl) = @_;
+
+ my $sth = $dbh->prepare(<<'__eosql');
+ SELECT CAST(NULL AS CHAR(1)) AS TABLE_CAT,
+ CAST(NULL AS CHAR(1)) AS TABLE_SCHEM,
+ rc.rdb$relation_name AS TABLE_NAME,
+ ix.rdb$field_name AS COLUMN_NAME,
+ ix.rdb$field_position + 1 AS KEY_SEQ,
+ rc.rdb$index_name AS PK_NAME
+ FROM rdb$relation_constraints rc
+ INNER JOIN
+ rdb$index_segments ix
+ ON rc.rdb$index_name = ix.rdb$index_name
+ WHERE rc.rdb$relation_name = ?
+ AND
+ rc.rdb$constraint_type = 'PRIMARY KEY'
+ ORDER BY 1, 2, 3, 5
+__eosql
+
+ if ($sth) {
+ $sth->{ChopBlanks} = 1;
+ return unless $sth->execute($tbl);
+ }
+
+ $sth;
+}
+
# from Michael Arnett <marnett@samc.com> :
sub tables
{
@@ -567,6 +596,13 @@ This driver supports the ping-method, which can be used to check the
validity of a database-handle. This is especially required by
C<Apache::DBI>.
+=item B<primary_key_info>
+
+ $sth = $dbh->primary_key_info('', '', $table_name);
+ @pks = $dbh->primary_key('', '', $table_name);
+
+Supported by the driver as proposed by DBI.
+
=item B<table_info>
$sth = $dbh->table_info;
diff --git a/MANIFEST b/MANIFEST
index a45673c..ff2a76f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -44,4 +44,5 @@ t/ak-dbd.t
t/dbdadmin.t
t/lib.pl
t/skeleton.test
+t/dbi-primary_key_info.t
META.yml Module meta-data (added by MakeMaker)
diff --git a/t/dbi-primary_key_info.t b/t/dbi-primary_key_info.t
new file mode 100644
index 0000000..4f7bd86
--- /dev/null
+++ b/t/dbi-primary_key_info.t
@@ -0,0 +1,58 @@
+#!perl -w
+# vim: ft=perl
+
+use Test::More;
+use DBI;
+use strict;
+use lib 't', '.';
+require 'lib.pl';
+$|= 1;
+
+use vars qw($table $test_dsn $test_user $test_password);
+my $dbh;
+eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
+ { RaiseError => 1, PrintError => 0, AutoCommit => 0 });};
+
+if ($@) {
+ plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+}
+plan tests => 12;
+
+ok(defined $dbh, "Connected to database for key info tests");
+
+$table = FindNewTable($dbh);
+
+ok($dbh->do(<<__eosql), "CREATE TABLE $table");
+ CREATE TABLE $table(
+ Z INTEGER NOT NULL,
+ Y CHAR(10) NOT NULL,
+ X INTEGER NOT NULL,
+ K CHAR(3) NOT NULL,
+ PRIMARY KEY(Z, Y, X),
+ UNIQUE(K)
+ )
+__eosql
+
+my $sth = $dbh->primary_key_info(undef, undef, $table);
+ok($sth, "Got primary key info");
+is_deeply($sth->{NAME_uc},
+ [qw|TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME|]);
+
+my $key_info = $sth->fetch;
+is_deeply([@$key_info[0..4]], [ undef, undef, $table, 'Z', '1' ]);
+ok($key_info->[5] =~ /\S/, "PK_NAME is set"); # Something like RBD$PRIMARY123
+
+$key_info = $sth->fetch;
+is_deeply([@$key_info[0..4]], [ undef, undef, $table, 'Y', '2' ]);
+ok($key_info->[5] =~ /\S/, "PK_NAME is set");
+
+$key_info = $sth->fetch;
+is_deeply([@$key_info[0..4]], [ undef, undef, $table, 'X', '3' ]);
+ok($key_info->[5] =~ /\S/, "PK_NAME is set");
+
+is_deeply([ $dbh->primary_key(undef, undef, $table) ], [qw|Z Y X|],
+ "Check primary_key results");
+
+ok($dbh->do("DROP TABLE $table"), "Dropped table");
+
+$dbh->disconnect();