1package DBIx::Class::PK;
2
3use strict;
4use warnings;
5
6use base qw/DBIx::Class::Row/;
7
8=head1 NAME
9
10DBIx::Class::PK - Primary Key class
11
12=head1 SYNOPSIS
13
14=head1 DESCRIPTION
15
16This class contains methods for handling primary keys and methods
17depending on them.
18
19=head1 METHODS
20
21=cut
22
23=head2 id
24
25Returns the primary key(s) for a row. Can't be called as
26a class method.
27
28=cut
29
30sub id {
31  my ($self) = @_;
32  $self->throw_exception( "Can't call id() as a class method" )
33    unless ref $self;
34  my @id_vals = $self->_ident_values;
35  return (wantarray ? @id_vals : $id_vals[0]);
36}
37
38sub _ident_values {
39  my ($self) = @_;
40  my (@ids, @missing);
41
42  for ($self->_pri_cols) {
43    push @ids, $self->get_column($_);
44    push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
45  }
46
47  if (@missing && $self->in_storage) {
48    $self->throw_exception (
49      'Unable to uniquely identify row object with missing PK columns: '
50      . join (', ', @missing )
51    );
52  }
53
54  return @ids;
55}
56
57=head2 ID
58
59Returns a unique id string identifying a row object by primary key.
60Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
61L<DBIx::Class::ObjectCache>.
62
63=over
64
65=item WARNING
66
67The default C<_create_ID> method used by this function orders the returned
68values by the alphabetical order of the primary column names, B<unlike>
69the L</id> method, which follows the same order in which columns were fed
70to L<DBIx::Class::ResultSource/set_primary_key>.
71
72=back
73
74=cut
75
76sub ID {
77  my ($self) = @_;
78  $self->throw_exception( "Can't call ID() as a class method" )
79    unless ref $self;
80  return undef unless $self->in_storage;
81  return $self->_create_ID(%{$self->ident_condition});
82}
83
84sub _create_ID {
85  my ($self, %vals) = @_;
86  return undef unless 0 == grep { !defined } values %vals;
87  return join '|', ref $self || $self, $self->result_source->name,
88    map { $_ . '=' . $vals{$_} } sort keys %vals;
89}
90
91=head2 ident_condition
92
93  my $cond = $result_source->ident_condition();
94
95  my $cond = $result_source->ident_condition('alias');
96
97Produces a condition hash to locate a row based on the primary key(s).
98
99=cut
100
101sub ident_condition {
102  my ($self, $alias) = @_;
103
104  my @pks = $self->_pri_cols;
105  my @vals = $self->_ident_values;
106
107  my (%cond, @undef);
108  my $prefix = defined $alias ? $alias.'.' : '';
109  for my $col (@pks) {
110    if (! defined ($cond{$prefix.$col} = shift @vals) ) {
111      push @undef, $col;
112    }
113  }
114
115  if (@undef && $self->in_storage) {
116    $self->throw_exception (
117      'Unable to construct row object identity condition due to NULL PK columns: '
118      . join (', ', @undef)
119    );
120  }
121
122  return \%cond;
123}
124
1251;
126
127=head1 AUTHORS
128
129Matt S. Trout <mst@shadowcatsystems.co.uk>
130
131=head1 LICENSE
132
133You may distribute this code under the same terms as Perl itself.
134
135=cut
136
137