From 8fae2f1deeef48459c9e3854bf7409fa9b961e29 Mon Sep 17 00:00:00 2001
From: Kenichi Ishigaki <ishigaki@cpan.org>
Date: Thu, 29 Nov 2012 13:57:06 +0000
Subject: [PATCH] resolved #81536

---
 lib/DBD/SQLite.pm                          | 31 +++++++++++++-
 t/rt_81536_multi_column_primary_key_info.t | 50 ++++++++++++++++++++++
 2 files changed, 80 insertions(+), 1 deletion(-)
 create mode 100644 t/rt_81536_multi_column_primary_key_info.t

diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm
index 6a04afa..2d13c9b 100644
--- a/lib/DBD/SQLite.pm
+++ b/lib/DBD/SQLite.pm
@@ -401,12 +401,41 @@ sub primary_key_info {
             my $quoted_tbname = $dbh->quote_identifier($tbname);
             my $t_sth = $dbh->prepare("PRAGMA $quoted_dbname.table_info($quoted_tbname)");
             $t_sth->execute;
+            my @pk;
             while(my $col = $t_sth->fetchrow_hashref) {
                 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, {
                     TABLE_SCHEM => $dbname,
                     TABLE_NAME  => $tbname,
-                    COLUMN_NAME => $col->{name},
+                    COLUMN_NAME => $pk[0],
                     KEY_SEQ     => scalar @pk_info + 1,
                     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
new file mode 100644
index 0000000..43c97c4
--- /dev/null
+++ b/t/rt_81536_multi_column_primary_key_info.t
@@ -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";
+}