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