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};
122 $new->throw_exception("No such column $key on $class")
123 unless $class->has_column($key);
124 $new->store_column($key => $attrs->{$key});
127 $new->{_relationship_data} = $related if $related;
128 $new->{_inflated_column} = $inflated if $inflated;
138 Inserts an object into the database if it isn't already in
139 there. Returns the object itself. Requires the object's result source to
140 be set, or the class to have a result_source_instance method. To insert
141 an entirely new object into the database, use C<create> (see
142 L<DBIx::Class::ResultSet/create>).
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}) {
165 $source->storage->txn_begin;
167 # The guard will save us if we blow out of this scope via die
169 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
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 $source->storage->insert($source, { $self->get_columns });
215 my @auto_pri = grep {
216 !defined $self->get_column($_) ||
217 ref($self->get_column($_)) eq 'SCALAR'
218 } $self->primary_columns;
221 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
222 # if defined $too_many;
224 my $storage = $self->result_source->storage;
225 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
226 unless $storage->can('last_insert_id');
227 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
228 $self->throw_exception( "Can't get last insert id" )
229 unless (@ids == @auto_pri);
230 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
233 if(!$self->{_rel_in_storage}) {
234 ## Now do the has_many rels, that need $selfs ID.
235 foreach my $relname (keys %related_stuff) {
236 my $rel_obj = $related_stuff{$relname};
238 if (Scalar::Util::blessed($rel_obj)
239 && $rel_obj->isa('DBIx::Class::Row')) {
241 } elsif (ref $rel_obj eq 'ARRAY') {
245 my $reverse = $source->reverse_relationship_info($relname);
246 foreach my $obj (@cands) {
247 $obj->set_from_related($_, $self) for keys %$reverse;
248 $obj->insert() if(!$obj->in_storage);
252 $source->storage->txn_commit;
253 $rollback_guard->dismiss;
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 not
273 my ($self, $val) = @_;
274 $self->{_in_storage} = $val if @_ > 1;
275 return $self->{_in_storage};
280 $obj->update \%columns?;
282 Must be run on an object that is already in the database; issues an SQL
283 UPDATE query to commit any changes to the object to the database if
286 Also takes an options hashref of C<< column_name => value> pairs >> to update
287 first. But be aware that this hashref might be edited in place, so dont rely on
288 it being the same after a call to C<update>. If you need to preserve the hashref,
289 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
294 my ($self, $upd) = @_;
295 $self->throw_exception( "Not in database" ) unless $self->in_storage;
296 my $ident_cond = $self->ident_condition;
297 $self->throw_exception("Cannot safely update a row in a PK-less table")
298 if ! keys %$ident_cond;
301 foreach my $key (keys %$upd) {
302 if (ref $upd->{$key}) {
303 my $info = $self->relationship_info($key);
304 if ($info && $info->{attrs}{accessor}
305 && $info->{attrs}{accessor} eq 'single')
307 my $rel = delete $upd->{$key};
308 $self->set_from_related($key => $rel);
309 $self->{_relationship_data}{$key} = $rel;
310 } elsif ($info && $info->{attrs}{accessor}
311 && $info->{attrs}{accessor} eq 'multi'
312 && ref $upd->{$key} eq 'ARRAY') {
313 my $others = delete $upd->{$key};
314 foreach my $rel_obj (@$others) {
315 if(!Scalar::Util::blessed($rel_obj)) {
316 $rel_obj = $self->create_related($key, $rel_obj);
319 $self->{_relationship_data}{$key} = $others;
320 # $related->{$key} = $others;
323 elsif ($self->has_column($key)
324 && exists $self->column_info($key)->{_inflate_info})
326 $self->set_inflated_column($key, delete $upd->{$key});
330 $self->set_columns($upd);
332 my %to_update = $self->get_dirty_columns;
333 return $self unless keys %to_update;
334 my $rows = $self->result_source->storage->update(
335 $self->result_source, \%to_update,
336 $self->{_orig_ident} || $ident_cond
339 $self->throw_exception( "Can't update ${self}: row not found" );
340 } elsif ($rows > 1) {
341 $self->throw_exception("Can't update ${self}: updated more than one row");
343 $self->{_dirty_columns} = {};
344 $self->{related_resultsets} = {};
345 undef $self->{_orig_ident};
353 Deletes the object from the database. The object is still perfectly
354 usable, but C<< ->in_storage() >> will now return 0 and the object must
355 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
356 on it. If you delete an object in a class with a C<has_many>
357 relationship, all the related objects will be deleted as well. To turn
358 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
359 hashref. Any database-level cascade or restrict will take precedence
360 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
367 $self->throw_exception( "Not in database" ) unless $self->in_storage;
368 my $ident_cond = $self->ident_condition;
369 $self->throw_exception("Cannot safely delete a row in a PK-less table")
370 if ! keys %$ident_cond;
371 foreach my $column (keys %$ident_cond) {
372 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
373 unless exists $self->{_column_data}{$column};
375 $self->result_source->storage->delete(
376 $self->result_source, $ident_cond);
377 $self->in_storage(undef);
379 $self->throw_exception("Can't do class delete without a ResultSource instance")
380 unless $self->can('result_source_instance');
381 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
382 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
383 $self->result_source_instance->resultset->search(@_)->delete;
390 my $val = $obj->get_column($col);
392 Gets a column value from a row object. Does not do any queries; the column
393 must have already been fetched from the database and stored in the object. If
394 there is an inflated value stored that has not yet been deflated, it is deflated
395 when the method is invoked.
400 my ($self, $column) = @_;
401 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
402 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
403 if (exists $self->{_inflated_column}{$column}) {
404 return $self->store_column($column,
405 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
407 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
411 =head2 has_column_loaded
413 if ( $obj->has_column_loaded($col) ) {
414 print "$col has been loaded from db";
417 Returns a true value if the column value has been loaded from the
418 database (or set locally).
422 sub has_column_loaded {
423 my ($self, $column) = @_;
424 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
425 return 1 if exists $self->{_inflated_column}{$column};
426 return exists $self->{_column_data}{$column};
431 my %data = $obj->get_columns;
433 Does C<get_column>, for all column values at once.
439 if (exists $self->{_inflated_column}) {
440 foreach my $col (keys %{$self->{_inflated_column}}) {
441 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
442 unless exists $self->{_column_data}{$col};
445 return %{$self->{_column_data}};
448 =head2 get_dirty_columns
450 my %data = $obj->get_dirty_columns;
452 Identical to get_columns but only returns those that have been changed.
456 sub get_dirty_columns {
458 return map { $_ => $self->{_column_data}{$_} }
459 keys %{$self->{_dirty_columns}};
462 =head2 get_inflated_columns
464 my $inflated_data = $obj->get_inflated_columns;
466 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
470 sub get_inflated_columns {
473 my $accessor = $self->column_info($_)->{'accessor'} || $_;
474 ($_ => $self->$accessor);
480 $obj->set_column($col => $val);
482 Sets a column value. If the new value is different from the old one,
483 the column is marked as dirty for when you next call $obj->update.
490 $self->{_orig_ident} ||= $self->ident_condition;
491 my $old = $self->get_column($column);
492 my $ret = $self->store_column(@_);
493 $self->{_dirty_columns}{$column} = 1
494 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
496 # XXX clear out the relation cache for this column
497 delete $self->{related_resultsets}{$column};
504 my $copy = $orig->set_columns({ $col => $val, ... });
506 Sets more than one column value at once.
511 my ($self,$data) = @_;
512 foreach my $col (keys %$data) {
513 $self->set_column($col,$data->{$col});
520 my $copy = $orig->copy({ change => $to, ... });
522 Inserts a new row with the specified changes.
527 my ($self, $changes) = @_;
529 my $col_data = { %{$self->{_column_data}} };
530 foreach my $col (keys %$col_data) {
531 delete $col_data->{$col}
532 if $self->result_source->column_info($col)->{is_auto_increment};
535 my $new = { _column_data => $col_data };
536 bless $new, ref $self;
538 $new->result_source($self->result_source);
539 $new->set_columns($changes);
541 foreach my $rel ($self->result_source->relationships) {
542 my $rel_info = $self->result_source->relationship_info($rel);
543 if ($rel_info->{attrs}{cascade_copy}) {
544 my $resolved = $self->result_source->resolve_condition(
545 $rel_info->{cond}, $rel, $new);
546 foreach my $related ($self->search_related($rel)) {
547 $related->copy($resolved);
556 $obj->store_column($col => $val);
558 Sets a column value without marking it as dirty.
563 my ($self, $column, $value) = @_;
564 $self->throw_exception( "No such column '${column}'" )
565 unless exists $self->{_column_data}{$column} || $self->has_column($column);
566 $self->throw_exception( "set_column called for ${column} without value" )
568 return $self->{_column_data}{$column} = $value;
571 =head2 inflate_result
573 Class->inflate_result($result_source, \%me, \%prefetch?)
575 Called by ResultSet to inflate a result from storage
580 my ($class, $source, $me, $prefetch) = @_;
582 my ($source_handle) = $source;
584 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
585 $source = $source_handle->resolve
587 $source_handle = $source->handle
591 _source_handle => $source_handle,
595 bless $new, (ref $class || $class);
598 foreach my $pre (keys %{$prefetch||{}}) {
599 my $pre_val = $prefetch->{$pre};
600 my $pre_source = $source->related_source($pre);
601 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
603 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
605 foreach my $pre_rec (@$pre_val) {
606 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
607 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
610 push(@pre_objects, $pre_source->result_class->inflate_result(
611 $pre_source, @{$pre_rec}));
613 $new->related_resultset($pre)->set_cache(\@pre_objects);
614 } elsif (defined $pre_val->[0]) {
616 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
617 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
619 $fetched = $pre_source->result_class->inflate_result(
620 $pre_source, @{$pre_val});
622 $new->related_resultset($pre)->set_cache([ $fetched ]);
623 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
624 $class->throw_exception("No accessor for prefetched $pre")
625 unless defined $accessor;
626 if ($accessor eq 'single') {
627 $new->{_relationship_data}{$pre} = $fetched;
628 } elsif ($accessor eq 'filter') {
629 $new->{_inflated_column}{$pre} = $fetched;
631 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
638 =head2 update_or_insert
640 $obj->update_or_insert
642 Updates the object if it's already in the db, else inserts it.
644 =head2 insert_or_update
646 $obj->insert_or_update
648 Alias for L</update_or_insert>
652 *insert_or_update = \&update_or_insert;
653 sub update_or_insert {
655 return ($self->in_storage ? $self->update : $self->insert);
660 my @changed_col_names = $obj->is_changed();
661 if ($obj->is_changed()) { ... }
663 In array context returns a list of columns with uncommited changes, or
664 in scalar context returns a true value if there are uncommitted
670 return keys %{shift->{_dirty_columns} || {}};
673 =head2 is_column_changed
675 if ($obj->is_column_changed('col')) { ... }
677 Returns a true value if the column has uncommitted changes.
681 sub is_column_changed {
682 my( $self, $col ) = @_;
683 return exists $self->{_dirty_columns}->{$col};
688 my $resultsource = $object->result_source;
690 Accessor to the ResultSource this object was created from
698 $self->_source_handle($_[0]->handle);
700 $self->_source_handle->resolve;
704 =head2 register_column
706 $column_info = { .... };
707 $class->register_column($column_name, $column_info);
709 Registers a column on the class. If the column_info has an 'accessor'
710 key, creates an accessor named after the value if defined; if there is
711 no such key, creates an accessor with the same name as the column
713 The column_info attributes are described in
714 L<DBIx::Class::ResultSource/add_columns>
718 sub register_column {
719 my ($class, $col, $info) = @_;
721 if (exists $info->{accessor}) {
722 return unless defined $info->{accessor};
723 $acc = [ $info->{accessor}, $col ];
725 $class->mk_group_accessors('column' => $acc);
729 =head2 throw_exception
731 See Schema's throw_exception.
735 sub throw_exception {
737 if (ref $self && ref $self->result_source && $self->result_source->schema) {
738 $self->result_source->schema->throw_exception(@_);
748 Matt S. Trout <mst@shadowcatsystems.co.uk>
752 You may distribute this code under the same terms as Perl itself.