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