ResultSetColumn::func() now returns all results if called in list context
[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/;
33dd4e80 8use Scalar::Util ();
9c6d6d93 9use Scope::Guard;
1edd1722 10
aec3eff1 11__PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
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
33dd4e80 32Passing an object, or an arrayref of objects as a value will call
33L<DBIx::Class::Relationship::Base/set_from_related> for you. When
34passed a hashref or an arrayref of hashrefs as the value, these will
35be turned into objects via new_related, and treated as if you had
36passed objects.
37
264f1571 38For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
39
7624b19f 40=cut
41
33dd4e80 42## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
43## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
44## When doing the later insert, we need to make sure the PKs are set.
45## using _relationship_data in new and funky ways..
46## check Relationship::CascadeActions and Relationship::Accessor for compat
47## tests!
48
7624b19f 49sub new {
448f820f 50 my ($class, $attrs) = @_;
7624b19f 51 $class = ref $class if ref $class;
04786a4c 52
53 my $new = { _column_data => {} };
54 bless $new, $class;
55
448f820f 56 if (my $handle = delete $attrs->{-source_handle}) {
57 $new->_source_handle($handle);
58 }
e9fe476b 59 if (my $source = delete $attrs->{-result_source}) {
60 $new->result_source($source);
61 }
a6a280b9 62
7624b19f 63 if ($attrs) {
27f01d1f 64 $new->throw_exception("attrs must be a hashref")
65 unless ref($attrs) eq 'HASH';
61a622ee 66
67 my ($related,$inflated);
de7c7c53 68 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
69 $new->{_rel_in_storage} = 1;
8222f722 70
61a622ee 71 foreach my $key (keys %$attrs) {
72 if (ref $attrs->{$key}) {
af2d42c0 73 ## Can we extract this lot to use with update(_or .. ) ?
61a622ee 74 my $info = $class->relationship_info($key);
75 if ($info && $info->{attrs}{accessor}
c4a30d56 76 && $info->{attrs}{accessor} eq 'single')
61a622ee 77 {
de7c7c53 78 my $rel_obj = delete $attrs->{$key};
33dd4e80 79 if(!Scalar::Util::blessed($rel_obj)) {
2ec8e594 80 $rel_obj = $new->find_or_new_related($key, $rel_obj);
33dd4e80 81 }
2bc3c81e 82
83 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
84
de7c7c53 85 $new->set_from_related($key, $rel_obj);
86 $related->{$key} = $rel_obj;
61a622ee 87 next;
33dd4e80 88 } elsif ($info && $info->{attrs}{accessor}
89 && $info->{attrs}{accessor} eq 'multi'
90 && ref $attrs->{$key} eq 'ARRAY') {
2ec8e594 91 my $others = delete $attrs->{$key};
92 foreach my $rel_obj (@$others) {
93 if(!Scalar::Util::blessed($rel_obj)) {
94 $rel_obj = $new->new_related($key, $rel_obj);
95 $new->{_rel_in_storage} = 0;
33dd4e80 96 }
2bc3c81e 97
98 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
2ec8e594 99 }
100 $related->{$key} = $others;
101 next;
102 } elsif ($info && $info->{attrs}{accessor}
103 && $info->{attrs}{accessor} eq 'filter')
61a622ee 104 {
33dd4e80 105 ## 'filter' should disappear and get merged in with 'single' above!
2ec8e594 106 my $rel_obj = delete $attrs->{$key};
33dd4e80 107 if(!Scalar::Util::blessed($rel_obj)) {
df78aeb1 108 $rel_obj = $new->find_or_new_related($key, $rel_obj);
109 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
33dd4e80 110 }
111 $inflated->{$key} = $rel_obj;
61a622ee 112 next;
2ec8e594 113 } elsif ($class->has_column($key)
114 && $class->column_info($key)->{_inflate_info}) {
61a622ee 115 $inflated->{$key} = $attrs->{$key};
116 next;
117 }
118 }
de7c7c53 119 use Data::Dumper;
61a622ee 120 $new->throw_exception("No such column $key on $class")
121 unless $class->has_column($key);
122 $new->store_column($key => $attrs->{$key});
7624b19f 123 }
f90375dd 124
61a622ee 125 $new->{_relationship_data} = $related if $related;
126 $new->{_inflated_column} = $inflated if $inflated;
7624b19f 127 }
04786a4c 128
7624b19f 129 return $new;
130}
131
8091aa91 132=head2 insert
7624b19f 133
134 $obj->insert;
135
b8810cc5 136Inserts an object into the database if it isn't already in
137there. Returns the object itself. Requires the object's result source to
138be set, or the class to have a result_source_instance method. To insert
139an entirely new object into the database, use C<create> (see
140L<DBIx::Class::ResultSet/create>).
7624b19f 141
264f1571 142This will also insert any uninserted, related objects held inside this
143one, see L<DBIx::Class::ResultSet/create> for more details.
144
7624b19f 145=cut
146
147sub insert {
148 my ($self) = @_;
149 return $self if $self->in_storage;
6aba697f 150 my $source = $self->result_source;
151 $source ||= $self->result_source($self->result_source_instance)
097d3227 152 if $self->can('result_source_instance');
aeb1bf75 153 $self->throw_exception("No result_source set on this object; can't insert")
154 unless $source;
6e399b4f 155
9c6d6d93 156 my $rollback_guard;
157
33dd4e80 158 # Check if we stored uninserted relobjs here in new()
33dd4e80 159 my %related_stuff = (%{$self->{_relationship_data} || {}},
160 %{$self->{_inflated_column} || {}});
9c6d6d93 161
ae66ef47 162 if(!$self->{_rel_in_storage}) {
8222f722 163 $source->storage->txn_begin;
164
9c6d6d93 165 # The guard will save us if we blow out of this scope via die
166
167 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
168
8222f722 169 ## Should all be in relationship_data, but we need to get rid of the
170 ## 'filter' reltype..
171 ## These are the FK rels, need their IDs for the insert.
9c6d6d93 172
173 my @pri = $self->primary_columns;
174
175 REL: foreach my $relname (keys %related_stuff) {
a8c98174 176
177 my $rel_obj = $related_stuff{$relname};
178
179 next REL unless (Scalar::Util::blessed($rel_obj)
180 && $rel_obj->isa('DBIx::Class::Row'));
181
182 my $cond = $source->relationship_info($relname)->{cond};
183
184 next REL unless ref($cond) eq 'HASH';
185
186 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
187
188 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
9c6d6d93 189
190 # assume anything that references our PK probably is dependent on us
a8c98174 191 # rather than vice versa, unless the far side is (a) defined or (b)
192 # auto-increment
9c6d6d93 193
194 foreach my $p (@pri) {
a8c98174 195 if (exists $keyhash->{$p}) {
a8c98174 196 unless (defined($rel_obj->get_column($keyhash->{$p}))
197 || $rel_obj->column_info($keyhash->{$p})
198 ->{is_auto_increment}) {
199 next REL;
200 }
201 }
9c6d6d93 202 }
203
a8c98174 204 $rel_obj->insert();
205 $self->set_from_related($relname, $rel_obj);
206 delete $related_stuff{$relname};
33dd4e80 207 }
208 }
6e399b4f 209
7af8b477 210 $source->storage->insert($source, { $self->get_columns });
ac8e89d7 211
212 ## PK::Auto
3fda409f 213 my @auto_pri = grep {
214 !defined $self->get_column($_) ||
215 ref($self->get_column($_)) eq 'SCALAR'
216 } $self->primary_columns;
217
218 if (@auto_pri) {
219 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
220 # if defined $too_many;
ac8e89d7 221
222 my $storage = $self->result_source->storage;
223 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
224 unless $storage->can('last_insert_id');
3fda409f 225 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
226 $self->throw_exception( "Can't get last insert id" )
227 unless (@ids == @auto_pri);
228 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
ac8e89d7 229 }
33dd4e80 230
ae66ef47 231 if(!$self->{_rel_in_storage}) {
8222f722 232 ## Now do the has_many rels, that need $selfs ID.
233 foreach my $relname (keys %related_stuff) {
9c6d6d93 234 my $rel_obj = $related_stuff{$relname};
235 my @cands;
236 if (Scalar::Util::blessed($rel_obj)
237 && $rel_obj->isa('DBIx::Class::Row')) {
238 @cands = ($rel_obj);
239 } elsif (ref $rel_obj eq 'ARRAY') {
240 @cands = @$rel_obj;
241 }
242 if (@cands) {
243 my $reverse = $source->reverse_relationship_info($relname);
244 foreach my $obj (@cands) {
245 $obj->set_from_related($_, $self) for keys %$reverse;
8222f722 246 $obj->insert() if(!$obj->in_storage);
247 }
33dd4e80 248 }
249 }
8222f722 250 $source->storage->txn_commit;
9c6d6d93 251 $rollback_guard->dismiss;
33dd4e80 252 }
33dd4e80 253
7624b19f 254 $self->in_storage(1);
255 $self->{_dirty_columns} = {};
64acc2bc 256 $self->{related_resultsets} = {};
729b29ae 257 undef $self->{_orig_ident};
7624b19f 258 return $self;
259}
260
8091aa91 261=head2 in_storage
7624b19f 262
263 $obj->in_storage; # Get value
264 $obj->in_storage(1); # Set value
265
264f1571 266Indicates whether the object exists as a row in the database or not
7624b19f 267
268=cut
269
270sub in_storage {
271 my ($self, $val) = @_;
272 $self->{_in_storage} = $val if @_ > 1;
273 return $self->{_in_storage};
274}
275
8091aa91 276=head2 update
7624b19f 277
d5d833d9 278 $obj->update \%columns?;
7624b19f 279
280Must be run on an object that is already in the database; issues an SQL
d3b0e369 281UPDATE query to commit any changes to the object to the database if
282required.
7624b19f 283
d5d833d9 284Also takes an options hashref of C<< column_name => value> pairs >> to update
285first. But be aware that this hashref might be edited in place, so dont rely on
8b621a87 286it being the same after a call to C<update>. If you need to preserve the hashref,
287it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
d5d833d9 288
7624b19f 289=cut
290
291sub update {
292 my ($self, $upd) = @_;
701da8c4 293 $self->throw_exception( "Not in database" ) unless $self->in_storage;
4b12b3c2 294 my $ident_cond = $self->ident_condition;
295 $self->throw_exception("Cannot safely update a row in a PK-less table")
296 if ! keys %$ident_cond;
6e399b4f 297
61a622ee 298 if ($upd) {
299 foreach my $key (keys %$upd) {
300 if (ref $upd->{$key}) {
301 my $info = $self->relationship_info($key);
302 if ($info && $info->{attrs}{accessor}
303 && $info->{attrs}{accessor} eq 'single')
304 {
305 my $rel = delete $upd->{$key};
306 $self->set_from_related($key => $rel);
307 $self->{_relationship_data}{$key} = $rel;
af2d42c0 308 } elsif ($info && $info->{attrs}{accessor}
309 && $info->{attrs}{accessor} eq 'multi'
310 && ref $upd->{$key} eq 'ARRAY') {
311 my $others = delete $upd->{$key};
312 foreach my $rel_obj (@$others) {
313 if(!Scalar::Util::blessed($rel_obj)) {
314 $rel_obj = $self->create_related($key, $rel_obj);
315 }
316 }
317 $self->{_relationship_data}{$key} = $others;
318# $related->{$key} = $others;
319 next;
320 }
61a622ee 321 elsif ($self->has_column($key)
322 && exists $self->column_info($key)->{_inflate_info})
323 {
324 $self->set_inflated_column($key, delete $upd->{$key});
325 }
326 }
327 }
328 $self->set_columns($upd);
329 }
5a9e0e60 330 my %to_update = $self->get_dirty_columns;
331 return $self unless keys %to_update;
88cb6a1d 332 my $rows = $self->result_source->storage->update(
f4afcd5d 333 $self->result_source, \%to_update,
334 $self->{_orig_ident} || $ident_cond
335 );
7624b19f 336 if ($rows == 0) {
701da8c4 337 $self->throw_exception( "Can't update ${self}: row not found" );
7624b19f 338 } elsif ($rows > 1) {
701da8c4 339 $self->throw_exception("Can't update ${self}: updated more than one row");
7624b19f 340 }
341 $self->{_dirty_columns} = {};
64acc2bc 342 $self->{related_resultsets} = {};
729b29ae 343 undef $self->{_orig_ident};
7624b19f 344 return $self;
345}
346
8091aa91 347=head2 delete
7624b19f 348
349 $obj->delete
350
b8810cc5 351Deletes the object from the database. The object is still perfectly
61a622ee 352usable, but C<< ->in_storage() >> will now return 0 and the object must
353reinserted using C<< ->insert() >> before C<< ->update() >> can be used
b8810cc5 354on it. If you delete an object in a class with a C<has_many>
355relationship, all the related objects will be deleted as well. To turn
356this behavior off, pass C<cascade_delete => 0> in the C<$attr>
357hashref. Any database-level cascade or restrict will take precedence
358over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
7624b19f 359
360=cut
361
362sub delete {
363 my $self = shift;
364 if (ref $self) {
701da8c4 365 $self->throw_exception( "Not in database" ) unless $self->in_storage;
4b12b3c2 366 my $ident_cond = $self->ident_condition;
367 $self->throw_exception("Cannot safely delete a row in a PK-less table")
368 if ! keys %$ident_cond;
e0f56292 369 foreach my $column (keys %$ident_cond) {
75d07914 370 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
371 unless exists $self->{_column_data}{$column};
e0f56292 372 }
88cb6a1d 373 $self->result_source->storage->delete(
7af8b477 374 $self->result_source, $ident_cond);
7624b19f 375 $self->in_storage(undef);
7624b19f 376 } else {
701da8c4 377 $self->throw_exception("Can't do class delete without a ResultSource instance")
097d3227 378 unless $self->can('result_source_instance');
aeb1bf75 379 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
380 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
097d3227 381 $self->result_source_instance->resultset->search(@_)->delete;
7624b19f 382 }
383 return $self;
384}
385
8091aa91 386=head2 get_column
7624b19f 387
388 my $val = $obj->get_column($col);
389
61a622ee 390Gets a column value from a row object. Does not do any queries; the column
391must have already been fetched from the database and stored in the object. If
392there is an inflated value stored that has not yet been deflated, it is deflated
393when the method is invoked.
7624b19f 394
395=cut
396
397sub get_column {
398 my ($self, $column) = @_;
701da8c4 399 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
aeb1bf75 400 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
61a622ee 401 if (exists $self->{_inflated_column}{$column}) {
402 return $self->store_column($column,
403 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
404 }
701da8c4 405 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
7624b19f 406 return undef;
407}
408
9b83fccd 409=head2 has_column_loaded
410
411 if ( $obj->has_column_loaded($col) ) {
412 print "$col has been loaded from db";
413 }
414
415Returns a true value if the column value has been loaded from the
416database (or set locally).
417
418=cut
419
def81720 420sub has_column_loaded {
421 my ($self, $column) = @_;
422 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
61a622ee 423 return 1 if exists $self->{_inflated_column}{$column};
aeb1bf75 424 return exists $self->{_column_data}{$column};
def81720 425}
426
8091aa91 427=head2 get_columns
076a6864 428
429 my %data = $obj->get_columns;
430
8091aa91 431Does C<get_column>, for all column values at once.
076a6864 432
433=cut
434
435sub get_columns {
436 my $self = shift;
61a622ee 437 if (exists $self->{_inflated_column}) {
438 foreach my $col (keys %{$self->{_inflated_column}}) {
439 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
c4a30d56 440 unless exists $self->{_column_data}{$col};
61a622ee 441 }
442 }
cb5f2eea 443 return %{$self->{_column_data}};
d7156e50 444}
445
446=head2 get_dirty_columns
447
448 my %data = $obj->get_dirty_columns;
449
450Identical to get_columns but only returns those that have been changed.
451
452=cut
453
454sub get_dirty_columns {
455 my $self = shift;
456 return map { $_ => $self->{_column_data}{$_} }
457 keys %{$self->{_dirty_columns}};
076a6864 458}
459
ba4a6453 460=head2 get_inflated_columns
461
462 my $inflated_data = $obj->get_inflated_columns;
463
464Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
465
466=cut
467
468sub get_inflated_columns {
469 my $self = shift;
470 return map {
471 my $accessor = $self->column_info($_)->{'accessor'} || $_;
472 ($_ => $self->$accessor);
473 } $self->columns;
474}
475
8091aa91 476=head2 set_column
7624b19f 477
478 $obj->set_column($col => $val);
479
8091aa91 480Sets a column value. If the new value is different from the old one,
481the column is marked as dirty for when you next call $obj->update.
7624b19f 482
483=cut
484
485sub set_column {
486 my $self = shift;
487 my ($column) = @_;
729b29ae 488 $self->{_orig_ident} ||= $self->ident_condition;
7624b19f 489 my $old = $self->get_column($column);
490 my $ret = $self->store_column(@_);
87772e46 491 $self->{_dirty_columns}{$column} = 1
492 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
7624b19f 493 return $ret;
494}
495
8091aa91 496=head2 set_columns
076a6864 497
dc818523 498 my $copy = $orig->set_columns({ $col => $val, ... });
076a6864 499
8091aa91 500Sets more than one column value at once.
076a6864 501
502=cut
503
504sub set_columns {
505 my ($self,$data) = @_;
a2ca474b 506 foreach my $col (keys %$data) {
507 $self->set_column($col,$data->{$col});
076a6864 508 }
c01ab172 509 return $self;
076a6864 510}
511
8091aa91 512=head2 copy
076a6864 513
514 my $copy = $orig->copy({ change => $to, ... });
515
8091aa91 516Inserts a new row with the specified changes.
076a6864 517
518=cut
519
c01ab172 520sub copy {
521 my ($self, $changes) = @_;
333cce60 522 $changes ||= {};
fde6e28e 523 my $col_data = { %{$self->{_column_data}} };
524 foreach my $col (keys %$col_data) {
525 delete $col_data->{$col}
526 if $self->result_source->column_info($col)->{is_auto_increment};
527 }
04786a4c 528
529 my $new = { _column_data => $col_data };
530 bless $new, ref $self;
531
83419ec6 532 $new->result_source($self->result_source);
ecd1f408 533 $new->set_columns($changes);
333cce60 534 $new->insert;
535 foreach my $rel ($self->result_source->relationships) {
536 my $rel_info = $self->result_source->relationship_info($rel);
537 if ($rel_info->{attrs}{cascade_copy}) {
538 my $resolved = $self->result_source->resolve_condition(
539 $rel_info->{cond}, $rel, $new);
540 foreach my $related ($self->search_related($rel)) {
541 $related->copy($resolved);
542 }
543 }
544 }
2c4c67b6 545 return $new;
c01ab172 546}
547
8091aa91 548=head2 store_column
7624b19f 549
550 $obj->store_column($col => $val);
551
8091aa91 552Sets a column value without marking it as dirty.
7624b19f 553
554=cut
555
556sub store_column {
557 my ($self, $column, $value) = @_;
75d07914 558 $self->throw_exception( "No such column '${column}'" )
d7156e50 559 unless exists $self->{_column_data}{$column} || $self->has_column($column);
75d07914 560 $self->throw_exception( "set_column called for ${column} without value" )
7624b19f 561 if @_ < 3;
562 return $self->{_column_data}{$column} = $value;
563}
564
b52e9bf8 565=head2 inflate_result
566
c01ab172 567 Class->inflate_result($result_source, \%me, \%prefetch?)
b52e9bf8 568
569Called by ResultSet to inflate a result from storage
570
571=cut
572
573sub inflate_result {
c01ab172 574 my ($class, $source, $me, $prefetch) = @_;
aec3eff1 575
576 my ($source_handle) = $source;
577
578 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
579 $source = $source_handle->resolve
580 } else {
581 $source_handle = $source->handle
582 }
583
04786a4c 584 my $new = {
aec3eff1 585 _source_handle => $source_handle,
04786a4c 586 _column_data => $me,
587 _in_storage => 1
588 };
589 bless $new, (ref $class || $class);
590
7fb16f1a 591 my $schema;
64acc2bc 592 foreach my $pre (keys %{$prefetch||{}}) {
593 my $pre_val = $prefetch->{$pre};
f9cc31dd 594 my $pre_source = $source->related_source($pre);
a86b1efe 595 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
596 unless $pre_source;
0f66a01b 597 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
a86b1efe 598 my @pre_objects;
599 foreach my $pre_rec (@$pre_val) {
75d07914 600 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
5a5bec6c 601 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
a86b1efe 602 next;
603 }
604 push(@pre_objects, $pre_source->result_class->inflate_result(
605 $pre_source, @{$pre_rec}));
606 }
607 $new->related_resultset($pre)->set_cache(\@pre_objects);
62e87ea8 608 } elsif (defined $pre_val->[0]) {
a86b1efe 609 my $fetched;
75d07914 610 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
a86b1efe 611 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
612 {
613 $fetched = $pre_source->result_class->inflate_result(
75d07914 614 $pre_source, @{$pre_val});
a86b1efe 615 }
9809a6df 616 $new->related_resultset($pre)->set_cache([ $fetched ]);
a86b1efe 617 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
618 $class->throw_exception("No accessor for prefetched $pre")
619 unless defined $accessor;
620 if ($accessor eq 'single') {
621 $new->{_relationship_data}{$pre} = $fetched;
622 } elsif ($accessor eq 'filter') {
623 $new->{_inflated_column}{$pre} = $fetched;
624 } else {
625 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
626 }
b52e9bf8 627 }
628 }
7624b19f 629 return $new;
630}
631
9b465d00 632=head2 update_or_insert
7624b19f 633
9b465d00 634 $obj->update_or_insert
7624b19f 635
8091aa91 636Updates the object if it's already in the db, else inserts it.
7624b19f 637
9b83fccd 638=head2 insert_or_update
639
640 $obj->insert_or_update
641
642Alias for L</update_or_insert>
643
7624b19f 644=cut
645
9b465d00 646*insert_or_update = \&update_or_insert;
647sub update_or_insert {
7624b19f 648 my $self = shift;
649 return ($self->in_storage ? $self->update : $self->insert);
650}
651
8091aa91 652=head2 is_changed
7624b19f 653
228dbcb4 654 my @changed_col_names = $obj->is_changed();
655 if ($obj->is_changed()) { ... }
7624b19f 656
9b83fccd 657In array context returns a list of columns with uncommited changes, or
658in scalar context returns a true value if there are uncommitted
659changes.
660
7624b19f 661=cut
662
663sub is_changed {
664 return keys %{shift->{_dirty_columns} || {}};
665}
228dbcb4 666
667=head2 is_column_changed
668
669 if ($obj->is_column_changed('col')) { ... }
670
9b83fccd 671Returns a true value if the column has uncommitted changes.
672
228dbcb4 673=cut
674
675sub is_column_changed {
676 my( $self, $col ) = @_;
677 return exists $self->{_dirty_columns}->{$col};
678}
7624b19f 679
097d3227 680=head2 result_source
681
9b83fccd 682 my $resultsource = $object->result_source;
097d3227 683
9b83fccd 684Accessor to the ResultSource this object was created from
87c4e602 685
aec3eff1 686=cut
687
688sub result_source {
689 my $self = shift;
690
691 if (@_) {
692 $self->_source_handle($_[0]->handle);
693 } else {
694 $self->_source_handle->resolve;
695 }
696}
697
9b83fccd 698=head2 register_column
27f01d1f 699
9b83fccd 700 $column_info = { .... };
701 $class->register_column($column_name, $column_info);
27f01d1f 702
9b83fccd 703Registers a column on the class. If the column_info has an 'accessor'
704key, creates an accessor named after the value if defined; if there is
705no such key, creates an accessor with the same name as the column
1f23a877 706
9b83fccd 707The column_info attributes are described in
708L<DBIx::Class::ResultSource/add_columns>
1f23a877 709
097d3227 710=cut
711
1f23a877 712sub register_column {
713 my ($class, $col, $info) = @_;
91b0fbd7 714 my $acc = $col;
715 if (exists $info->{accessor}) {
716 return unless defined $info->{accessor};
717 $acc = [ $info->{accessor}, $col ];
718 }
719 $class->mk_group_accessors('column' => $acc);
1f23a877 720}
721
701da8c4 722
5160b401 723=head2 throw_exception
701da8c4 724
725See Schema's throw_exception.
726
727=cut
728
729sub throw_exception {
730 my $self=shift;
66cab05c 731 if (ref $self && ref $self->result_source && $self->result_source->schema) {
701da8c4 732 $self->result_source->schema->throw_exception(@_);
733 } else {
734 croak(@_);
735 }
736}
737
7624b19f 7381;
739
7624b19f 740=head1 AUTHORS
741
daec44b8 742Matt S. Trout <mst@shadowcatsystems.co.uk>
7624b19f 743
744=head1 LICENSE
745
746You may distribute this code under the same terms as Perl itself.
747
748=cut