Cleaner error message for using source() without required argument
[dbsrgits/DBIx-Class.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
8091aa91 23=head2 id
076652e8 24
8091aa91 25Returns the primary key(s) for a row. Can't be called as
076652e8 26a class method.
27
28=cut
29
604d9f38 30sub id {
31 my ($self) = @_;
bc0c9800 32 $self->throw_exception( "Can't call id() as a class method" )
33 unless ref $self;
b946a283 34 my @id_vals = $self->_ident_values;
35 return (wantarray ? @id_vals : $id_vals[0]);
604d9f38 36}
37
bbd107cf 38sub _ident_values {
39 my ($self) = @_;
90f250bc 40
b946a283 41 my (@ids, @missing);
42
43 for ($self->_pri_cols) {
44 push @ids, $self->get_column($_);
45 push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
46 }
47
48 if (@missing && $self->in_storage) {
49 $self->throw_exception (
50 'Unable to uniquely identify row object with missing PK columns: '
51 . join (', ', @missing )
52 );
53 }
54
55 return @ids;
bbd107cf 56}
57
8091aa91 58=head2 ID
59
60Returns a unique id string identifying a row object by primary key.
75d07914 61Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
8091aa91 62L<DBIx::Class::ObjectCache>.
63
bbd107cf 64=over
65
66=item WARNING
67
68The default C<_create_ID> method used by this function orders the returned
69values by the alphabetical order of the primary column names, B<unlike>
70the L</id> method, which follows the same order in which columns were fed
71to L<DBIx::Class::ResultSource/set_primary_key>.
72
73=back
74
8091aa91 75=cut
76
48700d09 77sub ID {
78 my ($self) = @_;
bc0c9800 79 $self->throw_exception( "Can't call ID() as a class method" )
80 unless ref $self;
48700d09 81 return undef unless $self->in_storage;
b946a283 82 return $self->_create_ID(%{$self->ident_condition});
48700d09 83}
84
85sub _create_ID {
b946a283 86 my ($self, %vals) = @_;
90f3f5ff 87 return undef unless 0 == grep { !defined } values %vals;
bc0c9800 88 return join '|', ref $self || $self, $self->result_source->name,
75d07914 89 map { $_ . '=' . $vals{$_} } sort keys %vals;
48700d09 90}
91
9b83fccd 92=head2 ident_condition
93
94 my $cond = $result_source->ident_condition();
95
96 my $cond = $result_source->ident_condition('alias');
97
98Produces a condition hash to locate a row based on the primary key(s).
99
100=cut
101
103647d5 102sub ident_condition {
fea3d045 103 my ($self, $alias) = @_;
b946a283 104
105 my @pks = $self->_pri_cols;
106 my @vals = $self->_ident_values;
107
108 my (%cond, @undef);
e04df8ec 109 my $prefix = defined $alias ? $alias.'.' : '';
b946a283 110 for my $col (@pks) {
111 if (! defined ($cond{$prefix.$col} = shift @vals) ) {
112 push @undef, $col;
113 }
114 }
115
116 if (@undef && $self->in_storage) {
117 $self->throw_exception (
118 'Unable to construct row object identity condition due to NULL PK columns: '
119 . join (', ', @undef)
120 );
121 }
122
103647d5 123 return \%cond;
124}
125
dbd7896f 1261;
34d52be2 127
34d52be2 128=head1 AUTHORS
129
daec44b8 130Matt S. Trout <mst@shadowcatsystems.co.uk>
34d52be2 131
132=head1 LICENSE
133
134You may distribute this code under the same terms as Perl itself.
135
136=cut
137