Skip Menu |
 

This queue is for tickets about the DBD-SQLite CPAN distribution.

Report information
The Basics
Id: 81536
Status: resolved
Priority: 0/
Queue: DBD-SQLite

People
Owner: ishigaki [...] cpan.org
Requestors: VLYON [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 1.38_01
Fixed in: (no value)



Subject: primary_key_info returns the wrong KEY_SEQ
Download (untitled) / with headers
text/plain 553b
primary_key_info() returns primary keys in the sequence the columns have in the table rather than the sequence they have in the PRIMARY_KEY index! This is a critical bug. perl -MDBI -MData::Dumper -wle 'my $dbh = DBI->connect("DBI:SQLite:"); $dbh->do("CREATE TABLE t (id INT, type TEXT, PRIMARY KEY (type, id))"); my $pk = $dbh->primary_key_info(undef, undef, "t")- Show quoted text
>fetchall_arrayref({}); print Dumper($pk)'
The key sequence returned is: id, type But should have been: type, id I'll look into a patch for this, including tests. Regards, Vernon
Download (untitled) / with headers
text/plain 681b
Thanks for your report. Fixed in the trunk. On Thu Nov 29 21:04:10 2012, VLYON wrote: Show quoted text
> primary_key_info() returns primary keys in the sequence the columns
have Show quoted text
> in the table rather than the sequence they have in the PRIMARY_KEY > index! > > This is a critical bug. > > perl -MDBI -MData::Dumper -wle 'my $dbh = DBI->connect
("DBI:SQLite:"); Show quoted text
> $dbh->do("CREATE TABLE t (id INT, type TEXT, PRIMARY KEY (type,
id))"); Show quoted text
> my $pk = $dbh->primary_key_info(undef, undef, "t")-
> >fetchall_arrayref({}); print Dumper($pk)'
> > The key sequence returned is: id, type > But should have been: type, id > > I'll look into a patch for this, including tests. > > Regards, > Vernon
Download (untitled) / with headers
text/plain 476b
This is almost what I was working on, but it still has a few problems. If there is another index in a table covering the same columns as the primary key, they may have a different order, which could be returned instead of the primary key's order. (Very unlikely, but ...) CREATE TABLE t (a INT, b TEXT, UNIQUE (a, b), PRIMARY KEY (b, a)); Also, the primary key sequence when listing more than 1 table is wrong. It keeps increasing instead of starting at 1 for each table.
Download (untitled) / with headers
text/plain 1.6k
This patch shows the issue in a test: Index: t/42_primary_key_info.t =================================================================== --- t/42_primary_key_info.t (revision 15675) +++ t/42_primary_key_info.t (working copy) @@ -10,7 +10,7 @@ use Test::More; use Test::NoWarnings; -plan tests => (5 * 5) + (3 * 6 + 1) + 1; +plan tests => (5 * 5) + (3 * 7 + 1) + 1; for my $quote ('', qw/' " ` []/) { my ($begin_quote, $end_quote) = (substr($quote, 0, 1), substr($quote, -1, 1)); @@ -33,6 +33,8 @@ $dbh->do("attach database ':memory:' as remote"); $dbh->do("create table remote.bar (name text, primary key(name))"); $dbh->do("create temporary table baz (tmp primary key)"); + $dbh->do("attach database ':memory:' as multi"); + $dbh->do("create table multi.keys (a text, b integer, unique(a, b), primary key(b, a))"); { my $sth = $dbh->primary_key_info(undef, undef, 'foo'); @@ -87,4 +89,14 @@ is $pk_info[0]{TABLE_SCHEM} => 'temp', "scheme is correct"; is $pk_info[0]{COLUMN_NAME} => 'tmp', "pk name is correct"; } + + { + my $sth = $dbh->primary_key_info(undef, 'multi', 'keys'); + my @pk_info; + while(my $row = $sth->fetchrow_hashref) { push @pk_info, $row }; + is @pk_info => 2, "found 2 pks in an attached table"; + my @pk = map $_->{COLUMN_NAME}, sort {$a->{KEY_SEQ} <=> $b-> {KEY_SEQ}} @pk_info; + is join(' ', sort @pk) => 'a b', 'pks are correct'; + is join(' ', @pk) => 'b a', 'pk order is correct'; + } } \ No newline at end of file
RT-Send-CC: ishigaki [...] cpan.org
Download (untitled) / with headers
text/plain 433b
I've worked on a fix for this, but you're not gonna like it, :) Previously primary_key_info() used a very quick regex to find the primary keys in the CREATE TABLE sql, which did not handle quoted identifiers correctly! Since there is no reliable way to find the primary key sequence without parsing the sql, I've add a patch that parses the identifiers correctly. But, it thankfully only does this when there are multiple keys.
Subject: patch.txt
Download patch.txt
text/plain 3.2k
Index: lib/DBD/SQLite.pm =================================================================== --- lib/DBD/SQLite.pm (revision 15676) +++ lib/DBD/SQLite.pm (working copy) @@ -392,7 +392,7 @@ ($dbname eq 'temp') ? 'sqlite_temp_master' : $quoted_dbname.'.sqlite_master'; - my $sth = $dbh->prepare("SELECT name FROM $master_table WHERE type = ?"); + my $sth = $dbh->prepare("SELECT name, sql FROM $master_table WHERE type = ?"); $sth->execute("table"); while(my $row = $sth->fetchrow_hashref) { my $tbname = $row->{name}; @@ -403,40 +403,33 @@ $t_sth->execute; my @pk; while(my $col = $t_sth->fetchrow_hashref) { - next unless $col->{pk}; - push @pk, $col->{name}; + push @pk, $col->{name} if $col->{pk}; } # 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', - }; - } + if (@pk > 1 and $row->{sql} =~ /\bPRIMARY\s+KEY\s*\(((?:\s*((["'`])(?:\3\3|(?!\3).)+?\3(?!\3)|[a-z_][a-z0-9_]*?|\[[^\]]+\])\s*,\s*)+((["'`])(?:\5\5|(?!\5).)+?\5(?!\5)|[a-z_][a-z0-9_]*?|\[[^\]]+\]))\s*\)/si) { + my $pk_sql = $1; + @pk = (); + while($pk_sql =~ /((["'`])(?:\2\2|(?!\2).)+?\2(?!\2)|[a-z_][a-z0-9_]*?|\[[^\]]+\])(?:\s*,\s*|$)/sig) { + my($col, $quote) = ($1, $2); + if (defined $quote) { + $col = substr $col, 1, -1; + $col =~ s/$quote$quote/$quote/g; } + push @pk, $col; } } - else { + + my $key_seq = 0; + foreach my $pk_field (@pk) { push @pk_info, { TABLE_SCHEM => $dbname, TABLE_NAME => $tbname, - COLUMN_NAME => $pk[0], - KEY_SEQ => scalar @pk_info + 1, + COLUMN_NAME => $pk_field, + KEY_SEQ => ++$key_seq, PK_NAME => 'PRIMARY KEY', }; }
RT-Send-CC: ishigaki [...] cpan.org
Download (untitled) / with headers
text/plain 125b
Hi Kenichi, I've created a better patch. This one contains a bit better spacing to be clearer and patches the correct test.
Subject: patch2.txt
Download patch2.txt
text/plain 5.3k
Index: t/rt_81536_multi_column_primary_key_info.t =================================================================== --- t/rt_81536_multi_column_primary_key_info.t (revision 15676) +++ t/rt_81536_multi_column_primary_key_info.t (working copy) @@ -10,7 +10,7 @@ use Test::More; use Test::NoWarnings; -plan tests => 10 + 1; +plan tests => 15 + 1; # single column integer primary key { @@ -44,7 +44,23 @@ 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 => 2, "found 2 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"; } + +# multi-column primary key with quotes +{ + my $dbh = connect_ok(); + $dbh->do('create table foo (a, b, "c""d", unique(a, b, "c""d"), primary key( "c""d", [b], `a` ))'); + + 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 => 3, "found 3 pks"; + my @pk = map $_->{COLUMN_NAME}, @pk_info; + is join(' ', sort @pk) => 'a b c"d', 'all pks are correct'; + is join(' ', @pk) => 'c"d b a', 'pk order is correct'; + @pk = map $_->{COLUMN_NAME}, sort {$a->{KEY_SEQ} <=> $b->{KEY_SEQ}} @pk_info; + is join(' ', @pk) => 'c"d b a', 'pk KEY_SEQ is correct'; +} Index: lib/DBD/SQLite.pm =================================================================== --- lib/DBD/SQLite.pm (revision 15676) +++ lib/DBD/SQLite.pm (working copy) @@ -392,7 +392,7 @@ ($dbname eq 'temp') ? 'sqlite_temp_master' : $quoted_dbname.'.sqlite_master'; - my $sth = $dbh->prepare("SELECT name FROM $master_table WHERE type = ?"); + my $sth = $dbh->prepare("SELECT name, sql FROM $master_table WHERE type = ?"); $sth->execute("table"); while(my $row = $sth->fetchrow_hashref) { my $tbname = $row->{name}; @@ -403,40 +403,60 @@ $t_sth->execute; my @pk; while(my $col = $t_sth->fetchrow_hashref) { - next unless $col->{pk}; - push @pk, $col->{name}; + push @pk, $col->{name} if $col->{pk}; } # 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', - }; - } + if (@pk > 1 and $row->{sql} =~ /\bPRIMARY\s+KEY\s*\(\s* + ( + (?: + ( + [a-z_][a-z0-9_]* + | (["'`])(?:\3\3|(?!\3).)+?\3(?!\3) + | \[[^\]]+\] + ) + \s*,\s* + )+ + ( + [a-z_][a-z0-9_]* + | (["'`])(?:\5\5|(?!\5).)+?\5(?!\5) + | \[[^\]]+\] + ) + ) + \s*\)/six) { + my $pk_sql = $1; + @pk = (); + while($pk_sql =~ / + ( + [a-z_][a-z0-9_]* + | (["'`])(?:\2\2|(?!\2).)+?\2(?!\2) + | \[([^\]]+)\] + ) + (?:\s*,\s*|$) + /sixg) { + my($col, $quote, $brack) = ($1, $2, $3); + if ( defined $quote ) { + # Dequote "'` + $col = substr $col, 1, -1; + $col =~ s/$quote$quote/$quote/g; + } elsif ( defined $brack ) { + # Dequote [] + $col = $brack; } + push @pk, $col; } } - else { + + my $key_seq = 0; + foreach my $pk_field (@pk) { push @pk_info, { TABLE_SCHEM => $dbname, TABLE_NAME => $tbname, - COLUMN_NAME => $pk[0], - KEY_SEQ => scalar @pk_info + 1, + COLUMN_NAME => $pk_field, + KEY_SEQ => ++$key_seq, PK_NAME => 'PRIMARY KEY', }; }
Download (untitled) / with headers
text/plain 304b
It's completely acceptable with a test that describes the issue properly :) Thanks for your patches. Applied to the trunk. On Fri Nov 30 08:39:26 2012, VLYON wrote: Show quoted text
> Hi Kenichi, > > I've created a better patch. > This one contains a bit better spacing to be clearer and patches the > correct test.
Download (untitled) / with headers
text/plain 419b
Closed as DBD::SQLite 1.38_02 was out. Thanks. On Fri Nov 30 11:37:38 2012, ISHIGAKI wrote: Show quoted text
> It's completely acceptable with a test that describes the issue properly > :) Thanks for your patches. Applied to the trunk. > > On Fri Nov 30 08:39:26 2012, VLYON wrote:
> > Hi Kenichi, > > > > I've created a better patch. > > This one contains a bit better spacing to be clearer and patches the > > correct test.
>


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.