X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FPK.pm;h=cf8a194cc99f7a1fb51b82594c4cdf680d734163;hb=416e0bc0624a788f9e6389790b5beb20ced77a43;hp=4c8f1063201224a1a6214b102f15e23eedd1822c;hpb=9bbd8963f80a0ab929350653eb91fa1ae502c47b;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index 4c8f106..cf8a194 100644 --- a/lib/DBIx/Class/PK.pm +++ b/lib/DBIx/Class/PK.pm @@ -5,7 +5,7 @@ use warnings; use base qw/DBIx::Class::Row/; -=head1 NAME +=head1 NAME DBIx::Class::PK - Primary Key class @@ -13,44 +13,13 @@ DBIx::Class::PK - Primary Key class =head1 DESCRIPTION -This class contains methods for handling primary keys and methods +This class contains methods for handling primary keys and methods depending on them. =head1 METHODS =cut -sub _ident_cond { - my ($class) = @_; - return join(" AND ", map { "$_ = ?" } $class->primary_columns); -} - -sub _ident_values { - my ($self) = @_; - return (map { $self->{_column_data}{$_} } $self->primary_columns); -} - -=head2 discard_changes - -Re-selects the row from the database, losing any changes that had -been made. - -=cut - -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(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; - return $self; -} - =head2 id Returns the primary key(s) for a row. Can't be called as @@ -60,36 +29,67 @@ a class method. sub id { my ($self) = @_; - $self->throw_exception( "Can't call id() as a class method" ) unless ref $self; + $self->throw_exception( "Can't call id() as a class method" ) + unless ref $self; my @pk = $self->_ident_values; return (wantarray ? @pk : $pk[0]); } +sub _ident_values { + my ($self) = @_; + return (map { $self->{_column_data}{$_} } $self->primary_columns); +} + =head2 ID Returns a unique id string identifying a row object by primary key. -Used by L and +Used by L and L. +=over + +=item WARNING + +The default C<_create_ID> method used by this function orders the returned +values by the alphabetical order of the primary column names, B +the L method, which follows the same order in which columns were fed +to L. + +=back + =cut sub ID { my ($self) = @_; - $self->throw_exception( "Can't call ID() as a class method" ) unless ref $self; + $self->throw_exception( "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}{$_} } $self->primary_columns); + return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } + $self->primary_columns); } sub _create_ID { my ($self,%vals) = @_; return undef unless 0 == grep { !defined } values %vals; - return join '|', ref $self || $self, $self->result_source->name, map { $_ . '=' . $vals{$_} } sort keys %vals; + return join '|', ref $self || $self, $self->result_source->name, + map { $_ . '=' . $vals{$_} } sort keys %vals; } +=head2 ident_condition + + my $cond = $result_source->ident_condition(); + + my $cond = $result_source->ident_condition('alias'); + +Produces a condition hash to locate a row based on the primary key(s). + +=cut + sub ident_condition { my ($self, $alias) = @_; my %cond; - $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns; + my $prefix = defined $alias ? $alias.'.' : ''; + $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns; return \%cond; }