1) changed all 4 space indentation to 2 space style indents for replication code...
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / PK.pm
CommitLineData
dbd7896f 1package DBIx::Class::PK;
2
3use strict;
4use warnings;
5
1edd1722 6use base qw/DBIx::Class::Row/;
dbd7896f 7
75d07914 8=head1 NAME
34d52be2 9
10DBIx::Class::PK - Primary Key class
11
12=head1 SYNOPSIS
13
14=head1 DESCRIPTION
15
75d07914 16This class contains methods for handling primary keys and methods
8091aa91 17depending on them.
34d52be2 18
19=head1 METHODS
20
34d52be2 21=cut
22
dbd7896f 23sub _ident_values {
24 my ($self) = @_;
d7156e50 25 return (map { $self->{_column_data}{$_} } $self->primary_columns);
dbd7896f 26}
27
8091aa91 28=head2 discard_changes
076652e8 29
8091aa91 30Re-selects the row from the database, losing any changes that had
31been made.
076652e8 32
aefa6508 33This method can also be used to refresh from storage, retrieving any
34changes made since the row was last read from storage.
35
076652e8 36=cut
37
510ca912 38sub discard_changes {
39 my ($self) = @_;
243a6b72 40 delete $self->{_dirty_columns};
41 return unless $self->in_storage; # Don't reload if we aren't real!
42
43 my $reload = $self->result_source->schema->storage->reload_row($self);
44
45 unless ($reload) { # If we got deleted in the mean-time
46 $self->in_storage(0);
47 return $self;
48 }
49
50 %$self = %$reload;
51
52 # Avoid a possible infinite loop with
53 # sub DESTROY { $_[0]->discard_changes }
54 bless $reload, 'Do::Not::Exist';
55
c1d23573 56 return $self;
510ca912 57}
58
8091aa91 59=head2 id
076652e8 60
8091aa91 61Returns the primary key(s) for a row. Can't be called as
076652e8 62a class method.
63
64=cut
65
604d9f38 66sub id {
67 my ($self) = @_;
bc0c9800 68 $self->throw_exception( "Can't call id() as a class method" )
69 unless ref $self;
604d9f38 70 my @pk = $self->_ident_values;
71 return (wantarray ? @pk : $pk[0]);
72}
73
8091aa91 74=head2 ID
75
76Returns a unique id string identifying a row object by primary key.
75d07914 77Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
8091aa91 78L<DBIx::Class::ObjectCache>.
79
80=cut
81
48700d09 82sub ID {
83 my ($self) = @_;
bc0c9800 84 $self->throw_exception( "Can't call ID() as a class method" )
85 unless ref $self;
48700d09 86 return undef unless $self->in_storage;
bc0c9800 87 return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
88 $self->primary_columns);
48700d09 89}
90
91sub _create_ID {
9bbd8963 92 my ($self,%vals) = @_;
90f3f5ff 93 return undef unless 0 == grep { !defined } values %vals;
bc0c9800 94 return join '|', ref $self || $self, $self->result_source->name,
75d07914 95 map { $_ . '=' . $vals{$_} } sort keys %vals;
48700d09 96}
97
9b83fccd 98=head2 ident_condition
99
100 my $cond = $result_source->ident_condition();
101
102 my $cond = $result_source->ident_condition('alias');
103
104Produces a condition hash to locate a row based on the primary key(s).
105
106=cut
107
103647d5 108sub ident_condition {
fea3d045 109 my ($self, $alias) = @_;
103647d5 110 my %cond;
e04df8ec 111 my $prefix = defined $alias ? $alias.'.' : '';
112 $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
103647d5 113 return \%cond;
114}
115
dbd7896f 1161;
34d52be2 117
34d52be2 118=head1 AUTHORS
119
daec44b8 120Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 121
122=head1 LICENSE
123
124You may distribute this code under the same terms as Perl itself.
125
126=cut
127