Updated version and Changes for 0.06999_02
[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
9b83fccd 173=head2 has_column_loaded
174
175 if ( $obj->has_column_loaded($col) ) {
176 print "$col has been loaded from db";
177 }
178
179Returns a true value if the column value has been loaded from the
180database (or set locally).
181
182=cut
183
def81720 184sub has_column_loaded {
185 my ($self, $column) = @_;
186 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
aeb1bf75 187 return exists $self->{_column_data}{$column};
def81720 188}
189
8091aa91 190=head2 get_columns
076a6864 191
192 my %data = $obj->get_columns;
193
8091aa91 194Does C<get_column>, for all column values at once.
076a6864 195
196=cut
197
198sub get_columns {
199 my $self = shift;
cb5f2eea 200 return %{$self->{_column_data}};
d7156e50 201}
202
203=head2 get_dirty_columns
204
205 my %data = $obj->get_dirty_columns;
206
207Identical to get_columns but only returns those that have been changed.
208
209=cut
210
211sub get_dirty_columns {
212 my $self = shift;
213 return map { $_ => $self->{_column_data}{$_} }
214 keys %{$self->{_dirty_columns}};
076a6864 215}
216
8091aa91 217=head2 set_column
7624b19f 218
219 $obj->set_column($col => $val);
220
8091aa91 221Sets a column value. If the new value is different from the old one,
222the column is marked as dirty for when you next call $obj->update.
7624b19f 223
224=cut
225
226sub set_column {
227 my $self = shift;
228 my ($column) = @_;
229 my $old = $self->get_column($column);
230 my $ret = $self->store_column(@_);
87772e46 231 $self->{_dirty_columns}{$column} = 1
232 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
7624b19f 233 return $ret;
234}
235
8091aa91 236=head2 set_columns
076a6864 237
dc818523 238 my $copy = $orig->set_columns({ $col => $val, ... });
076a6864 239
8091aa91 240Sets more than one column value at once.
076a6864 241
242=cut
243
244sub set_columns {
245 my ($self,$data) = @_;
a2ca474b 246 foreach my $col (keys %$data) {
247 $self->set_column($col,$data->{$col});
076a6864 248 }
c01ab172 249 return $self;
076a6864 250}
251
8091aa91 252=head2 copy
076a6864 253
254 my $copy = $orig->copy({ change => $to, ... });
255
8091aa91 256Inserts a new row with the specified changes.
076a6864 257
258=cut
259
c01ab172 260sub copy {
261 my ($self, $changes) = @_;
333cce60 262 $changes ||= {};
fde6e28e 263 my $col_data = { %{$self->{_column_data}} };
264 foreach my $col (keys %$col_data) {
265 delete $col_data->{$col}
266 if $self->result_source->column_info($col)->{is_auto_increment};
267 }
aeb1bf75 268 my $new = bless { _column_data => $col_data }, ref $self;
83419ec6 269 $new->result_source($self->result_source);
ecd1f408 270 $new->set_columns($changes);
333cce60 271 $new->insert;
272 foreach my $rel ($self->result_source->relationships) {
273 my $rel_info = $self->result_source->relationship_info($rel);
274 if ($rel_info->{attrs}{cascade_copy}) {
275 my $resolved = $self->result_source->resolve_condition(
276 $rel_info->{cond}, $rel, $new);
277 foreach my $related ($self->search_related($rel)) {
278 $related->copy($resolved);
279 }
280 }
281 }
2c4c67b6 282 return $new;
c01ab172 283}
284
8091aa91 285=head2 store_column
7624b19f 286
287 $obj->store_column($col => $val);
288
8091aa91 289Sets a column value without marking it as dirty.
7624b19f 290
291=cut
292
293sub store_column {
294 my ($self, $column, $value) = @_;
75d07914 295 $self->throw_exception( "No such column '${column}'" )
d7156e50 296 unless exists $self->{_column_data}{$column} || $self->has_column($column);
75d07914 297 $self->throw_exception( "set_column called for ${column} without value" )
7624b19f 298 if @_ < 3;
299 return $self->{_column_data}{$column} = $value;
300}
301
b52e9bf8 302=head2 inflate_result
303
c01ab172 304 Class->inflate_result($result_source, \%me, \%prefetch?)
b52e9bf8 305
306Called by ResultSet to inflate a result from storage
307
308=cut
309
310sub inflate_result {
c01ab172 311 my ($class, $source, $me, $prefetch) = @_;
b52e9bf8 312 #use Data::Dumper; print Dumper(@_);
c01ab172 313 my $new = bless({ result_source => $source,
314 _column_data => $me,
315 _in_storage => 1
316 },
317 ref $class || $class);
7fb16f1a 318 my $schema;
64acc2bc 319 foreach my $pre (keys %{$prefetch||{}}) {
320 my $pre_val = $prefetch->{$pre};
f9cc31dd 321 my $pre_source = $source->related_source($pre);
a86b1efe 322 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
323 unless $pre_source;
0f66a01b 324 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
a86b1efe 325 my @pre_objects;
326 foreach my $pre_rec (@$pre_val) {
75d07914 327 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
5a5bec6c 328 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
a86b1efe 329 next;
330 }
331 push(@pre_objects, $pre_source->result_class->inflate_result(
332 $pre_source, @{$pre_rec}));
333 }
334 $new->related_resultset($pre)->set_cache(\@pre_objects);
62e87ea8 335 } elsif (defined $pre_val->[0]) {
a86b1efe 336 my $fetched;
75d07914 337 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
a86b1efe 338 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
339 {
340 $fetched = $pre_source->result_class->inflate_result(
75d07914 341 $pre_source, @{$pre_val});
a86b1efe 342 }
343 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
344 $class->throw_exception("No accessor for prefetched $pre")
345 unless defined $accessor;
346 if ($accessor eq 'single') {
347 $new->{_relationship_data}{$pre} = $fetched;
348 } elsif ($accessor eq 'filter') {
349 $new->{_inflated_column}{$pre} = $fetched;
350 } else {
351 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
352 }
b52e9bf8 353 }
354 }
7624b19f 355 return $new;
356}
357
9b465d00 358=head2 update_or_insert
7624b19f 359
9b465d00 360 $obj->update_or_insert
7624b19f 361
8091aa91 362Updates the object if it's already in the db, else inserts it.
7624b19f 363
9b83fccd 364=head2 insert_or_update
365
366 $obj->insert_or_update
367
368Alias for L</update_or_insert>
369
7624b19f 370=cut
371
9b465d00 372*insert_or_update = \&update_or_insert;
373sub update_or_insert {
7624b19f 374 my $self = shift;
375 return ($self->in_storage ? $self->update : $self->insert);
376}
377
8091aa91 378=head2 is_changed
7624b19f 379
228dbcb4 380 my @changed_col_names = $obj->is_changed();
381 if ($obj->is_changed()) { ... }
7624b19f 382
9b83fccd 383In array context returns a list of columns with uncommited changes, or
384in scalar context returns a true value if there are uncommitted
385changes.
386
7624b19f 387=cut
388
389sub is_changed {
390 return keys %{shift->{_dirty_columns} || {}};
391}
228dbcb4 392
393=head2 is_column_changed
394
395 if ($obj->is_column_changed('col')) { ... }
396
9b83fccd 397Returns a true value if the column has uncommitted changes.
398
228dbcb4 399=cut
400
401sub is_column_changed {
402 my( $self, $col ) = @_;
403 return exists $self->{_dirty_columns}->{$col};
404}
7624b19f 405
097d3227 406=head2 result_source
407
9b83fccd 408 my $resultsource = $object->result_source;
097d3227 409
9b83fccd 410Accessor to the ResultSource this object was created from
87c4e602 411
9b83fccd 412=head2 register_column
27f01d1f 413
9b83fccd 414 $column_info = { .... };
415 $class->register_column($column_name, $column_info);
27f01d1f 416
9b83fccd 417Registers a column on the class. If the column_info has an 'accessor'
418key, creates an accessor named after the value if defined; if there is
419no such key, creates an accessor with the same name as the column
1f23a877 420
9b83fccd 421The column_info attributes are described in
422L<DBIx::Class::ResultSource/add_columns>
1f23a877 423
097d3227 424=cut
425
1f23a877 426sub register_column {
427 my ($class, $col, $info) = @_;
91b0fbd7 428 my $acc = $col;
429 if (exists $info->{accessor}) {
430 return unless defined $info->{accessor};
431 $acc = [ $info->{accessor}, $col ];
432 }
433 $class->mk_group_accessors('column' => $acc);
1f23a877 434}
435
701da8c4 436
5160b401 437=head2 throw_exception
701da8c4 438
439See Schema's throw_exception.
440
441=cut
442
443sub throw_exception {
444 my $self=shift;
445 if (ref $self && ref $self->result_source) {
446 $self->result_source->schema->throw_exception(@_);
447 } else {
448 croak(@_);
449 }
450}
451
7624b19f 4521;
453
7624b19f 454=head1 AUTHORS
455
daec44b8 456Matt S. Trout <mst@shadowcatsystems.co.uk>
7624b19f 457
458=head1 LICENSE
459
460You may distribute this code under the same terms as Perl itself.
461
462=cut
463