From: David Kamholz <davekam@pobox.com>
Date: Tue, 27 Sep 2005 22:29:34 +0000 (+0000)
Subject: add ->ID method to PK.pm to generate unique object id (takes a hash of primary key... 
X-Git-Tag: v0.05005~208
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=48700d097b9f4e84f3246e25871a79e2c4ba29b8

add ->ID method to PK.pm to generate unique object id (takes a hash of primary key column-value pairs)
---

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index ed0b830..859eba3 100644
--- 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);
 }
 
@@ -98,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