From: David Kamholz 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-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=48700d097b9f4e84f3246e25871a79e2c4ba29b8;p=dbsrgits%2FDBIx-Class-Historic.git 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