X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FPK.pm;h=5be483325f8de54751f396d555394a511075da3d;hb=d4daee7b54e38e4b3d3d0a77759bddc1a4ede6e5;hp=0f4d0a721f741aac01b61d3edcd5942fcb4bdc07;hpb=bc0c980086ba429cf33b1d471d1035601727231f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm index 0f4d0a7..5be4833 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,43 +13,50 @@ 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 +=head2 discard_changes ($attrs) Re-selects the row from the database, losing any changes that had been made. +This method can also be used to refresh from storage, retrieving any +changes made since the row was last read from storage. + +$attrs is expected to be a hashref of attributes suitable for passing as the +second argument to $resultset->search($cond, $attrs); + =cut sub discard_changes { - my ($self) = @_; + my ($self, $attrs) = @_; delete $self->{_dirty_columns}; return unless $self->in_storage; # Don't reload if we aren't real! - my ($reload) = $self->result_source->resultset->find - (map { $self->$_ } $self->primary_columns); - unless ($reload) { # If we got deleted in the mean-time + + if( my $current_storage = $self->get_from_storage($attrs)) { + + # Set $self to the current. + %$self = %$current_storage; + + # Avoid a possible infinite loop with + # sub DESTROY { $_[0]->discard_changes } + bless $current_storage, 'Do::Not::Exist'; + + return $self; + } else { $self->in_storage(0); - return $self; + return $self; } - delete @{$self}{keys %$self}; - @{$self}{keys %$reload} = values %$reload; - return $self; } =head2 id @@ -70,7 +77,7 @@ sub id { =head2 ID Returns a unique id string identifying a row object by primary key. -Used by L and +Used by L and L. =cut @@ -88,14 +95,24 @@ 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; + 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; }