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 This will also insert any uninserted, related objects held inside this
142 one, see L<DBIx::Class::ResultSet/create> for more details.
148 return $self if $self->in_storage;
149 my $source = $self->result_source;
150 $source ||= $self->result_source($self->result_source_instance)
151 if $self->can('result_source_instance');
152 $self->throw_exception("No result_source set on this object; can't insert")
157 # Check if we stored uninserted relobjs here in new()
158 my %related_stuff = (%{$self->{_relationship_data} || {}},
159 %{$self->{_inflated_column} || {}});
161 if(!$self->{_rel_in_storage}) {
162 $source->storage->txn_begin;
164 # The guard will save us if we blow out of this scope via die
166 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
168 ## Should all be in relationship_data, but we need to get rid of the
169 ## 'filter' reltype..
170 ## These are the FK rels, need their IDs for the insert.
172 my @pri = $self->primary_columns;
174 REL: foreach my $relname (keys %related_stuff) {
176 my $rel_obj = $related_stuff{$relname};
178 next REL unless (Scalar::Util::blessed($rel_obj)
179 && $rel_obj->isa('DBIx::Class::Row'));
181 my $cond = $source->relationship_info($relname)->{cond};
183 next REL unless ref($cond) eq 'HASH';
185 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
187 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
189 # assume anything that references our PK probably is dependent on us
190 # rather than vice versa, unless the far side is (a) defined or (b)
193 foreach my $p (@pri) {
194 if (exists $keyhash->{$p}) {
195 unless (defined($rel_obj->get_column($keyhash->{$p}))
196 || $rel_obj->column_info($keyhash->{$p})
197 ->{is_auto_increment}) {
204 $self->set_from_related($relname, $rel_obj);
205 delete $related_stuff{$relname};
209 $source->storage->insert($source, { $self->get_columns });
212 my @auto_pri = grep {
213 !defined $self->get_column($_) ||
214 ref($self->get_column($_)) eq 'SCALAR'
215 } $self->primary_columns;
218 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
219 # if defined $too_many;
221 my $storage = $self->result_source->storage;
222 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
223 unless $storage->can('last_insert_id');
224 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
225 $self->throw_exception( "Can't get last insert id" )
226 unless (@ids == @auto_pri);
227 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
230 if(!$self->{_rel_in_storage}) {
231 ## Now do the has_many rels, that need $selfs ID.
232 foreach my $relname (keys %related_stuff) {
233 my $rel_obj = $related_stuff{$relname};
235 if (Scalar::Util::blessed($rel_obj)
236 && $rel_obj->isa('DBIx::Class::Row')) {
238 } elsif (ref $rel_obj eq 'ARRAY') {
242 my $reverse = $source->reverse_relationship_info($relname);
243 foreach my $obj (@cands) {
244 $obj->set_from_related($_, $self) for keys %$reverse;
245 $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
249 $source->storage->txn_commit;
250 $rollback_guard->dismiss;
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 not
270 my ($self, $val) = @_;
271 $self->{_in_storage} = $val if @_ > 1;
272 return $self->{_in_storage};
277 $obj->update \%columns?;
279 Must be run on an object that is already in the database; issues an SQL
280 UPDATE query to commit any changes to the object to the database if
283 Also takes an options hashref of C<< column_name => value> pairs >> to update
284 first. But be aware that this hashref might be edited in place, so dont rely on
285 it being the same after a call to C<update>. If you need to preserve the hashref,
286 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
291 my ($self, $upd) = @_;
292 $self->throw_exception( "Not in database" ) unless $self->in_storage;
293 my $ident_cond = $self->ident_condition;
294 $self->throw_exception("Cannot safely update a row in a PK-less table")
295 if ! keys %$ident_cond;
298 foreach my $key (keys %$upd) {
299 if (ref $upd->{$key}) {
300 my $info = $self->relationship_info($key);
301 if ($info && $info->{attrs}{accessor}
302 && $info->{attrs}{accessor} eq 'single')
304 my $rel = delete $upd->{$key};
305 $self->set_from_related($key => $rel);
306 $self->{_relationship_data}{$key} = $rel;
307 } elsif ($info && $info->{attrs}{accessor}
308 && $info->{attrs}{accessor} eq 'multi'
309 && ref $upd->{$key} eq 'ARRAY') {
310 my $others = delete $upd->{$key};
311 foreach my $rel_obj (@$others) {
312 if(!Scalar::Util::blessed($rel_obj)) {
313 $rel_obj = $self->create_related($key, $rel_obj);
316 $self->{_relationship_data}{$key} = $others;
317 # $related->{$key} = $others;
320 elsif ($self->has_column($key)
321 && exists $self->column_info($key)->{_inflate_info})
323 $self->set_inflated_column($key, delete $upd->{$key});
327 $self->set_columns($upd);
329 my %to_update = $self->get_dirty_columns;
330 return $self unless keys %to_update;
331 my $rows = $self->result_source->storage->update(
332 $self->result_source, \%to_update,
333 $self->{_orig_ident} || $ident_cond
336 $self->throw_exception( "Can't update ${self}: row not found" );
337 } elsif ($rows > 1) {
338 $self->throw_exception("Can't update ${self}: updated more than one row");
340 $self->{_dirty_columns} = {};
341 $self->{related_resultsets} = {};
342 undef $self->{_orig_ident};
350 Deletes the object from the database. The object is still perfectly
351 usable, but C<< ->in_storage() >> will now return 0 and the object must
352 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
353 on it. If you delete an object in a class with a C<has_many>
354 relationship, all the related objects will be deleted as well. To turn
355 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
356 hashref. Any database-level cascade or restrict will take precedence
357 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
364 $self->throw_exception( "Not in database" ) unless $self->in_storage;
365 my $ident_cond = $self->ident_condition;
366 $self->throw_exception("Cannot safely delete a row in a PK-less table")
367 if ! keys %$ident_cond;
368 foreach my $column (keys %$ident_cond) {
369 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
370 unless exists $self->{_column_data}{$column};
372 $self->result_source->storage->delete(
373 $self->result_source, $ident_cond);
374 $self->in_storage(undef);
376 $self->throw_exception("Can't do class delete without a ResultSource instance")
377 unless $self->can('result_source_instance');
378 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
379 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
380 $self->result_source_instance->resultset->search(@_)->delete;
387 my $val = $obj->get_column($col);
389 Gets a column value from a row object. Does not do any queries; the column
390 must have already been fetched from the database and stored in the object. If
391 there is an inflated value stored that has not yet been deflated, it is deflated
392 when the method is invoked.
397 my ($self, $column) = @_;
398 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
399 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
400 if (exists $self->{_inflated_column}{$column}) {
401 return $self->store_column($column,
402 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
404 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
408 =head2 has_column_loaded
410 if ( $obj->has_column_loaded($col) ) {
411 print "$col has been loaded from db";
414 Returns a true value if the column value has been loaded from the
415 database (or set locally).
419 sub has_column_loaded {
420 my ($self, $column) = @_;
421 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
422 return 1 if exists $self->{_inflated_column}{$column};
423 return exists $self->{_column_data}{$column};
428 my %data = $obj->get_columns;
430 Does C<get_column>, for all column values at once.
436 if (exists $self->{_inflated_column}) {
437 foreach my $col (keys %{$self->{_inflated_column}}) {
438 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
439 unless exists $self->{_column_data}{$col};
442 return %{$self->{_column_data}};
445 =head2 get_dirty_columns
447 my %data = $obj->get_dirty_columns;
449 Identical to get_columns but only returns those that have been changed.
453 sub get_dirty_columns {
455 return map { $_ => $self->{_column_data}{$_} }
456 keys %{$self->{_dirty_columns}};
459 =head2 get_inflated_columns
461 my $inflated_data = $obj->get_inflated_columns;
463 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
467 sub get_inflated_columns {
470 my $accessor = $self->column_info($_)->{'accessor'} || $_;
471 ($_ => $self->$accessor);
477 $obj->set_column($col => $val);
479 Sets a column value. If the new value is different from the old one,
480 the column is marked as dirty for when you next call $obj->update.
487 $self->{_orig_ident} ||= $self->ident_condition;
488 my $old = $self->get_column($column);
489 my $ret = $self->store_column(@_);
490 $self->{_dirty_columns}{$column} = 1
491 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
497 my $copy = $orig->set_columns({ $col => $val, ... });
499 Sets more than one column value at once.
504 my ($self,$data) = @_;
505 foreach my $col (keys %$data) {
506 $self->set_column($col,$data->{$col});
513 my $copy = $orig->copy({ change => $to, ... });
515 Inserts a new row with the specified changes.
520 my ($self, $changes) = @_;
522 my $col_data = { %{$self->{_column_data}} };
523 foreach my $col (keys %$col_data) {
524 delete $col_data->{$col}
525 if $self->result_source->column_info($col)->{is_auto_increment};
528 my $new = { _column_data => $col_data };
529 bless $new, ref $self;
531 $new->result_source($self->result_source);
532 $new->set_columns($changes);
535 # Its possible we'll have 2 relations to the same Source. We need to make
536 # sure we don't try to insert the same row twice esle we'll violate unique
538 my $rels_copied = {};
540 foreach my $rel ($self->result_source->relationships) {
541 my $rel_info = $self->result_source->relationship_info($rel);
543 next unless $rel_info->{attrs}{cascade_copy};
545 my $resolved = $self->result_source->resolve_condition(
546 $rel_info->{cond}, $rel, $new
549 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
550 foreach my $related ($self->search_related($rel)) {
551 my $id_str = join("\0", $related->id);
552 next if $copied->{$id_str};
553 $copied->{$id_str} = 1;
554 my $rel_copy = $related->copy($resolved);
563 $obj->store_column($col => $val);
565 Sets a column value without marking it as dirty.
570 my ($self, $column, $value) = @_;
571 $self->throw_exception( "No such column '${column}'" )
572 unless exists $self->{_column_data}{$column} || $self->has_column($column);
573 $self->throw_exception( "set_column called for ${column} without value" )
575 return $self->{_column_data}{$column} = $value;
578 =head2 inflate_result
580 Class->inflate_result($result_source, \%me, \%prefetch?)
582 Called by ResultSet to inflate a result from storage
587 my ($class, $source, $me, $prefetch) = @_;
589 my ($source_handle) = $source;
591 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
592 $source = $source_handle->resolve
594 $source_handle = $source->handle
598 _source_handle => $source_handle,
602 bless $new, (ref $class || $class);
605 foreach my $pre (keys %{$prefetch||{}}) {
606 my $pre_val = $prefetch->{$pre};
607 my $pre_source = $source->related_source($pre);
608 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
610 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
612 foreach my $pre_rec (@$pre_val) {
613 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
614 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
617 push(@pre_objects, $pre_source->result_class->inflate_result(
618 $pre_source, @{$pre_rec}));
620 $new->related_resultset($pre)->set_cache(\@pre_objects);
621 } elsif (defined $pre_val->[0]) {
623 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
624 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
626 $fetched = $pre_source->result_class->inflate_result(
627 $pre_source, @{$pre_val});
629 $new->related_resultset($pre)->set_cache([ $fetched ]);
630 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
631 $class->throw_exception("No accessor for prefetched $pre")
632 unless defined $accessor;
633 if ($accessor eq 'single') {
634 $new->{_relationship_data}{$pre} = $fetched;
635 } elsif ($accessor eq 'filter') {
636 $new->{_inflated_column}{$pre} = $fetched;
638 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
645 =head2 update_or_insert
647 $obj->update_or_insert
649 Updates the object if it's already in the db, else inserts it.
651 =head2 insert_or_update
653 $obj->insert_or_update
655 Alias for L</update_or_insert>
659 *insert_or_update = \&update_or_insert;
660 sub update_or_insert {
662 return ($self->in_storage ? $self->update : $self->insert);
667 my @changed_col_names = $obj->is_changed();
668 if ($obj->is_changed()) { ... }
670 In array context returns a list of columns with uncommited changes, or
671 in scalar context returns a true value if there are uncommitted
677 return keys %{shift->{_dirty_columns} || {}};
680 =head2 is_column_changed
682 if ($obj->is_column_changed('col')) { ... }
684 Returns a true value if the column has uncommitted changes.
688 sub is_column_changed {
689 my( $self, $col ) = @_;
690 return exists $self->{_dirty_columns}->{$col};
695 my $resultsource = $object->result_source;
697 Accessor to the ResultSource this object was created from
705 $self->_source_handle($_[0]->handle);
707 $self->_source_handle->resolve;
711 =head2 register_column
713 $column_info = { .... };
714 $class->register_column($column_name, $column_info);
716 Registers a column on the class. If the column_info has an 'accessor'
717 key, creates an accessor named after the value if defined; if there is
718 no such key, creates an accessor with the same name as the column
720 The column_info attributes are described in
721 L<DBIx::Class::ResultSource/add_columns>
725 sub register_column {
726 my ($class, $col, $info) = @_;
728 if (exists $info->{accessor}) {
729 return unless defined $info->{accessor};
730 $acc = [ $info->{accessor}, $col ];
732 $class->mk_group_accessors('column' => $acc);
736 =head2 throw_exception
738 See Schema's throw_exception.
742 sub throw_exception {
744 if (ref $self && ref $self->result_source && $self->result_source->schema) {
745 $self->result_source->schema->throw_exception(@_);
755 Matt S. Trout <mst@shadowcatsystems.co.uk>
759 You may distribute this code under the same terms as Perl itself.