Add warnings for non-unique find usage and improve explicit key attr handling in...

diff --git a/Changes b/Changes
index 3516d74..2ac1cc9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,6 +9,8 @@ Revision history for DBIx::Class
           nested transactions if auto_savepoint is set in connect_info.
         - Changed naming scheme for constraints and keys in the sqlt parser;
           names should now be consistent and collision-free.
+        - Improve handling of explicit key attr in ResultSet::find (zby)
+        - Add warnings for non-unique ResultSet::find queries (zby)
 
 0.08010 2008-03-01 10:30
         - Fix t/94versioning.t so it passes with latest SQL::Translator

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index b4f33ce..8adff20 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -332,11 +332,15 @@ Additionally, you can specify the columns explicitly by name:
 If the C<key> is specified as C<primary>, it searches only on the primary key.
 
 If no C<key> is specified, it searches on all unique constraints defined on the
-source, including the primary key.
+source for which column data is provided, including the primary key.
 
 If your table does not have a primary key, you B<must> provide a value for the
 C<key> attribute matching one of the unique constraints on the source.
 
+Note: If your query does not return only one row, a warning is generated:
+
+  Query returned more than one row
+
 See also L</find_or_create> and L</update_or_create>. For information on how to
 declare unique constraints, see
 L<DBIx::Class::ResultSource/add_unique_constraint>.
@@ -388,25 +392,46 @@ sub find {
     @{$input_query}{@keys} = values %related;
   }
 
-  my @unique_queries = $self->_unique_queries($input_query, $attrs);
 
   # Build the final query: Default to the disjunction of the unique queries,
   # but allow the input query in case the ResultSet defines the query or the
   # user is abusing find
   my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
-  my $query = @unique_queries
-    ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
-    : $self->_add_alias($input_query, $alias);
+  my $query;
+  if (exists $attrs->{key}) {
+    my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
+    my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
+    $query = $self->_add_alias($unique_query, $alias);
+  }
+  else {
+    my @unique_queries = $self->_unique_queries($input_query, $attrs);
+    $query = @unique_queries
+      ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
+      : $self->_add_alias($input_query, $alias);
+  }
 
   # Run the query
   if (keys %$attrs) {
     my $rs = $self->search($query, $attrs);
-    return keys %{$rs->_resolved_attrs->{collapse}} ? $rs->next : $rs->single;
+    if (keys %{$rs->_resolved_attrs->{collapse}}) {
+      my $row = $rs->next;
+      carp "Query returned more than one row" if $rs->next;
+      return $row;
+    }
+    else {
+      return $rs->single;
+    }
   }
   else {
-    return keys %{$self->_resolved_attrs->{collapse}}
-      ? $self->search($query)->next
-      : $self->single($query);
+    if (keys %{$self->_resolved_attrs->{collapse}}) {
+      my $rs = $self->search($query);
+      my $row = $rs->next;
+      carp "Query returned more than one row" if $rs->next;
+      return $row;
+    }
+    else {
+      return $self->single($query);
+    }
   }
 }
 

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 2c45eee..dde26c0 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -5,6 +5,7 @@ use base 'DBIx::Class::Storage';
 
 use strict;    
 use warnings;
+use Carp::Clan qw/^DBIx::Class/;
 use DBI;
 use SQL::Abstract::Limit;
 use DBIx::Class::Storage::DBI::Cursor;
@@ -1285,6 +1286,7 @@ sub select_single {
   my $self = shift;
   my ($rv, $sth, @bind) = $self->_select(@_);
   my @row = $sth->fetchrow_array;
+  carp "Query returned more than one row" if $sth->fetchrow_array;
   # Need to call finish() to work round broken DBDs
   $sth->finish();
   return @row;

diff --git a/t/61findnot.t b/t/61findnot.t
index ee7b582..17f64fd 100644 (file)
--- a/t/61findnot.t
+++ b/t/61findnot.t
@@ -2,12 +2,13 @@ use strict;
 use warnings;  
 
 use Test::More;
+use Test::Warn;
 use lib qw(t/lib);
 use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 17;
+plan tests => 20;
 
 my $art = $schema->resultset("Artist")->find(4);
 ok(!defined($art), 'Find on primary id: artist not found');
@@ -44,3 +45,18 @@ $cd = $schema->resultset("CD")->search({title => 'Call of the West'});
 @cd = $cd->single;
 cmp_ok(@cd, '==', 1, 'Return something even in array context');
 ok(@cd && !defined($cd[0]), 'Array contains an undef as only element');
+
+$cd = $schema->resultset("CD")->first;
+my $artist_rs = $schema->resultset("Artist")->search({ artistid => $cd->artist->artistid });
+$art = $artist_rs->find({ name => 'some other name' }, { key => 'primary' });
+ok($art, 'Artist found by key in the resultset');
+
+$artist_rs = $schema->resultset("Artist");
+warning_is {
+  $artist_rs->find({}, { key => 'primary' })
+} "DBIx::Class::ResultSet::find(): Query returned more than one row", "Non-unique find generated a cursor inexhaustion warning";
+
+$artist_rs = $schema->resultset("Artist")->search({}, { prefetch => 'cds' });
+warning_is {
+  $artist_rs->find({}, { key => 'primary' })
+} "DBIx::Class::ResultSet::find(): Query returned more than one row", "Non-unique find generated a cursor inexhaustion warning";