1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
7 use Carp::Clan qw/^DBIx::Class/;
9 __PACKAGE__->load_components(qw/AccessorGroup/);
11 __PACKAGE__->mk_group_accessors('simple' => 'result_source');
15 DBIx::Class::Row - Basic row methods
21 This class is responsible for defining and doing basic operations on rows
22 derived from L<DBIx::Class::ResultSource> objects.
28 my $obj = My::Class->new($attrs);
30 Creates a new row object from column => value mappings passed as a hash ref
35 my ($class, $attrs) = @_;
36 $class = ref $class if ref $class;
38 my $new = { _column_data => {} };
42 $new->throw_exception("attrs must be a hashref")
43 unless ref($attrs) eq 'HASH';
44 if (my $source = delete $attrs->{-result_source}) {
45 $new->result_source($source);
47 foreach my $k (keys %$attrs) {
48 $new->throw_exception("No such column $k on $class")
49 unless $class->has_column($k);
50 $new->store_column($k => $attrs->{$k});
61 Inserts an object into the database if it isn't already in
62 there. Returns the object itself. Requires the object's result source to
63 be set, or the class to have a result_source_instance method. To insert
64 an entirely new object into the database, use C<create> (see
65 L<DBIx::Class::ResultSet/create>).
71 return $self if $self->in_storage;
72 $self->{result_source} ||= $self->result_source_instance
73 if $self->can('result_source_instance');
74 my $source = $self->{result_source};
75 $self->throw_exception("No result_source set on this object; can't insert")
79 foreach my $column ($self->result_source->columns) {
81 $bind_attributes->{$column} = $self->result_source->column_info($column)->{bind_attributes}
82 if defined $self->result_source->column_info($column)->{bind_attributes};
84 $self->result_source->storage->bind_attributes($bind_attributes);
86 $source->storage->insert($source->from, { $self->get_columns });
88 $self->{_dirty_columns} = {};
89 $self->{related_resultsets} = {};
95 $obj->in_storage; # Get value
96 $obj->in_storage(1); # Set value
98 Indicated whether the object exists as a row in the database or not
103 my ($self, $val) = @_;
104 $self->{_in_storage} = $val if @_ > 1;
105 return $self->{_in_storage};
112 Must be run on an object that is already in the database; issues an SQL
113 UPDATE query to commit any changes to the object to the database if
119 my ($self, $upd) = @_;
120 $self->throw_exception( "Not in database" ) unless $self->in_storage;
121 $self->set_columns($upd) if $upd;
122 my %to_update = $self->get_dirty_columns;
123 return $self unless keys %to_update;
124 my $ident_cond = $self->ident_condition;
125 $self->throw_exception("Cannot safely update a row in a PK-less table")
126 if ! keys %$ident_cond;
129 foreach my $column ($self->result_source->columns) {
131 $bind_attributes->{$column} = $self->result_source->column_info($column)->{bind_attributes}
132 if defined $self->result_source->column_info($column)->{bind_attributes};
134 $self->result_source->storage->bind_attributes($bind_attributes);
136 my $rows = $self->result_source->storage->update(
137 $self->result_source->from, \%to_update, $ident_cond);
139 $self->throw_exception( "Can't update ${self}: row not found" );
140 } elsif ($rows > 1) {
141 $self->throw_exception("Can't update ${self}: updated more than one row");
143 $self->{_dirty_columns} = {};
144 $self->{related_resultsets} = {};
152 Deletes the object from the database. The object is still perfectly
153 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
154 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
155 on it. If you delete an object in a class with a C<has_many>
156 relationship, all the related objects will be deleted as well. To turn
157 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
158 hashref. Any database-level cascade or restrict will take precedence
159 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
166 $self->throw_exception( "Not in database" ) unless $self->in_storage;
167 my $ident_cond = $self->ident_condition;
168 $self->throw_exception("Cannot safely delete a row in a PK-less table")
169 if ! keys %$ident_cond;
170 foreach my $column (keys %$ident_cond) {
171 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
172 unless exists $self->{_column_data}{$column};
174 $self->result_source->storage->delete(
175 $self->result_source->from, $ident_cond);
176 $self->in_storage(undef);
178 $self->throw_exception("Can't do class delete without a ResultSource instance")
179 unless $self->can('result_source_instance');
180 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
181 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
182 $self->result_source_instance->resultset->search(@_)->delete;
189 my $val = $obj->get_column($col);
191 Gets a column value from a row object. Currently, does not do
192 any queries; the column must have already been fetched from
193 the database and stored in the object.
198 my ($self, $column) = @_;
199 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
200 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
201 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
205 =head2 has_column_loaded
207 if ( $obj->has_column_loaded($col) ) {
208 print "$col has been loaded from db";
211 Returns a true value if the column value has been loaded from the
212 database (or set locally).
216 sub has_column_loaded {
217 my ($self, $column) = @_;
218 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
219 return exists $self->{_column_data}{$column};
224 my %data = $obj->get_columns;
226 Does C<get_column>, for all column values at once.
232 return %{$self->{_column_data}};
235 =head2 get_dirty_columns
237 my %data = $obj->get_dirty_columns;
239 Identical to get_columns but only returns those that have been changed.
243 sub get_dirty_columns {
245 return map { $_ => $self->{_column_data}{$_} }
246 keys %{$self->{_dirty_columns}};
251 $obj->set_column($col => $val);
253 Sets a column value. If the new value is different from the old one,
254 the column is marked as dirty for when you next call $obj->update.
261 my $old = $self->get_column($column);
262 my $ret = $self->store_column(@_);
263 $self->{_dirty_columns}{$column} = 1
264 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
270 my $copy = $orig->set_columns({ $col => $val, ... });
272 Sets more than one column value at once.
277 my ($self,$data) = @_;
278 foreach my $col (keys %$data) {
279 $self->set_column($col,$data->{$col});
286 my $copy = $orig->copy({ change => $to, ... });
288 Inserts a new row with the specified changes.
293 my ($self, $changes) = @_;
295 my $col_data = { %{$self->{_column_data}} };
296 foreach my $col (keys %$col_data) {
297 delete $col_data->{$col}
298 if $self->result_source->column_info($col)->{is_auto_increment};
301 my $new = { _column_data => $col_data };
302 bless $new, ref $self;
304 $new->result_source($self->result_source);
305 $new->set_columns($changes);
307 foreach my $rel ($self->result_source->relationships) {
308 my $rel_info = $self->result_source->relationship_info($rel);
309 if ($rel_info->{attrs}{cascade_copy}) {
310 my $resolved = $self->result_source->resolve_condition(
311 $rel_info->{cond}, $rel, $new);
312 foreach my $related ($self->search_related($rel)) {
313 $related->copy($resolved);
322 $obj->store_column($col => $val);
324 Sets a column value without marking it as dirty.
329 my ($self, $column, $value) = @_;
330 $self->throw_exception( "No such column '${column}'" )
331 unless exists $self->{_column_data}{$column} || $self->has_column($column);
332 $self->throw_exception( "set_column called for ${column} without value" )
334 return $self->{_column_data}{$column} = $value;
337 =head2 inflate_result
339 Class->inflate_result($result_source, \%me, \%prefetch?)
341 Called by ResultSet to inflate a result from storage
346 my ($class, $source, $me, $prefetch) = @_;
347 #use Data::Dumper; print Dumper(@_);
349 result_source => $source,
353 bless $new, (ref $class || $class);
356 foreach my $pre (keys %{$prefetch||{}}) {
357 my $pre_val = $prefetch->{$pre};
358 my $pre_source = $source->related_source($pre);
359 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
361 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
363 foreach my $pre_rec (@$pre_val) {
364 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
365 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
368 push(@pre_objects, $pre_source->result_class->inflate_result(
369 $pre_source, @{$pre_rec}));
371 $new->related_resultset($pre)->set_cache(\@pre_objects);
372 } elsif (defined $pre_val->[0]) {
374 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
375 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
377 $fetched = $pre_source->result_class->inflate_result(
378 $pre_source, @{$pre_val});
380 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
381 $class->throw_exception("No accessor for prefetched $pre")
382 unless defined $accessor;
383 if ($accessor eq 'single') {
384 $new->{_relationship_data}{$pre} = $fetched;
385 } elsif ($accessor eq 'filter') {
386 $new->{_inflated_column}{$pre} = $fetched;
388 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
395 =head2 update_or_insert
397 $obj->update_or_insert
399 Updates the object if it's already in the db, else inserts it.
401 =head2 insert_or_update
403 $obj->insert_or_update
405 Alias for L</update_or_insert>
409 *insert_or_update = \&update_or_insert;
410 sub update_or_insert {
412 return ($self->in_storage ? $self->update : $self->insert);
417 my @changed_col_names = $obj->is_changed();
418 if ($obj->is_changed()) { ... }
420 In array context returns a list of columns with uncommited changes, or
421 in scalar context returns a true value if there are uncommitted
427 return keys %{shift->{_dirty_columns} || {}};
430 =head2 is_column_changed
432 if ($obj->is_column_changed('col')) { ... }
434 Returns a true value if the column has uncommitted changes.
438 sub is_column_changed {
439 my( $self, $col ) = @_;
440 return exists $self->{_dirty_columns}->{$col};
445 my $resultsource = $object->result_source;
447 Accessor to the ResultSource this object was created from
449 =head2 register_column
451 $column_info = { .... };
452 $class->register_column($column_name, $column_info);
454 Registers a column on the class. If the column_info has an 'accessor'
455 key, creates an accessor named after the value if defined; if there is
456 no such key, creates an accessor with the same name as the column
458 The column_info attributes are described in
459 L<DBIx::Class::ResultSource/add_columns>
463 sub register_column {
464 my ($class, $col, $info) = @_;
466 if (exists $info->{accessor}) {
467 return unless defined $info->{accessor};
468 $acc = [ $info->{accessor}, $col ];
470 $class->mk_group_accessors('column' => $acc);
474 =head2 throw_exception
476 See Schema's throw_exception.
480 sub throw_exception {
482 if (ref $self && ref $self->result_source) {
483 $self->result_source->schema->throw_exception(@_);
493 Matt S. Trout <mst@shadowcatsystems.co.uk>
497 You may distribute this code under the same terms as Perl itself.