Update manifest.

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / PK.pm

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index 20576bd..859eba3 100644 (file)
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -25,7 +25,6 @@ and depending on them.
 
 =cut
 
-
 sub _ident_cond {
   my ($class) = @_;
   return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries});
@@ -39,8 +38,7 @@ sub _ident_values {
 sub set_primary_key {
   my ($class, @cols) = @_;
   my %pri;
-  tie %pri, 'Tie::IxHash';
-  %pri = map { $_ => {} } @cols;
+  tie %pri, 'Tie::IxHash', map { $_ => {} } @cols;
   $class->_primaries(\%pri);
 }
 
@@ -54,18 +52,21 @@ sub find {
   if (ref $vals[0] eq 'HASH') {
     $query = $vals[0];
   } elsif (@pk == @vals) {
-    my $ret = ($class->search_literal($class->_ident_cond, @vals, $attrs))[0];
+    $query = {};
+    @{$query}{@pk} = @vals;
+    #my $ret = ($class->search_literal($class->_ident_cond, @vals, $attrs))[0];
     #warn "$class: ".join(', ', %{$ret->{_column_data}});
-    return $ret;
+    #return $ret;
   } else {
     $query = {@vals};
   }
   $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
-  my $ret = ($class->search($query))[0];
-  #warn "$class: ".join(', ', %{$ret->{_column_data}});
-  return $ret;
+  #return $class->search($query)->next;
+  my @cols = $class->_select_columns;
+  my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
+  return (@row ? $class->_row_to_object(\@cols, \@row) : ());
 }
 
 sub discard_changes {
@@ -95,6 +96,19 @@ sub primary_columns {
   return keys %{shift->_primaries};
 }
 
+sub ID {
+  my ($self) = @_;
+  $self->throw( "Can't call ID() as a class method" ) unless ref $self;
+  return undef unless $self->in_storage;
+  return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } keys %{$self->_primaries});
+}
+
+sub _create_ID {
+  my ($class,%vals) = @_;
+  $class = ref $class || $class;
+  return join '|', $class, map { $_ . '=' . $vals{$_} } sort keys %vals;    
+}
+
 1;
 
 =back