X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FPK.pm;h=3bb0740a87fbde2942ade9b5eddc020b4ddc8d50;hb=90f3f5ff9b01602cc4bca97fac113d65fb8efb7c;hp=ed0b830a4302fae3d52ef7ac3a8a11ea8c012792;hpb=1a14aa3f5016c456db28c148abab256ea72776df;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index ed0b830..3bb0740 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}); @@ -36,14 +35,25 @@ sub _ident_values { return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); } +=item set_primary_key <@cols> + +define one or more columns as primary key for this class + +=cut + 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); } +=item find + +Finds columns based on the primary key(s). + +=cut + sub find { my ($class, @vals) = @_; my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {}); @@ -71,6 +81,12 @@ sub find { return (@row ? $class->_row_to_object(\@cols, \@row) : ()); } +=item discard_changes + +Roll back changes that hasn't been comitted to the database. + +=cut + sub discard_changes { my ($self) = @_; delete $self->{_dirty_columns}; @@ -87,6 +103,13 @@ sub discard_changes { return $self; } +=item id + +returns the primary key(s) for the current row. Can't be called as +a class method. + +=cut + sub id { my ($self) = @_; $self->throw( "Can't call id() as a class method" ) unless ref $self; @@ -94,10 +117,30 @@ sub id { return (wantarray ? @pk : $pk[0]); } +=item primary_columns + +read-only accessor which returns a list of primary keys. + +=cut + 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) = @_; + return undef unless 0 == grep { !defined } values %vals; + $class = ref $class || $class; + return join '|', $class, map { $_ . '=' . $vals{$_} } sort keys %vals; +} + 1; =back