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")
77 #use Data::Dumper; warn Dumper($self);
78 $source->storage->insert($source->from, { $self->get_columns });
80 $self->{_dirty_columns} = {};
81 $self->{related_resultsets} = {};
87 $obj->in_storage; # Get value
88 $obj->in_storage(1); # Set value
90 Indicated whether the object exists as a row in the database or not
95 my ($self, $val) = @_;
96 $self->{_in_storage} = $val if @_ > 1;
97 return $self->{_in_storage};
104 Must be run on an object that is already in the database; issues an SQL
105 UPDATE query to commit any changes to the object to the database if
111 my ($self, $upd) = @_;
112 $self->throw_exception( "Not in database" ) unless $self->in_storage;
113 my $ident_cond = $self->ident_condition;
114 $self->throw_exception("Cannot safely update a row in a PK-less table")
115 if ! keys %$ident_cond;
116 $self->set_columns($upd) if $upd;
117 my %to_update = $self->get_dirty_columns;
118 return $self unless keys %to_update;
119 my $rows = $self->result_source->storage->update(
120 $self->result_source->from, \%to_update, $ident_cond);
122 $self->throw_exception( "Can't update ${self}: row not found" );
123 } elsif ($rows > 1) {
124 $self->throw_exception("Can't update ${self}: updated more than one row");
126 $self->{_dirty_columns} = {};
127 $self->{related_resultsets} = {};
135 Deletes the object from the database. The object is still perfectly
136 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
137 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
138 on it. If you delete an object in a class with a C<has_many>
139 relationship, all the related objects will be deleted as well. To turn
140 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
141 hashref. Any database-level cascade or restrict will take precedence
142 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
149 $self->throw_exception( "Not in database" ) unless $self->in_storage;
150 my $ident_cond = $self->ident_condition;
151 $self->throw_exception("Cannot safely delete a row in a PK-less table")
152 if ! keys %$ident_cond;
153 foreach my $column (keys %$ident_cond) {
154 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
155 unless exists $self->{_column_data}{$column};
157 $self->result_source->storage->delete(
158 $self->result_source->from, $ident_cond);
159 $self->in_storage(undef);
161 $self->throw_exception("Can't do class delete without a ResultSource instance")
162 unless $self->can('result_source_instance');
163 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
164 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
165 $self->result_source_instance->resultset->search(@_)->delete;
172 my $val = $obj->get_column($col);
174 Gets a column value from a row object. Currently, does not do
175 any queries; the column must have already been fetched from
176 the database and stored in the object.
181 my ($self, $column) = @_;
182 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
183 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
184 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
188 =head2 has_column_loaded
190 if ( $obj->has_column_loaded($col) ) {
191 print "$col has been loaded from db";
194 Returns a true value if the column value has been loaded from the
195 database (or set locally).
199 sub has_column_loaded {
200 my ($self, $column) = @_;
201 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
202 return exists $self->{_column_data}{$column};
207 my %data = $obj->get_columns;
209 Does C<get_column>, for all column values at once.
215 return %{$self->{_column_data}};
218 =head2 get_dirty_columns
220 my %data = $obj->get_dirty_columns;
222 Identical to get_columns but only returns those that have been changed.
226 sub get_dirty_columns {
228 return map { $_ => $self->{_column_data}{$_} }
229 keys %{$self->{_dirty_columns}};
234 $obj->set_column($col => $val);
236 Sets a column value. If the new value is different from the old one,
237 the column is marked as dirty for when you next call $obj->update.
244 my $old = $self->get_column($column);
245 my $ret = $self->store_column(@_);
246 $self->{_dirty_columns}{$column} = 1
247 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
253 my $copy = $orig->set_columns({ $col => $val, ... });
255 Sets more than one column value at once.
260 my ($self,$data) = @_;
261 foreach my $col (keys %$data) {
262 $self->set_column($col,$data->{$col});
269 my $copy = $orig->copy({ change => $to, ... });
271 Inserts a new row with the specified changes.
276 my ($self, $changes) = @_;
278 my $col_data = { %{$self->{_column_data}} };
279 foreach my $col (keys %$col_data) {
280 delete $col_data->{$col}
281 if $self->result_source->column_info($col)->{is_auto_increment};
284 my $new = { _column_data => $col_data };
285 bless $new, ref $self;
287 $new->result_source($self->result_source);
288 $new->set_columns($changes);
290 foreach my $rel ($self->result_source->relationships) {
291 my $rel_info = $self->result_source->relationship_info($rel);
292 if ($rel_info->{attrs}{cascade_copy}) {
293 my $resolved = $self->result_source->resolve_condition(
294 $rel_info->{cond}, $rel, $new);
295 foreach my $related ($self->search_related($rel)) {
296 $related->copy($resolved);
305 $obj->store_column($col => $val);
307 Sets a column value without marking it as dirty.
312 my ($self, $column, $value) = @_;
313 $self->throw_exception( "No such column '${column}'" )
314 unless exists $self->{_column_data}{$column} || $self->has_column($column);
315 $self->throw_exception( "set_column called for ${column} without value" )
317 return $self->{_column_data}{$column} = $value;
320 =head2 inflate_result
322 Class->inflate_result($result_source, \%me, \%prefetch?)
324 Called by ResultSet to inflate a result from storage
329 my ($class, $source, $me, $prefetch) = @_;
330 #use Data::Dumper; print Dumper(@_);
332 result_source => $source,
336 bless $new, (ref $class || $class);
339 foreach my $pre (keys %{$prefetch||{}}) {
340 my $pre_val = $prefetch->{$pre};
341 my $pre_source = $source->related_source($pre);
342 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
344 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
346 foreach my $pre_rec (@$pre_val) {
347 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
348 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
351 push(@pre_objects, $pre_source->result_class->inflate_result(
352 $pre_source, @{$pre_rec}));
354 $new->related_resultset($pre)->set_cache(\@pre_objects);
355 } elsif (defined $pre_val->[0]) {
357 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
358 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
360 $fetched = $pre_source->result_class->inflate_result(
361 $pre_source, @{$pre_val});
363 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
364 $class->throw_exception("No accessor for prefetched $pre")
365 unless defined $accessor;
366 if ($accessor eq 'single') {
367 $new->{_relationship_data}{$pre} = $fetched;
368 } elsif ($accessor eq 'filter') {
369 $new->{_inflated_column}{$pre} = $fetched;
371 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
378 =head2 update_or_insert
380 $obj->update_or_insert
382 Updates the object if it's already in the db, else inserts it.
384 =head2 insert_or_update
386 $obj->insert_or_update
388 Alias for L</update_or_insert>
392 *insert_or_update = \&update_or_insert;
393 sub update_or_insert {
395 return ($self->in_storage ? $self->update : $self->insert);
400 my @changed_col_names = $obj->is_changed();
401 if ($obj->is_changed()) { ... }
403 In array context returns a list of columns with uncommited changes, or
404 in scalar context returns a true value if there are uncommitted
410 return keys %{shift->{_dirty_columns} || {}};
413 =head2 is_column_changed
415 if ($obj->is_column_changed('col')) { ... }
417 Returns a true value if the column has uncommitted changes.
421 sub is_column_changed {
422 my( $self, $col ) = @_;
423 return exists $self->{_dirty_columns}->{$col};
428 my $resultsource = $object->result_source;
430 Accessor to the ResultSource this object was created from
432 =head2 register_column
434 $column_info = { .... };
435 $class->register_column($column_name, $column_info);
437 Registers a column on the class. If the column_info has an 'accessor'
438 key, creates an accessor named after the value if defined; if there is
439 no such key, creates an accessor with the same name as the column
441 The column_info attributes are described in
442 L<DBIx::Class::ResultSource/add_columns>
446 sub register_column {
447 my ($class, $col, $info) = @_;
449 if (exists $info->{accessor}) {
450 return unless defined $info->{accessor};
451 $acc = [ $info->{accessor}, $col ];
453 $class->mk_group_accessors('column' => $acc);
457 =head2 throw_exception
459 See Schema's throw_exception.
463 sub throw_exception {
465 if (ref $self && ref $self->result_source) {
466 $self->result_source->schema->throw_exception(@_);
476 Matt S. Trout <mst@shadowcatsystems.co.uk>
480 You may distribute this code under the same terms as Perl itself.