1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
7 use Carp::Clan qw/^DBIx::Class/;
11 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
15 DBIx::Class::Row - Basic row methods
21 This class is responsible for defining and doing basic operations on rows
22 derived from L<DBIx::Class::ResultSource> objects.
28 my $obj = My::Class->new($attrs);
30 Creates a new row object from column => value mappings passed as a hash ref
32 Passing an object, or an arrayref of objects as a value will call
33 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
34 passed a hashref or an arrayref of hashrefs as the value, these will
35 be turned into objects via new_related, and treated as if you had
38 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
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
50 my ($class, $attrs) = @_;
51 $class = ref $class if ref $class;
53 my $new = { _column_data => {} };
56 if (my $handle = delete $attrs->{-source_handle}) {
57 $new->_source_handle($handle);
59 if (my $source = delete $attrs->{-result_source}) {
60 $new->result_source($source);
64 $new->throw_exception("attrs must be a hashref")
65 unless ref($attrs) eq 'HASH';
67 my ($related,$inflated);
68 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
69 $new->{_rel_in_storage} = 1;
71 foreach my $key (keys %$attrs) {
72 if (ref $attrs->{$key}) {
73 ## Can we extract this lot to use with update(_or .. ) ?
74 my $info = $class->relationship_info($key);
75 if ($info && $info->{attrs}{accessor}
76 && $info->{attrs}{accessor} eq 'single')
78 my $rel_obj = delete $attrs->{$key};
79 if(!Scalar::Util::blessed($rel_obj)) {
80 $rel_obj = $new->find_or_new_related($key, $rel_obj);
83 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
85 $new->set_from_related($key, $rel_obj);
86 $related->{$key} = $rel_obj;
88 } elsif ($info && $info->{attrs}{accessor}
89 && $info->{attrs}{accessor} eq 'multi'
90 && ref $attrs->{$key} eq 'ARRAY') {
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;
98 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
100 $related->{$key} = $others;
102 } elsif ($info && $info->{attrs}{accessor}
103 && $info->{attrs}{accessor} eq 'filter')
105 ## 'filter' should disappear and get merged in with 'single' above!
106 my $rel_obj = delete $attrs->{$key};
107 if(!Scalar::Util::blessed($rel_obj)) {
108 $rel_obj = $new->find_or_new_related($key, $rel_obj);
109 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
111 $inflated->{$key} = $rel_obj;
113 } elsif ($class->has_column($key)
114 && $class->column_info($key)->{_inflate_info}) {
115 $inflated->{$key} = $attrs->{$key};
120 $new->throw_exception("No such column $key on $class")
121 unless $class->has_column($key);
122 $new->store_column($key => $attrs->{$key});
125 $new->{_relationship_data} = $related if $related;
126 $new->{_inflated_column} = $inflated if $inflated;
136 Inserts an object into the database if it isn't already in
137 there. Returns the object itself. Requires the object's result source to
138 be set, or the class to have a result_source_instance method. To insert
139 an entirely new object into the database, use C<create> (see
140 L<DBIx::Class::ResultSet/create>).
142 This will also insert any uninserted, related objects held inside this
143 one, see L<DBIx::Class::ResultSet/create> for more details.
149 return $self if $self->in_storage;
150 my $source = $self->result_source;
151 $source ||= $self->result_source($self->result_source_instance)
152 if $self->can('result_source_instance');
153 $self->throw_exception("No result_source set on this object; can't insert")
158 # Check if we stored uninserted relobjs here in new()
159 my %related_stuff = (%{$self->{_relationship_data} || {}},
160 %{$self->{_inflated_column} || {}});
162 if(!$self->{_rel_in_storage}) {
163 $source->storage->txn_begin;
165 # The guard will save us if we blow out of this scope via die
167 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
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.
173 my @pri = $self->primary_columns;
175 REL: foreach my $relname (keys %related_stuff) {
177 my $rel_obj = $related_stuff{$relname};
179 next REL unless (Scalar::Util::blessed($rel_obj)
180 && $rel_obj->isa('DBIx::Class::Row'));
182 my $cond = $source->relationship_info($relname)->{cond};
184 next REL unless ref($cond) eq 'HASH';
186 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
188 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
190 # assume anything that references our PK probably is dependent on us
191 # rather than vice versa, unless the far side is (a) defined or (b)
194 foreach my $p (@pri) {
195 if (exists $keyhash->{$p}) {
196 unless (defined($rel_obj->get_column($keyhash->{$p}))
197 || $rel_obj->column_info($keyhash->{$p})
198 ->{is_auto_increment}) {
205 $self->set_from_related($relname, $rel_obj);
206 delete $related_stuff{$relname};
210 $source->storage->insert($source, { $self->get_columns });
213 my @auto_pri = grep {
214 !defined $self->get_column($_) ||
215 ref($self->get_column($_)) eq 'SCALAR'
216 } $self->primary_columns;
219 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
220 # if defined $too_many;
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');
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;
231 if(!$self->{_rel_in_storage}) {
232 ## Now do the has_many rels, that need $selfs ID.
233 foreach my $relname (keys %related_stuff) {
234 my $rel_obj = $related_stuff{$relname};
236 if (Scalar::Util::blessed($rel_obj)
237 && $rel_obj->isa('DBIx::Class::Row')) {
239 } elsif (ref $rel_obj eq 'ARRAY') {
243 my $reverse = $source->reverse_relationship_info($relname);
244 foreach my $obj (@cands) {
245 $obj->set_from_related($_, $self) for keys %$reverse;
246 $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
250 $source->storage->txn_commit;
251 $rollback_guard->dismiss;
254 $self->in_storage(1);
255 $self->{_dirty_columns} = {};
256 $self->{related_resultsets} = {};
257 undef $self->{_orig_ident};
263 $obj->in_storage; # Get value
264 $obj->in_storage(1); # Set value
266 Indicates whether the object exists as a row in the database or not
271 my ($self, $val) = @_;
272 $self->{_in_storage} = $val if @_ > 1;
273 return $self->{_in_storage};
278 $obj->update \%columns?;
280 Must be run on an object that is already in the database; issues an SQL
281 UPDATE query to commit any changes to the object to the database if
284 Also takes an options hashref of C<< column_name => value> pairs >> to update
285 first. But be aware that this hashref might be edited in place, so dont rely on
286 it being the same after a call to C<update>. If you need to preserve the hashref,
287 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
292 my ($self, $upd) = @_;
293 $self->throw_exception( "Not in database" ) unless $self->in_storage;
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;
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')
305 my $rel = delete $upd->{$key};
306 $self->set_from_related($key => $rel);
307 $self->{_relationship_data}{$key} = $rel;
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);
317 $self->{_relationship_data}{$key} = $others;
318 # $related->{$key} = $others;
321 elsif ($self->has_column($key)
322 && exists $self->column_info($key)->{_inflate_info})
324 $self->set_inflated_column($key, delete $upd->{$key});
328 $self->set_columns($upd);
330 my %to_update = $self->get_dirty_columns;
331 return $self unless keys %to_update;
332 my $rows = $self->result_source->storage->update(
333 $self->result_source, \%to_update,
334 $self->{_orig_ident} || $ident_cond
337 $self->throw_exception( "Can't update ${self}: row not found" );
338 } elsif ($rows > 1) {
339 $self->throw_exception("Can't update ${self}: updated more than one row");
341 $self->{_dirty_columns} = {};
342 $self->{related_resultsets} = {};
343 undef $self->{_orig_ident};
351 Deletes the object from the database. The object is still perfectly
352 usable, but C<< ->in_storage() >> will now return 0 and the object must
353 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
354 on it. If you delete an object in a class with a C<has_many>
355 relationship, all the related objects will be deleted as well. To turn
356 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
357 hashref. Any database-level cascade or restrict will take precedence
358 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
365 $self->throw_exception( "Not in database" ) unless $self->in_storage;
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;
369 foreach my $column (keys %$ident_cond) {
370 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
371 unless exists $self->{_column_data}{$column};
373 $self->result_source->storage->delete(
374 $self->result_source, $ident_cond);
375 $self->in_storage(undef);
377 $self->throw_exception("Can't do class delete without a ResultSource instance")
378 unless $self->can('result_source_instance');
379 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
380 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
381 $self->result_source_instance->resultset->search(@_)->delete;
388 my $val = $obj->get_column($col);
390 Gets a column value from a row object. Does not do any queries; the column
391 must have already been fetched from the database and stored in the object. If
392 there is an inflated value stored that has not yet been deflated, it is deflated
393 when the method is invoked.
398 my ($self, $column) = @_;
399 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
400 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
401 if (exists $self->{_inflated_column}{$column}) {
402 return $self->store_column($column,
403 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
405 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
409 =head2 has_column_loaded
411 if ( $obj->has_column_loaded($col) ) {
412 print "$col has been loaded from db";
415 Returns a true value if the column value has been loaded from the
416 database (or set locally).
420 sub has_column_loaded {
421 my ($self, $column) = @_;
422 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
423 return 1 if exists $self->{_inflated_column}{$column};
424 return exists $self->{_column_data}{$column};
429 my %data = $obj->get_columns;
431 Does C<get_column>, for all column values at once.
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}))
440 unless exists $self->{_column_data}{$col};
443 return %{$self->{_column_data}};
446 =head2 get_dirty_columns
448 my %data = $obj->get_dirty_columns;
450 Identical to get_columns but only returns those that have been changed.
454 sub get_dirty_columns {
456 return map { $_ => $self->{_column_data}{$_} }
457 keys %{$self->{_dirty_columns}};
460 =head2 get_inflated_columns
462 my $inflated_data = $obj->get_inflated_columns;
464 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
468 sub get_inflated_columns {
471 my $accessor = $self->column_info($_)->{'accessor'} || $_;
472 ($_ => $self->$accessor);
478 $obj->set_column($col => $val);
480 Sets a column value. If the new value is different from the old one,
481 the column is marked as dirty for when you next call $obj->update.
488 $self->{_orig_ident} ||= $self->ident_condition;
489 my $old = $self->get_column($column);
490 my $ret = $self->store_column(@_);
491 $self->{_dirty_columns}{$column} = 1
492 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
498 my $copy = $orig->set_columns({ $col => $val, ... });
500 Sets more than one column value at once.
505 my ($self,$data) = @_;
506 foreach my $col (keys %$data) {
507 $self->set_column($col,$data->{$col});
514 my $copy = $orig->copy({ change => $to, ... });
516 Inserts a new row with the specified changes.
521 my ($self, $changes) = @_;
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};
529 my $new = { _column_data => $col_data };
530 bless $new, ref $self;
532 $new->result_source($self->result_source);
533 $new->set_columns($changes);
536 # Its possible we'll have 2 relations to the same Source. We need to make
537 # sure we don't try to insert the same row twice esle we'll violate unique
539 my $rels_copied = {};
541 foreach my $rel ($self->result_source->relationships) {
542 my $rel_info = $self->result_source->relationship_info($rel);
544 next unless $rel_info->{attrs}{cascade_copy};
546 my $resolved = $self->result_source->resolve_condition(
547 $rel_info->{cond}, $rel, $new
550 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
551 foreach my $related ($self->search_related($rel)) {
552 my $id_str = join("\0", $related->id);
553 next if $copied->{$id_str};
554 $copied->{$id_str} = 1;
555 my $rel_copy = $related->copy($resolved);
564 $obj->store_column($col => $val);
566 Sets a column value without marking it as dirty.
571 my ($self, $column, $value) = @_;
572 $self->throw_exception( "No such column '${column}'" )
573 unless exists $self->{_column_data}{$column} || $self->has_column($column);
574 $self->throw_exception( "set_column called for ${column} without value" )
576 return $self->{_column_data}{$column} = $value;
579 =head2 inflate_result
581 Class->inflate_result($result_source, \%me, \%prefetch?)
583 Called by ResultSet to inflate a result from storage
588 my ($class, $source, $me, $prefetch) = @_;
590 my ($source_handle) = $source;
592 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
593 $source = $source_handle->resolve
595 $source_handle = $source->handle
599 _source_handle => $source_handle,
603 bless $new, (ref $class || $class);
606 foreach my $pre (keys %{$prefetch||{}}) {
607 my $pre_val = $prefetch->{$pre};
608 my $pre_source = $source->related_source($pre);
609 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
611 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
613 foreach my $pre_rec (@$pre_val) {
614 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
615 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
618 push(@pre_objects, $pre_source->result_class->inflate_result(
619 $pre_source, @{$pre_rec}));
621 $new->related_resultset($pre)->set_cache(\@pre_objects);
622 } elsif (defined $pre_val->[0]) {
624 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
625 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
627 $fetched = $pre_source->result_class->inflate_result(
628 $pre_source, @{$pre_val});
630 $new->related_resultset($pre)->set_cache([ $fetched ]);
631 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
632 $class->throw_exception("No accessor for prefetched $pre")
633 unless defined $accessor;
634 if ($accessor eq 'single') {
635 $new->{_relationship_data}{$pre} = $fetched;
636 } elsif ($accessor eq 'filter') {
637 $new->{_inflated_column}{$pre} = $fetched;
639 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
646 =head2 update_or_insert
648 $obj->update_or_insert
650 Updates the object if it's already in the db, else inserts it.
652 =head2 insert_or_update
654 $obj->insert_or_update
656 Alias for L</update_or_insert>
660 *insert_or_update = \&update_or_insert;
661 sub update_or_insert {
663 return ($self->in_storage ? $self->update : $self->insert);
668 my @changed_col_names = $obj->is_changed();
669 if ($obj->is_changed()) { ... }
671 In array context returns a list of columns with uncommited changes, or
672 in scalar context returns a true value if there are uncommitted
678 return keys %{shift->{_dirty_columns} || {}};
681 =head2 is_column_changed
683 if ($obj->is_column_changed('col')) { ... }
685 Returns a true value if the column has uncommitted changes.
689 sub is_column_changed {
690 my( $self, $col ) = @_;
691 return exists $self->{_dirty_columns}->{$col};
696 my $resultsource = $object->result_source;
698 Accessor to the ResultSource this object was created from
706 $self->_source_handle($_[0]->handle);
708 $self->_source_handle->resolve;
712 =head2 register_column
714 $column_info = { .... };
715 $class->register_column($column_name, $column_info);
717 Registers a column on the class. If the column_info has an 'accessor'
718 key, creates an accessor named after the value if defined; if there is
719 no such key, creates an accessor with the same name as the column
721 The column_info attributes are described in
722 L<DBIx::Class::ResultSource/add_columns>
726 sub register_column {
727 my ($class, $col, $info) = @_;
729 if (exists $info->{accessor}) {
730 return unless defined $info->{accessor};
731 $acc = [ $info->{accessor}, $col ];
733 $class->mk_group_accessors('column' => $acc);
737 =head2 throw_exception
739 See Schema's throw_exception.
743 sub throw_exception {
745 if (ref $self && ref $self->result_source && $self->result_source->schema) {
746 $self->result_source->schema->throw_exception(@_);
756 Matt S. Trout <mst@shadowcatsystems.co.uk>
760 You may distribute this code under the same terms as Perl itself.