Commit | Line | Data |
7624b19f |
1 | package DBIx::Class::Row; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
1edd1722 |
6 | use base qw/DBIx::Class/; |
7 | |
7624b19f |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::Row - Basic row methods |
11 | |
12 | =head1 SYNOPSIS |
13 | |
14 | =head1 DESCRIPTION |
15 | |
16 | This class is responsible for defining and doing basic operations on rows |
17 | derived from L<DBIx::Class::Table> objects. |
18 | |
19 | =head1 METHODS |
20 | |
8091aa91 |
21 | =head2 new |
7624b19f |
22 | |
23 | my $obj = My::Class->new($attrs); |
24 | |
25 | Creates a new row object from column => value mappings passed as a hash ref |
26 | |
27 | =cut |
28 | |
29 | sub new { |
30 | my ($class, $attrs) = @_; |
31 | $class = ref $class if ref $class; |
32 | my $new = bless({ _column_data => { } }, $class); |
33 | if ($attrs) { |
34 | $new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH'; |
35 | while (my ($k, $v) = each %{$attrs}) { |
103647d5 |
36 | die "No such column $k on $class" unless $class->has_column($k); |
484c9dda |
37 | $new->store_column($k => $v); |
7624b19f |
38 | } |
39 | } |
40 | return $new; |
41 | } |
42 | |
8091aa91 |
43 | =head2 insert |
7624b19f |
44 | |
45 | $obj->insert; |
46 | |
47 | Inserts an object into the database if it isn't already in there. Returns |
48 | the object itself. |
49 | |
50 | =cut |
51 | |
52 | sub insert { |
53 | my ($self) = @_; |
54 | return $self if $self->in_storage; |
55 | #use Data::Dumper; warn Dumper($self); |
56 | my %in; |
57 | $in{$_} = $self->get_column($_) |
58 | for grep { defined $self->get_column($_) } $self->columns; |
59 | my %out = %{ $self->storage->insert($self->_table_name, \%in) }; |
60 | $self->store_column($_, $out{$_}) |
61 | for grep { $self->get_column($_) ne $out{$_} } keys %out; |
62 | $self->in_storage(1); |
63 | $self->{_dirty_columns} = {}; |
64 | return $self; |
65 | } |
66 | |
8091aa91 |
67 | =head2 in_storage |
7624b19f |
68 | |
69 | $obj->in_storage; # Get value |
70 | $obj->in_storage(1); # Set value |
71 | |
72 | Indicated whether the object exists as a row in the database or not |
73 | |
74 | =cut |
75 | |
76 | sub in_storage { |
77 | my ($self, $val) = @_; |
78 | $self->{_in_storage} = $val if @_ > 1; |
79 | return $self->{_in_storage}; |
80 | } |
81 | |
8091aa91 |
82 | =head2 create |
7624b19f |
83 | |
84 | my $new = My::Class->create($attrs); |
85 | |
86 | A shortcut for My::Class->new($attrs)->insert; |
87 | |
88 | =cut |
89 | |
90 | sub create { |
91 | my ($class, $attrs) = @_; |
92 | $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH'; |
93 | return $class->new($attrs)->insert; |
94 | } |
95 | |
8091aa91 |
96 | =head2 update |
7624b19f |
97 | |
98 | $obj->update; |
99 | |
100 | Must be run on an object that is already in the database; issues an SQL |
101 | UPDATE query to commit any changes to the object to the db if required. |
102 | |
103 | =cut |
104 | |
105 | sub update { |
106 | my ($self, $upd) = @_; |
107 | $self->throw( "Not in database" ) unless $self->in_storage; |
99be059e |
108 | my %to_update; |
7624b19f |
109 | $to_update{$_} = $self->get_column($_) for $self->is_changed; |
110 | return -1 unless keys %to_update; |
111 | my $rows = $self->storage->update($self->_table_name, \%to_update, |
112 | $self->ident_condition); |
113 | if ($rows == 0) { |
114 | $self->throw( "Can't update ${self}: row not found" ); |
115 | } elsif ($rows > 1) { |
116 | $self->throw("Can't update ${self}: updated more than one row"); |
117 | } |
118 | $self->{_dirty_columns} = {}; |
119 | return $self; |
120 | } |
121 | |
8091aa91 |
122 | =head2 delete |
7624b19f |
123 | |
124 | $obj->delete |
125 | |
126 | Deletes the object from the database. The object is still perfectly usable |
127 | accessor-wise etc. but ->in_storage will now return 0 and the object must |
128 | be re ->insert'ed before it can be ->update'ed |
129 | |
130 | =cut |
131 | |
132 | sub delete { |
133 | my $self = shift; |
134 | if (ref $self) { |
135 | $self->throw( "Not in database" ) unless $self->in_storage; |
136 | #warn $self->_ident_cond.' '.join(', ', $self->_ident_values); |
137 | $self->storage->delete($self->_table_name, $self->ident_condition); |
138 | $self->in_storage(undef); |
139 | #$self->store_column($_ => undef) for $self->primary_columns; |
140 | # Should probably also arrange to trash PK if auto |
141 | # but if we do, post-delete cascade triggers fail :/ |
142 | } else { |
143 | my $attrs = { }; |
144 | if (@_ > 1 && ref $_[$#_] eq 'HASH') { |
145 | $attrs = { %{ pop(@_) } }; |
146 | } |
147 | my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_}); |
148 | $self->storage->delete($self->_table_name, $query); |
149 | } |
150 | return $self; |
151 | } |
152 | |
8091aa91 |
153 | =head2 get_column |
7624b19f |
154 | |
155 | my $val = $obj->get_column($col); |
156 | |
8091aa91 |
157 | Gets a column value from a row object. Currently, does not do |
158 | any queries; the column must have already been fetched from |
159 | the database and stored in the object. |
7624b19f |
160 | |
161 | =cut |
162 | |
163 | sub get_column { |
164 | my ($self, $column) = @_; |
165 | $self->throw( "Can't fetch data as class method" ) unless ref $self; |
103647d5 |
166 | $self->throw( "No such column '${column}'" ) unless $self->has_column($column); |
7624b19f |
167 | return $self->{_column_data}{$column} |
168 | if exists $self->{_column_data}{$column}; |
169 | return undef; |
170 | } |
171 | |
8091aa91 |
172 | =head2 get_columns |
076a6864 |
173 | |
174 | my %data = $obj->get_columns; |
175 | |
8091aa91 |
176 | Does C<get_column>, for all column values at once. |
076a6864 |
177 | |
178 | =cut |
179 | |
180 | sub get_columns { |
181 | my $self = shift; |
182 | return map { $_ => $self->get_column($_) } $self->columns; |
183 | } |
184 | |
8091aa91 |
185 | =head2 set_column |
7624b19f |
186 | |
187 | $obj->set_column($col => $val); |
188 | |
8091aa91 |
189 | Sets a column value. If the new value is different from the old one, |
190 | the column is marked as dirty for when you next call $obj->update. |
7624b19f |
191 | |
192 | =cut |
193 | |
194 | sub set_column { |
195 | my $self = shift; |
196 | my ($column) = @_; |
197 | my $old = $self->get_column($column); |
198 | my $ret = $self->store_column(@_); |
199 | $self->{_dirty_columns}{$column} = 1 unless defined $old && $old eq $ret; |
200 | return $ret; |
201 | } |
202 | |
8091aa91 |
203 | =head2 set_columns |
076a6864 |
204 | |
dc818523 |
205 | my $copy = $orig->set_columns({ $col => $val, ... }); |
076a6864 |
206 | |
8091aa91 |
207 | Sets more than one column value at once. |
076a6864 |
208 | |
209 | =cut |
210 | |
211 | sub set_columns { |
212 | my ($self,$data) = @_; |
213 | while (my ($col,$val) = each %$data) { |
214 | $self->set_column($col,$val); |
215 | } |
216 | } |
217 | |
8091aa91 |
218 | =head2 copy |
076a6864 |
219 | |
220 | my $copy = $orig->copy({ change => $to, ... }); |
221 | |
8091aa91 |
222 | Inserts a new row with the specified changes. |
076a6864 |
223 | |
224 | =cut |
225 | |
8091aa91 |
226 | =head2 store_column |
7624b19f |
227 | |
228 | $obj->store_column($col => $val); |
229 | |
8091aa91 |
230 | Sets a column value without marking it as dirty. |
7624b19f |
231 | |
232 | =cut |
233 | |
234 | sub store_column { |
235 | my ($self, $column, $value) = @_; |
236 | $self->throw( "No such column '${column}'" ) |
103647d5 |
237 | unless $self->has_column($column); |
7624b19f |
238 | $self->throw( "set_column called for ${column} without value" ) |
239 | if @_ < 3; |
240 | return $self->{_column_data}{$column} = $value; |
241 | } |
242 | |
b52e9bf8 |
243 | =head2 inflate_result |
244 | |
245 | Class->inflate_result(\%me, \%prefetch?) |
246 | |
247 | Called by ResultSet to inflate a result from storage |
248 | |
249 | =cut |
250 | |
251 | sub inflate_result { |
252 | my ($class, $me, $prefetch) = @_; |
253 | #use Data::Dumper; print Dumper(@_); |
254 | my $new = bless({ _column_data => $me }, ref $class || $class); |
7624b19f |
255 | $new->in_storage(1); |
b52e9bf8 |
256 | PRE: foreach my $pre (keys %{$prefetch||{}}) { |
257 | my $rel_obj = $class->_relationships->{$pre}; |
258 | my $pre_class = $class->resolve_class($rel_obj->{class}); |
6aeb9185 |
259 | my $fetched = $pre_class->inflate_result(@{$prefetch->{$pre}}); |
b52e9bf8 |
260 | $class->throw("No accessor for prefetched $pre") |
261 | unless defined $rel_obj->{attrs}{accessor}; |
262 | if ($rel_obj->{attrs}{accessor} eq 'single') { |
263 | PRIMARY: foreach my $pri ($rel_obj->{class}->primary_columns) { |
264 | unless (defined $fetched->get_column($pri)) { |
265 | undef $fetched; |
266 | last PRIMARY; |
267 | } |
268 | } |
269 | $new->{_relationship_data}{$pre} = $fetched; |
270 | } elsif ($rel_obj->{attrs}{accessor} eq 'filter') { |
271 | $new->{_inflated_column}{$pre} = $fetched; |
272 | } else { |
273 | $class->throw("Don't know how to store prefetched $pre"); |
274 | } |
275 | } |
7624b19f |
276 | return $new; |
277 | } |
278 | |
7624b19f |
279 | sub copy { |
280 | my ($self, $changes) = @_; |
281 | my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self); |
282 | $new->set_column($_ => $changes->{$_}) for keys %$changes; |
283 | return $new->insert; |
284 | } |
285 | |
8091aa91 |
286 | =head2 insert_or_update |
7624b19f |
287 | |
288 | $obj->insert_or_update |
289 | |
8091aa91 |
290 | Updates the object if it's already in the db, else inserts it. |
7624b19f |
291 | |
292 | =cut |
293 | |
294 | sub insert_or_update { |
295 | my $self = shift; |
296 | return ($self->in_storage ? $self->update : $self->insert); |
297 | } |
298 | |
8091aa91 |
299 | =head2 is_changed |
7624b19f |
300 | |
301 | my @changed_col_names = $obj->is_changed |
302 | |
303 | =cut |
304 | |
305 | sub is_changed { |
306 | return keys %{shift->{_dirty_columns} || {}}; |
307 | } |
308 | |
309 | 1; |
310 | |
7624b19f |
311 | =head1 AUTHORS |
312 | |
daec44b8 |
313 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
7624b19f |
314 | |
315 | =head1 LICENSE |
316 | |
317 | You may distribute this code under the same terms as Perl itself. |
318 | |
319 | =cut |
320 | |