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) {
168 my $rel_obj = $related_stuff{$relname};
170 next REL unless (Scalar::Util::blessed($rel_obj)
171 && $rel_obj->isa('DBIx::Class::Row'));
173 my $cond = $source->relationship_info($relname)->{cond};
175 next REL unless ref($cond) eq 'HASH';
177 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
179 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
181 # assume anything that references our PK probably is dependent on us
182 # rather than vice versa, unless the far side is (a) defined or (b)
185 foreach my $p (@pri) {
186 if (exists $keyhash->{$p}) {
188 unless (defined($rel_obj->get_column($keyhash->{$p}))
189 || $rel_obj->column_info($keyhash->{$p})
190 ->{is_auto_increment}) {
197 $self->set_from_related($relname, $rel_obj);
198 delete $related_stuff{$relname};
202 $source->storage->insert($source, { $self->get_columns });
205 my @auto_pri = grep {
206 !defined $self->get_column($_) ||
207 ref($self->get_column($_)) eq 'SCALAR'
208 } $self->primary_columns;
211 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
212 # if defined $too_many;
214 my $storage = $self->result_source->storage;
215 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
216 unless $storage->can('last_insert_id');
217 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
218 $self->throw_exception( "Can't get last insert id" )
219 unless (@ids == @auto_pri);
220 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
223 if(!$self->{_rel_in_storage}) {
224 ## Now do the has_many rels, that need $selfs ID.
225 foreach my $relname (keys %related_stuff) {
226 my $rel_obj = $related_stuff{$relname};
228 if (Scalar::Util::blessed($rel_obj)
229 && $rel_obj->isa('DBIx::Class::Row')) {
231 } elsif (ref $rel_obj eq 'ARRAY') {
235 my $reverse = $source->reverse_relationship_info($relname);
236 foreach my $obj (@cands) {
237 $obj->set_from_related($_, $self) for keys %$reverse;
238 $obj->insert() if(!$obj->in_storage);
242 $source->storage->txn_commit;
243 $rollback_guard->dismiss;
246 $self->in_storage(1);
247 $self->{_dirty_columns} = {};
248 $self->{related_resultsets} = {};
249 undef $self->{_orig_ident};
255 $obj->in_storage; # Get value
256 $obj->in_storage(1); # Set value
258 Indicated whether the object exists as a row in the database or not
263 my ($self, $val) = @_;
264 $self->{_in_storage} = $val if @_ > 1;
265 return $self->{_in_storage};
270 $obj->update \%columns?;
272 Must be run on an object that is already in the database; issues an SQL
273 UPDATE query to commit any changes to the object to the database if
276 Also takes an options hashref of C<< column_name => value> pairs >> to update
277 first. But be aware that this hashref might be edited in place, so dont rely on
278 it being the same after a call to C<update>. If you need to preserve the hashref,
279 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
284 my ($self, $upd) = @_;
285 $self->throw_exception( "Not in database" ) unless $self->in_storage;
286 my $ident_cond = $self->ident_condition;
287 $self->throw_exception("Cannot safely update a row in a PK-less table")
288 if ! keys %$ident_cond;
291 foreach my $key (keys %$upd) {
292 if (ref $upd->{$key}) {
293 my $info = $self->relationship_info($key);
294 if ($info && $info->{attrs}{accessor}
295 && $info->{attrs}{accessor} eq 'single')
297 my $rel = delete $upd->{$key};
298 $self->set_from_related($key => $rel);
299 $self->{_relationship_data}{$key} = $rel;
300 } elsif ($info && $info->{attrs}{accessor}
301 && $info->{attrs}{accessor} eq 'multi'
302 && ref $upd->{$key} eq 'ARRAY') {
303 my $others = delete $upd->{$key};
304 foreach my $rel_obj (@$others) {
305 if(!Scalar::Util::blessed($rel_obj)) {
306 $rel_obj = $self->create_related($key, $rel_obj);
309 $self->{_relationship_data}{$key} = $others;
310 # $related->{$key} = $others;
313 elsif ($self->has_column($key)
314 && exists $self->column_info($key)->{_inflate_info})
316 $self->set_inflated_column($key, delete $upd->{$key});
320 $self->set_columns($upd);
322 my %to_update = $self->get_dirty_columns;
323 return $self unless keys %to_update;
324 my $rows = $self->result_source->storage->update(
325 $self->result_source, \%to_update,
326 $self->{_orig_ident} || $ident_cond
329 $self->throw_exception( "Can't update ${self}: row not found" );
330 } elsif ($rows > 1) {
331 $self->throw_exception("Can't update ${self}: updated more than one row");
333 $self->{_dirty_columns} = {};
334 $self->{related_resultsets} = {};
335 undef $self->{_orig_ident};
343 Deletes the object from the database. The object is still perfectly
344 usable, but C<< ->in_storage() >> will now return 0 and the object must
345 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
346 on it. If you delete an object in a class with a C<has_many>
347 relationship, all the related objects will be deleted as well. To turn
348 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
349 hashref. Any database-level cascade or restrict will take precedence
350 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
357 $self->throw_exception( "Not in database" ) unless $self->in_storage;
358 my $ident_cond = $self->ident_condition;
359 $self->throw_exception("Cannot safely delete a row in a PK-less table")
360 if ! keys %$ident_cond;
361 foreach my $column (keys %$ident_cond) {
362 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
363 unless exists $self->{_column_data}{$column};
365 $self->result_source->storage->delete(
366 $self->result_source, $ident_cond);
367 $self->in_storage(undef);
369 $self->throw_exception("Can't do class delete without a ResultSource instance")
370 unless $self->can('result_source_instance');
371 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
372 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
373 $self->result_source_instance->resultset->search(@_)->delete;
380 my $val = $obj->get_column($col);
382 Gets a column value from a row object. Does not do any queries; the column
383 must have already been fetched from the database and stored in the object. If
384 there is an inflated value stored that has not yet been deflated, it is deflated
385 when the method is invoked.
390 my ($self, $column) = @_;
391 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
392 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
393 if (exists $self->{_inflated_column}{$column}) {
394 return $self->store_column($column,
395 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
397 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
401 =head2 has_column_loaded
403 if ( $obj->has_column_loaded($col) ) {
404 print "$col has been loaded from db";
407 Returns a true value if the column value has been loaded from the
408 database (or set locally).
412 sub has_column_loaded {
413 my ($self, $column) = @_;
414 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
415 return 1 if exists $self->{_inflated_column}{$column};
416 return exists $self->{_column_data}{$column};
421 my %data = $obj->get_columns;
423 Does C<get_column>, for all column values at once.
429 if (exists $self->{_inflated_column}) {
430 foreach my $col (keys %{$self->{_inflated_column}}) {
431 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
432 unless exists $self->{_column_data}{$col};
435 return %{$self->{_column_data}};
438 =head2 get_dirty_columns
440 my %data = $obj->get_dirty_columns;
442 Identical to get_columns but only returns those that have been changed.
446 sub get_dirty_columns {
448 return map { $_ => $self->{_column_data}{$_} }
449 keys %{$self->{_dirty_columns}};
452 =head2 get_inflated_columns
454 my $inflated_data = $obj->get_inflated_columns;
456 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
460 sub get_inflated_columns {
463 my $accessor = $self->column_info($_)->{'accessor'} || $_;
464 ($_ => $self->$accessor);
470 $obj->set_column($col => $val);
472 Sets a column value. If the new value is different from the old one,
473 the column is marked as dirty for when you next call $obj->update.
480 $self->{_orig_ident} ||= $self->ident_condition;
481 my $old = $self->get_column($column);
482 my $ret = $self->store_column(@_);
483 $self->{_dirty_columns}{$column} = 1
484 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
490 my $copy = $orig->set_columns({ $col => $val, ... });
492 Sets more than one column value at once.
497 my ($self,$data) = @_;
498 foreach my $col (keys %$data) {
499 $self->set_column($col,$data->{$col});
506 my $copy = $orig->copy({ change => $to, ... });
508 Inserts a new row with the specified changes.
513 my ($self, $changes) = @_;
515 my $col_data = { %{$self->{_column_data}} };
516 foreach my $col (keys %$col_data) {
517 delete $col_data->{$col}
518 if $self->result_source->column_info($col)->{is_auto_increment};
521 my $new = { _column_data => $col_data };
522 bless $new, ref $self;
524 $new->result_source($self->result_source);
525 $new->set_columns($changes);
527 foreach my $rel ($self->result_source->relationships) {
528 my $rel_info = $self->result_source->relationship_info($rel);
529 if ($rel_info->{attrs}{cascade_copy}) {
530 my $resolved = $self->result_source->resolve_condition(
531 $rel_info->{cond}, $rel, $new);
532 foreach my $related ($self->search_related($rel)) {
533 $related->copy($resolved);
542 $obj->store_column($col => $val);
544 Sets a column value without marking it as dirty.
549 my ($self, $column, $value) = @_;
550 $self->throw_exception( "No such column '${column}'" )
551 unless exists $self->{_column_data}{$column} || $self->has_column($column);
552 $self->throw_exception( "set_column called for ${column} without value" )
554 return $self->{_column_data}{$column} = $value;
557 =head2 inflate_result
559 Class->inflate_result($result_source, \%me, \%prefetch?)
561 Called by ResultSet to inflate a result from storage
566 my ($class, $source, $me, $prefetch) = @_;
568 my ($source_handle) = $source;
570 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
571 $source = $source_handle->resolve
573 $source_handle = $source->handle
577 _source_handle => $source_handle,
581 bless $new, (ref $class || $class);
584 foreach my $pre (keys %{$prefetch||{}}) {
585 my $pre_val = $prefetch->{$pre};
586 my $pre_source = $source->related_source($pre);
587 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
589 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
591 foreach my $pre_rec (@$pre_val) {
592 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
593 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
596 push(@pre_objects, $pre_source->result_class->inflate_result(
597 $pre_source, @{$pre_rec}));
599 $new->related_resultset($pre)->set_cache(\@pre_objects);
600 } elsif (defined $pre_val->[0]) {
602 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
603 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
605 $fetched = $pre_source->result_class->inflate_result(
606 $pre_source, @{$pre_val});
608 $new->related_resultset($pre)->set_cache([ $fetched ]);
609 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
610 $class->throw_exception("No accessor for prefetched $pre")
611 unless defined $accessor;
612 if ($accessor eq 'single') {
613 $new->{_relationship_data}{$pre} = $fetched;
614 } elsif ($accessor eq 'filter') {
615 $new->{_inflated_column}{$pre} = $fetched;
617 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
624 =head2 update_or_insert
626 $obj->update_or_insert
628 Updates the object if it's already in the db, else inserts it.
630 =head2 insert_or_update
632 $obj->insert_or_update
634 Alias for L</update_or_insert>
638 *insert_or_update = \&update_or_insert;
639 sub update_or_insert {
641 return ($self->in_storage ? $self->update : $self->insert);
646 my @changed_col_names = $obj->is_changed();
647 if ($obj->is_changed()) { ... }
649 In array context returns a list of columns with uncommited changes, or
650 in scalar context returns a true value if there are uncommitted
656 return keys %{shift->{_dirty_columns} || {}};
659 =head2 is_column_changed
661 if ($obj->is_column_changed('col')) { ... }
663 Returns a true value if the column has uncommitted changes.
667 sub is_column_changed {
668 my( $self, $col ) = @_;
669 return exists $self->{_dirty_columns}->{$col};
674 my $resultsource = $object->result_source;
676 Accessor to the ResultSource this object was created from
684 $self->_source_handle($_[0]->handle);
686 $self->_source_handle->resolve;
690 =head2 register_column
692 $column_info = { .... };
693 $class->register_column($column_name, $column_info);
695 Registers a column on the class. If the column_info has an 'accessor'
696 key, creates an accessor named after the value if defined; if there is
697 no such key, creates an accessor with the same name as the column
699 The column_info attributes are described in
700 L<DBIx::Class::ResultSource/add_columns>
704 sub register_column {
705 my ($class, $col, $info) = @_;
707 if (exists $info->{accessor}) {
708 return unless defined $info->{accessor};
709 $acc = [ $info->{accessor}, $col ];
711 $class->mk_group_accessors('column' => $acc);
715 =head2 throw_exception
717 See Schema's throw_exception.
721 sub throw_exception {
723 if (ref $self && ref $self->result_source && $self->result_source->schema) {
724 $self->result_source->schema->throw_exception(@_);
734 Matt S. Trout <mst@shadowcatsystems.co.uk>
738 You may distribute this code under the same terms as Perl itself.