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)
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_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
523 $self->{_orig_ident} ||= $self->ident_condition;
524 my $old = $self->get_column($column);
525 my $ret = $self->store_column(@_);
526 $self->{_dirty_columns}{$column} = 1
527 if (defined $old xor defined $ret) || (defined $old && $old ne $ret);
529 # XXX clear out the relation cache for this column
530 delete $self->{related_resultsets}{$column};
537 my $copy = $orig->set_columns({ $col => $val, ... });
539 Sets more than one column value at once.
544 my ($self,$data) = @_;
545 foreach my $col (keys %$data) {
546 $self->set_column($col,$data->{$col});
551 =head2 set_inflated_columns
553 my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
555 Sets more than one column value at once, taking care to respect inflations and
556 relationships if relevant. Be aware that this hashref might be edited in place,
557 so dont rely on it being the same after a call to C<set_inflated_columns>. If
558 you need to preserve the hashref, it is sufficient to pass a shallow copy to
559 C<set_inflated_columns>, e.g. ( { %{ $href } } )
563 sub set_inflated_columns {
564 my ( $self, $upd ) = @_;
565 foreach my $key (keys %$upd) {
566 if (ref $upd->{$key}) {
567 my $info = $self->relationship_info($key);
568 if ($info && $info->{attrs}{accessor}
569 && $info->{attrs}{accessor} eq 'single')
571 my $rel = delete $upd->{$key};
572 $self->set_from_related($key => $rel);
573 $self->{_relationship_data}{$key} = $rel;
574 } elsif ($info && $info->{attrs}{accessor}
575 && $info->{attrs}{accessor} eq 'multi'
576 && ref $upd->{$key} eq 'ARRAY') {
577 my $others = delete $upd->{$key};
578 foreach my $rel_obj (@$others) {
579 if(!Scalar::Util::blessed($rel_obj)) {
580 $rel_obj = $self->create_related($key, $rel_obj);
583 $self->{_relationship_data}{$key} = $others;
584 # $related->{$key} = $others;
587 elsif ($self->has_column($key)
588 && exists $self->column_info($key)->{_inflate_info})
590 $self->set_inflated_column($key, delete $upd->{$key});
594 $self->set_columns($upd);
599 my $copy = $orig->copy({ change => $to, ... });
601 Inserts a new row with the specified changes. If the row has related
602 objects in a C<has_many> then those objects may be copied too depending
603 on the C<cascade_copy> relationship attribute.
608 my ($self, $changes) = @_;
610 my $col_data = { %{$self->{_column_data}} };
611 foreach my $col (keys %$col_data) {
612 delete $col_data->{$col}
613 if $self->result_source->column_info($col)->{is_auto_increment};
616 my $new = { _column_data => $col_data };
617 bless $new, ref $self;
619 $new->result_source($self->result_source);
620 $new->set_inflated_columns($changes);
623 # Its possible we'll have 2 relations to the same Source. We need to make
624 # sure we don't try to insert the same row twice esle we'll violate unique
626 my $rels_copied = {};
628 foreach my $rel ($self->result_source->relationships) {
629 my $rel_info = $self->result_source->relationship_info($rel);
631 next unless $rel_info->{attrs}{cascade_copy};
633 my $resolved = $self->result_source->resolve_condition(
634 $rel_info->{cond}, $rel, $new
637 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
638 foreach my $related ($self->search_related($rel)) {
639 my $id_str = join("\0", $related->id);
640 next if $copied->{$id_str};
641 $copied->{$id_str} = 1;
642 my $rel_copy = $related->copy($resolved);
651 $obj->store_column($col => $val);
653 Sets a column value without marking it as dirty.
658 my ($self, $column, $value) = @_;
659 $self->throw_exception( "No such column '${column}'" )
660 unless exists $self->{_column_data}{$column} || $self->has_column($column);
661 $self->throw_exception( "set_column called for ${column} without value" )
663 return $self->{_column_data}{$column} = $value;
666 =head2 inflate_result
668 Class->inflate_result($result_source, \%me, \%prefetch?)
670 Called by ResultSet to inflate a result from storage
675 my ($class, $source, $me, $prefetch) = @_;
677 my ($source_handle) = $source;
679 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
680 $source = $source_handle->resolve
682 $source_handle = $source->handle
686 _source_handle => $source_handle,
690 bless $new, (ref $class || $class);
693 foreach my $pre (keys %{$prefetch||{}}) {
694 my $pre_val = $prefetch->{$pre};
695 my $pre_source = $source->related_source($pre);
696 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
698 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
700 foreach my $pre_rec (@$pre_val) {
701 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
702 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
705 push(@pre_objects, $pre_source->result_class->inflate_result(
706 $pre_source, @{$pre_rec}));
708 $new->related_resultset($pre)->set_cache(\@pre_objects);
709 } elsif (defined $pre_val->[0]) {
711 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
712 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
714 $fetched = $pre_source->result_class->inflate_result(
715 $pre_source, @{$pre_val});
717 $new->related_resultset($pre)->set_cache([ $fetched ]);
718 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
719 $class->throw_exception("No accessor for prefetched $pre")
720 unless defined $accessor;
721 if ($accessor eq 'single') {
722 $new->{_relationship_data}{$pre} = $fetched;
723 } elsif ($accessor eq 'filter') {
724 $new->{_inflated_column}{$pre} = $fetched;
726 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
733 =head2 update_or_insert
735 $obj->update_or_insert
737 Updates the object if it's already in the database, according to
738 L</in_storage>, else inserts it.
740 =head2 insert_or_update
742 $obj->insert_or_update
744 Alias for L</update_or_insert>
748 sub insert_or_update { shift->update_or_insert(@_) }
750 sub update_or_insert {
752 return ($self->in_storage ? $self->update : $self->insert);
757 my @changed_col_names = $obj->is_changed();
758 if ($obj->is_changed()) { ... }
760 In array context returns a list of columns with uncommited changes, or
761 in scalar context returns a true value if there are uncommitted
767 return keys %{shift->{_dirty_columns} || {}};
770 =head2 is_column_changed
772 if ($obj->is_column_changed('col')) { ... }
774 Returns a true value if the column has uncommitted changes.
778 sub is_column_changed {
779 my( $self, $col ) = @_;
780 return exists $self->{_dirty_columns}->{$col};
785 my $resultsource = $object->result_source;
787 Accessor to the ResultSource this object was created from
795 $self->_source_handle($_[0]->handle);
797 $self->_source_handle->resolve;
801 =head2 register_column
803 $column_info = { .... };
804 $class->register_column($column_name, $column_info);
806 Registers a column on the class. If the column_info has an 'accessor'
807 key, creates an accessor named after the value if defined; if there is
808 no such key, creates an accessor with the same name as the column
810 The column_info attributes are described in
811 L<DBIx::Class::ResultSource/add_columns>
815 sub register_column {
816 my ($class, $col, $info) = @_;
818 if (exists $info->{accessor}) {
819 return unless defined $info->{accessor};
820 $acc = [ $info->{accessor}, $col ];
822 $class->mk_group_accessors('column' => $acc);
825 =head2 get_from_storage ($attrs)
827 Returns a new Row which is whatever the Storage has for the currently created
828 Row object. You can use this to see if the storage has become inconsistent with
829 whatever your Row object is.
831 $attrs is expected to be a hashref of attributes suitable for passing as the
832 second argument to $resultset->search($cond, $attrs);
836 sub get_from_storage {
838 my $attrs = shift @_;
839 my $resultset = $self->result_source->resultset;
842 $resultset = $resultset->search(undef, $attrs);
845 return $resultset->find($self->{_orig_ident} || $self->ident_condition);
848 =head2 throw_exception
850 See Schema's throw_exception.
854 sub throw_exception {
856 if (ref $self && ref $self->result_source && $self->result_source->schema) {
857 $self->result_source->schema->throw_exception(@_);
865 Returns the primary key(s) for a row. Can't be called as a class method.
866 Actually implemented in L<DBIx::Class::PK>
868 =head2 discard_changes
870 Re-selects the row from the database, losing any changes that had
873 This method can also be used to refresh from storage, retrieving any
874 changes made since the row was last read from storage. Actually
875 implemented in L<DBIx::Class::PK>
883 Matt S. Trout <mst@shadowcatsystems.co.uk>
887 You may distribute this code under the same terms as Perl itself.