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;
56 if (my $handle = delete $attrs->{-source_handle}) {
57 $new->_source_handle($handle);
59 if (my $source = delete $attrs->{-result_source}) {
60 $new->result_source($source);
64 $new->throw_exception("attrs must be a hashref")
65 unless ref($attrs) eq 'HASH';
67 my ($related,$inflated);
68 ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
69 $new->{_rel_in_storage} = 1;
71 foreach my $key (keys %$attrs) {
72 if (ref $attrs->{$key}) {
73 ## Can we extract this lot to use with update(_or .. ) ?
74 my $info = $class->relationship_info($key);
75 if ($info && $info->{attrs}{accessor}
76 && $info->{attrs}{accessor} eq 'single')
78 my $rel_obj = delete $attrs->{$key};
79 if(!Scalar::Util::blessed($rel_obj)) {
80 $rel_obj = $new->find_or_new_related($key, $rel_obj);
83 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
85 $new->set_from_related($key, $rel_obj);
86 $related->{$key} = $rel_obj;
88 } elsif ($info && $info->{attrs}{accessor}
89 && $info->{attrs}{accessor} eq 'multi'
90 && ref $attrs->{$key} eq 'ARRAY') {
91 my $others = delete $attrs->{$key};
92 foreach my $rel_obj (@$others) {
93 if(!Scalar::Util::blessed($rel_obj)) {
94 $rel_obj = $new->new_related($key, $rel_obj);
95 $new->{_rel_in_storage} = 0;
98 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
100 $related->{$key} = $others;
102 } elsif ($info && $info->{attrs}{accessor}
103 && $info->{attrs}{accessor} eq 'filter')
105 ## 'filter' should disappear and get merged in with 'single' above!
106 my $rel_obj = delete $attrs->{$key};
107 if(!Scalar::Util::blessed($rel_obj)) {
108 $rel_obj = $new->find_or_new_related($key, $rel_obj);
109 $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
111 $inflated->{$key} = $rel_obj;
113 } elsif ($class->has_column($key)
114 && $class->column_info($key)->{_inflate_info}) {
115 $inflated->{$key} = $attrs->{$key};
120 $new->throw_exception("No such column $key on $class")
121 unless $class->has_column($key);
122 $new->store_column($key => $attrs->{$key});
125 $new->{_relationship_data} = $related if $related;
126 $new->{_inflated_column} = $inflated if $inflated;
136 Inserts an object into the database if it isn't already in
137 there. Returns the object itself. Requires the object's result source to
138 be set, or the class to have a result_source_instance method. To insert
139 an entirely new object into the database, use C<create> (see
140 L<DBIx::Class::ResultSet/create>).
146 return $self if $self->in_storage;
147 my $source = $self->result_source;
148 $source ||= $self->result_source($self->result_source_instance)
149 if $self->can('result_source_instance');
150 $self->throw_exception("No result_source set on this object; can't insert")
155 # Check if we stored uninserted relobjs here in new()
156 my %related_stuff = (%{$self->{_relationship_data} || {}},
157 %{$self->{_inflated_column} || {}});
159 if(!$self->{_rel_in_storage}) {
160 $source->storage->txn_begin;
162 # The guard will save us if we blow out of this scope via die
164 $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
166 ## Should all be in relationship_data, but we need to get rid of the
167 ## 'filter' reltype..
168 ## These are the FK rels, need their IDs for the insert.
170 my @pri = $self->primary_columns;
172 REL: foreach my $relname (keys %related_stuff) {
174 my $rel_obj = $related_stuff{$relname};
176 next REL unless (Scalar::Util::blessed($rel_obj)
177 && $rel_obj->isa('DBIx::Class::Row'));
179 my $cond = $source->relationship_info($relname)->{cond};
181 next REL unless ref($cond) eq 'HASH';
183 # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
185 my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
187 # assume anything that references our PK probably is dependent on us
188 # rather than vice versa, unless the far side is (a) defined or (b)
191 foreach my $p (@pri) {
192 if (exists $keyhash->{$p}) {
194 unless (defined($rel_obj->get_column($keyhash->{$p}))
195 || $rel_obj->column_info($keyhash->{$p})
196 ->{is_auto_increment}) {
203 $self->set_from_related($relname, $rel_obj);
204 delete $related_stuff{$relname};
208 $source->storage->insert($source, { $self->get_columns });
211 my @auto_pri = grep {
212 !defined $self->get_column($_) ||
213 ref($self->get_column($_)) eq 'SCALAR'
214 } $self->primary_columns;
217 #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
218 # if defined $too_many;
220 my $storage = $self->result_source->storage;
221 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
222 unless $storage->can('last_insert_id');
223 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
224 $self->throw_exception( "Can't get last insert id" )
225 unless (@ids == @auto_pri);
226 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
229 if(!$self->{_rel_in_storage}) {
230 ## Now do the has_many rels, that need $selfs ID.
231 foreach my $relname (keys %related_stuff) {
232 my $rel_obj = $related_stuff{$relname};
234 if (Scalar::Util::blessed($rel_obj)
235 && $rel_obj->isa('DBIx::Class::Row')) {
237 } elsif (ref $rel_obj eq 'ARRAY') {
241 my $reverse = $source->reverse_relationship_info($relname);
242 foreach my $obj (@cands) {
243 $obj->set_from_related($_, $self) for keys %$reverse;
244 $obj->insert() if(!$obj->in_storage);
248 $source->storage->txn_commit;
249 $rollback_guard->dismiss;
252 $self->in_storage(1);
253 $self->{_dirty_columns} = {};
254 $self->{related_resultsets} = {};
255 undef $self->{_orig_ident};
261 $obj->in_storage; # Get value
262 $obj->in_storage(1); # Set value
264 Indicated whether the object exists as a row in the database or not
269 my ($self, $val) = @_;
270 $self->{_in_storage} = $val if @_ > 1;
271 return $self->{_in_storage};
276 $obj->update \%columns?;
278 Must be run on an object that is already in the database; issues an SQL
279 UPDATE query to commit any changes to the object to the database if
282 Also takes an options hashref of C<< column_name => value> pairs >> to update
283 first. But be aware that this hashref might be edited in place, so dont rely on
284 it being the same after a call to C<update>. If you need to preserve the hashref,
285 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
290 my ($self, $upd) = @_;
291 $self->throw_exception( "Not in database" ) unless $self->in_storage;
292 my $ident_cond = $self->ident_condition;
293 $self->throw_exception("Cannot safely update a row in a PK-less table")
294 if ! keys %$ident_cond;
297 foreach my $key (keys %$upd) {
298 if (ref $upd->{$key}) {
299 my $info = $self->relationship_info($key);
300 if ($info && $info->{attrs}{accessor}
301 && $info->{attrs}{accessor} eq 'single')
303 my $rel = delete $upd->{$key};
304 $self->set_from_related($key => $rel);
305 $self->{_relationship_data}{$key} = $rel;
306 } elsif ($info && $info->{attrs}{accessor}
307 && $info->{attrs}{accessor} eq 'multi'
308 && ref $upd->{$key} eq 'ARRAY') {
309 my $others = delete $upd->{$key};
310 foreach my $rel_obj (@$others) {
311 if(!Scalar::Util::blessed($rel_obj)) {
312 $rel_obj = $self->create_related($key, $rel_obj);
315 $self->{_relationship_data}{$key} = $others;
316 # $related->{$key} = $others;
319 elsif ($self->has_column($key)
320 && exists $self->column_info($key)->{_inflate_info})
322 $self->set_inflated_column($key, delete $upd->{$key});
326 $self->set_columns($upd);
328 my %to_update = $self->get_dirty_columns;
329 return $self unless keys %to_update;
330 my $rows = $self->result_source->storage->update(
331 $self->result_source, \%to_update,
332 $self->{_orig_ident} || $ident_cond
335 $self->throw_exception( "Can't update ${self}: row not found" );
336 } elsif ($rows > 1) {
337 $self->throw_exception("Can't update ${self}: updated more than one row");
339 $self->{_dirty_columns} = {};
340 $self->{related_resultsets} = {};
341 undef $self->{_orig_ident};
349 Deletes the object from the database. The object is still perfectly
350 usable, but C<< ->in_storage() >> will now return 0 and the object must
351 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
352 on it. If you delete an object in a class with a C<has_many>
353 relationship, all the related objects will be deleted as well. To turn
354 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
355 hashref. Any database-level cascade or restrict will take precedence
356 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
363 $self->throw_exception( "Not in database" ) unless $self->in_storage;
364 my $ident_cond = $self->ident_condition;
365 $self->throw_exception("Cannot safely delete a row in a PK-less table")
366 if ! keys %$ident_cond;
367 foreach my $column (keys %$ident_cond) {
368 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
369 unless exists $self->{_column_data}{$column};
371 $self->result_source->storage->delete(
372 $self->result_source, $ident_cond);
373 $self->in_storage(undef);
375 $self->throw_exception("Can't do class delete without a ResultSource instance")
376 unless $self->can('result_source_instance');
377 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
378 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
379 $self->result_source_instance->resultset->search(@_)->delete;
386 my $val = $obj->get_column($col);
388 Gets a column value from a row object. Does not do any queries; the column
389 must have already been fetched from the database and stored in the object. If
390 there is an inflated value stored that has not yet been deflated, it is deflated
391 when the method is invoked.
396 my ($self, $column) = @_;
397 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
398 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
399 if (exists $self->{_inflated_column}{$column}) {
400 return $self->store_column($column,
401 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
403 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
407 =head2 has_column_loaded
409 if ( $obj->has_column_loaded($col) ) {
410 print "$col has been loaded from db";
413 Returns a true value if the column value has been loaded from the
414 database (or set locally).
418 sub has_column_loaded {
419 my ($self, $column) = @_;
420 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
421 return 1 if exists $self->{_inflated_column}{$column};
422 return exists $self->{_column_data}{$column};
427 my %data = $obj->get_columns;
429 Does C<get_column>, for all column values at once.
435 if (exists $self->{_inflated_column}) {
436 foreach my $col (keys %{$self->{_inflated_column}}) {
437 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
438 unless exists $self->{_column_data}{$col};
441 return %{$self->{_column_data}};
444 =head2 get_dirty_columns
446 my %data = $obj->get_dirty_columns;
448 Identical to get_columns but only returns those that have been changed.
452 sub get_dirty_columns {
454 return map { $_ => $self->{_column_data}{$_} }
455 keys %{$self->{_dirty_columns}};
458 =head2 get_inflated_columns
460 my $inflated_data = $obj->get_inflated_columns;
462 Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
466 sub get_inflated_columns {
469 my $accessor = $self->column_info($_)->{'accessor'} || $_;
470 ($_ => $self->$accessor);
476 $obj->set_column($col => $val);
478 Sets a column value. If the new value is different from the old one,
479 the column is marked as dirty for when you next call $obj->update.
486 $self->{_orig_ident} ||= $self->ident_condition;
487 my $old = $self->get_column($column);
488 my $ret = $self->store_column(@_);
489 $self->{_dirty_columns}{$column} = 1
490 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
492 # XXX clear out the relation cache for this column
493 delete $self->{related_resultsets}{$column};
500 my $copy = $orig->set_columns({ $col => $val, ... });
502 Sets more than one column value at once.
507 my ($self,$data) = @_;
508 foreach my $col (keys %$data) {
509 $self->set_column($col,$data->{$col});
516 my $copy = $orig->copy({ change => $to, ... });
518 Inserts a new row with the specified changes.
523 my ($self, $changes) = @_;
525 my $col_data = { %{$self->{_column_data}} };
526 foreach my $col (keys %$col_data) {
527 delete $col_data->{$col}
528 if $self->result_source->column_info($col)->{is_auto_increment};
531 my $new = { _column_data => $col_data };
532 bless $new, ref $self;
534 $new->result_source($self->result_source);
535 $new->set_columns($changes);
537 foreach my $rel ($self->result_source->relationships) {
538 my $rel_info = $self->result_source->relationship_info($rel);
539 if ($rel_info->{attrs}{cascade_copy}) {
540 my $resolved = $self->result_source->resolve_condition(
541 $rel_info->{cond}, $rel, $new);
542 foreach my $related ($self->search_related($rel)) {
543 $related->copy($resolved);
552 $obj->store_column($col => $val);
554 Sets a column value without marking it as dirty.
559 my ($self, $column, $value) = @_;
560 $self->throw_exception( "No such column '${column}'" )
561 unless exists $self->{_column_data}{$column} || $self->has_column($column);
562 $self->throw_exception( "set_column called for ${column} without value" )
564 return $self->{_column_data}{$column} = $value;
567 =head2 inflate_result
569 Class->inflate_result($result_source, \%me, \%prefetch?)
571 Called by ResultSet to inflate a result from storage
576 my ($class, $source, $me, $prefetch) = @_;
578 my ($source_handle) = $source;
580 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
581 $source = $source_handle->resolve
583 $source_handle = $source->handle
587 _source_handle => $source_handle,
591 bless $new, (ref $class || $class);
594 foreach my $pre (keys %{$prefetch||{}}) {
595 my $pre_val = $prefetch->{$pre};
596 my $pre_source = $source->related_source($pre);
597 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
599 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
601 foreach my $pre_rec (@$pre_val) {
602 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
603 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
606 push(@pre_objects, $pre_source->result_class->inflate_result(
607 $pre_source, @{$pre_rec}));
609 $new->related_resultset($pre)->set_cache(\@pre_objects);
610 } elsif (defined $pre_val->[0]) {
612 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
613 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
615 $fetched = $pre_source->result_class->inflate_result(
616 $pre_source, @{$pre_val});
618 $new->related_resultset($pre)->set_cache([ $fetched ]);
619 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
620 $class->throw_exception("No accessor for prefetched $pre")
621 unless defined $accessor;
622 if ($accessor eq 'single') {
623 $new->{_relationship_data}{$pre} = $fetched;
624 } elsif ($accessor eq 'filter') {
625 $new->{_inflated_column}{$pre} = $fetched;
627 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
634 =head2 update_or_insert
636 $obj->update_or_insert
638 Updates the object if it's already in the db, else inserts it.
640 =head2 insert_or_update
642 $obj->insert_or_update
644 Alias for L</update_or_insert>
648 *insert_or_update = \&update_or_insert;
649 sub update_or_insert {
651 return ($self->in_storage ? $self->update : $self->insert);
656 my @changed_col_names = $obj->is_changed();
657 if ($obj->is_changed()) { ... }
659 In array context returns a list of columns with uncommited changes, or
660 in scalar context returns a true value if there are uncommitted
666 return keys %{shift->{_dirty_columns} || {}};
669 =head2 is_column_changed
671 if ($obj->is_column_changed('col')) { ... }
673 Returns a true value if the column has uncommitted changes.
677 sub is_column_changed {
678 my( $self, $col ) = @_;
679 return exists $self->{_dirty_columns}->{$col};
684 my $resultsource = $object->result_source;
686 Accessor to the ResultSource this object was created from
694 $self->_source_handle($_[0]->handle);
696 $self->_source_handle->resolve;
700 =head2 register_column
702 $column_info = { .... };
703 $class->register_column($column_name, $column_info);
705 Registers a column on the class. If the column_info has an 'accessor'
706 key, creates an accessor named after the value if defined; if there is
707 no such key, creates an accessor with the same name as the column
709 The column_info attributes are described in
710 L<DBIx::Class::ResultSource/add_columns>
714 sub register_column {
715 my ($class, $col, $info) = @_;
717 if (exists $info->{accessor}) {
718 return unless defined $info->{accessor};
719 $acc = [ $info->{accessor}, $col ];
721 $class->mk_group_accessors('column' => $acc);
725 =head2 throw_exception
727 See Schema's throw_exception.
731 sub throw_exception {
733 if (ref $self && ref $self->result_source && $self->result_source->schema) {
734 $self->result_source->schema->throw_exception(@_);
744 Matt S. Trout <mst@shadowcatsystems.co.uk>
748 You may distribute this code under the same terms as Perl itself.