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) = @_;
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->{-source_handle}) {
43 $new->_source_handle($source);
45 foreach my $k (keys %$attrs) {
46 $new->throw_exception("No such column $k on $class")
47 unless $class->has_column($k);
48 $new->store_column($k => $attrs->{$k});
59 Inserts an object into the database if it isn't already in
60 there. Returns the object itself. Requires the object's result source to
61 be set, or the class to have a result_source_instance method. To insert
62 an entirely new object into the database, use C<create> (see
63 L<DBIx::Class::ResultSet/create>).
69 return $self if $self->in_storage;
70 $self->{result_source} ||= $self->result_source_instance
71 if $self->can('result_source_instance');
72 my $source = $self->{result_source};
73 $self->throw_exception("No result_source set on this object; can't insert")
75 #use Data::Dumper; warn Dumper($self);
76 $source->storage->insert($source->from, { $self->get_columns });
78 $self->{_dirty_columns} = {};
79 $self->{related_resultsets} = {};
85 $obj->in_storage; # Get value
86 $obj->in_storage(1); # Set value
88 Indicated whether the object exists as a row in the database or not
93 my ($self, $val) = @_;
94 $self->{_in_storage} = $val if @_ > 1;
95 return $self->{_in_storage};
102 Must be run on an object that is already in the database; issues an SQL
103 UPDATE query to commit any changes to the object to the database if
109 my ($self, $upd) = @_;
110 $self->throw_exception( "Not in database" ) unless $self->in_storage;
111 $self->set_columns($upd) if $upd;
112 my %to_update = $self->get_dirty_columns;
113 return $self unless keys %to_update;
114 my $ident_cond = $self->ident_condition;
115 $self->throw_exception("Cannot safely update a row in a PK-less table")
116 if ! keys %$ident_cond;
117 my $rows = $self->result_source->storage->update(
118 $self->result_source->from, \%to_update, $ident_cond);
120 $self->throw_exception( "Can't update ${self}: row not found" );
121 } elsif ($rows > 1) {
122 $self->throw_exception("Can't update ${self}: updated more than one row");
124 $self->{_dirty_columns} = {};
125 $self->{related_resultsets} = {};
133 Deletes the object from the database. The object is still perfectly
134 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
135 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
136 on it. If you delete an object in a class with a C<has_many>
137 relationship, all the related objects will be deleted as well. To turn
138 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
139 hashref. Any database-level cascade or restrict will take precedence
140 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
147 $self->throw_exception( "Not in database" ) unless $self->in_storage;
148 my $ident_cond = $self->ident_condition;
149 $self->throw_exception("Cannot safely delete a row in a PK-less table")
150 if ! keys %$ident_cond;
151 foreach my $column (keys %$ident_cond) {
152 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
153 unless exists $self->{_column_data}{$column};
155 $self->result_source->storage->delete(
156 $self->result_source->from, $ident_cond);
157 $self->in_storage(undef);
159 $self->throw_exception("Can't do class delete without a ResultSource instance")
160 unless $self->can('result_source_instance');
161 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
162 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
163 $self->result_source_instance->resultset->search(@_)->delete;
170 my $val = $obj->get_column($col);
172 Gets a column value from a row object. Currently, does not do
173 any queries; the column must have already been fetched from
174 the database and stored in the object.
179 my ($self, $column) = @_;
180 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
181 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
182 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
186 =head2 has_column_loaded
188 if ( $obj->has_column_loaded($col) ) {
189 print "$col has been loaded from db";
192 Returns a true value if the column value has been loaded from the
193 database (or set locally).
197 sub has_column_loaded {
198 my ($self, $column) = @_;
199 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
200 return exists $self->{_column_data}{$column};
205 my %data = $obj->get_columns;
207 Does C<get_column>, for all column values at once.
213 return %{$self->{_column_data}};
216 =head2 get_dirty_columns
218 my %data = $obj->get_dirty_columns;
220 Identical to get_columns but only returns those that have been changed.
224 sub get_dirty_columns {
226 return map { $_ => $self->{_column_data}{$_} }
227 keys %{$self->{_dirty_columns}};
232 $obj->set_column($col => $val);
234 Sets a column value. If the new value is different from the old one,
235 the column is marked as dirty for when you next call $obj->update.
242 my $old = $self->get_column($column);
243 my $ret = $self->store_column(@_);
244 $self->{_dirty_columns}{$column} = 1
245 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
251 my $copy = $orig->set_columns({ $col => $val, ... });
253 Sets more than one column value at once.
258 my ($self,$data) = @_;
259 foreach my $col (keys %$data) {
260 $self->set_column($col,$data->{$col});
267 my $copy = $orig->copy({ change => $to, ... });
269 Inserts a new row with the specified changes.
274 my ($self, $changes) = @_;
276 my $col_data = { %{$self->{_column_data}} };
277 foreach my $col (keys %$col_data) {
278 delete $col_data->{$col}
279 if $self->result_source->column_info($col)->{is_auto_increment};
282 my $new = { _column_data => $col_data };
283 bless $new, ref $self;
285 $new->result_source($self->result_source);
286 $new->set_columns($changes);
288 foreach my $rel ($self->result_source->relationships) {
289 my $rel_info = $self->result_source->relationship_info($rel);
290 if ($rel_info->{attrs}{cascade_copy}) {
291 my $resolved = $self->result_source->resolve_condition(
292 $rel_info->{cond}, $rel, $new);
293 foreach my $related ($self->search_related($rel)) {
294 $related->copy($resolved);
303 $obj->store_column($col => $val);
305 Sets a column value without marking it as dirty.
310 my ($self, $column, $value) = @_;
311 $self->throw_exception( "No such column '${column}'" )
312 unless exists $self->{_column_data}{$column} || $self->has_column($column);
313 $self->throw_exception( "set_column called for ${column} without value" )
315 return $self->{_column_data}{$column} = $value;
318 =head2 inflate_result
320 Class->inflate_result($result_source, \%me, \%prefetch?)
322 Called by ResultSet to inflate a result from storage
327 my ($class, $source, $me, $prefetch) = @_;
329 my ($source_handle) = $source;
331 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
332 $source = $source_handle->resolve
334 $source_handle = $source->handle
338 _source_handle => $source_handle,
342 bless $new, (ref $class || $class);
345 foreach my $pre (keys %{$prefetch||{}}) {
346 my $pre_val = $prefetch->{$pre};
347 my $pre_source = $source->related_source($pre);
348 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
350 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
352 foreach my $pre_rec (@$pre_val) {
353 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
354 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
357 push(@pre_objects, $pre_source->result_class->inflate_result(
358 $pre_source, @{$pre_rec}));
360 $new->related_resultset($pre)->set_cache(\@pre_objects);
361 } elsif (defined $pre_val->[0]) {
363 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
364 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
366 $fetched = $pre_source->result_class->inflate_result(
367 $pre_source, @{$pre_val});
369 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
370 $class->throw_exception("No accessor for prefetched $pre")
371 unless defined $accessor;
372 if ($accessor eq 'single') {
373 $new->{_relationship_data}{$pre} = $fetched;
374 } elsif ($accessor eq 'filter') {
375 $new->{_inflated_column}{$pre} = $fetched;
377 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
384 =head2 update_or_insert
386 $obj->update_or_insert
388 Updates the object if it's already in the db, else inserts it.
390 =head2 insert_or_update
392 $obj->insert_or_update
394 Alias for L</update_or_insert>
398 *insert_or_update = \&update_or_insert;
399 sub update_or_insert {
401 return ($self->in_storage ? $self->update : $self->insert);
406 my @changed_col_names = $obj->is_changed();
407 if ($obj->is_changed()) { ... }
409 In array context returns a list of columns with uncommited changes, or
410 in scalar context returns a true value if there are uncommitted
416 return keys %{shift->{_dirty_columns} || {}};
419 =head2 is_column_changed
421 if ($obj->is_column_changed('col')) { ... }
423 Returns a true value if the column has uncommitted changes.
427 sub is_column_changed {
428 my( $self, $col ) = @_;
429 return exists $self->{_dirty_columns}->{$col};
434 my $resultsource = $object->result_source;
436 Accessor to the ResultSource this object was created from
444 $self->_source_handle($_[0]->handle);
446 $self->_source_handle->resolve;
450 =head2 register_column
452 $column_info = { .... };
453 $class->register_column($column_name, $column_info);
455 Registers a column on the class. If the column_info has an 'accessor'
456 key, creates an accessor named after the value if defined; if there is
457 no such key, creates an accessor with the same name as the column
459 The column_info attributes are described in
460 L<DBIx::Class::ResultSource/add_columns>
464 sub register_column {
465 my ($class, $col, $info) = @_;
467 if (exists $info->{accessor}) {
468 return unless defined $info->{accessor};
469 $acc = [ $info->{accessor}, $col ];
471 $class->mk_group_accessors('column' => $acc);
475 =head2 throw_exception
477 See Schema's throw_exception.
481 sub throw_exception {
483 if (ref $self && ref $self->result_source) {
484 $self->result_source->schema->throw_exception(@_);
494 Matt S. Trout <mst@shadowcatsystems.co.uk>
498 You may distribute this code under the same terms as Perl itself.