1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
7 use Carp::Clan qw/^DBIx::Class/;
9 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
13 DBIx::Class::Row - Basic row methods
19 This class is responsible for defining and doing basic operations on rows
20 derived from L<DBIx::Class::ResultSource> objects.
26 my $obj = My::Class->new($attrs);
28 Creates a new row object from column => value mappings passed as a hash ref
33 my ($class, $attrs, $source) = @_;
34 $class = ref $class if ref $class;
36 my $new = { _column_data => {} };
39 $new->_source_handle($source) if $source;
42 $new->throw_exception("attrs must be a hashref")
43 unless ref($attrs) eq 'HASH';
45 my ($related,$inflated);
46 foreach my $key (keys %$attrs) {
47 if (ref $attrs->{$key}) {
48 my $info = $class->relationship_info($key);
49 if ($info && $info->{attrs}{accessor}
50 && $info->{attrs}{accessor} eq 'single')
52 $new->set_from_related($key, $attrs->{$key});
53 $related->{$key} = $attrs->{$key};
56 elsif ($class->has_column($key)
57 && exists $class->column_info($key)->{_inflate_info})
59 $inflated->{$key} = $attrs->{$key};
63 $new->throw_exception("No such column $key on $class")
64 unless $class->has_column($key);
65 $new->store_column($key => $attrs->{$key});
67 if (my $source = delete $attrs->{-result_source}) {
68 $new->result_source($source);
71 $new->{_relationship_data} = $related if $related;
72 $new->{_inflated_column} = $inflated if $inflated;
82 Inserts an object into the database if it isn't already in
83 there. Returns the object itself. Requires the object's result source to
84 be set, or the class to have a result_source_instance method. To insert
85 an entirely new object into the database, use C<create> (see
86 L<DBIx::Class::ResultSet/create>).
92 return $self if $self->in_storage;
93 my $source = $self->result_source;
94 $source ||= $self->result_source($self->result_source_instance)
95 if $self->can('result_source_instance');
96 $self->throw_exception("No result_source set on this object; can't insert")
99 $source->storage->insert($source, { $self->get_columns });
100 $self->in_storage(1);
101 $self->{_dirty_columns} = {};
102 $self->{related_resultsets} = {};
103 undef $self->{_orig_ident};
109 $obj->in_storage; # Get value
110 $obj->in_storage(1); # Set value
112 Indicated whether the object exists as a row in the database or not
117 my ($self, $val) = @_;
118 $self->{_in_storage} = $val if @_ > 1;
119 return $self->{_in_storage};
126 Must be run on an object that is already in the database; issues an SQL
127 UPDATE query to commit any changes to the object to the database if
133 my ($self, $upd) = @_;
134 $self->throw_exception( "Not in database" ) unless $self->in_storage;
135 my $ident_cond = $self->ident_condition;
136 $self->throw_exception("Cannot safely update a row in a PK-less table")
137 if ! keys %$ident_cond;
140 foreach my $key (keys %$upd) {
141 if (ref $upd->{$key}) {
142 my $info = $self->relationship_info($key);
143 if ($info && $info->{attrs}{accessor}
144 && $info->{attrs}{accessor} eq 'single')
146 my $rel = delete $upd->{$key};
147 $self->set_from_related($key => $rel);
148 $self->{_relationship_data}{$key} = $rel;
150 elsif ($self->has_column($key)
151 && exists $self->column_info($key)->{_inflate_info})
153 $self->set_inflated_column($key, delete $upd->{$key});
157 $self->set_columns($upd);
159 my %to_update = $self->get_dirty_columns;
160 return $self unless keys %to_update;
161 my $rows = $self->result_source->storage->update(
162 $self->result_source, \%to_update,
163 $self->{_orig_ident} || $ident_cond
166 $self->throw_exception( "Can't update ${self}: row not found" );
167 } elsif ($rows > 1) {
168 $self->throw_exception("Can't update ${self}: updated more than one row");
170 $self->{_dirty_columns} = {};
171 $self->{related_resultsets} = {};
172 undef $self->{_orig_ident};
180 Deletes the object from the database. The object is still perfectly
181 usable, but C<< ->in_storage() >> will now return 0 and the object must
182 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
183 on it. If you delete an object in a class with a C<has_many>
184 relationship, all the related objects will be deleted as well. To turn
185 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
186 hashref. Any database-level cascade or restrict will take precedence
187 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
194 $self->throw_exception( "Not in database" ) unless $self->in_storage;
195 my $ident_cond = $self->ident_condition;
196 $self->throw_exception("Cannot safely delete a row in a PK-less table")
197 if ! keys %$ident_cond;
198 foreach my $column (keys %$ident_cond) {
199 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
200 unless exists $self->{_column_data}{$column};
202 $self->result_source->storage->delete(
203 $self->result_source, $ident_cond);
204 $self->in_storage(undef);
206 $self->throw_exception("Can't do class delete without a ResultSource instance")
207 unless $self->can('result_source_instance');
208 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
209 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
210 $self->result_source_instance->resultset->search(@_)->delete;
217 my $val = $obj->get_column($col);
219 Gets a column value from a row object. Does not do any queries; the column
220 must have already been fetched from the database and stored in the object. If
221 there is an inflated value stored that has not yet been deflated, it is deflated
222 when the method is invoked.
227 my ($self, $column) = @_;
228 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
229 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
230 if (exists $self->{_inflated_column}{$column}) {
231 return $self->store_column($column,
232 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
234 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
238 =head2 has_column_loaded
240 if ( $obj->has_column_loaded($col) ) {
241 print "$col has been loaded from db";
244 Returns a true value if the column value has been loaded from the
245 database (or set locally).
249 sub has_column_loaded {
250 my ($self, $column) = @_;
251 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
252 return 1 if exists $self->{_inflated_column}{$column};
253 return exists $self->{_column_data}{$column};
258 my %data = $obj->get_columns;
260 Does C<get_column>, for all column values at once.
266 if (exists $self->{_inflated_column}) {
267 foreach my $col (keys %{$self->{_inflated_column}}) {
268 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
269 unless exists $self->{_column_data}{$col};
272 return %{$self->{_column_data}};
275 =head2 get_dirty_columns
277 my %data = $obj->get_dirty_columns;
279 Identical to get_columns but only returns those that have been changed.
283 sub get_dirty_columns {
285 return map { $_ => $self->{_column_data}{$_} }
286 keys %{$self->{_dirty_columns}};
291 $obj->set_column($col => $val);
293 Sets a column value. If the new value is different from the old one,
294 the column is marked as dirty for when you next call $obj->update.
301 $self->{_orig_ident} ||= $self->ident_condition;
302 my $old = $self->get_column($column);
303 my $ret = $self->store_column(@_);
304 $self->{_dirty_columns}{$column} = 1
305 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
311 my $copy = $orig->set_columns({ $col => $val, ... });
313 Sets more than one column value at once.
318 my ($self,$data) = @_;
319 foreach my $col (keys %$data) {
320 $self->set_column($col,$data->{$col});
327 my $copy = $orig->copy({ change => $to, ... });
329 Inserts a new row with the specified changes.
334 my ($self, $changes) = @_;
336 my $col_data = { %{$self->{_column_data}} };
337 foreach my $col (keys %$col_data) {
338 delete $col_data->{$col}
339 if $self->result_source->column_info($col)->{is_auto_increment};
342 my $new = { _column_data => $col_data };
343 bless $new, ref $self;
345 $new->result_source($self->result_source);
346 $new->set_columns($changes);
348 foreach my $rel ($self->result_source->relationships) {
349 my $rel_info = $self->result_source->relationship_info($rel);
350 if ($rel_info->{attrs}{cascade_copy}) {
351 my $resolved = $self->result_source->resolve_condition(
352 $rel_info->{cond}, $rel, $new);
353 foreach my $related ($self->search_related($rel)) {
354 $related->copy($resolved);
363 $obj->store_column($col => $val);
365 Sets a column value without marking it as dirty.
370 my ($self, $column, $value) = @_;
371 $self->throw_exception( "No such column '${column}'" )
372 unless exists $self->{_column_data}{$column} || $self->has_column($column);
373 $self->throw_exception( "set_column called for ${column} without value" )
375 return $self->{_column_data}{$column} = $value;
378 =head2 inflate_result
380 Class->inflate_result($result_source, \%me, \%prefetch?)
382 Called by ResultSet to inflate a result from storage
387 my ($class, $source, $me, $prefetch) = @_;
389 my ($source_handle) = $source;
391 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
392 $source = $source_handle->resolve
394 $source_handle = $source->handle
398 _source_handle => $source_handle,
402 bless $new, (ref $class || $class);
405 foreach my $pre (keys %{$prefetch||{}}) {
406 my $pre_val = $prefetch->{$pre};
407 my $pre_source = $source->related_source($pre);
408 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
410 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
412 foreach my $pre_rec (@$pre_val) {
413 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
414 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
417 push(@pre_objects, $pre_source->result_class->inflate_result(
418 $pre_source, @{$pre_rec}));
420 $new->related_resultset($pre)->set_cache(\@pre_objects);
421 } elsif (defined $pre_val->[0]) {
423 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
424 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
426 $fetched = $pre_source->result_class->inflate_result(
427 $pre_source, @{$pre_val});
429 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
430 $class->throw_exception("No accessor for prefetched $pre")
431 unless defined $accessor;
432 if ($accessor eq 'single') {
433 $new->{_relationship_data}{$pre} = $fetched;
434 } elsif ($accessor eq 'filter') {
435 $new->{_inflated_column}{$pre} = $fetched;
437 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
444 =head2 update_or_insert
446 $obj->update_or_insert
448 Updates the object if it's already in the db, else inserts it.
450 =head2 insert_or_update
452 $obj->insert_or_update
454 Alias for L</update_or_insert>
458 *insert_or_update = \&update_or_insert;
459 sub update_or_insert {
461 return ($self->in_storage ? $self->update : $self->insert);
466 my @changed_col_names = $obj->is_changed();
467 if ($obj->is_changed()) { ... }
469 In array context returns a list of columns with uncommited changes, or
470 in scalar context returns a true value if there are uncommitted
476 return keys %{shift->{_dirty_columns} || {}};
479 =head2 is_column_changed
481 if ($obj->is_column_changed('col')) { ... }
483 Returns a true value if the column has uncommitted changes.
487 sub is_column_changed {
488 my( $self, $col ) = @_;
489 return exists $self->{_dirty_columns}->{$col};
494 my $resultsource = $object->result_source;
496 Accessor to the ResultSource this object was created from
504 $self->_source_handle($_[0]->handle);
506 $self->_source_handle->resolve;
510 =head2 register_column
512 $column_info = { .... };
513 $class->register_column($column_name, $column_info);
515 Registers a column on the class. If the column_info has an 'accessor'
516 key, creates an accessor named after the value if defined; if there is
517 no such key, creates an accessor with the same name as the column
519 The column_info attributes are described in
520 L<DBIx::Class::ResultSource/add_columns>
524 sub register_column {
525 my ($class, $col, $info) = @_;
527 if (exists $info->{accessor}) {
528 return unless defined $info->{accessor};
529 $acc = [ $info->{accessor}, $col ];
531 $class->mk_group_accessors('column' => $acc);
535 =head2 throw_exception
537 See Schema's throw_exception.
541 sub throw_exception {
543 if (ref $self && ref $self->result_source) {
544 $self->result_source->schema->throw_exception(@_);
554 Matt S. Trout <mst@shadowcatsystems.co.uk>
558 You may distribute this code under the same terms as Perl itself.