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