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")
98 #use Data::Dumper; warn Dumper($self);
99 $source->storage->insert($source->from, { $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;
139 foreach my $key (keys %$upd) {
140 if (ref $upd->{$key}) {
141 my $info = $self->relationship_info($key);
142 if ($info && $info->{attrs}{accessor}
143 && $info->{attrs}{accessor} eq 'single')
145 my $rel = delete $upd->{$key};
146 $self->set_from_related($key => $rel);
147 $self->{_relationship_data}{$key} = $rel;
149 elsif ($self->has_column($key)
150 && exists $self->column_info($key)->{_inflate_info})
152 $self->set_inflated_column($key, delete $upd->{$key});
156 $self->set_columns($upd);
158 my %to_update = $self->get_dirty_columns;
159 return $self unless keys %to_update;
160 my $rows = $self->result_source->storage->update(
161 $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
163 $self->throw_exception( "Can't update ${self}: row not found" );
164 } elsif ($rows > 1) {
165 $self->throw_exception("Can't update ${self}: updated more than one row");
167 $self->{_dirty_columns} = {};
168 $self->{related_resultsets} = {};
169 undef $self->{_orig_ident};
177 Deletes the object from the database. The object is still perfectly
178 usable, but C<< ->in_storage() >> will now return 0 and the object must
179 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
180 on it. If you delete an object in a class with a C<has_many>
181 relationship, all the related objects will be deleted as well. To turn
182 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
183 hashref. Any database-level cascade or restrict will take precedence
184 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
191 $self->throw_exception( "Not in database" ) unless $self->in_storage;
192 my $ident_cond = $self->ident_condition;
193 $self->throw_exception("Cannot safely delete a row in a PK-less table")
194 if ! keys %$ident_cond;
195 foreach my $column (keys %$ident_cond) {
196 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
197 unless exists $self->{_column_data}{$column};
199 $self->result_source->storage->delete(
200 $self->result_source->from, $ident_cond);
201 $self->in_storage(undef);
203 $self->throw_exception("Can't do class delete without a ResultSource instance")
204 unless $self->can('result_source_instance');
205 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
206 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
207 $self->result_source_instance->resultset->search(@_)->delete;
214 my $val = $obj->get_column($col);
216 Gets a column value from a row object. Does not do any queries; the column
217 must have already been fetched from the database and stored in the object. If
218 there is an inflated value stored that has not yet been deflated, it is deflated
219 when the method is invoked.
224 my ($self, $column) = @_;
225 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
226 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
227 if (exists $self->{_inflated_column}{$column}) {
228 return $self->store_column($column,
229 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
231 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
235 =head2 has_column_loaded
237 if ( $obj->has_column_loaded($col) ) {
238 print "$col has been loaded from db";
241 Returns a true value if the column value has been loaded from the
242 database (or set locally).
246 sub has_column_loaded {
247 my ($self, $column) = @_;
248 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
249 return 1 if exists $self->{_inflated_column}{$column};
250 return exists $self->{_column_data}{$column};
255 my %data = $obj->get_columns;
257 Does C<get_column>, for all column values at once.
263 if (exists $self->{_inflated_column}) {
264 foreach my $col (keys %{$self->{_inflated_column}}) {
265 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
266 unless exists $self->{_column_data}{$col};
269 return %{$self->{_column_data}};
272 =head2 get_dirty_columns
274 my %data = $obj->get_dirty_columns;
276 Identical to get_columns but only returns those that have been changed.
280 sub get_dirty_columns {
282 return map { $_ => $self->{_column_data}{$_} }
283 keys %{$self->{_dirty_columns}};
288 $obj->set_column($col => $val);
290 Sets a column value. If the new value is different from the old one,
291 the column is marked as dirty for when you next call $obj->update.
298 $self->{_orig_ident} ||= $self->ident_condition;
299 my $old = $self->get_column($column);
300 my $ret = $self->store_column(@_);
301 $self->{_dirty_columns}{$column} = 1
302 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
308 my $copy = $orig->set_columns({ $col => $val, ... });
310 Sets more than one column value at once.
315 my ($self,$data) = @_;
316 foreach my $col (keys %$data) {
317 $self->set_column($col,$data->{$col});
324 my $copy = $orig->copy({ change => $to, ... });
326 Inserts a new row with the specified changes.
331 my ($self, $changes) = @_;
333 my $col_data = { %{$self->{_column_data}} };
334 foreach my $col (keys %$col_data) {
335 delete $col_data->{$col}
336 if $self->result_source->column_info($col)->{is_auto_increment};
339 my $new = { _column_data => $col_data };
340 bless $new, ref $self;
342 $new->result_source($self->result_source);
343 $new->set_columns($changes);
345 foreach my $rel ($self->result_source->relationships) {
346 my $rel_info = $self->result_source->relationship_info($rel);
347 if ($rel_info->{attrs}{cascade_copy}) {
348 my $resolved = $self->result_source->resolve_condition(
349 $rel_info->{cond}, $rel, $new);
350 foreach my $related ($self->search_related($rel)) {
351 $related->copy($resolved);
360 $obj->store_column($col => $val);
362 Sets a column value without marking it as dirty.
367 my ($self, $column, $value) = @_;
368 $self->throw_exception( "No such column '${column}'" )
369 unless exists $self->{_column_data}{$column} || $self->has_column($column);
370 $self->throw_exception( "set_column called for ${column} without value" )
372 return $self->{_column_data}{$column} = $value;
375 =head2 inflate_result
377 Class->inflate_result($result_source, \%me, \%prefetch?)
379 Called by ResultSet to inflate a result from storage
384 my ($class, $source, $me, $prefetch) = @_;
386 my ($source_handle) = $source;
388 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
389 $source = $source_handle->resolve
391 $source_handle = $source->handle
395 _source_handle => $source_handle,
399 bless $new, (ref $class || $class);
402 foreach my $pre (keys %{$prefetch||{}}) {
403 my $pre_val = $prefetch->{$pre};
404 my $pre_source = $source->related_source($pre);
405 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
407 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
409 foreach my $pre_rec (@$pre_val) {
410 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
411 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
414 push(@pre_objects, $pre_source->result_class->inflate_result(
415 $pre_source, @{$pre_rec}));
417 $new->related_resultset($pre)->set_cache(\@pre_objects);
418 } elsif (defined $pre_val->[0]) {
420 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
421 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
423 $fetched = $pre_source->result_class->inflate_result(
424 $pre_source, @{$pre_val});
426 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
427 $class->throw_exception("No accessor for prefetched $pre")
428 unless defined $accessor;
429 if ($accessor eq 'single') {
430 $new->{_relationship_data}{$pre} = $fetched;
431 } elsif ($accessor eq 'filter') {
432 $new->{_inflated_column}{$pre} = $fetched;
434 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
441 =head2 update_or_insert
443 $obj->update_or_insert
445 Updates the object if it's already in the db, else inserts it.
447 =head2 insert_or_update
449 $obj->insert_or_update
451 Alias for L</update_or_insert>
455 *insert_or_update = \&update_or_insert;
456 sub update_or_insert {
458 return ($self->in_storage ? $self->update : $self->insert);
463 my @changed_col_names = $obj->is_changed();
464 if ($obj->is_changed()) { ... }
466 In array context returns a list of columns with uncommited changes, or
467 in scalar context returns a true value if there are uncommitted
473 return keys %{shift->{_dirty_columns} || {}};
476 =head2 is_column_changed
478 if ($obj->is_column_changed('col')) { ... }
480 Returns a true value if the column has uncommitted changes.
484 sub is_column_changed {
485 my( $self, $col ) = @_;
486 return exists $self->{_dirty_columns}->{$col};
491 my $resultsource = $object->result_source;
493 Accessor to the ResultSource this object was created from
501 $self->_source_handle($_[0]->handle);
503 $self->_source_handle->resolve;
507 =head2 register_column
509 $column_info = { .... };
510 $class->register_column($column_name, $column_info);
512 Registers a column on the class. If the column_info has an 'accessor'
513 key, creates an accessor named after the value if defined; if there is
514 no such key, creates an accessor with the same name as the column
516 The column_info attributes are described in
517 L<DBIx::Class::ResultSource/add_columns>
521 sub register_column {
522 my ($class, $col, $info) = @_;
524 if (exists $info->{accessor}) {
525 return unless defined $info->{accessor};
526 $acc = [ $info->{accessor}, $col ];
528 $class->mk_group_accessors('column' => $acc);
532 =head2 throw_exception
534 See Schema's throw_exception.
538 sub throw_exception {
540 if (ref $self && ref $self->result_source) {
541 $self->result_source->schema->throw_exception(@_);
551 Matt S. Trout <mst@shadowcatsystems.co.uk>
555 You may distribute this code under the same terms as Perl itself.