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