From 8228ee62d5c7a22d126cd19aca3894f9675fc40d Mon Sep 17 00:00:00 2001
From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 20 Feb 2013 11:49:45 +0100
Subject: [PATCH] Sanity-check columns added as primary key

---
 Changes                          |  2 ++
 lib/DBIx/Class/ResultSource.pm   | 19 +++++++++++++------
 t/resultsource/set_primary_key.t | 30 ++++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+), 6 deletions(-)
 create mode 100644 t/resultsource/set_primary_key.t

diff --git a/Changes b/Changes
index 3915b79f1..934f2f0bd 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,8 @@ Revision history for DBIx::Class
           inheritance.
         - Optimize the generated rowparsers even more - no user-visible
           changes.
+        - Emit a warning on incorrect use of nullable columns within a
+          primary key
 
 0.08240-TRIAL (EXPERIMENTAL BETA RELEASE) 2013-02-14 05:56 (UTC)
     * New Features / Changes
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index d33a74d58..3c9bda149 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -492,9 +492,9 @@ sub columns_info {
       }
       else {
         $self->throw_exception( sprintf (
-          "No such column '%s' on source %s",
+          "No such column '%s' on source '%s'",
           $_,
-          $self->source_name,
+          $self->source_name || $self->name || 'Unknown source...?',
         ));
       }
     }
@@ -588,11 +588,18 @@ for more info.
 
 sub set_primary_key {
   my ($self, @cols) = @_;
-  # check if primary key columns are valid columns
-  foreach my $col (@cols) {
-    $self->throw_exception("No such column $col on table " . $self->name)
-      unless $self->has_column($col);
+
+  my $colinfo = $self->columns_info(\@cols);
+  for my $col (@cols) {
+    carp_unique(sprintf (
+      "Primary key of source '%s' includes the column '%s' which has its "
+    . "'is_nullable' attribute set to true. This is a mistake and will cause "
+    . 'various Result-object operations to fail',
+      $self->source_name || $self->name || 'Unknown source...?',
+      $col,
+    )) if $colinfo->{$col}{is_nullable};
   }
+
   $self->_primaries(\@cols);
 
   $self->add_unique_constraint(primary => \@cols);
diff --git a/t/resultsource/set_primary_key.t b/t/resultsource/set_primary_key.t
new file mode 100644
index 000000000..b4b65f8b9
--- /dev/null
+++ b/t/resultsource/set_primary_key.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Test::Warn;
+
+use lib 't/lib';
+use DBICTest;
+
+throws_ok {
+  package Foo;
+  use base 'DBIx::Class::Core';
+  __PACKAGE__->table('foo');
+  __PACKAGE__->set_primary_key('bar')
+} qr/No such column 'bar' on source 'foo' /,
+'proper exception on non-existing column as PK';
+
+warnings_exist {
+  package Foo2;
+  use base 'DBIx::Class::Core';
+  __PACKAGE__->table('foo');
+  __PACKAGE__->add_columns(
+    foo => {},
+    bar => { is_nullable => 1 },
+  );
+  __PACKAGE__->set_primary_key(qw(foo bar))
+} qr/Primary key of source 'foo' includes the column 'bar' which has its 'is_nullable' attribute set to true/,
+'proper exception on non-existing column as PK';
+
+done_testing;