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 ## 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().
40 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
41 ## When doing the later insert, we need to make sure the PKs are set.
42 ## using _relationship_data in new and funky ways..
43 ## check Relationship::CascadeActions and Relationship::Accessor for compat
47 my ($class, $attrs) = @_;
48 $class = ref $class if ref $class;
50 my $new = { _column_data => {} };
53 if (my $handle = delete $attrs->{-source_handle}) {
54 $new->_source_handle($handle);
56 if (my $source = delete $attrs->{-result_source}) {
57 $new->result_source($source);
61 $new->throw_exception("attrs must be a hashref")
62 unless ref($attrs) eq 'HASH';
64 my ($related,$inflated);
65 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
66 $new->{_rel_in_storage} = 1;
68 foreach my $key (keys %$attrs) {
69 if (ref $attrs->{$key}) {
70 ## Can we extract this lot to use with update(_or .. ) ?
71 my $info = $class->relationship_info($key);
72 if ($info && $info->{attrs}{accessor}
73 && $info->{attrs}{accessor} eq 'single')
75 my $rel_obj = delete $attrs->{$key};
76 if(!Scalar::Util::blessed($rel_obj)) {
77 $rel_obj = $new->find_or_new_related($key, $rel_obj);
78 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
80 $new->set_from_related($key, $rel_obj);
81 $related->{$key} = $rel_obj;
83 } elsif ($info && $info->{attrs}{accessor}
84 && $info->{attrs}{accessor} eq 'multi'
85 && ref $attrs->{$key} eq 'ARRAY') {
86 my $others = delete $attrs->{$key};
87 foreach my $rel_obj (@$others) {
88 if(!Scalar::Util::blessed($rel_obj)) {
89 $rel_obj = $new->new_related($key, $rel_obj);
90 $new->{_rel_in_storage} = 0;
93 $related->{$key} = $others;
95 } elsif ($info && $info->{attrs}{accessor}
96 && $info->{attrs}{accessor} eq 'filter')
98 ## 'filter' should disappear and get merged in with 'single' above!
99 my $rel_obj = delete $attrs->{$key};
100 if(!Scalar::Util::blessed($rel_obj)) {
101 $rel_obj = $new->find_or_new_related($key, $rel_obj);
102 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
104 $inflated->{$key} = $rel_obj;
106 } elsif ($class->has_column($key)
107 && $class->column_info($key)->{_inflate_info}) {
108 $inflated->{$key} = $attrs->{$key};
113 $new->throw_exception("No such column $key on $class")
114 unless $class->has_column($key);
115 $new->store_column($key => $attrs->{$key});
118 $new->{_relationship_data} = $related if $related;
119 $new->{_inflated_column} = $inflated if $inflated;
129 Inserts an object into the database if it isn't already in
130 there. Returns the object itself. Requires the object's result source to
131 be set, or the class to have a result_source_instance method. To insert
132 an entirely new object into the database, use C<create> (see
133 L<DBIx::Class::ResultSet/create>).
139 return $self if $self->in_storage;
140 my $source = $self->result_source;
141 $source ||= $self->result_source($self->result_source_instance)
142 if $self->can('result_source_instance');
143 $self->throw_exception("No result_source set on this object; can't insert")
146 # Check if we stored uninserted relobjs here in new()
147 my %related_stuff = (%{$self->{_relationship_data} || {}},
148 %{$self->{_inflated_column} || {}});
149 if(!$self->{_rel_in_storage})
151 $source->storage->txn_begin;
153 ## Should all be in relationship_data, but we need to get rid of the
154 ## 'filter' reltype..
155 ## These are the FK rels, need their IDs for the insert.
156 foreach my $relname (keys %related_stuff) {
157 my $rel_obj = $related_stuff{$relname};
158 if(Scalar::Util::blessed($rel_obj) && $rel_obj->isa('DBIx::Class::Row')) {
160 $self->set_from_related($relname, $rel_obj);
165 $source->storage->insert($source, { $self->get_columns });
168 my ($pri, $too_many) = grep { !defined $self->get_column($_) ||
169 ref($self->get_column($_)) eq 'SCALAR'} $self->primary_columns;
171 $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
172 if defined $too_many;
174 my $storage = $self->result_source->storage;
175 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
176 unless $storage->can('last_insert_id');
177 my $id = $storage->last_insert_id($self->result_source,$pri);
178 $self->throw_exception( "Can't get last insert id" ) unless $id;
179 $self->store_column($pri => $id);
182 if(!$self->{_rel_in_storage})
184 ## Now do the has_many rels, that need $selfs ID.
185 foreach my $relname (keys %related_stuff) {
186 my $relobj = $related_stuff{$relname};
187 if(ref $relobj eq 'ARRAY') {
188 foreach my $obj (@$relobj) {
189 my $info = $self->relationship_info($relname);
190 ## What about multi-col FKs ?
191 my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/);
192 $obj->set_from_related($key, $self);
193 $obj->insert() if(!$obj->in_storage);
197 $source->storage->txn_commit;
200 $self->in_storage(1);
201 $self->{_dirty_columns} = {};
202 $self->{related_resultsets} = {};
203 undef $self->{_orig_ident};
209 $obj->in_storage; # Get value
210 $obj->in_storage(1); # Set value
212 Indicated whether the object exists as a row in the database or not
217 my ($self, $val) = @_;
218 $self->{_in_storage} = $val if @_ > 1;
219 return $self->{_in_storage};
224 $obj->update \%columns?;
226 Must be run on an object that is already in the database; issues an SQL
227 UPDATE query to commit any changes to the object to the database if
230 Also takes an options hashref of C<< column_name => value> pairs >> to update
231 first. But be aware that this hashref might be edited in place, so dont rely on
232 it being the same after a call to C<update>.
237 my ($self, $upd) = @_;
238 $self->throw_exception( "Not in database" ) unless $self->in_storage;
239 my $ident_cond = $self->ident_condition;
240 $self->throw_exception("Cannot safely update a row in a PK-less table")
241 if ! keys %$ident_cond;
244 foreach my $key (keys %$upd) {
245 if (ref $upd->{$key}) {
246 my $info = $self->relationship_info($key);
247 if ($info && $info->{attrs}{accessor}
248 && $info->{attrs}{accessor} eq 'single')
250 my $rel = delete $upd->{$key};
251 $self->set_from_related($key => $rel);
252 $self->{_relationship_data}{$key} = $rel;
253 } elsif ($info && $info->{attrs}{accessor}
254 && $info->{attrs}{accessor} eq 'multi'
255 && ref $upd->{$key} eq 'ARRAY') {
256 my $others = delete $upd->{$key};
257 foreach my $rel_obj (@$others) {
258 if(!Scalar::Util::blessed($rel_obj)) {
259 $rel_obj = $self->create_related($key, $rel_obj);
262 $self->{_relationship_data}{$key} = $others;
263 # $related->{$key} = $others;
266 elsif ($self->has_column($key)
267 && exists $self->column_info($key)->{_inflate_info})
269 $self->set_inflated_column($key, delete $upd->{$key});
273 $self->set_columns($upd);
275 my %to_update = $self->get_dirty_columns;
276 return $self unless keys %to_update;
277 my $rows = $self->result_source->storage->update(
278 $self->result_source, \%to_update,
279 $self->{_orig_ident} || $ident_cond
282 $self->throw_exception( "Can't update ${self}: row not found" );
283 } elsif ($rows > 1) {
284 $self->throw_exception("Can't update ${self}: updated more than one row");
286 $self->{_dirty_columns} = {};
287 $self->{related_resultsets} = {};
288 undef $self->{_orig_ident};
296 Deletes the object from the database. The object is still perfectly
297 usable, but C<< ->in_storage() >> will now return 0 and the object must
298 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
299 on it. If you delete an object in a class with a C<has_many>
300 relationship, all the related objects will be deleted as well. To turn
301 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
302 hashref. Any database-level cascade or restrict will take precedence
303 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
310 $self->throw_exception( "Not in database" ) unless $self->in_storage;
311 my $ident_cond = $self->ident_condition;
312 $self->throw_exception("Cannot safely delete a row in a PK-less table")
313 if ! keys %$ident_cond;
314 foreach my $column (keys %$ident_cond) {
315 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
316 unless exists $self->{_column_data}{$column};
318 $self->result_source->storage->delete(
319 $self->result_source, $ident_cond);
320 $self->in_storage(undef);
322 $self->throw_exception("Can't do class delete without a ResultSource instance")
323 unless $self->can('result_source_instance');
324 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
325 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
326 $self->result_source_instance->resultset->search(@_)->delete;
333 my $val = $obj->get_column($col);
335 Gets a column value from a row object. Does not do any queries; the column
336 must have already been fetched from the database and stored in the object. If
337 there is an inflated value stored that has not yet been deflated, it is deflated
338 when the method is invoked.
343 my ($self, $column) = @_;
344 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
345 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
346 if (exists $self->{_inflated_column}{$column}) {
347 return $self->store_column($column,
348 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
350 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
354 =head2 has_column_loaded
356 if ( $obj->has_column_loaded($col) ) {
357 print "$col has been loaded from db";
360 Returns a true value if the column value has been loaded from the
361 database (or set locally).
365 sub has_column_loaded {
366 my ($self, $column) = @_;
367 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
368 return 1 if exists $self->{_inflated_column}{$column};
369 return exists $self->{_column_data}{$column};
374 my %data = $obj->get_columns;
376 Does C<get_column>, for all column values at once.
382 if (exists $self->{_inflated_column}) {
383 foreach my $col (keys %{$self->{_inflated_column}}) {
384 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
385 unless exists $self->{_column_data}{$col};
388 return %{$self->{_column_data}};
391 =head2 get_dirty_columns
393 my %data = $obj->get_dirty_columns;
395 Identical to get_columns but only returns those that have been changed.
399 sub get_dirty_columns {
401 return map { $_ => $self->{_column_data}{$_} }
402 keys %{$self->{_dirty_columns}};
407 $obj->set_column($col => $val);
409 Sets a column value. If the new value is different from the old one,
410 the column is marked as dirty for when you next call $obj->update.
417 $self->{_orig_ident} ||= $self->ident_condition;
418 my $old = $self->get_column($column);
419 my $ret = $self->store_column(@_);
420 $self->{_dirty_columns}{$column} = 1
421 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
427 my $copy = $orig->set_columns({ $col => $val, ... });
429 Sets more than one column value at once.
434 my ($self,$data) = @_;
435 foreach my $col (keys %$data) {
436 $self->set_column($col,$data->{$col});
443 my $copy = $orig->copy({ change => $to, ... });
445 Inserts a new row with the specified changes.
450 my ($self, $changes) = @_;
452 my $col_data = { %{$self->{_column_data}} };
453 foreach my $col (keys %$col_data) {
454 delete $col_data->{$col}
455 if $self->result_source->column_info($col)->{is_auto_increment};
458 my $new = { _column_data => $col_data };
459 bless $new, ref $self;
461 $new->result_source($self->result_source);
462 $new->set_columns($changes);
464 foreach my $rel ($self->result_source->relationships) {
465 my $rel_info = $self->result_source->relationship_info($rel);
466 if ($rel_info->{attrs}{cascade_copy}) {
467 my $resolved = $self->result_source->resolve_condition(
468 $rel_info->{cond}, $rel, $new);
469 foreach my $related ($self->search_related($rel)) {
470 $related->copy($resolved);
479 $obj->store_column($col => $val);
481 Sets a column value without marking it as dirty.
486 my ($self, $column, $value) = @_;
487 $self->throw_exception( "No such column '${column}'" )
488 unless exists $self->{_column_data}{$column} || $self->has_column($column);
489 $self->throw_exception( "set_column called for ${column} without value" )
491 return $self->{_column_data}{$column} = $value;
494 =head2 inflate_result
496 Class->inflate_result($result_source, \%me, \%prefetch?)
498 Called by ResultSet to inflate a result from storage
503 my ($class, $source, $me, $prefetch) = @_;
505 my ($source_handle) = $source;
507 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
508 $source = $source_handle->resolve
510 $source_handle = $source->handle
514 _source_handle => $source_handle,
518 bless $new, (ref $class || $class);
521 foreach my $pre (keys %{$prefetch||{}}) {
522 my $pre_val = $prefetch->{$pre};
523 my $pre_source = $source->related_source($pre);
524 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
526 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
528 foreach my $pre_rec (@$pre_val) {
529 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
530 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
533 push(@pre_objects, $pre_source->result_class->inflate_result(
534 $pre_source, @{$pre_rec}));
536 $new->related_resultset($pre)->set_cache(\@pre_objects);
537 } elsif (defined $pre_val->[0]) {
539 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
540 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
542 $fetched = $pre_source->result_class->inflate_result(
543 $pre_source, @{$pre_val});
545 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
546 $class->throw_exception("No accessor for prefetched $pre")
547 unless defined $accessor;
548 if ($accessor eq 'single') {
549 $new->{_relationship_data}{$pre} = $fetched;
550 } elsif ($accessor eq 'filter') {
551 $new->{_inflated_column}{$pre} = $fetched;
553 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
560 =head2 update_or_insert
562 $obj->update_or_insert
564 Updates the object if it's already in the db, else inserts it.
566 =head2 insert_or_update
568 $obj->insert_or_update
570 Alias for L</update_or_insert>
574 *insert_or_update = \&update_or_insert;
575 sub update_or_insert {
577 return ($self->in_storage ? $self->update : $self->insert);
582 my @changed_col_names = $obj->is_changed();
583 if ($obj->is_changed()) { ... }
585 In array context returns a list of columns with uncommited changes, or
586 in scalar context returns a true value if there are uncommitted
592 return keys %{shift->{_dirty_columns} || {}};
595 =head2 is_column_changed
597 if ($obj->is_column_changed('col')) { ... }
599 Returns a true value if the column has uncommitted changes.
603 sub is_column_changed {
604 my( $self, $col ) = @_;
605 return exists $self->{_dirty_columns}->{$col};
610 my $resultsource = $object->result_source;
612 Accessor to the ResultSource this object was created from
620 $self->_source_handle($_[0]->handle);
622 $self->_source_handle->resolve;
626 =head2 register_column
628 $column_info = { .... };
629 $class->register_column($column_name, $column_info);
631 Registers a column on the class. If the column_info has an 'accessor'
632 key, creates an accessor named after the value if defined; if there is
633 no such key, creates an accessor with the same name as the column
635 The column_info attributes are described in
636 L<DBIx::Class::ResultSource/add_columns>
640 sub register_column {
641 my ($class, $col, $info) = @_;
643 if (exists $info->{accessor}) {
644 return unless defined $info->{accessor};
645 $acc = [ $info->{accessor}, $col ];
647 $class->mk_group_accessors('column' => $acc);
651 =head2 throw_exception
653 See Schema's throw_exception.
657 sub throw_exception {
659 if (ref $self && ref $self->result_source) {
660 $self->result_source->schema->throw_exception(@_);
670 Matt S. Trout <mst@shadowcatsystems.co.uk>
674 You may distribute this code under the same terms as Perl itself.