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};
124 $obj->update \%columns?;
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
130 Also takes an options hashref of C<< column_name => value> pairs >> to update
131 first. But be aware that this hashref might be edited in place, so dont rely on
132 it being the same after a call to C<update>.
137 my ($self, $upd) = @_;
138 $self->throw_exception( "Not in database" ) unless $self->in_storage;
139 my $ident_cond = $self->ident_condition;
140 $self->throw_exception("Cannot safely update a row in a PK-less table")
141 if ! keys %$ident_cond;
144 foreach my $key (keys %$upd) {
145 if (ref $upd->{$key}) {
146 my $info = $self->relationship_info($key);
147 if ($info && $info->{attrs}{accessor}
148 && $info->{attrs}{accessor} eq 'single')
150 my $rel = delete $upd->{$key};
151 $self->set_from_related($key => $rel);
152 $self->{_relationship_data}{$key} = $rel;
154 elsif ($self->has_column($key)
155 && exists $self->column_info($key)->{_inflate_info})
157 $self->set_inflated_column($key, delete $upd->{$key});
161 $self->set_columns($upd);
163 my %to_update = $self->get_dirty_columns;
164 return $self unless keys %to_update;
165 my $rows = $self->result_source->storage->update(
166 $self->result_source, \%to_update,
167 $self->{_orig_ident} || $ident_cond
170 $self->throw_exception( "Can't update ${self}: row not found" );
171 } elsif ($rows > 1) {
172 $self->throw_exception("Can't update ${self}: updated more than one row");
174 $self->{_dirty_columns} = {};
175 $self->{related_resultsets} = {};
176 undef $self->{_orig_ident};
184 Deletes the object from the database. The object is still perfectly
185 usable, but C<< ->in_storage() >> will now return 0 and the object must
186 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
187 on it. If you delete an object in a class with a C<has_many>
188 relationship, all the related objects will be deleted as well. To turn
189 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
190 hashref. Any database-level cascade or restrict will take precedence
191 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
198 $self->throw_exception( "Not in database" ) unless $self->in_storage;
199 my $ident_cond = $self->ident_condition;
200 $self->throw_exception("Cannot safely delete a row in a PK-less table")
201 if ! keys %$ident_cond;
202 foreach my $column (keys %$ident_cond) {
203 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
204 unless exists $self->{_column_data}{$column};
206 $self->result_source->storage->delete(
207 $self->result_source, $ident_cond);
208 $self->in_storage(undef);
210 $self->throw_exception("Can't do class delete without a ResultSource instance")
211 unless $self->can('result_source_instance');
212 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
213 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
214 $self->result_source_instance->resultset->search(@_)->delete;
221 my $val = $obj->get_column($col);
223 Gets a column value from a row object. Does not do any queries; the column
224 must have already been fetched from the database and stored in the object. If
225 there is an inflated value stored that has not yet been deflated, it is deflated
226 when the method is invoked.
231 my ($self, $column) = @_;
232 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
233 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
234 if (exists $self->{_inflated_column}{$column}) {
235 return $self->store_column($column,
236 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
238 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
242 =head2 has_column_loaded
244 if ( $obj->has_column_loaded($col) ) {
245 print "$col has been loaded from db";
248 Returns a true value if the column value has been loaded from the
249 database (or set locally).
253 sub has_column_loaded {
254 my ($self, $column) = @_;
255 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
256 return 1 if exists $self->{_inflated_column}{$column};
257 return exists $self->{_column_data}{$column};
262 my %data = $obj->get_columns;
264 Does C<get_column>, for all column values at once.
270 if (exists $self->{_inflated_column}) {
271 foreach my $col (keys %{$self->{_inflated_column}}) {
272 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
273 unless exists $self->{_column_data}{$col};
276 return %{$self->{_column_data}};
279 =head2 get_dirty_columns
281 my %data = $obj->get_dirty_columns;
283 Identical to get_columns but only returns those that have been changed.
287 sub get_dirty_columns {
289 return map { $_ => $self->{_column_data}{$_} }
290 keys %{$self->{_dirty_columns}};
295 $obj->set_column($col => $val);
297 Sets a column value. If the new value is different from the old one,
298 the column is marked as dirty for when you next call $obj->update.
305 $self->{_orig_ident} ||= $self->ident_condition;
306 my $old = $self->get_column($column);
307 my $ret = $self->store_column(@_);
308 $self->{_dirty_columns}{$column} = 1
309 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
315 my $copy = $orig->set_columns({ $col => $val, ... });
317 Sets more than one column value at once.
322 my ($self,$data) = @_;
323 foreach my $col (keys %$data) {
324 $self->set_column($col,$data->{$col});
331 my $copy = $orig->copy({ change => $to, ... });
333 Inserts a new row with the specified changes.
338 my ($self, $changes) = @_;
340 my $col_data = { %{$self->{_column_data}} };
341 foreach my $col (keys %$col_data) {
342 delete $col_data->{$col}
343 if $self->result_source->column_info($col)->{is_auto_increment};
346 my $new = { _column_data => $col_data };
347 bless $new, ref $self;
349 $new->result_source($self->result_source);
350 $new->set_columns($changes);
352 foreach my $rel ($self->result_source->relationships) {
353 my $rel_info = $self->result_source->relationship_info($rel);
354 if ($rel_info->{attrs}{cascade_copy}) {
355 my $resolved = $self->result_source->resolve_condition(
356 $rel_info->{cond}, $rel, $new);
357 foreach my $related ($self->search_related($rel)) {
358 $related->copy($resolved);
367 $obj->store_column($col => $val);
369 Sets a column value without marking it as dirty.
374 my ($self, $column, $value) = @_;
375 $self->throw_exception( "No such column '${column}'" )
376 unless exists $self->{_column_data}{$column} || $self->has_column($column);
377 $self->throw_exception( "set_column called for ${column} without value" )
379 return $self->{_column_data}{$column} = $value;
382 =head2 inflate_result
384 Class->inflate_result($result_source, \%me, \%prefetch?)
386 Called by ResultSet to inflate a result from storage
391 my ($class, $source, $me, $prefetch) = @_;
393 my ($source_handle) = $source;
395 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
396 $source = $source_handle->resolve
398 $source_handle = $source->handle
402 _source_handle => $source_handle,
406 bless $new, (ref $class || $class);
409 foreach my $pre (keys %{$prefetch||{}}) {
410 my $pre_val = $prefetch->{$pre};
411 my $pre_source = $source->related_source($pre);
412 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
414 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
416 foreach my $pre_rec (@$pre_val) {
417 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
418 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
421 push(@pre_objects, $pre_source->result_class->inflate_result(
422 $pre_source, @{$pre_rec}));
424 $new->related_resultset($pre)->set_cache(\@pre_objects);
425 } elsif (defined $pre_val->[0]) {
427 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
428 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
430 $fetched = $pre_source->result_class->inflate_result(
431 $pre_source, @{$pre_val});
433 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
434 $class->throw_exception("No accessor for prefetched $pre")
435 unless defined $accessor;
436 if ($accessor eq 'single') {
437 $new->{_relationship_data}{$pre} = $fetched;
438 } elsif ($accessor eq 'filter') {
439 $new->{_inflated_column}{$pre} = $fetched;
441 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
448 =head2 update_or_insert
450 $obj->update_or_insert
452 Updates the object if it's already in the db, else inserts it.
454 =head2 insert_or_update
456 $obj->insert_or_update
458 Alias for L</update_or_insert>
462 *insert_or_update = \&update_or_insert;
463 sub update_or_insert {
465 return ($self->in_storage ? $self->update : $self->insert);
470 my @changed_col_names = $obj->is_changed();
471 if ($obj->is_changed()) { ... }
473 In array context returns a list of columns with uncommited changes, or
474 in scalar context returns a true value if there are uncommitted
480 return keys %{shift->{_dirty_columns} || {}};
483 =head2 is_column_changed
485 if ($obj->is_column_changed('col')) { ... }
487 Returns a true value if the column has uncommitted changes.
491 sub is_column_changed {
492 my( $self, $col ) = @_;
493 return exists $self->{_dirty_columns}->{$col};
498 my $resultsource = $object->result_source;
500 Accessor to the ResultSource this object was created from
508 $self->_source_handle($_[0]->handle);
510 $self->_source_handle->resolve;
514 =head2 register_column
516 $column_info = { .... };
517 $class->register_column($column_name, $column_info);
519 Registers a column on the class. If the column_info has an 'accessor'
520 key, creates an accessor named after the value if defined; if there is
521 no such key, creates an accessor with the same name as the column
523 The column_info attributes are described in
524 L<DBIx::Class::ResultSource/add_columns>
528 sub register_column {
529 my ($class, $col, $info) = @_;
531 if (exists $info->{accessor}) {
532 return unless defined $info->{accessor};
533 $acc = [ $info->{accessor}, $col ];
535 $class->mk_group_accessors('column' => $acc);
539 =head2 throw_exception
541 See Schema's throw_exception.
545 sub throw_exception {
547 if (ref $self && ref $self->result_source) {
548 $self->result_source->schema->throw_exception(@_);
558 Matt S. Trout <mst@shadowcatsystems.co.uk>
562 You may distribute this code under the same terms as Perl itself.