find_related now does search_related->find

diff --git a/lib/DBIx/Class/CDBICompat/Retrieve.pm b/lib/DBIx/Class/CDBICompat/Retrieve.pm
index 31dd128..3259bb2 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/Retrieve.pm
+++ b/lib/DBIx/Class/CDBICompat/Retrieve.pm
@@ -3,8 +3,11 @@ package DBIx::Class::CDBICompat::Retrieve;
 use strict;
 use warnings FATAL => 'all';
 
-sub retrieve          { shift->find(@_)            }
-sub retrieve_all      { shift->search              }
+
+sub retrieve  {
+  die "No args to retrieve" unless @_ > 1;
+  shift->find(@_);
+}
 
 sub retrieve_from_sql {
   my ($class, $cond, @rest) = @_;
@@ -12,6 +15,7 @@ sub retrieve_from_sql {
   $class->search_literal($cond, @rest);
 }
 
+sub retrieve_all      { shift->search              }
 sub count_all         { shift->count               }
   # Contributed by Numa. No test for this though.
 

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 0986be8..a96f66a 100644 (file)
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -280,6 +280,9 @@ sub new_related {
 sub find_related {
   my $self = shift;
   my $rel = shift;
+  return $self->search_related($rel)->find(@_);
+
+  # Marked for death.
   my $rel_obj = $self->_relationships->{$rel};
   $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
   my ($cond) = $self->resolve_condition($rel_obj->{cond}, { _action => 'convert' });

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 6ca976b..0920e42 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -137,6 +137,36 @@ sub search_literal {
   return $self->search(\$cond, $attrs);
 }
 
+=head2 find(@colvalues), find(\%cols)
+
+Finds a row based on its primary key(s).                                        
+
+=cut                                                                            
+
+sub find {
+  my ($self, @vals) = @_;
+  my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
+  my @pk = $self->{source}->primary_columns;
+  #use Data::Dumper; warn Dumper($attrs, @vals, @pk);
+  $self->{source}->result_class->throw( "Can't find unless primary columns are defined" )
+    unless @pk;
+  my $query;
+  if (ref $vals[0] eq 'HASH') {
+    $query = $vals[0];
+  } elsif (@pk == @vals) {
+    $query = {};
+    @{$query}{@pk} = @vals;
+  } else {
+    $query = {@vals};
+  }
+  #warn Dumper($query);
+  # Useless -> disabled
+  #$self->{source}->result_class->throw( "Can't find unless all primary keys are specified" )
+  #  unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
+                                  # column names etc. Not sure what to do yet
+  return $self->search($query)->next;
+}
+
 =head2 search_related
 
   $rs->search_related('relname', $cond?, $attrs?);

diff --git a/t/run/05multipk.tl b/t/run/05multipk.tl
index 2f49936..783207f 100644 (file)
--- a/t/run/05multipk.tl
+++ b/t/run/05multipk.tl
@@ -1,10 +1,10 @@
 sub run_tests {
 
-plan tests => 3;
-
+plan tests => 4;
+$artist = DBICTest::Artist->find(1);
+ok($artist->find_related('twokeys', {cd => 1}), "find multiple pks using relationships + args");
 ok(DBICTest->class("FourKeys")->find(1,2,3,4), "find multiple pks without hash");
 ok(DBICTest->class("FourKeys")->find(5,4,3,6), "find multiple pks without hash");
-
 is(DBICTest->class("FourKeys")->find(1,2,3,4)->ID, 'DBICTest::FourKeys|bar=2|foo=1|goodbye=4|hello=3', 'unique object id ok for multiple pks');
 
 }