From: Daniel Westermann-Clark <danieltwc@cpan.org>
Date: Tue, 19 Dec 2006 06:22:09 +0000 (+0000)
Subject: fix find_related-based queries to correctly grep the unique key
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d180c0f33c2fbbe3a20f994b1c61703c67128e6e;p=dbsrgits%2FDBIx-Class-Historic.git

fix find_related-based queries to correctly grep the unique key
---

diff --git a/Changes b/Changes
index 1692e35..f685c59 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for DBIx::Class
 
+        - fix find_related-based queries to correctly grep the unique key
+
 0.07003 2006-11-16 11:52:00
         - fix for rt.cpan.org #22740 (use $^X instead of hardcoded "perl")
         - Tweaks to resultset to allow inflate_result to return an array
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index ce93efa..af68b29 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -409,21 +409,23 @@ sub _unique_queries {
     ? ($attrs->{key})
     : $self->result_source->unique_constraint_names;
 
+  my $where = $self->_collapse_cond($self->{attrs}{where} || {});
+  my $num_where = scalar keys %$where;
+
   my @unique_queries;
   foreach my $name (@constraint_names) {
     my @unique_cols = $self->result_source->unique_constraint_columns($name);
     my $unique_query = $self->_build_unique_query($query, \@unique_cols);
 
+    my $num_cols = scalar @unique_cols;
     my $num_query = scalar keys %$unique_query;
-    next unless $num_query;
 
-    # XXX: Assuming quite a bit about $self->{attrs}{where}
-    my $num_cols = scalar @unique_cols;
-    my $num_where = exists $self->{attrs}{where}
-      ? scalar keys %{ $self->{attrs}{where} }
-      : 0;
-    push @unique_queries, $unique_query
-      if $num_query + $num_where == $num_cols;
+    my $total = $num_query + $num_where;
+    if ($num_query && ($num_query == $num_cols || $total == $num_cols)) {
+      # The query is either unique on its own or is unique in combination with
+      # the existing where clause
+      push @unique_queries, $unique_query;
+    }
   }
 
   return @unique_queries;
diff --git a/t/80unique.t b/t/80unique.t
index eebb66e..6108f28 100644
--- a/t/80unique.t
+++ b/t/80unique.t
@@ -7,7 +7,7 @@ use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 43;
+plan tests => 45;
 
 # Check the defined unique constraints
 is_deeply(
@@ -126,8 +126,9 @@ is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
 is($cd8->title, $cd1->title, 'title is correct');
 is($cd8->year, $cd1->year, 'year is correct');
 
-my $cd9 = $artist->update_or_create_related('cds',
+my $cd9 = $artist->cds->update_or_create(
   {
+    cdid   => $cd1->cdid,
     title  => $title,
     year   => 2021,
   },
@@ -161,7 +162,24 @@ my $row = $schema->resultset('NoPrimaryKey')->update_or_create(
   },
   { key => 'foo_bar' }
 );
+
 ok(! $row->is_changed, 'update_or_create on table without primary key: row is clean');
 is($row->foo, 1, 'foo is correct');
 is($row->bar, 2, 'bar is correct');
 is($row->baz, 3, 'baz is correct');
+
+# Test a unique condition with extra information in the where attr
+{
+  my $artist = $schema->resultset('Artist')->find({ artistid => 1 });
+  my $cd = $artist->cds->find_or_new(
+    {
+      cdid  => 1,
+      title => 'Not The Real Title',
+      year  => 3000,
+    },
+    { key => 'primary' }
+  );
+
+  ok($cd->in_storage, 'find correctly grepped the key across a relationship');
+  is($cd->cdid, 1, 'cdid is correct');
+}