1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
7 use Carp::Clan qw/^DBIx::Class/;
10 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
14 DBIx::Class::Row - Basic row methods
20 This class is responsible for defining and doing basic operations on rows
21 derived from L<DBIx::Class::ResultSource> objects.
27 my $obj = My::Class->new($attrs);
29 Creates a new row object from column => value mappings passed as a hash ref
31 Passing an object, or an arrayref of objects as a value will call
32 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
33 passed a hashref or an arrayref of hashrefs as the value, these will
34 be turned into objects via new_related, and treated as if you had
39 ## NB (JER) - this assumes set_from_related can cope with multi-rels
40 ## 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().
41 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
42 ## When doing the later insert, we need to make sure the PKs are set.
43 ## using _relationship_data in new and funky ways..
44 ## check Relationship::CascadeActions and Relationship::Accessor for compat
48 my ($class, $attrs, $source) = @_;
49 $class = ref $class if ref $class;
51 my $new = { _column_data => {} };
54 $new->_source_handle($source) if $source;
57 $new->throw_exception("attrs must be a hashref")
58 unless ref($attrs) eq 'HASH';
60 my ($related,$inflated);
61 foreach my $key (keys %$attrs) {
62 if (ref $attrs->{$key}) {
63 my $info = $class->relationship_info($key);
64 if ($info && $info->{attrs}{accessor}
65 && $info->{attrs}{accessor} eq 'single')
67 my $rel_obj = $attrs->{$key};
68 $new->{_rel_in_storage} = 1;
69 if(!Scalar::Util::blessed($rel_obj)) {
70 $rel_obj = $new->new_related($key, $rel_obj);
71 $new->{_rel_in_storage} = 0;
73 $new->set_from_related($key, $attrs->{$key});
74 $related->{$key} = $attrs->{$key};
76 } elsif ($info && $info->{attrs}{accessor}
77 && $info->{attrs}{accessor} eq 'multi'
78 && ref $attrs->{$key} eq 'ARRAY') {
79 my $others = delete $attrs->{$key};
80 $new->{_rel_in_storage} = 1;
81 foreach my $rel_obj (@$others) {
82 if(!Scalar::Util::blessed($rel_obj)) {
83 $rel_obj = $new->new_related($key, $rel_obj);
84 $new->{_rel_in_storage} = 0;
87 # $new->set_from_related($key, $others);
88 $related->{$key} = $others;
90 } elsif ($class->has_column($key)
91 && exists $class->column_info($key)->{_inflate_info})
93 ## 'filter' should disappear and get merged in with 'single' above!
94 my $rel_obj = $attrs->{$key};
95 $new->{_rel_in_storage} = 1;
96 if(!Scalar::Util::blessed($rel_obj)) {
97 $rel_obj = $new->new_related($key, $rel_obj);
98 $new->{_rel_in_storage} = 0;
100 $inflated->{$key} = $rel_obj;
104 $new->throw_exception("No such column $key on $class")
105 unless $class->has_column($key);
106 $new->store_column($key => $attrs->{$key});
108 if (my $source = delete $attrs->{-result_source}) {
109 $new->result_source($source);
112 $new->{_relationship_data} = $related if $related;
113 $new->{_inflated_column} = $inflated if $inflated;
123 Inserts an object into the database if it isn't already in
124 there. Returns the object itself. Requires the object's result source to
125 be set, or the class to have a result_source_instance method. To insert
126 an entirely new object into the database, use C<create> (see
127 L<DBIx::Class::ResultSet/create>).
133 return $self if $self->in_storage;
134 my $source = $self->result_source;
135 $source ||= $self->result_source($self->result_source_instance)
136 if $self->can('result_source_instance');
137 $self->throw_exception("No result_source set on this object; can't insert")
140 # Check if we stored uninserted relobjs here in new()
141 $source->storage->txn_begin if(!$self->{_rel_in_storage});
143 my %related_stuff = (%{$self->{_relationship_data} || {}},
144 %{$self->{_inflated_column} || {}});
145 ## Should all be in relationship_data, but we need to get rid of the
146 ## 'filter' reltype..
147 foreach my $relname (keys %related_stuff) {
148 my $relobj = $related_stuff{$relname};
149 if(ref $relobj ne 'ARRAY') {
150 $relobj->insert() if(!$relobj->in_storage);
151 $self->set_from_related($relname, $relobj);
155 $source->storage->insert($source, { $self->get_columns });
158 my ($pri, $too_many) = grep { !defined $self->get_column($_) ||
159 ref($self->get_column($_)) eq 'SCALAR'} $self->primary_columns;
161 $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
162 if defined $too_many;
164 my $storage = $self->result_source->storage;
165 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
166 unless $storage->can('last_insert_id');
167 my $id = $storage->last_insert_id($self->result_source,$pri);
168 $self->throw_exception( "Can't get last insert id" ) unless $id;
169 $self->store_column($pri => $id);
172 foreach my $relname (keys %related_stuff) {
173 my $relobj = $related_stuff{$relname};
174 if(ref $relobj eq 'ARRAY') {
175 foreach my $obj (@$relobj) {
176 my $info = $self->relationship_info($relname);
177 ## What about multi-col FKs ?
178 my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/);
179 $obj->set_from_related($key, $self);
180 $obj->insert() if(!$obj->in_storage);
184 $source->storage->txn_commit if(!$self->{_rel_in_storage});
186 $self->in_storage(1);
187 $self->{_dirty_columns} = {};
188 $self->{related_resultsets} = {};
189 undef $self->{_orig_ident};
195 $obj->in_storage; # Get value
196 $obj->in_storage(1); # Set value
198 Indicated whether the object exists as a row in the database or not
203 my ($self, $val) = @_;
204 $self->{_in_storage} = $val if @_ > 1;
205 return $self->{_in_storage};
212 Must be run on an object that is already in the database; issues an SQL
213 UPDATE query to commit any changes to the object to the database if
219 my ($self, $upd) = @_;
220 $self->throw_exception( "Not in database" ) unless $self->in_storage;
221 my $ident_cond = $self->ident_condition;
222 $self->throw_exception("Cannot safely update a row in a PK-less table")
223 if ! keys %$ident_cond;
226 foreach my $key (keys %$upd) {
227 if (ref $upd->{$key}) {
228 my $info = $self->relationship_info($key);
229 if ($info && $info->{attrs}{accessor}
230 && $info->{attrs}{accessor} eq 'single')
232 my $rel = delete $upd->{$key};
233 $self->set_from_related($key => $rel);
234 $self->{_relationship_data}{$key} = $rel;
236 elsif ($self->has_column($key)
237 && exists $self->column_info($key)->{_inflate_info})
239 $self->set_inflated_column($key, delete $upd->{$key});
243 $self->set_columns($upd);
245 my %to_update = $self->get_dirty_columns;
246 return $self unless keys %to_update;
247 my $rows = $self->result_source->storage->update(
248 $self->result_source, \%to_update,
249 $self->{_orig_ident} || $ident_cond
252 $self->throw_exception( "Can't update ${self}: row not found" );
253 } elsif ($rows > 1) {
254 $self->throw_exception("Can't update ${self}: updated more than one row");
256 $self->{_dirty_columns} = {};
257 $self->{related_resultsets} = {};
258 undef $self->{_orig_ident};
266 Deletes the object from the database. The object is still perfectly
267 usable, but C<< ->in_storage() >> will now return 0 and the object must
268 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
269 on it. If you delete an object in a class with a C<has_many>
270 relationship, all the related objects will be deleted as well. To turn
271 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
272 hashref. Any database-level cascade or restrict will take precedence
273 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
280 $self->throw_exception( "Not in database" ) unless $self->in_storage;
281 my $ident_cond = $self->ident_condition;
282 $self->throw_exception("Cannot safely delete a row in a PK-less table")
283 if ! keys %$ident_cond;
284 foreach my $column (keys %$ident_cond) {
285 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
286 unless exists $self->{_column_data}{$column};
288 $self->result_source->storage->delete(
289 $self->result_source, $ident_cond);
290 $self->in_storage(undef);
292 $self->throw_exception("Can't do class delete without a ResultSource instance")
293 unless $self->can('result_source_instance');
294 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
295 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
296 $self->result_source_instance->resultset->search(@_)->delete;
303 my $val = $obj->get_column($col);
305 Gets a column value from a row object. Does not do any queries; the column
306 must have already been fetched from the database and stored in the object. If
307 there is an inflated value stored that has not yet been deflated, it is deflated
308 when the method is invoked.
313 my ($self, $column) = @_;
314 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
315 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
316 if (exists $self->{_inflated_column}{$column}) {
317 return $self->store_column($column,
318 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
320 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
324 =head2 has_column_loaded
326 if ( $obj->has_column_loaded($col) ) {
327 print "$col has been loaded from db";
330 Returns a true value if the column value has been loaded from the
331 database (or set locally).
335 sub has_column_loaded {
336 my ($self, $column) = @_;
337 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
338 return 1 if exists $self->{_inflated_column}{$column};
339 return exists $self->{_column_data}{$column};
344 my %data = $obj->get_columns;
346 Does C<get_column>, for all column values at once.
352 if (exists $self->{_inflated_column}) {
353 foreach my $col (keys %{$self->{_inflated_column}}) {
354 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
355 unless exists $self->{_column_data}{$col};
358 return %{$self->{_column_data}};
361 =head2 get_dirty_columns
363 my %data = $obj->get_dirty_columns;
365 Identical to get_columns but only returns those that have been changed.
369 sub get_dirty_columns {
371 return map { $_ => $self->{_column_data}{$_} }
372 keys %{$self->{_dirty_columns}};
377 $obj->set_column($col => $val);
379 Sets a column value. If the new value is different from the old one,
380 the column is marked as dirty for when you next call $obj->update.
387 $self->{_orig_ident} ||= $self->ident_condition;
388 my $old = $self->get_column($column);
389 my $ret = $self->store_column(@_);
390 $self->{_dirty_columns}{$column} = 1
391 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
397 my $copy = $orig->set_columns({ $col => $val, ... });
399 Sets more than one column value at once.
404 my ($self,$data) = @_;
405 foreach my $col (keys %$data) {
406 $self->set_column($col,$data->{$col});
413 my $copy = $orig->copy({ change => $to, ... });
415 Inserts a new row with the specified changes.
420 my ($self, $changes) = @_;
422 my $col_data = { %{$self->{_column_data}} };
423 foreach my $col (keys %$col_data) {
424 delete $col_data->{$col}
425 if $self->result_source->column_info($col)->{is_auto_increment};
428 my $new = { _column_data => $col_data };
429 bless $new, ref $self;
431 $new->result_source($self->result_source);
432 $new->set_columns($changes);
434 foreach my $rel ($self->result_source->relationships) {
435 my $rel_info = $self->result_source->relationship_info($rel);
436 if ($rel_info->{attrs}{cascade_copy}) {
437 my $resolved = $self->result_source->resolve_condition(
438 $rel_info->{cond}, $rel, $new);
439 foreach my $related ($self->search_related($rel)) {
440 $related->copy($resolved);
449 $obj->store_column($col => $val);
451 Sets a column value without marking it as dirty.
456 my ($self, $column, $value) = @_;
457 $self->throw_exception( "No such column '${column}'" )
458 unless exists $self->{_column_data}{$column} || $self->has_column($column);
459 $self->throw_exception( "set_column called for ${column} without value" )
461 return $self->{_column_data}{$column} = $value;
464 =head2 inflate_result
466 Class->inflate_result($result_source, \%me, \%prefetch?)
468 Called by ResultSet to inflate a result from storage
473 my ($class, $source, $me, $prefetch) = @_;
475 my ($source_handle) = $source;
477 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
478 $source = $source_handle->resolve
480 $source_handle = $source->handle
484 _source_handle => $source_handle,
488 bless $new, (ref $class || $class);
491 foreach my $pre (keys %{$prefetch||{}}) {
492 my $pre_val = $prefetch->{$pre};
493 my $pre_source = $source->related_source($pre);
494 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
496 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
498 foreach my $pre_rec (@$pre_val) {
499 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
500 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
503 push(@pre_objects, $pre_source->result_class->inflate_result(
504 $pre_source, @{$pre_rec}));
506 $new->related_resultset($pre)->set_cache(\@pre_objects);
507 } elsif (defined $pre_val->[0]) {
509 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
510 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
512 $fetched = $pre_source->result_class->inflate_result(
513 $pre_source, @{$pre_val});
515 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
516 $class->throw_exception("No accessor for prefetched $pre")
517 unless defined $accessor;
518 if ($accessor eq 'single') {
519 $new->{_relationship_data}{$pre} = $fetched;
520 } elsif ($accessor eq 'filter') {
521 $new->{_inflated_column}{$pre} = $fetched;
523 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
530 =head2 update_or_insert
532 $obj->update_or_insert
534 Updates the object if it's already in the db, else inserts it.
536 =head2 insert_or_update
538 $obj->insert_or_update
540 Alias for L</update_or_insert>
544 *insert_or_update = \&update_or_insert;
545 sub update_or_insert {
547 return ($self->in_storage ? $self->update : $self->insert);
552 my @changed_col_names = $obj->is_changed();
553 if ($obj->is_changed()) { ... }
555 In array context returns a list of columns with uncommited changes, or
556 in scalar context returns a true value if there are uncommitted
562 return keys %{shift->{_dirty_columns} || {}};
565 =head2 is_column_changed
567 if ($obj->is_column_changed('col')) { ... }
569 Returns a true value if the column has uncommitted changes.
573 sub is_column_changed {
574 my( $self, $col ) = @_;
575 return exists $self->{_dirty_columns}->{$col};
580 my $resultsource = $object->result_source;
582 Accessor to the ResultSource this object was created from
590 $self->_source_handle($_[0]->handle);
592 $self->_source_handle->resolve;
596 =head2 register_column
598 $column_info = { .... };
599 $class->register_column($column_name, $column_info);
601 Registers a column on the class. If the column_info has an 'accessor'
602 key, creates an accessor named after the value if defined; if there is
603 no such key, creates an accessor with the same name as the column
605 The column_info attributes are described in
606 L<DBIx::Class::ResultSource/add_columns>
610 sub register_column {
611 my ($class, $col, $info) = @_;
613 if (exists $info->{accessor}) {
614 return unless defined $info->{accessor};
615 $acc = [ $info->{accessor}, $col ];
617 $class->mk_group_accessors('column' => $acc);
621 =head2 throw_exception
623 See Schema's throw_exception.
627 sub throw_exception {
629 if (ref $self && ref $self->result_source) {
630 $self->result_source->schema->throw_exception(@_);
640 Matt S. Trout <mst@shadowcatsystems.co.uk>
644 You may distribute this code under the same terms as Perl itself.