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};
119 $new->throw_exception("No such column $key on $class")
120 unless $class->has_column($key);
121 $new->store_column($key => $attrs->{$key});
124 $new->{_relationship_data} = $related if $related;
125 $new->{_inflated_column} = $inflated if $inflated;
135 Inserts an object into the database if it isn't already in
136 there. Returns the object itself. Requires the object's result source to
137 be set, or the class to have a result_source_instance method. To insert
138 an entirely new object into the database, use C<create> (see
139 L<DBIx::Class::ResultSet/create>).
141 To fetch an uninserted row object, call
142 L<new|DBIx::Class::ResultSet/new> on a resultset.
144 This will also insert any uninserted, related objects held inside this
145 one, see L<DBIx::Class::ResultSet/create> for more details.
151 return $self if $self->in_storage;
152 my $source = $self->result_source;
153 $source ||= $self->result_source($self->result_source_instance)
154 if $self->can('result_source_instance');
155 $self->throw_exception("No result_source set on this object; can't insert")
160 # Check if we stored uninserted relobjs here in new()
161 my %related_stuff = (%{$self->{_relationship_data} || {}},
162 %{$self->{_inflated_column} || {}});
164 if(!$self->{_rel_in_storage}) {
166 # The guard will save us if we blow out of this scope via die
167 $rollback_guard = $source->storage->txn_scope_guard;
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 $rollback_guard->commit;
253 $self->in_storage(1);
254 $self->{_dirty_columns} = {};
255 $self->{related_resultsets} = {};
256 undef $self->{_orig_ident};
262 $obj->in_storage; # Get value
263 $obj->in_storage(1); # Set value
265 Indicates whether the object exists as a row in the database or
266 not. This is set to true when L<DBIx::Class::ResultSet/find>,
267 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
270 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
271 L</delete> on one, sets it to false.
276 my ($self, $val) = @_;
277 $self->{_in_storage} = $val if @_ > 1;
278 return $self->{_in_storage};
283 $obj->update \%columns?;
285 Must be run on an object that is already in the database; issues an SQL
286 UPDATE query to commit any changes to the object to the database if
289 Also takes an options hashref of C<< column_name => value> pairs >> to update
290 first. But be aware that the hashref will be passed to
291 C<set_inflated_columns>, which might edit it in place, so dont rely on it being
292 the same after a call to C<update>. If you need to preserve the hashref, it is
293 sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
298 my ($self, $upd) = @_;
299 $self->throw_exception( "Not in database" ) unless $self->in_storage;
300 my $ident_cond = $self->ident_condition;
301 $self->throw_exception("Cannot safely update a row in a PK-less table")
302 if ! keys %$ident_cond;
304 $self->set_inflated_columns($upd) if $upd;
305 my %to_update = $self->get_dirty_columns;
306 return $self unless keys %to_update;
307 my $rows = $self->result_source->storage->update(
308 $self->result_source, \%to_update,
309 $self->{_orig_ident} || $ident_cond
312 $self->throw_exception( "Can't update ${self}: row not found" );
313 } elsif ($rows > 1) {
314 $self->throw_exception("Can't update ${self}: updated more than one row");
316 $self->{_dirty_columns} = {};
317 $self->{related_resultsets} = {};
318 undef $self->{_orig_ident};
326 Deletes the object from the database. The object is still perfectly
327 usable, but C<< ->in_storage() >> will now return 0 and the object must
328 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
329 on it. If you delete an object in a class with a C<has_many>
330 relationship, all the related objects will be deleted as well. To turn
331 this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
332 hashref. Any database-level cascade or restrict will take precedence
333 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
340 $self->throw_exception( "Not in database" ) unless $self->in_storage;
341 my $ident_cond = $self->ident_condition;
342 $self->throw_exception("Cannot safely delete a row in a PK-less table")
343 if ! keys %$ident_cond;
344 foreach my $column (keys %$ident_cond) {
345 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
346 unless exists $self->{_column_data}{$column};
348 $self->result_source->storage->delete(
349 $self->result_source, $ident_cond);
350 $self->in_storage(undef);
352 $self->throw_exception("Can't do class delete without a ResultSource instance")
353 unless $self->can('result_source_instance');
354 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
355 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
356 $self->result_source_instance->resultset->search(@_)->delete;
363 my $val = $obj->get_column($col);
365 Returns a raw column value from the row object, if it has already
366 been fetched from the database or set by an accessor.
368 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
369 will be deflated and returned.
374 my ($self, $column) = @_;
375 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
376 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
377 if (exists $self->{_inflated_column}{$column}) {
378 return $self->store_column($column,
379 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
381 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
385 =head2 has_column_loaded
387 if ( $obj->has_column_loaded($col) ) {
388 print "$col has been loaded from db";
391 Returns a true value if the column value has been loaded from the
392 database (or set locally).
396 sub has_column_loaded {
397 my ($self, $column) = @_;
398 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
399 return 1 if exists $self->{_inflated_column}{$column};
400 return exists $self->{_column_data}{$column};
405 my %data = $obj->get_columns;
407 Does C<get_column>, for all loaded column values at once.
413 if (exists $self->{_inflated_column}) {
414 foreach my $col (keys %{$self->{_inflated_column}}) {
415 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
416 unless exists $self->{_column_data}{$col};
419 return %{$self->{_column_data}};
422 =head2 get_dirty_columns
424 my %data = $obj->get_dirty_columns;
426 Identical to get_columns but only returns those that have been changed.
430 sub get_dirty_columns {
432 return map { $_ => $self->{_column_data}{$_} }
433 keys %{$self->{_dirty_columns}};
436 =head2 get_inflated_columns
438 my %inflated_data = $obj->get_inflated_columns;
440 Similar to get_columns but objects are returned for inflated columns
441 instead of their raw non-inflated values.
445 sub get_inflated_columns {
448 my $accessor = $self->column_info($_)->{'accessor'} || $_;
449 ($_ => $self->$accessor);
455 $obj->set_column($col => $val);
457 Sets a raw column value. If the new value is different from the old one,
458 the column is marked as dirty for when you next call $obj->update.
460 If passed an object or reference, this will happily attempt store the
461 value, and a later insert/update will try and stringify/numify as
469 $self->{_orig_ident} ||= $self->ident_condition;
470 my $old = $self->get_column($column);
471 my $ret = $self->store_column(@_);
472 $self->{_dirty_columns}{$column} = 1
473 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
479 my $copy = $orig->set_columns({ $col => $val, ... });
481 Sets more than one column value at once.
486 my ($self,$data) = @_;
487 foreach my $col (keys %$data) {
488 $self->set_column($col,$data->{$col});
493 =head2 set_inflated_columns
495 my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
497 Sets more than one column value at once, taking care to respect inflations and
498 relationships if relevant. Be aware that this hashref might be edited in place,
499 so dont rely on it being the same after a call to C<set_inflated_columns>. If
500 you need to preserve the hashref, it is sufficient to pass a shallow copy to
501 C<set_inflated_columns>, e.g. ( { %{ $href } } )
505 sub set_inflated_columns {
506 my ( $self, $upd ) = @_;
507 foreach my $key (keys %$upd) {
508 if (ref $upd->{$key}) {
509 my $info = $self->relationship_info($key);
510 if ($info && $info->{attrs}{accessor}
511 && $info->{attrs}{accessor} eq 'single')
513 my $rel = delete $upd->{$key};
514 $self->set_from_related($key => $rel);
515 $self->{_relationship_data}{$key} = $rel;
516 } elsif ($info && $info->{attrs}{accessor}
517 && $info->{attrs}{accessor} eq 'multi'
518 && ref $upd->{$key} eq 'ARRAY') {
519 my $others = delete $upd->{$key};
520 foreach my $rel_obj (@$others) {
521 if(!Scalar::Util::blessed($rel_obj)) {
522 $rel_obj = $self->create_related($key, $rel_obj);
525 $self->{_relationship_data}{$key} = $others;
526 # $related->{$key} = $others;
529 elsif ($self->has_column($key)
530 && exists $self->column_info($key)->{_inflate_info})
532 $self->set_inflated_column($key, delete $upd->{$key});
536 $self->set_columns($upd);
541 my $copy = $orig->copy({ change => $to, ... });
543 Inserts a new row with the specified changes.
548 my ($self, $changes) = @_;
550 my $col_data = { %{$self->{_column_data}} };
551 foreach my $col (keys %$col_data) {
552 delete $col_data->{$col}
553 if $self->result_source->column_info($col)->{is_auto_increment};
556 my $new = { _column_data => $col_data };
557 bless $new, ref $self;
559 $new->result_source($self->result_source);
560 $new->set_inflated_columns($changes);
563 # Its possible we'll have 2 relations to the same Source. We need to make
564 # sure we don't try to insert the same row twice esle we'll violate unique
566 my $rels_copied = {};
568 foreach my $rel ($self->result_source->relationships) {
569 my $rel_info = $self->result_source->relationship_info($rel);
571 next unless $rel_info->{attrs}{cascade_copy};
573 my $resolved = $self->result_source->resolve_condition(
574 $rel_info->{cond}, $rel, $new
577 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
578 foreach my $related ($self->search_related($rel)) {
579 my $id_str = join("\0", $related->id);
580 next if $copied->{$id_str};
581 $copied->{$id_str} = 1;
582 my $rel_copy = $related->copy($resolved);
591 $obj->store_column($col => $val);
593 Sets a column value without marking it as dirty.
598 my ($self, $column, $value) = @_;
599 $self->throw_exception( "No such column '${column}'" )
600 unless exists $self->{_column_data}{$column} || $self->has_column($column);
601 $self->throw_exception( "set_column called for ${column} without value" )
603 return $self->{_column_data}{$column} = $value;
606 =head2 inflate_result
608 Class->inflate_result($result_source, \%me, \%prefetch?)
610 Called by ResultSet to inflate a result from storage
615 my ($class, $source, $me, $prefetch) = @_;
617 my ($source_handle) = $source;
619 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
620 $source = $source_handle->resolve
622 $source_handle = $source->handle
626 _source_handle => $source_handle,
630 bless $new, (ref $class || $class);
633 foreach my $pre (keys %{$prefetch||{}}) {
634 my $pre_val = $prefetch->{$pre};
635 my $pre_source = $source->related_source($pre);
636 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
638 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
640 foreach my $pre_rec (@$pre_val) {
641 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
642 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
645 push(@pre_objects, $pre_source->result_class->inflate_result(
646 $pre_source, @{$pre_rec}));
648 $new->related_resultset($pre)->set_cache(\@pre_objects);
649 } elsif (defined $pre_val->[0]) {
651 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
652 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
654 $fetched = $pre_source->result_class->inflate_result(
655 $pre_source, @{$pre_val});
657 $new->related_resultset($pre)->set_cache([ $fetched ]);
658 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
659 $class->throw_exception("No accessor for prefetched $pre")
660 unless defined $accessor;
661 if ($accessor eq 'single') {
662 $new->{_relationship_data}{$pre} = $fetched;
663 } elsif ($accessor eq 'filter') {
664 $new->{_inflated_column}{$pre} = $fetched;
666 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
673 =head2 update_or_insert
675 $obj->update_or_insert
677 Updates the object if it's already in the database, according to
678 L</in_storage>, else inserts it.
680 =head2 insert_or_update
682 $obj->insert_or_update
684 Alias for L</update_or_insert>
688 *insert_or_update = \&update_or_insert;
689 sub update_or_insert {
691 return ($self->in_storage ? $self->update : $self->insert);
696 my @changed_col_names = $obj->is_changed();
697 if ($obj->is_changed()) { ... }
699 In array context returns a list of columns with uncommited changes, or
700 in scalar context returns a true value if there are uncommitted
706 return keys %{shift->{_dirty_columns} || {}};
709 =head2 is_column_changed
711 if ($obj->is_column_changed('col')) { ... }
713 Returns a true value if the column has uncommitted changes.
717 sub is_column_changed {
718 my( $self, $col ) = @_;
719 return exists $self->{_dirty_columns}->{$col};
724 my $resultsource = $object->result_source;
726 Accessor to the ResultSource this object was created from
734 $self->_source_handle($_[0]->handle);
736 $self->_source_handle->resolve;
740 =head2 register_column
742 $column_info = { .... };
743 $class->register_column($column_name, $column_info);
745 Registers a column on the class. If the column_info has an 'accessor'
746 key, creates an accessor named after the value if defined; if there is
747 no such key, creates an accessor with the same name as the column
749 The column_info attributes are described in
750 L<DBIx::Class::ResultSource/add_columns>
754 sub register_column {
755 my ($class, $col, $info) = @_;
757 if (exists $info->{accessor}) {
758 return unless defined $info->{accessor};
759 $acc = [ $info->{accessor}, $col ];
761 $class->mk_group_accessors('column' => $acc);
765 =head2 throw_exception
767 See Schema's throw_exception.
771 sub throw_exception {
773 if (ref $self && ref $self->result_source && $self->result_source->schema) {
774 $self->result_source->schema->throw_exception(@_);
782 Returns the primary key(s) for a row. Can't be called as a class method.
783 Actually implemented in L<DBIx::Class::PK>
785 =head2 discard_changes
787 Re-selects the row from the database, losing any changes that had
790 This method can also be used to refresh from storage, retrieving any
791 changes made since the row was last read from storage. Actually
792 implemented in L<DBIx::Class::PK>
800 Matt S. Trout <mst@shadowcatsystems.co.uk>
804 You may distribute this code under the same terms as Perl itself.