Commit | Line | Data |
dbd7896f |
1 | package DBIx::Class::PK; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base qw/Class::Data::Inheritable DBIx::Class::SQL/; |
7 | |
8 | __PACKAGE__->mk_classdata('_primaries' => {}); |
9 | |
10 | sub _ident_cond { |
11 | my ($class) = @_; |
12 | return join(" AND ", map { "$_ = ?" } keys %{$class->_primaries}); |
13 | } |
14 | |
15 | sub _ident_values { |
16 | my ($self) = @_; |
17 | return (map { $self->{_column_data}{$_} } keys %{$self->_primaries}); |
18 | } |
19 | |
20 | sub set_primary { |
21 | my ($class, @cols) = @_; |
22 | my %pri; |
23 | $pri{$_} = {} for @cols; |
24 | $class->_primaries(\%pri); |
25 | } |
26 | |
27 | sub retrieve { |
28 | my ($class, @vals) = @_; |
29 | my @pk = keys %{$class->_primaries}; |
30 | die "Can't retrieve unless primary columns are defined" unless @pk; |
31 | my $query; |
32 | if (ref $vals[0] eq 'HASH') { |
33 | $query = $vals[0]; |
a3018bd3 |
34 | } elsif (@pk == @vals) { |
35 | return ($class->retrieve_from_sql($class->_ident_cond, @vals))[0]; |
dbd7896f |
36 | } else { |
37 | $query = {@vals}; |
38 | } |
39 | die "Can't retrieve unless all primary keys are specified" |
40 | unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc |
41 | # column names etc. Not sure what to do yet |
42 | return ($class->search($query))[0]; |
43 | } |
44 | |
45 | 1; |