simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00
Code Issues Releases Wiki Activity

Fixed $sth->primary_key_info according to DBI spec

Browse source
This commit is contained in:
Vernon Lyon 2009-09-29 17:15:59 +00:00
parent bcb95ed536
commit 0c5dbbf467
3 changed files with 50 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Changes
View file

@ -13,6 +13,8 @@ Changes for Perl extension DBD-SQLite
the spec in DBI and added support for attached databases. (VLYON)
- Added documentation and an 'Escape' attribute for $sth->table_info.
(VLYON)
- Fixed $sth->primary_key_info to work according to the spec in DBI
and changed the tests in t/27_metadata.t to reflect this. (VLYON)
1.26_03 Wed 12 Aug 2009
- Updated to SQLite 3.6.17 (ISHIGAKI)

9
lib/DBD/SQLite.pm
View file

@ -318,12 +318,17 @@ END_SQL
}
sub primary_key_info {
my($dbh, $catalog, $schema, $table) = @_;
my ($dbh, $catalog, $schema, $table) = @_;
# Escape the schema and table name
$schema =~ s/([\\_%])/\\$1/g if defined $schema;
my $escaped = $table;
$escaped =~ s/([\\_%])/\\$1/g;
my $sth_tables = $dbh->table_info($catalog, $schema, $escaped, undef, {Escape => '\\'});
# This is a hack but much simpler than using pragma index_list etc
# also the pragma doesn't list 'INTEGER PRIMARY KEY' autoinc PKs!
my @pk_info;
my $sth_tables = $dbh->table_info($catalog, $schema, $table, undef);
while ( my $row = $sth_tables->fetchrow_hashref ) {
my $sql = $row->{sqlite_sql} or next;
next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si;

83
t/27_metadata.t
View file

@ -6,55 +6,54 @@ BEGIN {
$^W = 1;
}
use Test::More tests => 27;
use Test::More tests => 21;
use t::lib::Test;
my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { });
ok($dbh);
$dbh->{PrintError} = 0;
$dbh->do("drop table meta$_") for 1..5;
$dbh->{PrintError} = 1;
ok $dbh->do("create table meta1 (f1 varchar(2) PRIMARY KEY, f2 char(1))");
ok $dbh->do("create table meta2 (f1 varchar(2), f2 char(1), PRIMARY KEY (f1))");
ok $dbh->do("create table meta3 (f2 char(1), f1 varchar(2) PRIMARY KEY)");
# 1-4. Connect & create tables
my $dbh = connect_ok(dbfile => 'foo');
ok $dbh->do('CREATE TABLE meta1 (f1 INTEGER PRIMARY KEY, f2 CHAR(1))'), 'Create table meta1';
ok $dbh->do('CREATE TABLE meta2 (f1 VARCHAR(2), f2 CHAR(1), PRIMARY KEY (f1))'), 'Create table meta2';
ok $dbh->do('CREATE TABLE meta3 (f2 CHAR(1), f1 VARCHAR(2) PRIMARY KEY)'), 'Create table meta3';
$dbh->trace(0);
$DBI::neat_maxlen = 4000;
my $sth = $dbh->primary_key_info(undef, undef, '%');
ok $sth;
my $pki = $sth->fetchall_hashref('TABLE_NAME');
ok $pki;
# 5-10. Get & check primary_key_info
for my $table (qw(meta1 meta2 meta3)) {
ok my $sth = $dbh->primary_key_info(undef, undef, $table), "Get primary_key_info for $table";
my $pki = $sth->fetchall_arrayref([3,4]);
#use Data::Dumper; print Dumper($pki);
is_deeply $pki, [['f1', 1]], "Correct primary_key_info returned for $table";
}
# 11-14. Multi column primary key
ok $dbh->do('CREATE TABLE meta4 (f1 VARCHAR(2), f2 CHAR(1), PRIMARY KEY (f1,f2))'), 'Create table meta4';
ok my $sth = $dbh->primary_key_info(undef, undef, 'meta4'), 'Get primary_key_info for meta4';
my $pki = $sth->fetchall_arrayref({COLUMN_NAME => 1, KEY_SEQ => 1});
#use Data::Dumper; print Dumper($pki);
ok keys %$pki == 3;
ok $_->{COLUMN_NAME} eq 'f1' for values %$pki;
is @$pki, 2, 'Primary key contains 2 columns';
is_deeply $pki, [{COLUMN_NAME => 'f1', KEY_SEQ => 1},{COLUMN_NAME => 'f2', KEY_SEQ => 2}],
'Correct primary_key_info returned for meta4';
ok $dbh->do("create table meta4 (f1 varchar(2), f2 char(1), PRIMARY KEY (f1,f2))");
$sth = $dbh->primary_key_info(undef, undef, 'meta4');
ok $sth;
$pki = $sth->fetchall_hashref('COLUMN_NAME');
ok $pki;
#use Data::Dumper; print Dumper($pki);
ok keys %$pki == 2;
ok $pki->{f1}->{KEY_SEQ} == 1;
ok $pki->{f2}->{KEY_SEQ} == 2;
# 15,16. Test primary_key
ok my @pk = $dbh->primary_key(undef, undef, 'meta4'), 'Get primary_key for meta4';
is_deeply \@pk, [qw(f1 f2)], 'Correct primary_key returned for meta4';
my @pk = $dbh->primary_key(undef, undef, 'meta4');
ok @pk == 2;
ok "@pk" eq "f1 f2";
ok $dbh->do("insert into meta4 values ('xyz', 'b')");
$sth = $dbh->prepare("select * from meta4");
ok $sth;
ok $sth->execute();
ok $sth->fetch();
# 17-21. I'm not sure what this is testing
$dbh->do("INSERT INTO meta4 VALUES ('xyz', 'b')");
$sth = $dbh->prepare('SELECT * FROM meta4');
$sth->execute;
$sth->fetch;
my $types = $sth->{TYPE};
my $names = $sth->{NAME};
# warn("Types: @$types, Names: @$names\n");
ok( @$types == @$names );
print "# Types: @$types\n";
print "# Names: @$names\n";
ok($types->[0] eq 'varchar(2)');
ok($types->[1] eq 'char(1)');
diag "Types: @$types\nNames: @$names";
is scalar @$types, scalar @$names, '$sth->{TYPE} array is same length as $sth->{NAME} array';
# FIXME: This is wrong! $sth->{TYPE} should return an array of integers see: rt #46873
TODO: {
local $TODO = '$sth->{TYPE} should return an array of integers.';
isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string';
isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string';
like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer';
like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer';
}
ok $dbh->do("create table meta5 ( f1 integer PRIMARY KEY )");
@pk = $dbh->primary_key(undef, undef, 'meta5');
ok($pk[0] eq 'f1');