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) = @_;
34 $class = ref $class if ref $class;
36 my $new = { _column_data => {} };
39 if (my $handle = delete $attrs->{-source_handle}) {
40 $new->_source_handle($handle);
44 $new->throw_exception("attrs must be a hashref")
45 unless ref($attrs) eq 'HASH';
47 my ($related,$inflated);
48 foreach my $key (keys %$attrs) {
49 if (ref $attrs->{$key}) {
50 my $info = $class->relationship_info($key);
51 if ($info && $info->{attrs}{accessor}
52 && $info->{attrs}{accessor} eq 'single')
54 $new->set_from_related($key, $attrs->{$key});
55 $related->{$key} = $attrs->{$key};
58 elsif ($class->has_column($key)
59 && exists $class->column_info($key)->{_inflate_info})
61 $inflated->{$key} = $attrs->{$key};
65 $new->throw_exception("No such column $key on $class")
66 unless $class->has_column($key);
67 $new->store_column($key => $attrs->{$key});
69 if (my $source = delete $attrs->{-result_source}) {
70 $new->result_source($source);
73 $new->{_relationship_data} = $related if $related;
74 $new->{_inflated_column} = $inflated if $inflated;
84 Inserts an object into the database if it isn't already in
85 there. Returns the object itself. Requires the object's result source to
86 be set, or the class to have a result_source_instance method. To insert
87 an entirely new object into the database, use C<create> (see
88 L<DBIx::Class::ResultSet/create>).
94 return $self if $self->in_storage;
95 my $source = $self->result_source;
96 $source ||= $self->result_source($self->result_source_instance)
97 if $self->can('result_source_instance');
98 $self->throw_exception("No result_source set on this object; can't insert")
101 $source->storage->insert($source, { $self->get_columns });
102 $self->in_storage(1);
103 $self->{_dirty_columns} = {};
104 $self->{related_resultsets} = {};
105 undef $self->{_orig_ident};
111 $obj->in_storage; # Get value
112 $obj->in_storage(1); # Set value
114 Indicated whether the object exists as a row in the database or not
119 my ($self, $val) = @_;
120 $self->{_in_storage} = $val if @_ > 1;
121 return $self->{_in_storage};
126 $obj->update \%columns?;
128 Must be run on an object that is already in the database; issues an SQL
129 UPDATE query to commit any changes to the object to the database if
132 Also takes an options hashref of C<< column_name => value> pairs >> to update
133 first. But be aware that this hashref might be edited in place, so dont rely on
134 it being the same after a call to C<update>.
139 my ($self, $upd) = @_;
140 $self->throw_exception( "Not in database" ) unless $self->in_storage;
141 my $ident_cond = $self->ident_condition;
142 $self->throw_exception("Cannot safely update a row in a PK-less table")
143 if ! keys %$ident_cond;
146 foreach my $key (keys %$upd) {
147 if (ref $upd->{$key}) {
148 my $info = $self->relationship_info($key);
149 if ($info && $info->{attrs}{accessor}
150 && $info->{attrs}{accessor} eq 'single')
152 my $rel = delete $upd->{$key};
153 $self->set_from_related($key => $rel);
154 $self->{_relationship_data}{$key} = $rel;
156 elsif ($self->has_column($key)
157 && exists $self->column_info($key)->{_inflate_info})
159 $self->set_inflated_column($key, delete $upd->{$key});
163 $self->set_columns($upd);
165 my %to_update = $self->get_dirty_columns;
166 return $self unless keys %to_update;
167 my $rows = $self->result_source->storage->update(
168 $self->result_source, \%to_update,
169 $self->{_orig_ident} || $ident_cond
172 $self->throw_exception( "Can't update ${self}: row not found" );
173 } elsif ($rows > 1) {
174 $self->throw_exception("Can't update ${self}: updated more than one row");
176 $self->{_dirty_columns} = {};
177 $self->{related_resultsets} = {};
178 undef $self->{_orig_ident};
186 Deletes the object from the database. The object is still perfectly
187 usable, but C<< ->in_storage() >> will now return 0 and the object must
188 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
189 on it. If you delete an object in a class with a C<has_many>
190 relationship, all the related objects will be deleted as well. To turn
191 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
192 hashref. Any database-level cascade or restrict will take precedence
193 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
200 $self->throw_exception( "Not in database" ) unless $self->in_storage;
201 my $ident_cond = $self->ident_condition;
202 $self->throw_exception("Cannot safely delete a row in a PK-less table")
203 if ! keys %$ident_cond;
204 foreach my $column (keys %$ident_cond) {
205 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
206 unless exists $self->{_column_data}{$column};
208 $self->result_source->storage->delete(
209 $self->result_source, $ident_cond);
210 $self->in_storage(undef);
212 $self->throw_exception("Can't do class delete without a ResultSource instance")
213 unless $self->can('result_source_instance');
214 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
215 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
216 $self->result_source_instance->resultset->search(@_)->delete;
223 my $val = $obj->get_column($col);
225 Gets a column value from a row object. Does not do any queries; the column
226 must have already been fetched from the database and stored in the object. If
227 there is an inflated value stored that has not yet been deflated, it is deflated
228 when the method is invoked.
233 my ($self, $column) = @_;
234 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
235 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
236 if (exists $self->{_inflated_column}{$column}) {
237 return $self->store_column($column,
238 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
240 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
244 =head2 has_column_loaded
246 if ( $obj->has_column_loaded($col) ) {
247 print "$col has been loaded from db";
250 Returns a true value if the column value has been loaded from the
251 database (or set locally).
255 sub has_column_loaded {
256 my ($self, $column) = @_;
257 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
258 return 1 if exists $self->{_inflated_column}{$column};
259 return exists $self->{_column_data}{$column};
264 my %data = $obj->get_columns;
266 Does C<get_column>, for all column values at once.
272 if (exists $self->{_inflated_column}) {
273 foreach my $col (keys %{$self->{_inflated_column}}) {
274 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
275 unless exists $self->{_column_data}{$col};
278 return %{$self->{_column_data}};
281 =head2 get_dirty_columns
283 my %data = $obj->get_dirty_columns;
285 Identical to get_columns but only returns those that have been changed.
289 sub get_dirty_columns {
291 return map { $_ => $self->{_column_data}{$_} }
292 keys %{$self->{_dirty_columns}};
297 $obj->set_column($col => $val);
299 Sets a column value. If the new value is different from the old one,
300 the column is marked as dirty for when you next call $obj->update.
307 $self->{_orig_ident} ||= $self->ident_condition;
308 my $old = $self->get_column($column);
309 my $ret = $self->store_column(@_);
310 $self->{_dirty_columns}{$column} = 1
311 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
317 my $copy = $orig->set_columns({ $col => $val, ... });
319 Sets more than one column value at once.
324 my ($self,$data) = @_;
325 foreach my $col (keys %$data) {
326 $self->set_column($col,$data->{$col});
333 my $copy = $orig->copy({ change => $to, ... });
335 Inserts a new row with the specified changes.
340 my ($self, $changes) = @_;
342 my $col_data = { %{$self->{_column_data}} };
343 foreach my $col (keys %$col_data) {
344 delete $col_data->{$col}
345 if $self->result_source->column_info($col)->{is_auto_increment};
348 my $new = { _column_data => $col_data };
349 bless $new, ref $self;
351 $new->result_source($self->result_source);
352 $new->set_columns($changes);
354 foreach my $rel ($self->result_source->relationships) {
355 my $rel_info = $self->result_source->relationship_info($rel);
356 if ($rel_info->{attrs}{cascade_copy}) {
357 my $resolved = $self->result_source->resolve_condition(
358 $rel_info->{cond}, $rel, $new);
359 foreach my $related ($self->search_related($rel)) {
360 $related->copy($resolved);
369 $obj->store_column($col => $val);
371 Sets a column value without marking it as dirty.
376 my ($self, $column, $value) = @_;
377 $self->throw_exception( "No such column '${column}'" )
378 unless exists $self->{_column_data}{$column} || $self->has_column($column);
379 $self->throw_exception( "set_column called for ${column} without value" )
381 return $self->{_column_data}{$column} = $value;
384 =head2 inflate_result
386 Class->inflate_result($result_source, \%me, \%prefetch?)
388 Called by ResultSet to inflate a result from storage
393 my ($class, $source, $me, $prefetch) = @_;
395 my ($source_handle) = $source;
397 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
398 $source = $source_handle->resolve
400 $source_handle = $source->handle
404 _source_handle => $source_handle,
408 bless $new, (ref $class || $class);
411 foreach my $pre (keys %{$prefetch||{}}) {
412 my $pre_val = $prefetch->{$pre};
413 my $pre_source = $source->related_source($pre);
414 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
416 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
418 foreach my $pre_rec (@$pre_val) {
419 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
420 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
423 push(@pre_objects, $pre_source->result_class->inflate_result(
424 $pre_source, @{$pre_rec}));
426 $new->related_resultset($pre)->set_cache(\@pre_objects);
427 } elsif (defined $pre_val->[0]) {
429 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
430 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
432 $fetched = $pre_source->result_class->inflate_result(
433 $pre_source, @{$pre_val});
435 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
436 $class->throw_exception("No accessor for prefetched $pre")
437 unless defined $accessor;
438 if ($accessor eq 'single') {
439 $new->{_relationship_data}{$pre} = $fetched;
440 } elsif ($accessor eq 'filter') {
441 $new->{_inflated_column}{$pre} = $fetched;
443 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
450 =head2 update_or_insert
452 $obj->update_or_insert
454 Updates the object if it's already in the db, else inserts it.
456 =head2 insert_or_update
458 $obj->insert_or_update
460 Alias for L</update_or_insert>
464 *insert_or_update = \&update_or_insert;
465 sub update_or_insert {
467 return ($self->in_storage ? $self->update : $self->insert);
472 my @changed_col_names = $obj->is_changed();
473 if ($obj->is_changed()) { ... }
475 In array context returns a list of columns with uncommited changes, or
476 in scalar context returns a true value if there are uncommitted
482 return keys %{shift->{_dirty_columns} || {}};
485 =head2 is_column_changed
487 if ($obj->is_column_changed('col')) { ... }
489 Returns a true value if the column has uncommitted changes.
493 sub is_column_changed {
494 my( $self, $col ) = @_;
495 return exists $self->{_dirty_columns}->{$col};
500 my $resultsource = $object->result_source;
502 Accessor to the ResultSource this object was created from
510 $self->_source_handle($_[0]->handle);
512 $self->_source_handle->resolve;
516 =head2 register_column
518 $column_info = { .... };
519 $class->register_column($column_name, $column_info);
521 Registers a column on the class. If the column_info has an 'accessor'
522 key, creates an accessor named after the value if defined; if there is
523 no such key, creates an accessor with the same name as the column
525 The column_info attributes are described in
526 L<DBIx::Class::ResultSource/add_columns>
530 sub register_column {
531 my ($class, $col, $info) = @_;
533 if (exists $info->{accessor}) {
534 return unless defined $info->{accessor};
535 $acc = [ $info->{accessor}, $col ];
537 $class->mk_group_accessors('column' => $acc);
541 =head2 throw_exception
543 See Schema's throw_exception.
547 sub throw_exception {
549 if (ref $self && ref $self->result_source) {
550 $self->result_source->schema->throw_exception(@_);
560 Matt S. Trout <mst@shadowcatsystems.co.uk>
564 You may distribute this code under the same terms as Perl itself.