From 0cabcee217e2b510e673eb3b081ee5cda821ddb4 Mon Sep 17 00:00:00 2001
From: Kenichi Ishigaki <ishigaki@cpan.org>
Date: Fri, 30 Nov 2012 02:34:14 +0000
Subject: [PATCH] applied a patch from VLYON on #81536

---
 lib/DBD/SQLite.pm                          | 66 ++++++++++++++--------
 t/rt_81536_multi_column_primary_key_info.t | 20 ++++++-
 2 files changed, 61 insertions(+), 25 deletions(-)

diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm
index 2d13c9b..7382e57 100644
--- a/lib/DBD/SQLite.pm
+++ b/lib/DBD/SQLite.pm
@@ -392,7 +392,7 @@ sub primary_key_info {
             ($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 @@ sub primary_key_info {
             $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',
                 };
             }
diff --git a/t/rt_81536_multi_column_primary_key_info.t b/t/rt_81536_multi_column_primary_key_info.t
index 43c97c4..3af765b 100644
--- a/t/rt_81536_multi_column_primary_key_info.t
+++ b/t/rt_81536_multi_column_primary_key_info.t
@@ -10,7 +10,7 @@ use t::lib::Test qw/connect_ok/;
 use Test::More;
 use Test::NoWarnings;
 
-plan tests => 10 + 1;
+plan tests => 15 + 1;
 
 # single column integer primary key
 {
@@ -44,7 +44,23 @@ plan tests => 10 + 1;
 	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';
+}