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

resolved #81536

Browse source
This commit is contained in:
Kenichi Ishigaki 2012-11-29 13:57:06 +00:00
parent dcfcf4bb04
commit 8fae2f1dee
2 changed files with 80 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
lib/DBD/SQLite.pm
View file

@ -401,12 +401,41 @@ sub primary_key_info {
my $quoted_tbname = $dbh->quote_identifier($tbname); my $quoted_tbname = $dbh->quote_identifier($tbname);
my $t_sth = $dbh->prepare("PRAGMA $quoted_dbname.table_info($quoted_tbname)"); my $t_sth = $dbh->prepare("PRAGMA $quoted_dbname.table_info($quoted_tbname)");
$t_sth->execute; $t_sth->execute;
my @pk;
while(my $col = $t_sth->fetchrow_hashref) { while(my $col = $t_sth->fetchrow_hashref) {
next unless $col->{pk}; next unless $col->{pk};
push @pk, $col->{name};
}
# If there're multiple primary key columns, we need to
# find their order from one of the auto-generated unique
# indices (note that single column integer primary key
# doesn't create an index).
if (@pk > 1) {
my $indices = $dbh->selectall_arrayref("PRAGMA $quoted_dbname.index_list($quoted_tbname)", {Slice => +{}});
for my $index (@$indices) {
next unless $index->{unique};
my $quoted_idxname = $dbh->quote_identifier($index->{name});
my $cols = $dbh->selectall_arrayref("PRAGMA $quoted_dbname.index_info($quoted_idxname)", {Slice => +{}});
my %seen;
if (@pk == grep { !$seen{$_}++ } (@pk, map { $_->{name} } @$cols)) {
for (@$cols) {
push @pk_info, {
TABLE_SCHEM => $dbname,
TABLE_NAME => $tbname,
COLUMN_NAME => $_->{name},
KEY_SEQ => scalar @pk_info + 1,
PK_NAME => 'PRIMARY KEY',
};
}
}
}
}
else {
push @pk_info, { push @pk_info, {
TABLE_SCHEM => $dbname, TABLE_SCHEM => $dbname,
TABLE_NAME => $tbname, TABLE_NAME => $tbname,
COLUMN_NAME => $col->{name}, COLUMN_NAME => $pk[0],
KEY_SEQ => scalar @pk_info + 1, KEY_SEQ => scalar @pk_info + 1,
PK_NAME => 'PRIMARY KEY', PK_NAME => 'PRIMARY KEY',
}; };

50
t/rt_81536_multi_column_primary_key_info.t Normal file
View file

@ -0,0 +1,50 @@
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
use Test::NoWarnings;
plan tests => 10 + 1;
# single column integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id integer primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# single column not-integer primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id text primary key, type text)");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 1, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'id', "first pk name is id";
}
# multi-column primary key
{
my $dbh = connect_ok();
$dbh->do("create table foo (id id, type text, primary key(type, id))");
my $sth = $dbh->primary_key_info(undef, undef, 'foo');
my @pk_info;
while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row };
is @pk_info => 2, "found 1 pks";
is $pk_info[0]{COLUMN_NAME} => 'type', "first pk name is type";
is $pk_info[1]{COLUMN_NAME} => 'id', "second pk name is id";
}