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
49 sub __new_related_find_or_new_helper {
50 my ($self, $relname, $data) = @_;
51 if ($self->__their_pk_needs_us($relname, $data)) {
52 return $self->result_source
53 ->related_source($relname)
57 if ($self->result_source->pk_depends_on($relname, $data)) {
58 return $self->result_source
59 ->related_source($relname)
61 ->find_or_create($data);
63 return $self->find_or_new_related($relname, $data);
66 sub __their_pk_needs_us { # this should maybe be in resultsource.
67 my ($self, $relname, $data) = @_;
68 my $source = $self->result_source;
69 my $reverse = $source->reverse_relationship_info($relname);
70 my $rel_source = $source->related_source($relname);
71 my $us = { $self->get_columns };
72 foreach my $key (keys %$reverse) {
73 # if their primary key depends on us, then we have to
74 # just create a result and we'll fill it out afterwards
75 return 1 if $rel_source->pk_depends_on($key, $us);
81 my ($class, $attrs) = @_;
82 $class = ref $class if ref $class;
89 if (my $handle = delete $attrs->{-source_handle}) {
90 $new->_source_handle($handle);
94 if ($source = delete $attrs->{-result_source}) {
95 $new->result_source($source);
99 $new->throw_exception("attrs must be a hashref")
100 unless ref($attrs) eq 'HASH';
102 my ($related,$inflated);
103 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
104 $new->{_rel_in_storage} = 1;
106 foreach my $key (keys %$attrs) {
107 if (ref $attrs->{$key}) {
108 ## Can we extract this lot to use with update(_or .. ) ?
109 confess "Can't do multi-create without result source" unless $source;
110 my $info = $source->relationship_info($key);
111 if ($info && $info->{attrs}{accessor}
112 && $info->{attrs}{accessor} eq 'single')
114 my $rel_obj = delete $attrs->{$key};
115 if(!Scalar::Util::blessed($rel_obj)) {
116 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
119 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
121 $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
122 $related->{$key} = $rel_obj;
124 } elsif ($info && $info->{attrs}{accessor}
125 && $info->{attrs}{accessor} eq 'multi'
126 && ref $attrs->{$key} eq 'ARRAY') {
127 my $others = delete $attrs->{$key};
128 foreach my $rel_obj (@$others) {
129 if(!Scalar::Util::blessed($rel_obj)) {
130 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
133 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
134 $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
136 $related->{$key} = $others;
138 } elsif ($info && $info->{attrs}{accessor}
139 && $info->{attrs}{accessor} eq 'filter')
141 ## 'filter' should disappear and get merged in with 'single' above!
142 my $rel_obj = delete $attrs->{$key};
143 if(!Scalar::Util::blessed($rel_obj)) {
144 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
146 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
147 $inflated->{$key} = $rel_obj;
149 } elsif ($class->has_column($key)
150 && $class->column_info($key)->{_inflate_info}) {
151 $inflated->{$key} = $attrs->{$key};
155 $new->throw_exception("No such column $key on $class")
156 unless $class->has_column($key);
157 $new->store_column($key => $attrs->{$key});
160 $new->{_relationship_data} = $related if $related;
161 $new->{_inflated_column} = $inflated if $inflated;
171 Inserts an object into the database if it isn't already in
172 there. Returns the object itself. Requires the object's result source to
173 be set, or the class to have a result_source_instance method. To insert
174 an entirely new object into the database, use C<create> (see
175 L<DBIx::Class::ResultSet/create>).
177 To fetch an uninserted row object, call
178 L<new|DBIx::Class::ResultSet/new> on a resultset.
180 This will also insert any uninserted, related objects held inside this
181 one, see L<DBIx::Class::ResultSet/create> for more details.
187 return $self if $self->in_storage;
188 my $source = $self->result_source;
189 $source ||= $self->result_source($self->result_source_instance)
190 if $self->can('result_source_instance');
191 $self->throw_exception("No result_source set on this object; can't insert")
196 # Check if we stored uninserted relobjs here in new()
197 my %related_stuff = (%{$self->{_relationship_data} || {}},
198 %{$self->{_inflated_column} || {}});
200 if(!$self->{_rel_in_storage}) {
202 # The guard will save us if we blow out of this scope via die
203 $rollback_guard = $source->storage->txn_scope_guard;
205 ## Should all be in relationship_data, but we need to get rid of the
206 ## 'filter' reltype..
207 ## These are the FK rels, need their IDs for the insert.
209 my @pri = $self->primary_columns;
211 REL: foreach my $relname (keys %related_stuff) {
213 my $rel_obj = $related_stuff{$relname};
215 next REL unless (Scalar::Util::blessed($rel_obj)
216 && $rel_obj->isa('DBIx::Class::Row'));
218 next REL unless $source->pk_depends_on(
219 $relname, { $rel_obj->get_columns }
223 $self->set_from_related($relname, $rel_obj);
224 delete $related_stuff{$relname};
228 my $updated_cols = $source->storage->insert($source, { $self->get_columns });
229 $self->set_columns($updated_cols);
232 my @auto_pri = grep {
233 !defined $self->get_column($_) ||
234 ref($self->get_column($_)) eq 'SCALAR'
235 } $self->primary_columns;
238 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
239 # if defined $too_many;
241 my $storage = $self->result_source->storage;
242 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
243 unless $storage->can('last_insert_id');
244 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
245 $self->throw_exception( "Can't get last insert id" )
246 unless (@ids == @auto_pri);
247 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
250 $self->{_dirty_columns} = {};
251 $self->{related_resultsets} = {};
253 if(!$self->{_rel_in_storage}) {
254 ## Now do the has_many rels, that need $selfs ID.
255 foreach my $relname (keys %related_stuff) {
256 my $rel_obj = $related_stuff{$relname};
258 if (Scalar::Util::blessed($rel_obj)
259 && $rel_obj->isa('DBIx::Class::Row')) {
261 } elsif (ref $rel_obj eq 'ARRAY') {
265 my $reverse = $source->reverse_relationship_info($relname);
266 foreach my $obj (@cands) {
267 $obj->set_from_related($_, $self) for keys %$reverse;
268 my $them = { $obj->get_inflated_columns };
269 if ($self->__their_pk_needs_us($relname, $them)) {
270 $obj = $self->find_or_create_related($relname, $them);
277 $rollback_guard->commit;
280 $self->in_storage(1);
281 undef $self->{_orig_ident};
287 $obj->in_storage; # Get value
288 $obj->in_storage(1); # Set value
290 Indicates whether the object exists as a row in the database or
291 not. This is set to true when L<DBIx::Class::ResultSet/find>,
292 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
295 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
296 L</delete> on one, sets it to false.
301 my ($self, $val) = @_;
302 $self->{_in_storage} = $val if @_ > 1;
303 return $self->{_in_storage};
308 $obj->update \%columns?;
310 Must be run on an object that is already in the database; issues an SQL
311 UPDATE query to commit any changes to the object to the database if
314 Also takes an options hashref of C<< column_name => value> pairs >> to update
315 first. But be aware that the hashref will be passed to
316 C<set_inflated_columns>, which might edit it in place, so dont rely on it being
317 the same after a call to C<update>. If you need to preserve the hashref, it is
318 sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
320 If the values passed or any of the column values set on the object
321 contain scalar references, eg:
323 $obj->last_modified(\'NOW()');
325 $obj->update({ last_modified => \'NOW()' });
327 The update will pass the values verbatim into SQL. (See
328 L<SQL::Abstract> docs). The values in your Row object will NOT change
329 as a result of the update call, if you want the object to be updated
330 with the actual values from the database, call L</discard_changes>
333 $obj->update()->discard_changes();
338 my ($self, $upd) = @_;
339 $self->throw_exception( "Not in database" ) unless $self->in_storage;
340 my $ident_cond = $self->ident_condition;
341 $self->throw_exception("Cannot safely update a row in a PK-less table")
342 if ! keys %$ident_cond;
344 $self->set_inflated_columns($upd) if $upd;
345 my %to_update = $self->get_dirty_columns;
346 return $self unless keys %to_update;
347 my $rows = $self->result_source->storage->update(
348 $self->result_source, \%to_update,
349 $self->{_orig_ident} || $ident_cond
352 $self->throw_exception( "Can't update ${self}: row not found" );
353 } elsif ($rows > 1) {
354 $self->throw_exception("Can't update ${self}: updated more than one row");
356 $self->{_dirty_columns} = {};
357 $self->{related_resultsets} = {};
358 undef $self->{_orig_ident};
366 Deletes the object from the database. The object is still perfectly
367 usable, but C<< ->in_storage() >> will now return 0 and the object must
368 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
369 on it. If you delete an object in a class with a C<has_many>
370 relationship, all the related objects will be deleted as well. To turn
371 this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
372 hashref. Any database-level cascade or restrict will take precedence
373 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
380 $self->throw_exception( "Not in database" ) unless $self->in_storage;
381 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
382 $self->throw_exception("Cannot safely delete a row in a PK-less table")
383 if ! keys %$ident_cond;
384 foreach my $column (keys %$ident_cond) {
385 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
386 unless exists $self->{_column_data}{$column};
388 $self->result_source->storage->delete(
389 $self->result_source, $ident_cond);
390 $self->in_storage(undef);
392 $self->throw_exception("Can't do class delete without a ResultSource instance")
393 unless $self->can('result_source_instance');
394 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
395 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
396 $self->result_source_instance->resultset->search(@_)->delete;
403 my $val = $obj->get_column($col);
405 Returns a raw column value from the row object, if it has already
406 been fetched from the database or set by an accessor.
408 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
409 will be deflated and returned.
414 my ($self, $column) = @_;
415 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
416 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
417 if (exists $self->{_inflated_column}{$column}) {
418 return $self->store_column($column,
419 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
421 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
425 =head2 has_column_loaded
427 if ( $obj->has_column_loaded($col) ) {
428 print "$col has been loaded from db";
431 Returns a true value if the column value has been loaded from the
432 database (or set locally).
436 sub has_column_loaded {
437 my ($self, $column) = @_;
438 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
439 return 1 if exists $self->{_inflated_column}{$column};
440 return exists $self->{_column_data}{$column};
445 my %data = $obj->get_columns;
447 Does C<get_column>, for all loaded column values at once.
453 if (exists $self->{_inflated_column}) {
454 foreach my $col (keys %{$self->{_inflated_column}}) {
455 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
456 unless exists $self->{_column_data}{$col};
459 return %{$self->{_column_data}};
462 =head2 get_dirty_columns
464 my %data = $obj->get_dirty_columns;
466 Identical to get_columns but only returns those that have been changed.
470 sub get_dirty_columns {
472 return map { $_ => $self->{_column_data}{$_} }
473 keys %{$self->{_dirty_columns}};
476 =head2 make_column_dirty
478 Marks a column dirty regardless if it has really changed. Throws an
479 exception if the column does not exist.
482 sub make_column_dirty {
483 my ($self, $column) = @_;
485 $self->throw_exception( "No such column '${column}'" )
486 unless exists $self->{_column_data}{$column} || $self->has_column($column);
487 $self->{_dirty_columns}{$column} = 1;
490 =head2 get_inflated_columns
492 my %inflated_data = $obj->get_inflated_columns;
494 Similar to get_columns but objects are returned for inflated columns
495 instead of their raw non-inflated values.
499 sub get_inflated_columns {
502 my $accessor = $self->column_info($_)->{'accessor'} || $_;
503 ($_ => $self->$accessor);
509 $obj->set_column($col => $val);
511 Sets a raw column value. If the new value is different from the old one,
512 the column is marked as dirty for when you next call $obj->update.
514 If passed an object or reference, this will happily attempt store the
515 value, and a later insert/update will try and stringify/numify as
521 my ($self, $column, $new_value) = @_;
523 $self->{_orig_ident} ||= $self->ident_condition;
524 my $old_value = $self->get_column($column);
526 $self->store_column($column, $new_value);
527 $self->{_dirty_columns}{$column} = 1
528 if (defined $old_value xor defined $new_value) || (defined $old_value && $old_value ne $new_value);
530 # XXX clear out the relation cache for this column
531 delete $self->{related_resultsets}{$column};
538 my $copy = $orig->set_columns({ $col => $val, ... });
540 Sets more than one column value at once.
545 my ($self,$data) = @_;
546 foreach my $col (keys %$data) {
547 $self->set_column($col,$data->{$col});
552 =head2 set_inflated_columns
554 my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
556 Sets more than one column value at once, taking care to respect inflations and
557 relationships if relevant. Be aware that this hashref might be edited in place,
558 so dont rely on it being the same after a call to C<set_inflated_columns>. If
559 you need to preserve the hashref, it is sufficient to pass a shallow copy to
560 C<set_inflated_columns>, e.g. ( { %{ $href } } )
564 sub set_inflated_columns {
565 my ( $self, $upd ) = @_;
566 foreach my $key (keys %$upd) {
567 if (ref $upd->{$key}) {
568 my $info = $self->relationship_info($key);
569 if ($info && $info->{attrs}{accessor}
570 && $info->{attrs}{accessor} eq 'single')
572 my $rel = delete $upd->{$key};
573 $self->set_from_related($key => $rel);
574 $self->{_relationship_data}{$key} = $rel;
575 } elsif ($info && $info->{attrs}{accessor}
576 && $info->{attrs}{accessor} eq 'multi'
577 && ref $upd->{$key} eq 'ARRAY') {
578 my $others = delete $upd->{$key};
579 foreach my $rel_obj (@$others) {
580 if(!Scalar::Util::blessed($rel_obj)) {
581 $rel_obj = $self->create_related($key, $rel_obj);
584 $self->{_relationship_data}{$key} = $others;
585 # $related->{$key} = $others;
588 elsif ($self->has_column($key)
589 && exists $self->column_info($key)->{_inflate_info})
591 $self->set_inflated_column($key, delete $upd->{$key});
595 $self->set_columns($upd);
600 my $copy = $orig->copy({ change => $to, ... });
602 Inserts a new row with the specified changes. If the row has related
603 objects in a C<has_many> then those objects may be copied too depending
604 on the C<cascade_copy> relationship attribute.
609 my ($self, $changes) = @_;
611 my $col_data = { %{$self->{_column_data}} };
612 foreach my $col (keys %$col_data) {
613 delete $col_data->{$col}
614 if $self->result_source->column_info($col)->{is_auto_increment};
617 my $new = { _column_data => $col_data };
618 bless $new, ref $self;
620 $new->result_source($self->result_source);
621 $new->set_inflated_columns($changes);
624 # Its possible we'll have 2 relations to the same Source. We need to make
625 # sure we don't try to insert the same row twice esle we'll violate unique
627 my $rels_copied = {};
629 foreach my $rel ($self->result_source->relationships) {
630 my $rel_info = $self->result_source->relationship_info($rel);
632 next unless $rel_info->{attrs}{cascade_copy};
634 my $resolved = $self->result_source->resolve_condition(
635 $rel_info->{cond}, $rel, $new
638 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
639 foreach my $related ($self->search_related($rel)) {
640 my $id_str = join("\0", $related->id);
641 next if $copied->{$id_str};
642 $copied->{$id_str} = 1;
643 my $rel_copy = $related->copy($resolved);
652 $obj->store_column($col => $val);
654 Sets a column value without marking it as dirty.
659 my ($self, $column, $value) = @_;
660 $self->throw_exception( "No such column '${column}'" )
661 unless exists $self->{_column_data}{$column} || $self->has_column($column);
662 $self->throw_exception( "set_column called for ${column} without value" )
664 return $self->{_column_data}{$column} = $value;
667 =head2 inflate_result
669 Class->inflate_result($result_source, \%me, \%prefetch?)
671 Called by ResultSet to inflate a result from storage
676 my ($class, $source, $me, $prefetch) = @_;
678 my ($source_handle) = $source;
680 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
681 $source = $source_handle->resolve
683 $source_handle = $source->handle
687 _source_handle => $source_handle,
691 bless $new, (ref $class || $class);
694 foreach my $pre (keys %{$prefetch||{}}) {
695 my $pre_val = $prefetch->{$pre};
696 my $pre_source = $source->related_source($pre);
697 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
699 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
701 foreach my $pre_rec (@$pre_val) {
702 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
703 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
706 push(@pre_objects, $pre_source->result_class->inflate_result(
707 $pre_source, @{$pre_rec}));
709 $new->related_resultset($pre)->set_cache(\@pre_objects);
710 } elsif (defined $pre_val->[0]) {
712 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
713 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
715 $fetched = $pre_source->result_class->inflate_result(
716 $pre_source, @{$pre_val});
718 $new->related_resultset($pre)->set_cache([ $fetched ]);
719 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
720 $class->throw_exception("No accessor for prefetched $pre")
721 unless defined $accessor;
722 if ($accessor eq 'single') {
723 $new->{_relationship_data}{$pre} = $fetched;
724 } elsif ($accessor eq 'filter') {
725 $new->{_inflated_column}{$pre} = $fetched;
727 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
734 =head2 update_or_insert
736 $obj->update_or_insert
738 Updates the object if it's already in the database, according to
739 L</in_storage>, else inserts it.
741 =head2 insert_or_update
743 $obj->insert_or_update
745 Alias for L</update_or_insert>
749 sub insert_or_update { shift->update_or_insert(@_) }
751 sub update_or_insert {
753 return ($self->in_storage ? $self->update : $self->insert);
758 my @changed_col_names = $obj->is_changed();
759 if ($obj->is_changed()) { ... }
761 In array context returns a list of columns with uncommited changes, or
762 in scalar context returns a true value if there are uncommitted
768 return keys %{shift->{_dirty_columns} || {}};
771 =head2 is_column_changed
773 if ($obj->is_column_changed('col')) { ... }
775 Returns a true value if the column has uncommitted changes.
779 sub is_column_changed {
780 my( $self, $col ) = @_;
781 return exists $self->{_dirty_columns}->{$col};
786 my $resultsource = $object->result_source;
788 Accessor to the ResultSource this object was created from
796 $self->_source_handle($_[0]->handle);
798 $self->_source_handle->resolve;
802 =head2 register_column
804 $column_info = { .... };
805 $class->register_column($column_name, $column_info);
807 Registers a column on the class. If the column_info has an 'accessor'
808 key, creates an accessor named after the value if defined; if there is
809 no such key, creates an accessor with the same name as the column
811 The column_info attributes are described in
812 L<DBIx::Class::ResultSource/add_columns>
816 sub register_column {
817 my ($class, $col, $info) = @_;
819 if (exists $info->{accessor}) {
820 return unless defined $info->{accessor};
821 $acc = [ $info->{accessor}, $col ];
823 $class->mk_group_accessors('column' => $acc);
826 =head2 get_from_storage ($attrs)
828 Returns a new Row which is whatever the Storage has for the currently created
829 Row object. You can use this to see if the storage has become inconsistent with
830 whatever your Row object is.
832 $attrs is expected to be a hashref of attributes suitable for passing as the
833 second argument to $resultset->search($cond, $attrs);
837 sub get_from_storage {
839 my $attrs = shift @_;
840 my $resultset = $self->result_source->resultset;
843 $resultset = $resultset->search(undef, $attrs);
846 return $resultset->find($self->{_orig_ident} || $self->ident_condition);
849 =head2 throw_exception
851 See Schema's throw_exception.
855 sub throw_exception {
857 if (ref $self && ref $self->result_source && $self->result_source->schema) {
858 $self->result_source->schema->throw_exception(@_);
866 Returns the primary key(s) for a row. Can't be called as a class method.
867 Actually implemented in L<DBIx::Class::PK>
869 =head2 discard_changes
871 Re-selects the row from the database, losing any changes that had
874 This method can also be used to refresh from storage, retrieving any
875 changes made since the row was last read from storage. Actually
876 implemented in L<DBIx::Class::PK>
884 Matt S. Trout <mst@shadowcatsystems.co.uk>
888 You may distribute this code under the same terms as Perl itself.