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);
81 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
83 $new->set_from_related($key, $rel_obj);
84 $related->{$key} = $rel_obj;
86 } elsif ($info && $info->{attrs}{accessor}
87 && $info->{attrs}{accessor} eq 'multi'
88 && ref $attrs->{$key} eq 'ARRAY') {
89 my $others = delete $attrs->{$key};
90 foreach my $rel_obj (@$others) {
91 if(!Scalar::Util::blessed($rel_obj)) {
92 $rel_obj = $new->new_related($key, $rel_obj);
93 $new->{_rel_in_storage} = 0;
96 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
98 $related->{$key} = $others;
100 } elsif ($info && $info->{attrs}{accessor}
101 && $info->{attrs}{accessor} eq 'filter')
103 ## 'filter' should disappear and get merged in with 'single' above!
104 my $rel_obj = delete $attrs->{$key};
105 if(!Scalar::Util::blessed($rel_obj)) {
106 $rel_obj = $new->find_or_new_related($key, $rel_obj);
107 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
109 $inflated->{$key} = $rel_obj;
111 } elsif ($class->has_column($key)
112 && $class->column_info($key)->{_inflate_info}) {
113 $inflated->{$key} = $attrs->{$key};
118 $new->throw_exception("No such column $key on $class")
119 unless $class->has_column($key);
120 $new->store_column($key => $attrs->{$key});
123 $new->{_relationship_data} = $related if $related;
124 $new->{_inflated_column} = $inflated if $inflated;
134 Inserts an object into the database if it isn't already in
135 there. Returns the object itself. Requires the object's result source to
136 be set, or the class to have a result_source_instance method. To insert
137 an entirely new object into the database, use C<create> (see
138 L<DBIx::Class::ResultSet/create>).
144 return $self if $self->in_storage;
145 my $source = $self->result_source;
146 $source ||= $self->result_source($self->result_source_instance)
147 if $self->can('result_source_instance');
148 $self->throw_exception("No result_source set on this object; can't insert")
153 # Check if we stored uninserted relobjs here in new()
154 my %related_stuff = (%{$self->{_relationship_data} || {}},
155 %{$self->{_inflated_column} || {}});
157 if(!$self->{_rel_in_storage}) {
158 $source->storage->txn_begin;
160 # The guard will save us if we blow out of this scope via die
162 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
164 ## Should all be in relationship_data, but we need to get rid of the
165 ## 'filter' reltype..
166 ## These are the FK rels, need their IDs for the insert.
168 my @pri = $self->primary_columns;
170 REL: foreach my $relname (keys %related_stuff) {
172 my $rel_obj = $related_stuff{$relname};
174 next REL unless (Scalar::Util::blessed($rel_obj)
175 && $rel_obj->isa('DBIx::Class::Row'));
177 my $cond = $source->relationship_info($relname)->{cond};
179 next REL unless ref($cond) eq 'HASH';
181 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
183 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
185 # assume anything that references our PK probably is dependent on us
186 # rather than vice versa, unless the far side is (a) defined or (b)
189 foreach my $p (@pri) {
190 if (exists $keyhash->{$p}) {
191 unless (defined($rel_obj->get_column($keyhash->{$p}))
192 || $rel_obj->column_info($keyhash->{$p})
193 ->{is_auto_increment}) {
200 $self->set_from_related($relname, $rel_obj);
201 delete $related_stuff{$relname};
205 $source->storage->insert($source, { $self->get_columns });
208 my @auto_pri = grep {
209 !defined $self->get_column($_) ||
210 ref($self->get_column($_)) eq 'SCALAR'
211 } $self->primary_columns;
214 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
215 # if defined $too_many;
217 my $storage = $self->result_source->storage;
218 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
219 unless $storage->can('last_insert_id');
220 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
221 $self->throw_exception( "Can't get last insert id" )
222 unless (@ids == @auto_pri);
223 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
226 if(!$self->{_rel_in_storage}) {
227 ## Now do the has_many rels, that need $selfs ID.
228 foreach my $relname (keys %related_stuff) {
229 my $rel_obj = $related_stuff{$relname};
231 if (Scalar::Util::blessed($rel_obj)
232 && $rel_obj->isa('DBIx::Class::Row')) {
234 } elsif (ref $rel_obj eq 'ARRAY') {
238 my $reverse = $source->reverse_relationship_info($relname);
239 foreach my $obj (@cands) {
240 $obj->set_from_related($_, $self) for keys %$reverse;
241 $obj->insert() if(!$obj->in_storage);
245 $source->storage->txn_commit;
246 $rollback_guard->dismiss;
249 $self->in_storage(1);
250 $self->{_dirty_columns} = {};
251 $self->{related_resultsets} = {};
252 undef $self->{_orig_ident};
258 $obj->in_storage; # Get value
259 $obj->in_storage(1); # Set value
261 Indicated whether the object exists as a row in the database or not
266 my ($self, $val) = @_;
267 $self->{_in_storage} = $val if @_ > 1;
268 return $self->{_in_storage};
273 $obj->update \%columns?;
275 Must be run on an object that is already in the database; issues an SQL
276 UPDATE query to commit any changes to the object to the database if
279 Also takes an options hashref of C<< column_name => value> pairs >> to update
280 first. But be aware that this hashref might be edited in place, so dont rely on
281 it being the same after a call to C<update>. If you need to preserve the hashref,
282 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
287 my ($self, $upd) = @_;
288 $self->throw_exception( "Not in database" ) unless $self->in_storage;
289 my $ident_cond = $self->ident_condition;
290 $self->throw_exception("Cannot safely update a row in a PK-less table")
291 if ! keys %$ident_cond;
294 foreach my $key (keys %$upd) {
295 if (ref $upd->{$key}) {
296 my $info = $self->relationship_info($key);
297 if ($info && $info->{attrs}{accessor}
298 && $info->{attrs}{accessor} eq 'single')
300 my $rel = delete $upd->{$key};
301 $self->set_from_related($key => $rel);
302 $self->{_relationship_data}{$key} = $rel;
303 } elsif ($info && $info->{attrs}{accessor}
304 && $info->{attrs}{accessor} eq 'multi'
305 && ref $upd->{$key} eq 'ARRAY') {
306 my $others = delete $upd->{$key};
307 foreach my $rel_obj (@$others) {
308 if(!Scalar::Util::blessed($rel_obj)) {
309 $rel_obj = $self->create_related($key, $rel_obj);
312 $self->{_relationship_data}{$key} = $others;
313 # $related->{$key} = $others;
316 elsif ($self->has_column($key)
317 && exists $self->column_info($key)->{_inflate_info})
319 $self->set_inflated_column($key, delete $upd->{$key});
323 $self->set_columns($upd);
325 my %to_update = $self->get_dirty_columns;
326 return $self unless keys %to_update;
327 my $rows = $self->result_source->storage->update(
328 $self->result_source, \%to_update,
329 $self->{_orig_ident} || $ident_cond
332 $self->throw_exception( "Can't update ${self}: row not found" );
333 } elsif ($rows > 1) {
334 $self->throw_exception("Can't update ${self}: updated more than one row");
336 $self->{_dirty_columns} = {};
337 $self->{related_resultsets} = {};
338 undef $self->{_orig_ident};
346 Deletes the object from the database. The object is still perfectly
347 usable, but C<< ->in_storage() >> will now return 0 and the object must
348 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
349 on it. If you delete an object in a class with a C<has_many>
350 relationship, all the related objects will be deleted as well. To turn
351 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
352 hashref. Any database-level cascade or restrict will take precedence
353 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
360 $self->throw_exception( "Not in database" ) unless $self->in_storage;
361 my $ident_cond = $self->ident_condition;
362 $self->throw_exception("Cannot safely delete a row in a PK-less table")
363 if ! keys %$ident_cond;
364 foreach my $column (keys %$ident_cond) {
365 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
366 unless exists $self->{_column_data}{$column};
368 $self->result_source->storage->delete(
369 $self->result_source, $ident_cond);
370 $self->in_storage(undef);
372 $self->throw_exception("Can't do class delete without a ResultSource instance")
373 unless $self->can('result_source_instance');
374 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
375 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
376 $self->result_source_instance->resultset->search(@_)->delete;
383 my $val = $obj->get_column($col);
385 Gets a column value from a row object. Does not do any queries; the column
386 must have already been fetched from the database and stored in the object. If
387 there is an inflated value stored that has not yet been deflated, it is deflated
388 when the method is invoked.
393 my ($self, $column) = @_;
394 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
395 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
396 if (exists $self->{_inflated_column}{$column}) {
397 return $self->store_column($column,
398 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
400 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
404 =head2 has_column_loaded
406 if ( $obj->has_column_loaded($col) ) {
407 print "$col has been loaded from db";
410 Returns a true value if the column value has been loaded from the
411 database (or set locally).
415 sub has_column_loaded {
416 my ($self, $column) = @_;
417 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
418 return 1 if exists $self->{_inflated_column}{$column};
419 return exists $self->{_column_data}{$column};
424 my %data = $obj->get_columns;
426 Does C<get_column>, for all column values at once.
432 if (exists $self->{_inflated_column}) {
433 foreach my $col (keys %{$self->{_inflated_column}}) {
434 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
435 unless exists $self->{_column_data}{$col};
438 return %{$self->{_column_data}};
441 =head2 get_dirty_columns
443 my %data = $obj->get_dirty_columns;
445 Identical to get_columns but only returns those that have been changed.
449 sub get_dirty_columns {
451 return map { $_ => $self->{_column_data}{$_} }
452 keys %{$self->{_dirty_columns}};
455 =head2 get_inflated_columns
457 my $inflated_data = $obj->get_inflated_columns;
459 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
463 sub get_inflated_columns {
466 my $accessor = $self->column_info($_)->{'accessor'} || $_;
467 ($_ => $self->$accessor);
473 $obj->set_column($col => $val);
475 Sets a column value. If the new value is different from the old one,
476 the column is marked as dirty for when you next call $obj->update.
483 $self->{_orig_ident} ||= $self->ident_condition;
484 my $old = $self->get_column($column);
485 my $ret = $self->store_column(@_);
486 $self->{_dirty_columns}{$column} = 1
487 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
493 my $copy = $orig->set_columns({ $col => $val, ... });
495 Sets more than one column value at once.
500 my ($self,$data) = @_;
501 foreach my $col (keys %$data) {
502 $self->set_column($col,$data->{$col});
509 my $copy = $orig->copy({ change => $to, ... });
511 Inserts a new row with the specified changes.
516 my ($self, $changes) = @_;
518 my $col_data = { %{$self->{_column_data}} };
519 foreach my $col (keys %$col_data) {
520 delete $col_data->{$col}
521 if $self->result_source->column_info($col)->{is_auto_increment};
524 my $new = { _column_data => $col_data };
525 bless $new, ref $self;
527 $new->result_source($self->result_source);
528 $new->set_columns($changes);
530 foreach my $rel ($self->result_source->relationships) {
531 my $rel_info = $self->result_source->relationship_info($rel);
532 if ($rel_info->{attrs}{cascade_copy}) {
533 my $resolved = $self->result_source->resolve_condition(
534 $rel_info->{cond}, $rel, $new);
535 foreach my $related ($self->search_related($rel)) {
536 $related->copy($resolved);
545 $obj->store_column($col => $val);
547 Sets a column value without marking it as dirty.
552 my ($self, $column, $value) = @_;
553 $self->throw_exception( "No such column '${column}'" )
554 unless exists $self->{_column_data}{$column} || $self->has_column($column);
555 $self->throw_exception( "set_column called for ${column} without value" )
557 return $self->{_column_data}{$column} = $value;
560 =head2 inflate_result
562 Class->inflate_result($result_source, \%me, \%prefetch?)
564 Called by ResultSet to inflate a result from storage
569 my ($class, $source, $me, $prefetch) = @_;
571 my ($source_handle) = $source;
573 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
574 $source = $source_handle->resolve
576 $source_handle = $source->handle
580 _source_handle => $source_handle,
584 bless $new, (ref $class || $class);
587 foreach my $pre (keys %{$prefetch||{}}) {
588 my $pre_val = $prefetch->{$pre};
589 my $pre_source = $source->related_source($pre);
590 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
592 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
594 foreach my $pre_rec (@$pre_val) {
595 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
596 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
599 push(@pre_objects, $pre_source->result_class->inflate_result(
600 $pre_source, @{$pre_rec}));
602 $new->related_resultset($pre)->set_cache(\@pre_objects);
603 } elsif (defined $pre_val->[0]) {
605 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
606 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
608 $fetched = $pre_source->result_class->inflate_result(
609 $pre_source, @{$pre_val});
611 $new->related_resultset($pre)->set_cache([ $fetched ]);
612 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
613 $class->throw_exception("No accessor for prefetched $pre")
614 unless defined $accessor;
615 if ($accessor eq 'single') {
616 $new->{_relationship_data}{$pre} = $fetched;
617 } elsif ($accessor eq 'filter') {
618 $new->{_inflated_column}{$pre} = $fetched;
620 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
627 =head2 update_or_insert
629 $obj->update_or_insert
631 Updates the object if it's already in the db, else inserts it.
633 =head2 insert_or_update
635 $obj->insert_or_update
637 Alias for L</update_or_insert>
641 *insert_or_update = \&update_or_insert;
642 sub update_or_insert {
644 return ($self->in_storage ? $self->update : $self->insert);
649 my @changed_col_names = $obj->is_changed();
650 if ($obj->is_changed()) { ... }
652 In array context returns a list of columns with uncommited changes, or
653 in scalar context returns a true value if there are uncommitted
659 return keys %{shift->{_dirty_columns} || {}};
662 =head2 is_column_changed
664 if ($obj->is_column_changed('col')) { ... }
666 Returns a true value if the column has uncommitted changes.
670 sub is_column_changed {
671 my( $self, $col ) = @_;
672 return exists $self->{_dirty_columns}->{$col};
677 my $resultsource = $object->result_source;
679 Accessor to the ResultSource this object was created from
687 $self->_source_handle($_[0]->handle);
689 $self->_source_handle->resolve;
693 =head2 register_column
695 $column_info = { .... };
696 $class->register_column($column_name, $column_info);
698 Registers a column on the class. If the column_info has an 'accessor'
699 key, creates an accessor named after the value if defined; if there is
700 no such key, creates an accessor with the same name as the column
702 The column_info attributes are described in
703 L<DBIx::Class::ResultSource/add_columns>
707 sub register_column {
708 my ($class, $col, $info) = @_;
710 if (exists $info->{accessor}) {
711 return unless defined $info->{accessor};
712 $acc = [ $info->{accessor}, $col ];
714 $class->mk_group_accessors('column' => $acc);
718 =head2 throw_exception
720 See Schema's throw_exception.
724 sub throw_exception {
726 if (ref $self && ref $self->result_source && $self->result_source->schema) {
727 $self->result_source->schema->throw_exception(@_);
737 Matt S. Trout <mst@shadowcatsystems.co.uk>
741 You may distribute this code under the same terms as Perl itself.