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) = @_; |
c687b87e |
29 | my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {}); |
dbd7896f |
30 | my @pk = keys %{$class->_primaries}; |
31 | die "Can't retrieve unless primary columns are defined" unless @pk; |
32 | my $query; |
33 | if (ref $vals[0] eq 'HASH') { |
34 | $query = $vals[0]; |
a3018bd3 |
35 | } elsif (@pk == @vals) { |
c687b87e |
36 | my $ret = ($class->retrieve_from_sql($class->_ident_cond, @vals, $attrs))[0]; |
12bbb339 |
37 | #warn "$class: ".join(', ', %{$ret->{_column_data}}); |
38 | return $ret; |
dbd7896f |
39 | } else { |
40 | $query = {@vals}; |
41 | } |
42 | die "Can't retrieve unless all primary keys are specified" |
43 | unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc |
44 | # column names etc. Not sure what to do yet |
12bbb339 |
45 | my $ret = ($class->search($query))[0]; |
46 | #warn "$class: ".join(', ', %{$ret->{_column_data}}); |
47 | return $ret; |
dbd7896f |
48 | } |
49 | |
510ca912 |
50 | sub discard_changes { |
51 | my ($self) = @_; |
52 | delete $self->{_dirty_columns}; |
c1d23573 |
53 | return unless $self->in_database; # Don't reload if we aren't real! |
54 | my ($reload) = $self->retrieve($self->id); |
55 | unless ($reload) { # If we got deleted in the mean-time |
56 | $self->in_database(0); |
57 | return $self; |
58 | } |
59 | $self->store_column($_ => $reload->get_column($_)) |
60 | foreach keys %{$self->_columns}; |
61 | return $self; |
510ca912 |
62 | } |
63 | |
604d9f38 |
64 | sub id { |
65 | my ($self) = @_; |
66 | die "Can't call id() as a class method" unless ref $self; |
67 | my @pk = $self->_ident_values; |
68 | return (wantarray ? @pk : $pk[0]); |
69 | } |
70 | |
dbd7896f |
71 | 1; |