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 | |
510ca912 |
20 | sub set_primary_key { |
dbd7896f |
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) { |
12bbb339 |
35 | my $ret = ($class->retrieve_from_sql($class->_ident_cond, @vals))[0]; |
36 | #warn "$class: ".join(', ', %{$ret->{_column_data}}); |
37 | return $ret; |
dbd7896f |
38 | } else { |
39 | $query = {@vals}; |
40 | } |
41 | die "Can't retrieve unless all primary keys are specified" |
42 | unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc |
43 | # column names etc. Not sure what to do yet |
12bbb339 |
44 | my $ret = ($class->search($query))[0]; |
45 | #warn "$class: ".join(', ', %{$ret->{_column_data}}); |
46 | return $ret; |
dbd7896f |
47 | } |
48 | |
510ca912 |
49 | sub discard_changes { |
50 | my ($self) = @_; |
51 | delete $self->{_dirty_columns}; |
52 | $_[0] = $self->retrieve($self->id); |
53 | } |
54 | |
604d9f38 |
55 | sub id { |
56 | my ($self) = @_; |
57 | die "Can't call id() as a class method" unless ref $self; |
58 | my @pk = $self->_ident_values; |
59 | return (wantarray ? @pk : $pk[0]); |
60 | } |
61 | |
dbd7896f |
62 | 1; |