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}) {
163 # The guard will save us if we blow out of this scope via die
164 $rollback_guard = $source->storage->txn_scope_guard;
166 ## Should all be in relationship_data, but we need to get rid of the
167 ## 'filter' reltype..
168 ## These are the FK rels, need their IDs for the insert.
170 my @pri = $self->primary_columns;
172 REL: foreach my $relname (keys %related_stuff) {
174 my $rel_obj = $related_stuff{$relname};
176 next REL unless (Scalar::Util::blessed($rel_obj)
177 && $rel_obj->isa('DBIx::Class::Row'));
179 my $cond = $source->relationship_info($relname)->{cond};
181 next REL unless ref($cond) eq 'HASH';
183 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
185 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
187 # assume anything that references our PK probably is dependent on us
188 # rather than vice versa, unless the far side is (a) defined or (b)
191 foreach my $p (@pri) {
192 if (exists $keyhash->{$p}) {
193 unless (defined($rel_obj->get_column($keyhash->{$p}))
194 || $rel_obj->column_info($keyhash->{$p})
195 ->{is_auto_increment}) {
202 $self->set_from_related($relname, $rel_obj);
203 delete $related_stuff{$relname};
207 $source->storage->insert($source, { $self->get_columns });
210 my @auto_pri = grep {
211 !defined $self->get_column($_) ||
212 ref($self->get_column($_)) eq 'SCALAR'
213 } $self->primary_columns;
216 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
217 # if defined $too_many;
219 my $storage = $self->result_source->storage;
220 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
221 unless $storage->can('last_insert_id');
222 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
223 $self->throw_exception( "Can't get last insert id" )
224 unless (@ids == @auto_pri);
225 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
228 if(!$self->{_rel_in_storage}) {
229 ## Now do the has_many rels, that need $selfs ID.
230 foreach my $relname (keys %related_stuff) {
231 my $rel_obj = $related_stuff{$relname};
233 if (Scalar::Util::blessed($rel_obj)
234 && $rel_obj->isa('DBIx::Class::Row')) {
236 } elsif (ref $rel_obj eq 'ARRAY') {
240 my $reverse = $source->reverse_relationship_info($relname);
241 foreach my $obj (@cands) {
242 $obj->set_from_related($_, $self) for keys %$reverse;
243 $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
247 $rollback_guard->commit;
250 $self->in_storage(1);
251 $self->{_dirty_columns} = {};
252 $self->{related_resultsets} = {};
253 undef $self->{_orig_ident};
259 $obj->in_storage; # Get value
260 $obj->in_storage(1); # Set value
262 Indicates whether the object exists as a row in the database or not
267 my ($self, $val) = @_;
268 $self->{_in_storage} = $val if @_ > 1;
269 return $self->{_in_storage};
274 $obj->update \%columns?;
276 Must be run on an object that is already in the database; issues an SQL
277 UPDATE query to commit any changes to the object to the database if
280 Also takes an options hashref of C<< column_name => value> pairs >> to update
281 first. But be aware that the hashref will be passed to
282 C<set_inflated_columns>, which might edit it in place, so dont rely on it being
283 the same after a call to C<update>. If you need to preserve the hashref, it is
284 sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
289 my ($self, $upd) = @_;
290 $self->throw_exception( "Not in database" ) unless $self->in_storage;
291 my $ident_cond = $self->ident_condition;
292 $self->throw_exception("Cannot safely update a row in a PK-less table")
293 if ! keys %$ident_cond;
295 $self->set_inflated_columns($upd) if $upd;
296 my %to_update = $self->get_dirty_columns;
297 return $self unless keys %to_update;
298 my $rows = $self->result_source->storage->update(
299 $self->result_source, \%to_update,
300 $self->{_orig_ident} || $ident_cond
303 $self->throw_exception( "Can't update ${self}: row not found" );
304 } elsif ($rows > 1) {
305 $self->throw_exception("Can't update ${self}: updated more than one row");
307 $self->{_dirty_columns} = {};
308 $self->{related_resultsets} = {};
309 undef $self->{_orig_ident};
317 Deletes the object from the database. The object is still perfectly
318 usable, but C<< ->in_storage() >> will now return 0 and the object must
319 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
320 on it. If you delete an object in a class with a C<has_many>
321 relationship, all the related objects will be deleted as well. To turn
322 this behavior off, pass C<< cascade_delete => 0 >> in the C<$attr>
323 hashref. Any database-level cascade or restrict will take precedence
324 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
331 $self->throw_exception( "Not in database" ) unless $self->in_storage;
332 my $ident_cond = $self->ident_condition;
333 $self->throw_exception("Cannot safely delete a row in a PK-less table")
334 if ! keys %$ident_cond;
335 foreach my $column (keys %$ident_cond) {
336 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
337 unless exists $self->{_column_data}{$column};
339 $self->result_source->storage->delete(
340 $self->result_source, $ident_cond);
341 $self->in_storage(undef);
343 $self->throw_exception("Can't do class delete without a ResultSource instance")
344 unless $self->can('result_source_instance');
345 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
346 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
347 $self->result_source_instance->resultset->search(@_)->delete;
354 my $val = $obj->get_column($col);
356 Gets a column value from a row object. Does not do any queries; the column
357 must have already been fetched from the database and stored in the object. If
358 there is an inflated value stored that has not yet been deflated, it is deflated
359 when the method is invoked.
364 my ($self, $column) = @_;
365 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
366 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
367 if (exists $self->{_inflated_column}{$column}) {
368 return $self->store_column($column,
369 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
371 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
375 =head2 has_column_loaded
377 if ( $obj->has_column_loaded($col) ) {
378 print "$col has been loaded from db";
381 Returns a true value if the column value has been loaded from the
382 database (or set locally).
386 sub has_column_loaded {
387 my ($self, $column) = @_;
388 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
389 return 1 if exists $self->{_inflated_column}{$column};
390 return exists $self->{_column_data}{$column};
395 my %data = $obj->get_columns;
397 Does C<get_column>, for all column values at once.
403 if (exists $self->{_inflated_column}) {
404 foreach my $col (keys %{$self->{_inflated_column}}) {
405 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
406 unless exists $self->{_column_data}{$col};
409 return %{$self->{_column_data}};
412 =head2 get_dirty_columns
414 my %data = $obj->get_dirty_columns;
416 Identical to get_columns but only returns those that have been changed.
420 sub get_dirty_columns {
422 return map { $_ => $self->{_column_data}{$_} }
423 keys %{$self->{_dirty_columns}};
426 =head2 get_inflated_columns
428 my $inflated_data = $obj->get_inflated_columns;
430 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
434 sub get_inflated_columns {
437 my $accessor = $self->column_info($_)->{'accessor'} || $_;
438 ($_ => $self->$accessor);
444 $obj->set_column($col => $val);
446 Sets a column value. If the new value is different from the old one,
447 the column is marked as dirty for when you next call $obj->update.
454 $self->{_orig_ident} ||= $self->ident_condition;
455 my $old = $self->get_column($column);
456 my $ret = $self->store_column(@_);
457 $self->{_dirty_columns}{$column} = 1
458 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
464 my $copy = $orig->set_columns({ $col => $val, ... });
466 Sets more than one column value at once.
471 my ($self,$data) = @_;
472 foreach my $col (keys %$data) {
473 $self->set_column($col,$data->{$col});
478 =head2 set_inflated_columns
480 my $copy = $orig->set_inflated_columns({ $col => $val, $rel => $obj, ... });
482 Sets more than one column value at once, taking care to respect inflations and
483 relationships if relevant. Be aware that this hashref might be edited in place,
484 so dont rely on it being the same after a call to C<set_inflated_columns>. If
485 you need to preserve the hashref, it is sufficient to pass a shallow copy to
486 C<set_inflated_columns>, e.g. ( { %{ $href } } )
490 sub set_inflated_columns {
491 my ( $self, $upd ) = @_;
492 foreach my $key (keys %$upd) {
493 if (ref $upd->{$key}) {
494 my $info = $self->relationship_info($key);
495 if ($info && $info->{attrs}{accessor}
496 && $info->{attrs}{accessor} eq 'single')
498 my $rel = delete $upd->{$key};
499 $self->set_from_related($key => $rel);
500 $self->{_relationship_data}{$key} = $rel;
501 } elsif ($info && $info->{attrs}{accessor}
502 && $info->{attrs}{accessor} eq 'multi'
503 && ref $upd->{$key} eq 'ARRAY') {
504 my $others = delete $upd->{$key};
505 foreach my $rel_obj (@$others) {
506 if(!Scalar::Util::blessed($rel_obj)) {
507 $rel_obj = $self->create_related($key, $rel_obj);
510 $self->{_relationship_data}{$key} = $others;
511 # $related->{$key} = $others;
514 elsif ($self->has_column($key)
515 && exists $self->column_info($key)->{_inflate_info})
517 $self->set_inflated_column($key, delete $upd->{$key});
521 $self->set_columns($upd);
526 my $copy = $orig->copy({ change => $to, ... });
528 Inserts a new row with the specified changes.
533 my ($self, $changes) = @_;
535 my $col_data = { %{$self->{_column_data}} };
536 foreach my $col (keys %$col_data) {
537 delete $col_data->{$col}
538 if $self->result_source->column_info($col)->{is_auto_increment};
541 my $new = { _column_data => $col_data };
542 bless $new, ref $self;
544 $new->result_source($self->result_source);
545 $new->set_inflated_columns($changes);
548 # Its possible we'll have 2 relations to the same Source. We need to make
549 # sure we don't try to insert the same row twice esle we'll violate unique
551 my $rels_copied = {};
553 foreach my $rel ($self->result_source->relationships) {
554 my $rel_info = $self->result_source->relationship_info($rel);
556 next unless $rel_info->{attrs}{cascade_copy};
558 my $resolved = $self->result_source->resolve_condition(
559 $rel_info->{cond}, $rel, $new
562 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
563 foreach my $related ($self->search_related($rel)) {
564 my $id_str = join("\0", $related->id);
565 next if $copied->{$id_str};
566 $copied->{$id_str} = 1;
567 my $rel_copy = $related->copy($resolved);
576 $obj->store_column($col => $val);
578 Sets a column value without marking it as dirty.
583 my ($self, $column, $value) = @_;
584 $self->throw_exception( "No such column '${column}'" )
585 unless exists $self->{_column_data}{$column} || $self->has_column($column);
586 $self->throw_exception( "set_column called for ${column} without value" )
588 return $self->{_column_data}{$column} = $value;
591 =head2 inflate_result
593 Class->inflate_result($result_source, \%me, \%prefetch?)
595 Called by ResultSet to inflate a result from storage
600 my ($class, $source, $me, $prefetch) = @_;
602 my ($source_handle) = $source;
604 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
605 $source = $source_handle->resolve
607 $source_handle = $source->handle
611 _source_handle => $source_handle,
615 bless $new, (ref $class || $class);
618 foreach my $pre (keys %{$prefetch||{}}) {
619 my $pre_val = $prefetch->{$pre};
620 my $pre_source = $source->related_source($pre);
621 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
623 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
625 foreach my $pre_rec (@$pre_val) {
626 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
627 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
630 push(@pre_objects, $pre_source->result_class->inflate_result(
631 $pre_source, @{$pre_rec}));
633 $new->related_resultset($pre)->set_cache(\@pre_objects);
634 } elsif (defined $pre_val->[0]) {
636 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
637 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
639 $fetched = $pre_source->result_class->inflate_result(
640 $pre_source, @{$pre_val});
642 $new->related_resultset($pre)->set_cache([ $fetched ]);
643 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
644 $class->throw_exception("No accessor for prefetched $pre")
645 unless defined $accessor;
646 if ($accessor eq 'single') {
647 $new->{_relationship_data}{$pre} = $fetched;
648 } elsif ($accessor eq 'filter') {
649 $new->{_inflated_column}{$pre} = $fetched;
651 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
658 =head2 update_or_insert
660 $obj->update_or_insert
662 Updates the object if it's already in the db, else inserts it.
664 =head2 insert_or_update
666 $obj->insert_or_update
668 Alias for L</update_or_insert>
672 *insert_or_update = \&update_or_insert;
673 sub update_or_insert {
675 return ($self->in_storage ? $self->update : $self->insert);
680 my @changed_col_names = $obj->is_changed();
681 if ($obj->is_changed()) { ... }
683 In array context returns a list of columns with uncommited changes, or
684 in scalar context returns a true value if there are uncommitted
690 return keys %{shift->{_dirty_columns} || {}};
693 =head2 is_column_changed
695 if ($obj->is_column_changed('col')) { ... }
697 Returns a true value if the column has uncommitted changes.
701 sub is_column_changed {
702 my( $self, $col ) = @_;
703 return exists $self->{_dirty_columns}->{$col};
708 my $resultsource = $object->result_source;
710 Accessor to the ResultSource this object was created from
718 $self->_source_handle($_[0]->handle);
720 $self->_source_handle->resolve;
724 =head2 register_column
726 $column_info = { .... };
727 $class->register_column($column_name, $column_info);
729 Registers a column on the class. If the column_info has an 'accessor'
730 key, creates an accessor named after the value if defined; if there is
731 no such key, creates an accessor with the same name as the column
733 The column_info attributes are described in
734 L<DBIx::Class::ResultSource/add_columns>
738 sub register_column {
739 my ($class, $col, $info) = @_;
741 if (exists $info->{accessor}) {
742 return unless defined $info->{accessor};
743 $acc = [ $info->{accessor}, $col ];
745 $class->mk_group_accessors('column' => $acc);
749 =head2 throw_exception
751 See Schema's throw_exception.
755 sub throw_exception {
757 if (ref $self && ref $self->result_source && $self->result_source->schema) {
758 $self->result_source->schema->throw_exception(@_);
766 Returns the primary key(s) for a row. Can't be called as a class method.
767 Actually implemented in L<DBIx::Class::PK>
769 =head2 discard_changes
771 Re-selects the row from the database, losing any changes that had
774 This method can also be used to refresh from storage, retrieving any
775 changes made since the row was last read from storage. Actually
776 implemented in L<DBIx::Class::PK>
784 Matt S. Trout <mst@shadowcatsystems.co.uk>
788 You may distribute this code under the same terms as Perl itself.