1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
7 use Carp::Clan qw/^DBIx::Class/;
9 __PACKAGE__->mk_group_accessors('simple' => 'result_source');
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 => {} };
40 $new->throw_exception("attrs must be a hashref")
41 unless ref($attrs) eq 'HASH';
42 if (my $source = delete $attrs->{-result_source}) {
43 $new->result_source($source);
46 my ($related,$inflated);
47 foreach my $key (keys %$attrs) {
48 if (ref $attrs->{$key}) {
49 my $info = $class->relationship_info($key);
50 if ($info && $info->{attrs}{accessor}
51 && $info->{attrs}{accessor} eq 'single')
53 $new->set_from_related($key, $attrs->{$key});
54 $related->{$key} = $attrs->{$key};
57 elsif ($class->has_column($key)
58 && exists $class->column_info($key)->{_inflate_info})
60 $inflated->{$key} = $attrs->{$key};
64 $new->throw_exception("No such column $key on $class")
65 unless $class->has_column($key);
66 $new->store_column($key => $attrs->{$key});
68 $new->{_relationship_data} = $related if $related;
69 $new->{_inflated_column} = $inflated if $inflated;
79 Inserts an object into the database if it isn't already in
80 there. Returns the object itself. Requires the object's result source to
81 be set, or the class to have a result_source_instance method. To insert
82 an entirely new object into the database, use C<create> (see
83 L<DBIx::Class::ResultSet/create>).
89 return $self if $self->in_storage;
90 $self->{result_source} ||= $self->result_source_instance
91 if $self->can('result_source_instance');
92 my $source = $self->{result_source};
93 $self->throw_exception("No result_source set on this object; can't insert")
95 #use Data::Dumper; warn Dumper($self);
96 $source->storage->insert($source->from, { $self->get_columns });
98 $self->{_dirty_columns} = {};
99 $self->{related_resultsets} = {};
105 $obj->in_storage; # Get value
106 $obj->in_storage(1); # Set value
108 Indicated whether the object exists as a row in the database or not
113 my ($self, $val) = @_;
114 $self->{_in_storage} = $val if @_ > 1;
115 return $self->{_in_storage};
122 Must be run on an object that is already in the database; issues an SQL
123 UPDATE query to commit any changes to the object to the database if
129 my ($self, $upd) = @_;
130 $self->throw_exception( "Not in database" ) unless $self->in_storage;
131 my $ident_cond = $self->ident_condition;
132 $self->throw_exception("Cannot safely update a row in a PK-less table")
133 if ! keys %$ident_cond;
135 foreach my $key (keys %$upd) {
136 if (ref $upd->{$key}) {
137 my $info = $self->relationship_info($key);
138 if ($info && $info->{attrs}{accessor}
139 && $info->{attrs}{accessor} eq 'single')
141 my $rel = delete $upd->{$key};
142 $self->set_from_related($key => $rel);
143 $self->{_relationship_data}{$key} = $rel;
145 elsif ($self->has_column($key)
146 && exists $self->column_info($key)->{_inflate_info})
148 $self->set_inflated_column($key, delete $upd->{$key});
152 $self->set_columns($upd);
154 my %to_update = $self->get_dirty_columns;
155 return $self unless keys %to_update;
156 my $rows = $self->result_source->storage->update(
157 $self->result_source->from, \%to_update, $ident_cond);
159 $self->throw_exception( "Can't update ${self}: row not found" );
160 } elsif ($rows > 1) {
161 $self->throw_exception("Can't update ${self}: updated more than one row");
163 $self->{_dirty_columns} = {};
164 $self->{related_resultsets} = {};
172 Deletes the object from the database. The object is still perfectly
173 usable, but C<< ->in_storage() >> will now return 0 and the object must
174 reinserted using C<< ->insert() >> before C<< ->update() >> can be used
175 on it. If you delete an object in a class with a C<has_many>
176 relationship, all the related objects will be deleted as well. To turn
177 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
178 hashref. Any database-level cascade or restrict will take precedence
179 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
186 $self->throw_exception( "Not in database" ) unless $self->in_storage;
187 my $ident_cond = $self->ident_condition;
188 $self->throw_exception("Cannot safely delete a row in a PK-less table")
189 if ! keys %$ident_cond;
190 foreach my $column (keys %$ident_cond) {
191 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
192 unless exists $self->{_column_data}{$column};
194 $self->result_source->storage->delete(
195 $self->result_source->from, $ident_cond);
196 $self->in_storage(undef);
198 $self->throw_exception("Can't do class delete without a ResultSource instance")
199 unless $self->can('result_source_instance');
200 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
201 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
202 $self->result_source_instance->resultset->search(@_)->delete;
209 my $val = $obj->get_column($col);
211 Gets a column value from a row object. Does not do any queries; the column
212 must have already been fetched from the database and stored in the object. If
213 there is an inflated value stored that has not yet been deflated, it is deflated
214 when the method is invoked.
219 my ($self, $column) = @_;
220 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
221 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
222 if (exists $self->{_inflated_column}{$column}) {
223 return $self->store_column($column,
224 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
226 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
230 =head2 has_column_loaded
232 if ( $obj->has_column_loaded($col) ) {
233 print "$col has been loaded from db";
236 Returns a true value if the column value has been loaded from the
237 database (or set locally).
241 sub has_column_loaded {
242 my ($self, $column) = @_;
243 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
244 return 1 if exists $self->{_inflated_column}{$column};
245 return exists $self->{_column_data}{$column};
250 my %data = $obj->get_columns;
252 Does C<get_column>, for all column values at once.
258 if (exists $self->{_inflated_column}) {
259 foreach my $col (keys %{$self->{_inflated_column}}) {
260 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
261 unless exists $self->{_column_data}{$col};
264 return %{$self->{_column_data}};
267 =head2 get_dirty_columns
269 my %data = $obj->get_dirty_columns;
271 Identical to get_columns but only returns those that have been changed.
275 sub get_dirty_columns {
277 return map { $_ => $self->{_column_data}{$_} }
278 keys %{$self->{_dirty_columns}};
283 $obj->set_column($col => $val);
285 Sets a column value. If the new value is different from the old one,
286 the column is marked as dirty for when you next call $obj->update.
293 my $old = $self->get_column($column);
294 my $ret = $self->store_column(@_);
295 $self->{_dirty_columns}{$column} = 1
296 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
302 my $copy = $orig->set_columns({ $col => $val, ... });
304 Sets more than one column value at once.
309 my ($self,$data) = @_;
310 foreach my $col (keys %$data) {
311 $self->set_column($col,$data->{$col});
318 my $copy = $orig->copy({ change => $to, ... });
320 Inserts a new row with the specified changes.
325 my ($self, $changes) = @_;
327 my $col_data = { %{$self->{_column_data}} };
328 foreach my $col (keys %$col_data) {
329 delete $col_data->{$col}
330 if $self->result_source->column_info($col)->{is_auto_increment};
333 my $new = { _column_data => $col_data };
334 bless $new, ref $self;
336 $new->result_source($self->result_source);
337 $new->set_columns($changes);
339 foreach my $rel ($self->result_source->relationships) {
340 my $rel_info = $self->result_source->relationship_info($rel);
341 if ($rel_info->{attrs}{cascade_copy}) {
342 my $resolved = $self->result_source->resolve_condition(
343 $rel_info->{cond}, $rel, $new);
344 foreach my $related ($self->search_related($rel)) {
345 $related->copy($resolved);
354 $obj->store_column($col => $val);
356 Sets a column value without marking it as dirty.
361 my ($self, $column, $value) = @_;
362 $self->throw_exception( "No such column '${column}'" )
363 unless exists $self->{_column_data}{$column} || $self->has_column($column);
364 $self->throw_exception( "set_column called for ${column} without value" )
366 return $self->{_column_data}{$column} = $value;
369 =head2 inflate_result
371 Class->inflate_result($result_source, \%me, \%prefetch?)
373 Called by ResultSet to inflate a result from storage
378 my ($class, $source, $me, $prefetch) = @_;
379 #use Data::Dumper; print Dumper(@_);
381 result_source => $source,
385 bless $new, (ref $class || $class);
388 foreach my $pre (keys %{$prefetch||{}}) {
389 my $pre_val = $prefetch->{$pre};
390 my $pre_source = $source->related_source($pre);
391 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
393 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
395 foreach my $pre_rec (@$pre_val) {
396 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
397 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
400 push(@pre_objects, $pre_source->result_class->inflate_result(
401 $pre_source, @{$pre_rec}));
403 $new->related_resultset($pre)->set_cache(\@pre_objects);
404 } elsif (defined $pre_val->[0]) {
406 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
407 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
409 $fetched = $pre_source->result_class->inflate_result(
410 $pre_source, @{$pre_val});
412 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
413 $class->throw_exception("No accessor for prefetched $pre")
414 unless defined $accessor;
415 if ($accessor eq 'single') {
416 $new->{_relationship_data}{$pre} = $fetched;
417 } elsif ($accessor eq 'filter') {
418 $new->{_inflated_column}{$pre} = $fetched;
420 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
427 =head2 update_or_insert
429 $obj->update_or_insert
431 Updates the object if it's already in the db, else inserts it.
433 =head2 insert_or_update
435 $obj->insert_or_update
437 Alias for L</update_or_insert>
441 *insert_or_update = \&update_or_insert;
442 sub update_or_insert {
444 return ($self->in_storage ? $self->update : $self->insert);
449 my @changed_col_names = $obj->is_changed();
450 if ($obj->is_changed()) { ... }
452 In array context returns a list of columns with uncommited changes, or
453 in scalar context returns a true value if there are uncommitted
459 return keys %{shift->{_dirty_columns} || {}};
462 =head2 is_column_changed
464 if ($obj->is_column_changed('col')) { ... }
466 Returns a true value if the column has uncommitted changes.
470 sub is_column_changed {
471 my( $self, $col ) = @_;
472 return exists $self->{_dirty_columns}->{$col};
477 my $resultsource = $object->result_source;
479 Accessor to the ResultSource this object was created from
481 =head2 register_column
483 $column_info = { .... };
484 $class->register_column($column_name, $column_info);
486 Registers a column on the class. If the column_info has an 'accessor'
487 key, creates an accessor named after the value if defined; if there is
488 no such key, creates an accessor with the same name as the column
490 The column_info attributes are described in
491 L<DBIx::Class::ResultSource/add_columns>
495 sub register_column {
496 my ($class, $col, $info) = @_;
498 if (exists $info->{accessor}) {
499 return unless defined $info->{accessor};
500 $acc = [ $info->{accessor}, $col ];
502 $class->mk_group_accessors('column' => $acc);
506 =head2 throw_exception
508 See Schema's throw_exception.
512 sub throw_exception {
514 if (ref $self && ref $self->result_source) {
515 $self->result_source->schema->throw_exception(@_);
525 Matt S. Trout <mst@shadowcatsystems.co.uk>
529 You may distribute this code under the same terms as Perl itself.