Commit | Line | Data |
dbd7896f |
1 | package DBIx::Class::PK; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
1edd1722 |
6 | use base qw/DBIx::Class::Row/; |
dbd7896f |
7 | |
75d07914 |
8 | =head1 NAME |
34d52be2 |
9 | |
10 | DBIx::Class::PK - Primary Key class |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | =head1 DESCRIPTION |
15 | |
75d07914 |
16 | This class contains methods for handling primary keys and methods |
8091aa91 |
17 | depending on them. |
34d52be2 |
18 | |
19 | =head1 METHODS |
20 | |
34d52be2 |
21 | =cut |
22 | |
dbd7896f |
23 | sub _ident_values { |
24 | my ($self) = @_; |
d7156e50 |
25 | return (map { $self->{_column_data}{$_} } $self->primary_columns); |
dbd7896f |
26 | } |
27 | |
7e38d850 |
28 | =head2 discard_changes ($attrs) |
076652e8 |
29 | |
8091aa91 |
30 | Re-selects the row from the database, losing any changes that had |
31 | been made. |
076652e8 |
32 | |
aefa6508 |
33 | This method can also be used to refresh from storage, retrieving any |
34 | changes made since the row was last read from storage. |
35 | |
7e38d850 |
36 | $attrs is expected to be a hashref of attributes suitable for passing as the |
37 | second argument to $resultset->search($cond, $attrs); |
38 | |
076652e8 |
39 | =cut |
40 | |
510ca912 |
41 | sub discard_changes { |
7e38d850 |
42 | my ($self, $attrs) = @_; |
243a6b72 |
43 | delete $self->{_dirty_columns}; |
44 | return unless $self->in_storage; # Don't reload if we aren't real! |
d4daee7b |
45 | |
b54dbe8c |
46 | $attrs = { force_pool => 'master', %{ defined $attrs ? $attrs:{} } }; |
7e38d850 |
47 | if( my $current_storage = $self->get_from_storage($attrs)) { |
d4daee7b |
48 | |
b9b4e52f |
49 | # Set $self to the current. |
50 | %$self = %$current_storage; |
d4daee7b |
51 | |
b9b4e52f |
52 | # Avoid a possible infinite loop with |
53 | # sub DESTROY { $_[0]->discard_changes } |
54 | bless $current_storage, 'Do::Not::Exist'; |
d4daee7b |
55 | |
b9b4e52f |
56 | return $self; |
57 | } else { |
243a6b72 |
58 | $self->in_storage(0); |
b9b4e52f |
59 | return $self; |
243a6b72 |
60 | } |
510ca912 |
61 | } |
62 | |
8091aa91 |
63 | =head2 id |
076652e8 |
64 | |
8091aa91 |
65 | Returns the primary key(s) for a row. Can't be called as |
076652e8 |
66 | a class method. |
67 | |
68 | =cut |
69 | |
604d9f38 |
70 | sub id { |
71 | my ($self) = @_; |
bc0c9800 |
72 | $self->throw_exception( "Can't call id() as a class method" ) |
73 | unless ref $self; |
604d9f38 |
74 | my @pk = $self->_ident_values; |
75 | return (wantarray ? @pk : $pk[0]); |
76 | } |
77 | |
8091aa91 |
78 | =head2 ID |
79 | |
80 | Returns a unique id string identifying a row object by primary key. |
75d07914 |
81 | Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and |
8091aa91 |
82 | L<DBIx::Class::ObjectCache>. |
83 | |
84 | =cut |
85 | |
48700d09 |
86 | sub ID { |
87 | my ($self) = @_; |
bc0c9800 |
88 | $self->throw_exception( "Can't call ID() as a class method" ) |
89 | unless ref $self; |
48700d09 |
90 | return undef unless $self->in_storage; |
bc0c9800 |
91 | return $self->_create_ID(map { $_ => $self->{_column_data}{$_} } |
92 | $self->primary_columns); |
48700d09 |
93 | } |
94 | |
95 | sub _create_ID { |
9bbd8963 |
96 | my ($self,%vals) = @_; |
90f3f5ff |
97 | return undef unless 0 == grep { !defined } values %vals; |
bc0c9800 |
98 | return join '|', ref $self || $self, $self->result_source->name, |
75d07914 |
99 | map { $_ . '=' . $vals{$_} } sort keys %vals; |
48700d09 |
100 | } |
101 | |
9b83fccd |
102 | =head2 ident_condition |
103 | |
104 | my $cond = $result_source->ident_condition(); |
105 | |
106 | my $cond = $result_source->ident_condition('alias'); |
107 | |
108 | Produces a condition hash to locate a row based on the primary key(s). |
109 | |
110 | =cut |
111 | |
103647d5 |
112 | sub ident_condition { |
fea3d045 |
113 | my ($self, $alias) = @_; |
103647d5 |
114 | my %cond; |
e04df8ec |
115 | my $prefix = defined $alias ? $alias.'.' : ''; |
116 | $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns; |
103647d5 |
117 | return \%cond; |
118 | } |
119 | |
dbd7896f |
120 | 1; |
34d52be2 |
121 | |
34d52be2 |
122 | =head1 AUTHORS |
123 | |
daec44b8 |
124 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 |
125 | |
126 | =head1 LICENSE |
127 | |
128 | You may distribute this code under the same terms as Perl itself. |
129 | |
130 | =cut |
131 | |