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
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) = @_;
49 $class = ref $class if ref $class;
51 my $new = { _column_data => {} };
54 if (my $handle = delete $attrs->{-source_handle}) {
55 $new->_source_handle($handle);
57 if (my $source = delete $attrs->{-result_source}) {
58 $new->result_source($source);
62 $new->throw_exception("attrs must be a hashref")
63 unless ref($attrs) eq 'HASH';
65 my ($related,$inflated);
66 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
67 $new->{_rel_in_storage} = 1;
69 foreach my $key (keys %$attrs) {
70 if (ref $attrs->{$key}) {
71 ## Can we extract this lot to use with update(_or .. ) ?
72 my $info = $class->relationship_info($key);
73 if ($info && $info->{attrs}{accessor}
74 && $info->{attrs}{accessor} eq 'single')
76 my $rel_obj = delete $attrs->{$key};
77 if(!Scalar::Util::blessed($rel_obj)) {
78 $rel_obj = $new->find_or_new_related($key, $rel_obj);
79 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
81 $new->set_from_related($key, $rel_obj);
82 $related->{$key} = $rel_obj;
84 } elsif ($info && $info->{attrs}{accessor}
85 && $info->{attrs}{accessor} eq 'multi'
86 && ref $attrs->{$key} eq 'ARRAY') {
87 my $others = delete $attrs->{$key};
88 foreach my $rel_obj (@$others) {
89 if(!Scalar::Util::blessed($rel_obj)) {
90 $rel_obj = $new->new_related($key, $rel_obj);
91 $new->{_rel_in_storage} = 0;
94 $related->{$key} = $others;
96 } elsif ($info && $info->{attrs}{accessor}
97 && $info->{attrs}{accessor} eq 'filter')
99 ## 'filter' should disappear and get merged in with 'single' above!
100 my $rel_obj = delete $attrs->{$key};
101 if(!Scalar::Util::blessed($rel_obj)) {
102 $rel_obj = $new->find_or_new_related($key, $rel_obj);
103 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
105 $inflated->{$key} = $rel_obj;
107 } elsif ($class->has_column($key)
108 && $class->column_info($key)->{_inflate_info}) {
109 $inflated->{$key} = $attrs->{$key};
114 $new->throw_exception("No such column $key on $class")
115 unless $class->has_column($key);
116 $new->store_column($key => $attrs->{$key});
119 $new->{_relationship_data} = $related if $related;
120 $new->{_inflated_column} = $inflated if $inflated;
130 Inserts an object into the database if it isn't already in
131 there. Returns the object itself. Requires the object's result source to
132 be set, or the class to have a result_source_instance method. To insert
133 an entirely new object into the database, use C<create> (see
134 L<DBIx::Class::ResultSet/create>).
140 return $self if $self->in_storage;
141 my $source = $self->result_source;
142 $source ||= $self->result_source($self->result_source_instance)
143 if $self->can('result_source_instance');
144 $self->throw_exception("No result_source set on this object; can't insert")
149 # Check if we stored uninserted relobjs here in new()
150 my %related_stuff = (%{$self->{_relationship_data} || {}},
151 %{$self->{_inflated_column} || {}});
153 if(!$self->{_rel_in_storage}) {
154 $source->storage->txn_begin;
156 # The guard will save us if we blow out of this scope via die
158 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
160 ## Should all be in relationship_data, but we need to get rid of the
161 ## 'filter' reltype..
162 ## These are the FK rels, need their IDs for the insert.
164 my @pri = $self->primary_columns;
166 REL: foreach my $relname (keys %related_stuff) {
167 my $keyhash = $source->resolve_condition(
168 $source->relationship_info($relname)->{cond},
170 ); # the above argset gives me the dependent cols on self
172 # assume anything that references our PK probably is dependent on us
173 # rather than vice versa
175 foreach my $p (@pri) {
176 next REL if exists $keyhash->{$p};
179 my $rel_obj = $related_stuff{$relname};
180 if(Scalar::Util::blessed($rel_obj) && $rel_obj->isa('DBIx::Class::Row')) {
182 $self->set_from_related($relname, $rel_obj);
183 delete $related_stuff{$relname};
188 $source->storage->insert($source, { $self->get_columns });
191 my @auto_pri = grep {
192 !defined $self->get_column($_) ||
193 ref($self->get_column($_)) eq 'SCALAR'
194 } $self->primary_columns;
197 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
198 # if defined $too_many;
200 my $storage = $self->result_source->storage;
201 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
202 unless $storage->can('last_insert_id');
203 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
204 $self->throw_exception( "Can't get last insert id" )
205 unless (@ids == @auto_pri);
206 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
209 if(!$self->{_rel_in_storage}) {
210 ## Now do the has_many rels, that need $selfs ID.
211 foreach my $relname (keys %related_stuff) {
212 my $rel_obj = $related_stuff{$relname};
214 if (Scalar::Util::blessed($rel_obj)
215 && $rel_obj->isa('DBIx::Class::Row')) {
217 } elsif (ref $rel_obj eq 'ARRAY') {
221 my $reverse = $source->reverse_relationship_info($relname);
222 foreach my $obj (@cands) {
223 $obj->set_from_related($_, $self) for keys %$reverse;
224 $obj->insert() if(!$obj->in_storage);
228 $source->storage->txn_commit;
229 $rollback_guard->dismiss;
232 $self->in_storage(1);
233 $self->{_dirty_columns} = {};
234 $self->{related_resultsets} = {};
235 undef $self->{_orig_ident};
241 $obj->in_storage; # Get value
242 $obj->in_storage(1); # Set value
244 Indicated whether the object exists as a row in the database or not
249 my ($self, $val) = @_;
250 $self->{_in_storage} = $val if @_ > 1;
251 return $self->{_in_storage};
256 $obj->update \%columns?;
258 Must be run on an object that is already in the database; issues an SQL
259 UPDATE query to commit any changes to the object to the database if
262 Also takes an options hashref of C<< column_name => value> pairs >> to update
263 first. But be aware that this hashref might be edited in place, so dont rely on
264 it being the same after a call to C<update>. If you need to preserve the hashref,
265 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
270 my ($self, $upd) = @_;
271 $self->throw_exception( "Not in database" ) unless $self->in_storage;
272 my $ident_cond = $self->ident_condition;
273 $self->throw_exception("Cannot safely update a row in a PK-less table")
274 if ! keys %$ident_cond;
277 foreach my $key (keys %$upd) {
278 if (ref $upd->{$key}) {
279 my $info = $self->relationship_info($key);
280 if ($info && $info->{attrs}{accessor}
281 && $info->{attrs}{accessor} eq 'single')
283 my $rel = delete $upd->{$key};
284 $self->set_from_related($key => $rel);
285 $self->{_relationship_data}{$key} = $rel;
286 } elsif ($info && $info->{attrs}{accessor}
287 && $info->{attrs}{accessor} eq 'multi'
288 && ref $upd->{$key} eq 'ARRAY') {
289 my $others = delete $upd->{$key};
290 foreach my $rel_obj (@$others) {
291 if(!Scalar::Util::blessed($rel_obj)) {
292 $rel_obj = $self->create_related($key, $rel_obj);
295 $self->{_relationship_data}{$key} = $others;
296 # $related->{$key} = $others;
299 elsif ($self->has_column($key)
300 && exists $self->column_info($key)->{_inflate_info})
302 $self->set_inflated_column($key, delete $upd->{$key});
306 $self->set_columns($upd);
308 my %to_update = $self->get_dirty_columns;
309 return $self unless keys %to_update;
310 my $rows = $self->result_source->storage->update(
311 $self->result_source, \%to_update,
312 $self->{_orig_ident} || $ident_cond
315 $self->throw_exception( "Can't update ${self}: row not found" );
316 } elsif ($rows > 1) {
317 $self->throw_exception("Can't update ${self}: updated more than one row");
319 $self->{_dirty_columns} = {};
320 $self->{related_resultsets} = {};
321 undef $self->{_orig_ident};
329 Deletes the object from the database. The object is still perfectly
330 usable, but C<< ->in_storage() >> will now return 0 and the object must
331 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
332 on it. If you delete an object in a class with a C<has_many>
333 relationship, all the related objects will be deleted as well. To turn
334 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
335 hashref. Any database-level cascade or restrict will take precedence
336 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
343 $self->throw_exception( "Not in database" ) unless $self->in_storage;
344 my $ident_cond = $self->ident_condition;
345 $self->throw_exception("Cannot safely delete a row in a PK-less table")
346 if ! keys %$ident_cond;
347 foreach my $column (keys %$ident_cond) {
348 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
349 unless exists $self->{_column_data}{$column};
351 $self->result_source->storage->delete(
352 $self->result_source, $ident_cond);
353 $self->in_storage(undef);
355 $self->throw_exception("Can't do class delete without a ResultSource instance")
356 unless $self->can('result_source_instance');
357 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
358 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
359 $self->result_source_instance->resultset->search(@_)->delete;
366 my $val = $obj->get_column($col);
368 Gets a column value from a row object. Does not do any queries; the column
369 must have already been fetched from the database and stored in the object. If
370 there is an inflated value stored that has not yet been deflated, it is deflated
371 when the method is invoked.
376 my ($self, $column) = @_;
377 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
378 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
379 if (exists $self->{_inflated_column}{$column}) {
380 return $self->store_column($column,
381 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
383 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
387 =head2 has_column_loaded
389 if ( $obj->has_column_loaded($col) ) {
390 print "$col has been loaded from db";
393 Returns a true value if the column value has been loaded from the
394 database (or set locally).
398 sub has_column_loaded {
399 my ($self, $column) = @_;
400 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
401 return 1 if exists $self->{_inflated_column}{$column};
402 return exists $self->{_column_data}{$column};
407 my %data = $obj->get_columns;
409 Does C<get_column>, for all column values at once.
415 if (exists $self->{_inflated_column}) {
416 foreach my $col (keys %{$self->{_inflated_column}}) {
417 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
418 unless exists $self->{_column_data}{$col};
421 return %{$self->{_column_data}};
424 =head2 get_dirty_columns
426 my %data = $obj->get_dirty_columns;
428 Identical to get_columns but only returns those that have been changed.
432 sub get_dirty_columns {
434 return map { $_ => $self->{_column_data}{$_} }
435 keys %{$self->{_dirty_columns}};
438 =head2 get_inflated_columns
440 my $inflated_data = $obj->get_inflated_columns;
442 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
446 sub get_inflated_columns {
449 my $accessor = $self->column_info($_)->{'accessor'} || $_;
450 ($_ => $self->$accessor);
456 $obj->set_column($col => $val);
458 Sets a column value. If the new value is different from the old one,
459 the column is marked as dirty for when you next call $obj->update.
466 $self->{_orig_ident} ||= $self->ident_condition;
467 my $old = $self->get_column($column);
468 my $ret = $self->store_column(@_);
469 $self->{_dirty_columns}{$column} = 1
470 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
476 my $copy = $orig->set_columns({ $col => $val, ... });
478 Sets more than one column value at once.
483 my ($self,$data) = @_;
484 foreach my $col (keys %$data) {
485 $self->set_column($col,$data->{$col});
492 my $copy = $orig->copy({ change => $to, ... });
494 Inserts a new row with the specified changes.
499 my ($self, $changes) = @_;
501 my $col_data = { %{$self->{_column_data}} };
502 foreach my $col (keys %$col_data) {
503 delete $col_data->{$col}
504 if $self->result_source->column_info($col)->{is_auto_increment};
507 my $new = { _column_data => $col_data };
508 bless $new, ref $self;
510 $new->result_source($self->result_source);
511 $new->set_columns($changes);
513 foreach my $rel ($self->result_source->relationships) {
514 my $rel_info = $self->result_source->relationship_info($rel);
515 if ($rel_info->{attrs}{cascade_copy}) {
516 my $resolved = $self->result_source->resolve_condition(
517 $rel_info->{cond}, $rel, $new);
518 foreach my $related ($self->search_related($rel)) {
519 $related->copy($resolved);
528 $obj->store_column($col => $val);
530 Sets a column value without marking it as dirty.
535 my ($self, $column, $value) = @_;
536 $self->throw_exception( "No such column '${column}'" )
537 unless exists $self->{_column_data}{$column} || $self->has_column($column);
538 $self->throw_exception( "set_column called for ${column} without value" )
540 return $self->{_column_data}{$column} = $value;
543 =head2 inflate_result
545 Class->inflate_result($result_source, \%me, \%prefetch?)
547 Called by ResultSet to inflate a result from storage
552 my ($class, $source, $me, $prefetch) = @_;
554 my ($source_handle) = $source;
556 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
557 $source = $source_handle->resolve
559 $source_handle = $source->handle
563 _source_handle => $source_handle,
567 bless $new, (ref $class || $class);
570 foreach my $pre (keys %{$prefetch||{}}) {
571 my $pre_val = $prefetch->{$pre};
572 my $pre_source = $source->related_source($pre);
573 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
575 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
577 foreach my $pre_rec (@$pre_val) {
578 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
579 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
582 push(@pre_objects, $pre_source->result_class->inflate_result(
583 $pre_source, @{$pre_rec}));
585 $new->related_resultset($pre)->set_cache(\@pre_objects);
586 } elsif (defined $pre_val->[0]) {
588 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
589 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
591 $fetched = $pre_source->result_class->inflate_result(
592 $pre_source, @{$pre_val});
594 $new->related_resultset($pre)->set_cache([ $fetched ]);
595 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
596 $class->throw_exception("No accessor for prefetched $pre")
597 unless defined $accessor;
598 if ($accessor eq 'single') {
599 $new->{_relationship_data}{$pre} = $fetched;
600 } elsif ($accessor eq 'filter') {
601 $new->{_inflated_column}{$pre} = $fetched;
603 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
610 =head2 update_or_insert
612 $obj->update_or_insert
614 Updates the object if it's already in the db, else inserts it.
616 =head2 insert_or_update
618 $obj->insert_or_update
620 Alias for L</update_or_insert>
624 *insert_or_update = \&update_or_insert;
625 sub update_or_insert {
627 return ($self->in_storage ? $self->update : $self->insert);
632 my @changed_col_names = $obj->is_changed();
633 if ($obj->is_changed()) { ... }
635 In array context returns a list of columns with uncommited changes, or
636 in scalar context returns a true value if there are uncommitted
642 return keys %{shift->{_dirty_columns} || {}};
645 =head2 is_column_changed
647 if ($obj->is_column_changed('col')) { ... }
649 Returns a true value if the column has uncommitted changes.
653 sub is_column_changed {
654 my( $self, $col ) = @_;
655 return exists $self->{_dirty_columns}->{$col};
660 my $resultsource = $object->result_source;
662 Accessor to the ResultSource this object was created from
670 $self->_source_handle($_[0]->handle);
672 $self->_source_handle->resolve;
676 =head2 register_column
678 $column_info = { .... };
679 $class->register_column($column_name, $column_info);
681 Registers a column on the class. If the column_info has an 'accessor'
682 key, creates an accessor named after the value if defined; if there is
683 no such key, creates an accessor with the same name as the column
685 The column_info attributes are described in
686 L<DBIx::Class::ResultSource/add_columns>
690 sub register_column {
691 my ($class, $col, $info) = @_;
693 if (exists $info->{accessor}) {
694 return unless defined $info->{accessor};
695 $acc = [ $info->{accessor}, $col ];
697 $class->mk_group_accessors('column' => $acc);
701 =head2 throw_exception
703 See Schema's throw_exception.
707 sub throw_exception {
709 if (ref $self && ref $self->result_source && $self->result_source->schema) {
710 $self->result_source->schema->throw_exception(@_);
720 Matt S. Trout <mst@shadowcatsystems.co.uk>
724 You may distribute this code under the same terms as Perl itself.