X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FPK.pm;h=f156b59519c3700f1ec5ca71f1292f2157e0e9d2;hb=741d6d0ecddc46df590f700f5270d1e287d4ab2b;hp=3dba00d888606eec43539812537955602b03551b;hpb=076652e8bd5edaaf4c6c6a65f631bf529bbff41c;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index 3dba00d..f156b59 100644 --- a/lib/DBIx/Class/PK.pm +++ b/lib/DBIx/Class/PK.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Tie::IxHash; -use base qw/Class::Data::Inheritable/; +use base qw/DBIx::Class::Row/; __PACKAGE__->mk_classdata('_primaries' => {}); @@ -16,13 +16,11 @@ DBIx::Class::PK - Primary Key class =head1 DESCRIPTION -This class represents methods handling primary keys -and depending on them. +This class contains methods for handling primary keys and methods +depending on them. =head1 METHODS -=over 4 - =cut sub _ident_cond { @@ -35,22 +33,28 @@ sub _ident_values { return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); } -=item set_primary_key <@cols> +=head2 set_primary_key(@cols) -define one or more columns as primary key for this class +Defines one or more columns as primary key for this class. Should be +called after C. =cut sub set_primary_key { my ($class, @cols) = @_; + # check if primary key columns are valid columns + for (@cols) { + $class->throw( "Column $_ can't be used as primary key because it isn't defined in $class" ) + unless $class->has_column($_); + } my %pri; tie %pri, 'Tie::IxHash', map { $_ => {} } @cols; $class->_primaries(\%pri); } -=item find +=head2 find(@colvalues), find(\%cols) -Finds columns based on the primary key(s). +Finds a row based on its primary key(s). =cut @@ -75,15 +79,16 @@ sub find { $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 $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) : ()); + 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) : ()); } -=item discard_changes +=head2 discard_changes -Roll back changes that hasn't been comitted to the database. +Re-selects the row from the database, losing any changes that had +been made. =cut @@ -91,21 +96,19 @@ sub discard_changes { my ($self) = @_; delete $self->{_dirty_columns}; return unless $self->in_storage; # Don't reload if we aren't real! - my ($reload) = $self->find($self->id); + my ($reload) = $self->find(map { $self->$_ } $self->primary_columns); unless ($reload) { # If we got deleted in the mean-time $self->in_storage(0); return $self; } delete @{$self}{keys %$self}; @{$self}{keys %$reload} = values %$reload; - #$self->store_column($_ => $reload->get_column($_)) - # foreach keys %{$self->_columns}; return $self; } -=item id +=head2 id -returns the primary key(s) for the current row. Can't be called as +Returns the primary key(s) for a row. Can't be called as a class method. =cut @@ -117,9 +120,10 @@ sub id { return (wantarray ? @pk : $pk[0]); } -=item primary_columns +=head2 primary_columns -read-only accessor which returns a list of primary keys. +Read-only accessor which returns the list of primary keys for a class +(in scalar context, only returns the first primary key). =cut @@ -127,6 +131,14 @@ sub primary_columns { return keys %{shift->_primaries}; } +=head2 ID + +Returns a unique id string identifying a row object by primary key. +Used by L and +L. + +=cut + sub ID { my ($self) = @_; $self->throw( "Can't call ID() as a class method" ) unless ref $self; @@ -136,13 +148,19 @@ sub ID { 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; +sub ident_condition { + my ($self) = @_; + my %cond; + $cond{$_} = $self->get_column($_) for $self->primary_columns; + return \%cond; +} -=back +1; =head1 AUTHORS