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, $self->{_orig_ident} || $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);
246 # save our original ident condition if
247 # they modify any part of the PK
248 if(!$self->{_orig_ident}) {
249 foreach ($self->primary_columns) {
251 $self->{_orig_ident} = $self->ident_condition;
257 my $ret = $self->store_column(@_);
258 $self->{_dirty_columns}{$column} = 1
259 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
265 my $copy = $orig->set_columns({ $col => $val, ... });
267 Sets more than one column value at once.
272 my ($self,$data) = @_;
273 foreach my $col (keys %$data) {
274 $self->set_column($col,$data->{$col});
281 my $copy = $orig->copy({ change => $to, ... });
283 Inserts a new row with the specified changes.
288 my ($self, $changes) = @_;
290 my $col_data = { %{$self->{_column_data}} };
291 foreach my $col (keys %$col_data) {
292 delete $col_data->{$col}
293 if $self->result_source->column_info($col)->{is_auto_increment};
296 my $new = { _column_data => $col_data };
297 bless $new, ref $self;
299 $new->result_source($self->result_source);
300 $new->set_columns($changes);
302 foreach my $rel ($self->result_source->relationships) {
303 my $rel_info = $self->result_source->relationship_info($rel);
304 if ($rel_info->{attrs}{cascade_copy}) {
305 my $resolved = $self->result_source->resolve_condition(
306 $rel_info->{cond}, $rel, $new);
307 foreach my $related ($self->search_related($rel)) {
308 $related->copy($resolved);
317 $obj->store_column($col => $val);
319 Sets a column value without marking it as dirty.
324 my ($self, $column, $value) = @_;
325 $self->throw_exception( "No such column '${column}'" )
326 unless exists $self->{_column_data}{$column} || $self->has_column($column);
327 $self->throw_exception( "set_column called for ${column} without value" )
329 return $self->{_column_data}{$column} = $value;
332 =head2 inflate_result
334 Class->inflate_result($result_source, \%me, \%prefetch?)
336 Called by ResultSet to inflate a result from storage
341 my ($class, $source, $me, $prefetch) = @_;
342 #use Data::Dumper; print Dumper(@_);
344 result_source => $source,
348 bless $new, (ref $class || $class);
351 foreach my $pre (keys %{$prefetch||{}}) {
352 my $pre_val = $prefetch->{$pre};
353 my $pre_source = $source->related_source($pre);
354 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
356 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
358 foreach my $pre_rec (@$pre_val) {
359 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
360 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
363 push(@pre_objects, $pre_source->result_class->inflate_result(
364 $pre_source, @{$pre_rec}));
366 $new->related_resultset($pre)->set_cache(\@pre_objects);
367 } elsif (defined $pre_val->[0]) {
369 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
370 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
372 $fetched = $pre_source->result_class->inflate_result(
373 $pre_source, @{$pre_val});
375 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
376 $class->throw_exception("No accessor for prefetched $pre")
377 unless defined $accessor;
378 if ($accessor eq 'single') {
379 $new->{_relationship_data}{$pre} = $fetched;
380 } elsif ($accessor eq 'filter') {
381 $new->{_inflated_column}{$pre} = $fetched;
383 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
390 =head2 update_or_insert
392 $obj->update_or_insert
394 Updates the object if it's already in the db, else inserts it.
396 =head2 insert_or_update
398 $obj->insert_or_update
400 Alias for L</update_or_insert>
404 *insert_or_update = \&update_or_insert;
405 sub update_or_insert {
407 return ($self->in_storage ? $self->update : $self->insert);
412 my @changed_col_names = $obj->is_changed();
413 if ($obj->is_changed()) { ... }
415 In array context returns a list of columns with uncommited changes, or
416 in scalar context returns a true value if there are uncommitted
422 return keys %{shift->{_dirty_columns} || {}};
425 =head2 is_column_changed
427 if ($obj->is_column_changed('col')) { ... }
429 Returns a true value if the column has uncommitted changes.
433 sub is_column_changed {
434 my( $self, $col ) = @_;
435 return exists $self->{_dirty_columns}->{$col};
440 my $resultsource = $object->result_source;
442 Accessor to the ResultSource this object was created from
444 =head2 register_column
446 $column_info = { .... };
447 $class->register_column($column_name, $column_info);
449 Registers a column on the class. If the column_info has an 'accessor'
450 key, creates an accessor named after the value if defined; if there is
451 no such key, creates an accessor with the same name as the column
453 The column_info attributes are described in
454 L<DBIx::Class::ResultSource/add_columns>
458 sub register_column {
459 my ($class, $col, $info) = @_;
461 if (exists $info->{accessor}) {
462 return unless defined $info->{accessor};
463 $acc = [ $info->{accessor}, $col ];
465 $class->mk_group_accessors('column' => $acc);
469 =head2 throw_exception
471 See Schema's throw_exception.
475 sub throw_exception {
477 if (ref $self && ref $self->result_source) {
478 $self->result_source->schema->throw_exception(@_);
488 Matt S. Trout <mst@shadowcatsystems.co.uk>
492 You may distribute this code under the same terms as Perl itself.