Add automatic naming of unique constraints
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Row.pm
CommitLineData
7624b19f 1package DBIx::Class::Row;
2
3use strict;
4use warnings;
5
1edd1722 6use base qw/DBIx::Class/;
701da8c4 7use Carp::Clan qw/^DBIx::Class/;
1edd1722 8
097d3227 9__PACKAGE__->load_components(qw/AccessorGroup/);
10
11__PACKAGE__->mk_group_accessors('simple' => 'result_source');
8c49f629 12
75d07914 13=head1 NAME
7624b19f 14
15DBIx::Class::Row - Basic row methods
16
17=head1 SYNOPSIS
18
19=head1 DESCRIPTION
20
21This class is responsible for defining and doing basic operations on rows
1ea77c14 22derived from L<DBIx::Class::ResultSource> objects.
7624b19f 23
24=head1 METHODS
25
8091aa91 26=head2 new
7624b19f 27
28 my $obj = My::Class->new($attrs);
29
30Creates a new row object from column => value mappings passed as a hash ref
31
32=cut
33
34sub new {
35 my ($class, $attrs) = @_;
36 $class = ref $class if ref $class;
aeb1bf75 37 my $new = bless { _column_data => {} }, $class;
7624b19f 38 if ($attrs) {
27f01d1f 39 $new->throw_exception("attrs must be a hashref")
40 unless ref($attrs) eq 'HASH';
a2ca474b 41 foreach my $k (keys %$attrs) {
27f01d1f 42 $new->throw_exception("No such column $k on $class")
75d07914 43 unless $class->has_column($k);
a2ca474b 44 $new->store_column($k => $attrs->{$k});
7624b19f 45 }
46 }
47 return $new;
48}
49
8091aa91 50=head2 insert
7624b19f 51
52 $obj->insert;
53
54Inserts an object into the database if it isn't already in there. Returns
097d3227 55the object itself. Requires the object's result source to be set, or the
56class to have a result_source_instance method.
7624b19f 57
58=cut
59
60sub insert {
61 my ($self) = @_;
62 return $self if $self->in_storage;
097d3227 63 $self->{result_source} ||= $self->result_source_instance
64 if $self->can('result_source_instance');
65 my $source = $self->{result_source};
aeb1bf75 66 $self->throw_exception("No result_source set on this object; can't insert")
67 unless $source;
7624b19f 68 #use Data::Dumper; warn Dumper($self);
097d3227 69 $source->storage->insert($source->from, { $self->get_columns });
7624b19f 70 $self->in_storage(1);
71 $self->{_dirty_columns} = {};
64acc2bc 72 $self->{related_resultsets} = {};
7624b19f 73 return $self;
74}
75
8091aa91 76=head2 in_storage
7624b19f 77
78 $obj->in_storage; # Get value
79 $obj->in_storage(1); # Set value
80
81Indicated whether the object exists as a row in the database or not
82
83=cut
84
85sub in_storage {
86 my ($self, $val) = @_;
87 $self->{_in_storage} = $val if @_ > 1;
88 return $self->{_in_storage};
89}
90
8091aa91 91=head2 update
7624b19f 92
93 $obj->update;
94
95Must be run on an object that is already in the database; issues an SQL
96UPDATE query to commit any changes to the object to the db if required.
97
98=cut
99
100sub update {
101 my ($self, $upd) = @_;
701da8c4 102 $self->throw_exception( "Not in database" ) unless $self->in_storage;
fc27a867 103 $self->set_columns($upd) if $upd;
d7156e50 104 my %to_update = $self->get_dirty_columns;
c01ab172 105 return $self unless keys %to_update;
4b12b3c2 106 my $ident_cond = $self->ident_condition;
107 $self->throw_exception("Cannot safely update a row in a PK-less table")
108 if ! keys %$ident_cond;
88cb6a1d 109 my $rows = $self->result_source->storage->update(
4b12b3c2 110 $self->result_source->from, \%to_update, $ident_cond);
7624b19f 111 if ($rows == 0) {
701da8c4 112 $self->throw_exception( "Can't update ${self}: row not found" );
7624b19f 113 } elsif ($rows > 1) {
701da8c4 114 $self->throw_exception("Can't update ${self}: updated more than one row");
7624b19f 115 }
116 $self->{_dirty_columns} = {};
64acc2bc 117 $self->{related_resultsets} = {};
7624b19f 118 return $self;
119}
120
8091aa91 121=head2 delete
7624b19f 122
123 $obj->delete
124
75d07914 125Deletes the object from the database. The object is still perfectly usable,
126but ->in_storage() will now return 0 and the object must re inserted using
880a1a0c 127->insert() before ->update() can be used on it.
7624b19f 128
129=cut
130
131sub delete {
132 my $self = shift;
133 if (ref $self) {
701da8c4 134 $self->throw_exception( "Not in database" ) unless $self->in_storage;
4b12b3c2 135 my $ident_cond = $self->ident_condition;
136 $self->throw_exception("Cannot safely delete a row in a PK-less table")
137 if ! keys %$ident_cond;
e0f56292 138 foreach my $column (keys %$ident_cond) {
75d07914 139 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
140 unless exists $self->{_column_data}{$column};
e0f56292 141 }
88cb6a1d 142 $self->result_source->storage->delete(
4b12b3c2 143 $self->result_source->from, $ident_cond);
7624b19f 144 $self->in_storage(undef);
7624b19f 145 } else {
701da8c4 146 $self->throw_exception("Can't do class delete without a ResultSource instance")
097d3227 147 unless $self->can('result_source_instance');
aeb1bf75 148 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
149 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
097d3227 150 $self->result_source_instance->resultset->search(@_)->delete;
7624b19f 151 }
152 return $self;
153}
154
8091aa91 155=head2 get_column
7624b19f 156
157 my $val = $obj->get_column($col);
158
8091aa91 159Gets a column value from a row object. Currently, does not do
160any queries; the column must have already been fetched from
161the database and stored in the object.
7624b19f 162
163=cut
164
165sub get_column {
166 my ($self, $column) = @_;
701da8c4 167 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
aeb1bf75 168 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
701da8c4 169 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
7624b19f 170 return undef;
171}
172
def81720 173sub has_column_loaded {
174 my ($self, $column) = @_;
175 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
aeb1bf75 176 return exists $self->{_column_data}{$column};
def81720 177}
178
8091aa91 179=head2 get_columns
076a6864 180
181 my %data = $obj->get_columns;
182
8091aa91 183Does C<get_column>, for all column values at once.
076a6864 184
185=cut
186
187sub get_columns {
188 my $self = shift;
cb5f2eea 189 return %{$self->{_column_data}};
d7156e50 190}
191
192=head2 get_dirty_columns
193
194 my %data = $obj->get_dirty_columns;
195
196Identical to get_columns but only returns those that have been changed.
197
198=cut
199
200sub get_dirty_columns {
201 my $self = shift;
202 return map { $_ => $self->{_column_data}{$_} }
203 keys %{$self->{_dirty_columns}};
076a6864 204}
205
8091aa91 206=head2 set_column
7624b19f 207
208 $obj->set_column($col => $val);
209
8091aa91 210Sets a column value. If the new value is different from the old one,
211the column is marked as dirty for when you next call $obj->update.
7624b19f 212
213=cut
214
215sub set_column {
216 my $self = shift;
217 my ($column) = @_;
218 my $old = $self->get_column($column);
219 my $ret = $self->store_column(@_);
87772e46 220 $self->{_dirty_columns}{$column} = 1
221 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
7624b19f 222 return $ret;
223}
224
8091aa91 225=head2 set_columns
076a6864 226
dc818523 227 my $copy = $orig->set_columns({ $col => $val, ... });
076a6864 228
8091aa91 229Sets more than one column value at once.
076a6864 230
231=cut
232
233sub set_columns {
234 my ($self,$data) = @_;
a2ca474b 235 foreach my $col (keys %$data) {
236 $self->set_column($col,$data->{$col});
076a6864 237 }
c01ab172 238 return $self;
076a6864 239}
240
8091aa91 241=head2 copy
076a6864 242
243 my $copy = $orig->copy({ change => $to, ... });
244
8091aa91 245Inserts a new row with the specified changes.
076a6864 246
247=cut
248
c01ab172 249sub copy {
250 my ($self, $changes) = @_;
333cce60 251 $changes ||= {};
fde6e28e 252 my $col_data = { %{$self->{_column_data}} };
253 foreach my $col (keys %$col_data) {
254 delete $col_data->{$col}
255 if $self->result_source->column_info($col)->{is_auto_increment};
256 }
aeb1bf75 257 my $new = bless { _column_data => $col_data }, ref $self;
83419ec6 258 $new->result_source($self->result_source);
ecd1f408 259 $new->set_columns($changes);
333cce60 260 $new->insert;
261 foreach my $rel ($self->result_source->relationships) {
262 my $rel_info = $self->result_source->relationship_info($rel);
263 if ($rel_info->{attrs}{cascade_copy}) {
264 my $resolved = $self->result_source->resolve_condition(
265 $rel_info->{cond}, $rel, $new);
266 foreach my $related ($self->search_related($rel)) {
267 $related->copy($resolved);
268 }
269 }
270 }
2c4c67b6 271 return $new;
c01ab172 272}
273
8091aa91 274=head2 store_column
7624b19f 275
276 $obj->store_column($col => $val);
277
8091aa91 278Sets a column value without marking it as dirty.
7624b19f 279
280=cut
281
282sub store_column {
283 my ($self, $column, $value) = @_;
75d07914 284 $self->throw_exception( "No such column '${column}'" )
d7156e50 285 unless exists $self->{_column_data}{$column} || $self->has_column($column);
75d07914 286 $self->throw_exception( "set_column called for ${column} without value" )
7624b19f 287 if @_ < 3;
288 return $self->{_column_data}{$column} = $value;
289}
290
b52e9bf8 291=head2 inflate_result
292
c01ab172 293 Class->inflate_result($result_source, \%me, \%prefetch?)
b52e9bf8 294
295Called by ResultSet to inflate a result from storage
296
297=cut
298
299sub inflate_result {
c01ab172 300 my ($class, $source, $me, $prefetch) = @_;
b52e9bf8 301 #use Data::Dumper; print Dumper(@_);
c01ab172 302 my $new = bless({ result_source => $source,
303 _column_data => $me,
304 _in_storage => 1
305 },
306 ref $class || $class);
7fb16f1a 307 my $schema;
64acc2bc 308 foreach my $pre (keys %{$prefetch||{}}) {
309 my $pre_val = $prefetch->{$pre};
f9cc31dd 310 my $pre_source = $source->related_source($pre);
a86b1efe 311 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
312 unless $pre_source;
0f66a01b 313 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
a86b1efe 314 my @pre_objects;
315 foreach my $pre_rec (@$pre_val) {
75d07914 316 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
5a5bec6c 317 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
a86b1efe 318 next;
319 }
320 push(@pre_objects, $pre_source->result_class->inflate_result(
321 $pre_source, @{$pre_rec}));
322 }
323 $new->related_resultset($pre)->set_cache(\@pre_objects);
62e87ea8 324 } elsif (defined $pre_val->[0]) {
a86b1efe 325 my $fetched;
75d07914 326 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
a86b1efe 327 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
328 {
329 $fetched = $pre_source->result_class->inflate_result(
75d07914 330 $pre_source, @{$pre_val});
a86b1efe 331 }
332 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
333 $class->throw_exception("No accessor for prefetched $pre")
334 unless defined $accessor;
335 if ($accessor eq 'single') {
336 $new->{_relationship_data}{$pre} = $fetched;
337 } elsif ($accessor eq 'filter') {
338 $new->{_inflated_column}{$pre} = $fetched;
339 } else {
340 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
341 }
b52e9bf8 342 }
343 }
7624b19f 344 return $new;
345}
346
9b465d00 347=head2 update_or_insert
7624b19f 348
9b465d00 349 $obj->update_or_insert
7624b19f 350
8091aa91 351Updates the object if it's already in the db, else inserts it.
7624b19f 352
353=cut
354
9b465d00 355*insert_or_update = \&update_or_insert;
356sub update_or_insert {
7624b19f 357 my $self = shift;
358 return ($self->in_storage ? $self->update : $self->insert);
359}
360
8091aa91 361=head2 is_changed
7624b19f 362
228dbcb4 363 my @changed_col_names = $obj->is_changed();
364 if ($obj->is_changed()) { ... }
7624b19f 365
366=cut
367
368sub is_changed {
369 return keys %{shift->{_dirty_columns} || {}};
370}
228dbcb4 371
372=head2 is_column_changed
373
374 if ($obj->is_column_changed('col')) { ... }
375
376=cut
377
378sub is_column_changed {
379 my( $self, $col ) = @_;
380 return exists $self->{_dirty_columns}->{$col};
381}
7624b19f 382
097d3227 383=head2 result_source
384
385 Accessor to the ResultSource this object was created from
386
87c4e602 387=head2 register_column
388
27f01d1f 389=over 4
390
ebc77b53 391=item Arguments: $column, $column_info
27f01d1f 392
393=back
1f23a877 394
91b0fbd7 395 Registers a column on the class. If the column_info has an 'accessor' key,
396 creates an accessor named after the value if defined; if there is no such
397 key, creates an accessor with the same name as the column
1f23a877 398
097d3227 399=cut
400
1f23a877 401sub register_column {
402 my ($class, $col, $info) = @_;
91b0fbd7 403 my $acc = $col;
404 if (exists $info->{accessor}) {
405 return unless defined $info->{accessor};
406 $acc = [ $info->{accessor}, $col ];
407 }
408 $class->mk_group_accessors('column' => $acc);
1f23a877 409}
410
701da8c4 411
5160b401 412=head2 throw_exception
701da8c4 413
414See Schema's throw_exception.
415
416=cut
417
418sub throw_exception {
419 my $self=shift;
420 if (ref $self && ref $self->result_source) {
421 $self->result_source->schema->throw_exception(@_);
422 } else {
423 croak(@_);
424 }
425}
426
7624b19f 4271;
428
7624b19f 429=head1 AUTHORS
430
daec44b8 431Matt S. Trout <mst@shadowcatsystems.co.uk>
7624b19f 432
433=head1 LICENSE
434
435You may distribute this code under the same terms as Perl itself.
436
437=cut
438