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;
58 if (my $handle = delete $attrs->{-source_handle}) {
59 $new->_source_handle($handle);
61 if (my $source = delete $attrs->{-result_source}) {
62 $new->result_source($source);
66 $new->throw_exception("attrs must be a hashref")
67 unless ref($attrs) eq 'HASH';
69 my ($related,$inflated);
70 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
71 $new->{_rel_in_storage} = 1;
73 foreach my $key (keys %$attrs) {
74 if (ref $attrs->{$key}) {
75 ## Can we extract this lot to use with update(_or .. ) ?
76 my $info = $class->relationship_info($key);
77 if ($info && $info->{attrs}{accessor}
78 && $info->{attrs}{accessor} eq 'single')
80 my $rel_obj = delete $attrs->{$key};
81 if(!Scalar::Util::blessed($rel_obj)) {
82 $rel_obj = $new->find_or_new_related($key, $rel_obj);
85 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
87 $new->set_from_related($key, $rel_obj);
88 $related->{$key} = $rel_obj;
90 } elsif ($info && $info->{attrs}{accessor}
91 && $info->{attrs}{accessor} eq 'multi'
92 && ref $attrs->{$key} eq 'ARRAY') {
93 my $others = delete $attrs->{$key};
94 foreach my $rel_obj (@$others) {
95 if(!Scalar::Util::blessed($rel_obj)) {
96 $rel_obj = $new->new_related($key, $rel_obj);
97 $new->{_rel_in_storage} = 0;
100 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
102 $related->{$key} = $others;
104 } elsif ($info && $info->{attrs}{accessor}
105 && $info->{attrs}{accessor} eq 'filter')
107 ## 'filter' should disappear and get merged in with 'single' above!
108 my $rel_obj = delete $attrs->{$key};
109 if(!Scalar::Util::blessed($rel_obj)) {
110 $rel_obj = $new->find_or_new_related($key, $rel_obj);
111 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
113 $inflated->{$key} = $rel_obj;
115 } elsif ($class->has_column($key)
116 && $class->column_info($key)->{_inflate_info}) {
117 $inflated->{$key} = $attrs->{$key};
121 $new->throw_exception("No such column $key on $class")
122 unless $class->has_column($key);
123 $new->store_column($key => $attrs->{$key});
126 $new->{_relationship_data} = $related if $related;
127 $new->{_inflated_column} = $inflated if $inflated;
137 Inserts an object into the database if it isn't already in
138 there. Returns the object itself. Requires the object's result source to
139 be set, or the class to have a result_source_instance method. To insert
140 an entirely new object into the database, use C<create> (see
141 L<DBIx::Class::ResultSet/create>).
143 To fetch an uninserted row object, call
144 L<new|DBIx::Class::ResultSet/new> on a resultset.
146 This will also insert any uninserted, related objects held inside this
147 one, see L<DBIx::Class::ResultSet/create> for more details.
153 return $self if $self->in_storage;
154 my $source = $self->result_source;
155 $source ||= $self->result_source($self->result_source_instance)
156 if $self->can('result_source_instance');
157 $self->throw_exception("No result_source set on this object; can't insert")
162 # Check if we stored uninserted relobjs here in new()
163 my %related_stuff = (%{$self->{_relationship_data} || {}},
164 %{$self->{_inflated_column} || {}});
166 if(!$self->{_rel_in_storage}) {
168 # The guard will save us if we blow out of this scope via die
169 $rollback_guard = $source->storage->txn_scope_guard;
171 ## Should all be in relationship_data, but we need to get rid of the
172 ## 'filter' reltype..
173 ## These are the FK rels, need their IDs for the insert.
175 my @pri = $self->primary_columns;
177 REL: foreach my $relname (keys %related_stuff) {
179 my $rel_obj = $related_stuff{$relname};
181 next REL unless (Scalar::Util::blessed($rel_obj)
182 && $rel_obj->isa('DBIx::Class::Row'));
184 my $cond = $source->relationship_info($relname)->{cond};
186 next REL unless ref($cond) eq 'HASH';
188 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
190 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
192 # assume anything that references our PK probably is dependent on us
193 # rather than vice versa, unless the far side is (a) defined or (b)
196 foreach my $p (@pri) {
197 if (exists $keyhash->{$p}) {
198 unless (defined($rel_obj->get_column($keyhash->{$p}))
199 || $rel_obj->column_info($keyhash->{$p})
200 ->{is_auto_increment}) {
207 $self->set_from_related($relname, $rel_obj);
208 delete $related_stuff{$relname};
212 my $updated_cols = $source->storage->insert($source, { $self->get_columns });
213 $self->set_columns($updated_cols);
216 my @auto_pri = grep {
217 !defined $self->get_column($_) ||
218 ref($self->get_column($_)) eq 'SCALAR'
219 } $self->primary_columns;
222 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
223 # if defined $too_many;
225 my $storage = $self->result_source->storage;
226 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
227 unless $storage->can('last_insert_id');
228 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
229 $self->throw_exception( "Can't get last insert id" )
230 unless (@ids == @auto_pri);
231 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
234 if(!$self->{_rel_in_storage}) {
235 ## Now do the has_many rels, that need $selfs ID.
236 foreach my $relname (keys %related_stuff) {
237 my $rel_obj = $related_stuff{$relname};
239 if (Scalar::Util::blessed($rel_obj)
240 && $rel_obj->isa('DBIx::Class::Row')) {
242 } elsif (ref $rel_obj eq 'ARRAY') {
246 my $reverse = $source->reverse_relationship_info($relname);
247 foreach my $obj (@cands) {
248 $obj->set_from_related($_, $self) for keys %$reverse;
249 $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
253 $rollback_guard->commit;
256 $self->in_storage(1);
257 $self->{_dirty_columns} = {};
258 $self->{related_resultsets} = {};
259 undef $self->{_orig_ident};
265 $obj->in_storage; # Get value
266 $obj->in_storage(1); # Set value
268 Indicates whether the object exists as a row in the database or
269 not. This is set to true when L<DBIx::Class::ResultSet/find>,
270 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
273 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
274 L</delete> on one, sets it to false.
279 my ($self, $val) = @_;
280 $self->{_in_storage} = $val if @_ > 1;
281 return $self->{_in_storage};
286 $obj->update \%columns?;
288 Must be run on an object that is already in the database; issues an SQL
289 UPDATE query to commit any changes to the object to the database if
292 Also takes an options hashref of C<< column_name => value> pairs >> to update
293 first. But be aware that the hashref will be passed to
294 C<set_inflated_columns>, which might edit it in place, so dont rely on it being
295 the same after a call to C<update>. If you need to preserve the hashref, it is
296 sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
301 my ($self, $upd) = @_;
302 $self->throw_exception( "Not in database" ) unless $self->in_storage;
303 my $ident_cond = $self->ident_condition;
304 $self->throw_exception("Cannot safely update a row in a PK-less table")
305 if ! keys %$ident_cond;
307 $self->set_inflated_columns($upd) if $upd;
308 my %to_update = $self->get_dirty_columns;
309 return $self unless keys %to_update;
310 my $rows = $self->result_source->storage->update(
311 $self->result_source, \%to_update,
312 $self->{_orig_ident} || $ident_cond
315 $self->throw_exception( "Can't update ${self}: row not found" );
316 } elsif ($rows > 1) {
317 $self->throw_exception("Can't update ${self}: updated more than one row");
319 $self->{_dirty_columns} = {};
320 $self->{related_resultsets} = {};
321 undef $self->{_orig_ident};
329 Deletes the object from the database. The object is still perfectly
330 usable, but C<< ->in_storage() >> will now return 0 and the object must
331 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
332 on it. If you delete an object in a class with a C<has_many>
333 relationship, all the related objects will be deleted as well. To turn
334 this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
335 hashref. Any database-level cascade or restrict will take precedence
336 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
343 $self->throw_exception( "Not in database" ) unless $self->in_storage;
344 my $ident_cond = $self->ident_condition;
345 $self->throw_exception("Cannot safely delete a row in a PK-less table")
346 if ! keys %$ident_cond;
347 foreach my $column (keys %$ident_cond) {
348 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
349 unless exists $self->{_column_data}{$column};
351 $self->result_source->storage->delete(
352 $self->result_source, $ident_cond);
353 $self->in_storage(undef);
355 $self->throw_exception("Can't do class delete without a ResultSource instance")
356 unless $self->can('result_source_instance');
357 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
358 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
359 $self->result_source_instance->resultset->search(@_)->delete;
366 my $val = $obj->get_column($col);
368 Returns a raw column value from the row object, if it has already
369 been fetched from the database or set by an accessor.
371 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
372 will be deflated and returned.
377 my ($self, $column) = @_;
378 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
379 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
380 if (exists $self->{_inflated_column}{$column}) {
381 return $self->store_column($column,
382 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
384 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
388 =head2 has_column_loaded
390 if ( $obj->has_column_loaded($col) ) {
391 print "$col has been loaded from db";
394 Returns a true value if the column value has been loaded from the
395 database (or set locally).
399 sub has_column_loaded {
400 my ($self, $column) = @_;
401 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
402 return 1 if exists $self->{_inflated_column}{$column};
403 return exists $self->{_column_data}{$column};
408 my %data = $obj->get_columns;
410 Does C<get_column>, for all loaded column values at once.
416 if (exists $self->{_inflated_column}) {
417 foreach my $col (keys %{$self->{_inflated_column}}) {
418 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
419 unless exists $self->{_column_data}{$col};
422 return %{$self->{_column_data}};
425 =head2 get_dirty_columns
427 my %data = $obj->get_dirty_columns;
429 Identical to get_columns but only returns those that have been changed.
433 sub get_dirty_columns {
435 return map { $_ => $self->{_column_data}{$_} }
436 keys %{$self->{_dirty_columns}};
439 =head2 get_inflated_columns
441 my %inflated_data = $obj->get_inflated_columns;
443 Similar to get_columns but objects are returned for inflated columns
444 instead of their raw non-inflated values.
448 sub get_inflated_columns {
451 my $accessor = $self->column_info($_)->{'accessor'} || $_;
452 ($_ => $self->$accessor);
458 $obj->set_column($col => $val);
460 Sets a raw column value. If the new value is different from the old one,
461 the column is marked as dirty for when you next call $obj->update.
463 If passed an object or reference, this will happily attempt store the
464 value, and a later insert/update will try and stringify/numify as
472 $self->{_orig_ident} ||= $self->ident_condition;
473 my $old = $self->get_column($column);
474 my $ret = $self->store_column(@_);
475 $self->{_dirty_columns}{$column} = 1
476 if (defined $old xor defined $ret) || (defined $old && $old ne $ret);
478 # XXX clear out the relation cache for this column
479 delete $self->{related_resultsets}{$column};
486 my $copy = $orig->set_columns({ $col => $val, ... });
488 Sets more than one column value at once.
493 my ($self,$data) = @_;
494 foreach my $col (keys %$data) {
495 $self->set_column($col,$data->{$col});
500 =head2 set_inflated_columns
502 my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
504 Sets more than one column value at once, taking care to respect inflations and
505 relationships if relevant. Be aware that this hashref might be edited in place,
506 so dont rely on it being the same after a call to C<set_inflated_columns>. If
507 you need to preserve the hashref, it is sufficient to pass a shallow copy to
508 C<set_inflated_columns>, e.g. ( { %{ $href } } )
512 sub set_inflated_columns {
513 my ( $self, $upd ) = @_;
514 foreach my $key (keys %$upd) {
515 if (ref $upd->{$key}) {
516 my $info = $self->relationship_info($key);
517 if ($info && $info->{attrs}{accessor}
518 && $info->{attrs}{accessor} eq 'single')
520 my $rel = delete $upd->{$key};
521 $self->set_from_related($key => $rel);
522 $self->{_relationship_data}{$key} = $rel;
523 } elsif ($info && $info->{attrs}{accessor}
524 && $info->{attrs}{accessor} eq 'multi'
525 && ref $upd->{$key} eq 'ARRAY') {
526 my $others = delete $upd->{$key};
527 foreach my $rel_obj (@$others) {
528 if(!Scalar::Util::blessed($rel_obj)) {
529 $rel_obj = $self->create_related($key, $rel_obj);
532 $self->{_relationship_data}{$key} = $others;
533 # $related->{$key} = $others;
536 elsif ($self->has_column($key)
537 && exists $self->column_info($key)->{_inflate_info})
539 $self->set_inflated_column($key, delete $upd->{$key});
543 $self->set_columns($upd);
548 my $copy = $orig->copy({ change => $to, ... });
550 Inserts a new row with the specified changes. If the row has related
551 objects in a C<has_many> then those objects may be copied too depending
552 on the C<cascade_copy> relationship attribute.
557 my ($self, $changes) = @_;
559 my $col_data = { %{$self->{_column_data}} };
560 foreach my $col (keys %$col_data) {
561 delete $col_data->{$col}
562 if $self->result_source->column_info($col)->{is_auto_increment};
565 my $new = { _column_data => $col_data };
566 bless $new, ref $self;
568 $new->result_source($self->result_source);
569 $new->set_inflated_columns($changes);
572 # Its possible we'll have 2 relations to the same Source. We need to make
573 # sure we don't try to insert the same row twice esle we'll violate unique
575 my $rels_copied = {};
577 foreach my $rel ($self->result_source->relationships) {
578 my $rel_info = $self->result_source->relationship_info($rel);
580 next unless $rel_info->{attrs}{cascade_copy};
582 my $resolved = $self->result_source->resolve_condition(
583 $rel_info->{cond}, $rel, $new
586 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
587 foreach my $related ($self->search_related($rel)) {
588 my $id_str = join("\0", $related->id);
589 next if $copied->{$id_str};
590 $copied->{$id_str} = 1;
591 my $rel_copy = $related->copy($resolved);
600 $obj->store_column($col => $val);
602 Sets a column value without marking it as dirty.
607 my ($self, $column, $value) = @_;
608 $self->throw_exception( "No such column '${column}'" )
609 unless exists $self->{_column_data}{$column} || $self->has_column($column);
610 $self->throw_exception( "set_column called for ${column} without value" )
612 return $self->{_column_data}{$column} = $value;
615 =head2 inflate_result
617 Class->inflate_result($result_source, \%me, \%prefetch?)
619 Called by ResultSet to inflate a result from storage
624 my ($class, $source, $me, $prefetch) = @_;
626 my ($source_handle) = $source;
628 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
629 $source = $source_handle->resolve
631 $source_handle = $source->handle
635 _source_handle => $source_handle,
639 bless $new, (ref $class || $class);
642 foreach my $pre (keys %{$prefetch||{}}) {
643 my $pre_val = $prefetch->{$pre};
644 my $pre_source = $source->related_source($pre);
645 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
647 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
649 foreach my $pre_rec (@$pre_val) {
650 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
651 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
654 push(@pre_objects, $pre_source->result_class->inflate_result(
655 $pre_source, @{$pre_rec}));
657 $new->related_resultset($pre)->set_cache(\@pre_objects);
658 } elsif (defined $pre_val->[0]) {
660 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
661 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
663 $fetched = $pre_source->result_class->inflate_result(
664 $pre_source, @{$pre_val});
666 $new->related_resultset($pre)->set_cache([ $fetched ]);
667 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
668 $class->throw_exception("No accessor for prefetched $pre")
669 unless defined $accessor;
670 if ($accessor eq 'single') {
671 $new->{_relationship_data}{$pre} = $fetched;
672 } elsif ($accessor eq 'filter') {
673 $new->{_inflated_column}{$pre} = $fetched;
675 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
682 =head2 update_or_insert
684 $obj->update_or_insert
686 Updates the object if it's already in the database, according to
687 L</in_storage>, else inserts it.
689 =head2 insert_or_update
691 $obj->insert_or_update
693 Alias for L</update_or_insert>
697 *insert_or_update = \&update_or_insert;
698 sub update_or_insert {
700 return ($self->in_storage ? $self->update : $self->insert);
705 my @changed_col_names = $obj->is_changed();
706 if ($obj->is_changed()) { ... }
708 In array context returns a list of columns with uncommited changes, or
709 in scalar context returns a true value if there are uncommitted
715 return keys %{shift->{_dirty_columns} || {}};
718 =head2 is_column_changed
720 if ($obj->is_column_changed('col')) { ... }
722 Returns a true value if the column has uncommitted changes.
726 sub is_column_changed {
727 my( $self, $col ) = @_;
728 return exists $self->{_dirty_columns}->{$col};
733 my $resultsource = $object->result_source;
735 Accessor to the ResultSource this object was created from
743 $self->_source_handle($_[0]->handle);
745 $self->_source_handle->resolve;
749 =head2 register_column
751 $column_info = { .... };
752 $class->register_column($column_name, $column_info);
754 Registers a column on the class. If the column_info has an 'accessor'
755 key, creates an accessor named after the value if defined; if there is
756 no such key, creates an accessor with the same name as the column
758 The column_info attributes are described in
759 L<DBIx::Class::ResultSource/add_columns>
763 sub register_column {
764 my ($class, $col, $info) = @_;
766 if (exists $info->{accessor}) {
767 return unless defined $info->{accessor};
768 $acc = [ $info->{accessor}, $col ];
770 $class->mk_group_accessors('column' => $acc);
774 =head2 throw_exception
776 See Schema's throw_exception.
780 sub throw_exception {
782 if (ref $self && ref $self->result_source && $self->result_source->schema) {
783 $self->result_source->schema->throw_exception(@_);
791 Returns the primary key(s) for a row. Can't be called as a class method.
792 Actually implemented in L<DBIx::Class::PK>
794 =head2 discard_changes
796 Re-selects the row from the database, losing any changes that had
799 This method can also be used to refresh from storage, retrieving any
800 changes made since the row was last read from storage. Actually
801 implemented in L<DBIx::Class::PK>
809 Matt S. Trout <mst@shadowcatsystems.co.uk>
813 You may distribute this code under the same terms as Perl itself.