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} = {};
82 undef $self->{_orig_ident};
88 $obj->in_storage; # Get value
89 $obj->in_storage(1); # Set value
91 Indicated whether the object exists as a row in the database or not
96 my ($self, $val) = @_;
97 $self->{_in_storage} = $val if @_ > 1;
98 return $self->{_in_storage};
103 $obj->update \%columns?;
105 Must be run on an object that is already in the database; issues an SQL
106 UPDATE query to commit any changes to the object to the database if
109 Also takes an options hashref of C<< column_name => value> pairs >> to update
110 first. But be aware that this hashref might be edited in place, so dont rely on
111 it being the same after a call to C<update>. If you need to preserve the hashref,
112 it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
117 my ($self, $upd) = @_;
118 $self->throw_exception( "Not in database" ) unless $self->in_storage;
119 my $ident_cond = $self->ident_condition;
120 $self->throw_exception("Cannot safely update a row in a PK-less table")
121 if ! keys %$ident_cond;
122 $self->set_columns($upd) if $upd;
123 my %to_update = $self->get_dirty_columns;
124 return $self unless keys %to_update;
125 my $rows = $self->result_source->storage->update(
126 $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
128 $self->throw_exception( "Can't update ${self}: row not found" );
129 } elsif ($rows > 1) {
130 $self->throw_exception("Can't update ${self}: updated more than one row");
132 $self->{_dirty_columns} = {};
133 $self->{related_resultsets} = {};
134 undef $self->{_orig_ident};
142 Deletes the object from the database. The object is still perfectly
143 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
144 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
145 on it. If you delete an object in a class with a C<has_many>
146 relationship, all the related objects will be deleted as well. To turn
147 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
148 hashref. Any database-level cascade or restrict will take precedence
149 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
156 $self->throw_exception( "Not in database" ) unless $self->in_storage;
157 my $ident_cond = $self->ident_condition;
158 $self->throw_exception("Cannot safely delete a row in a PK-less table")
159 if ! keys %$ident_cond;
160 foreach my $column (keys %$ident_cond) {
161 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
162 unless exists $self->{_column_data}{$column};
164 $self->result_source->storage->delete(
165 $self->result_source->from, $ident_cond);
166 $self->in_storage(undef);
168 $self->throw_exception("Can't do class delete without a ResultSource instance")
169 unless $self->can('result_source_instance');
170 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
171 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
172 $self->result_source_instance->resultset->search(@_)->delete;
179 my $val = $obj->get_column($col);
181 Gets a column value from a row object. Currently, does not do
182 any queries; the column must have already been fetched from
183 the database and stored in the object.
188 my ($self, $column) = @_;
189 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
190 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
191 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
195 =head2 has_column_loaded
197 if ( $obj->has_column_loaded($col) ) {
198 print "$col has been loaded from db";
201 Returns a true value if the column value has been loaded from the
202 database (or set locally).
206 sub has_column_loaded {
207 my ($self, $column) = @_;
208 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
209 return exists $self->{_column_data}{$column};
214 my %data = $obj->get_columns;
216 Does C<get_column>, for all column values at once.
222 return %{$self->{_column_data}};
225 =head2 get_dirty_columns
227 my %data = $obj->get_dirty_columns;
229 Identical to get_columns but only returns those that have been changed.
233 sub get_dirty_columns {
235 return map { $_ => $self->{_column_data}{$_} }
236 keys %{$self->{_dirty_columns}};
241 $obj->set_column($col => $val);
243 Sets a column value. If the new value is different from the old one,
244 the column is marked as dirty for when you next call $obj->update.
251 $self->{_orig_ident} ||= $self->ident_condition;
252 my $old = $self->get_column($column);
253 my $ret = $self->store_column(@_);
254 $self->{_dirty_columns}{$column} = 1
255 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
261 my $copy = $orig->set_columns({ $col => $val, ... });
263 Sets more than one column value at once.
268 my ($self,$data) = @_;
269 foreach my $col (keys %$data) {
270 $self->set_column($col,$data->{$col});
277 my $copy = $orig->copy({ change => $to, ... });
279 Inserts a new row with the specified changes.
284 my ($self, $changes) = @_;
286 my $col_data = { %{$self->{_column_data}} };
287 foreach my $col (keys %$col_data) {
288 delete $col_data->{$col}
289 if $self->result_source->column_info($col)->{is_auto_increment};
292 my $new = { _column_data => $col_data };
293 bless $new, ref $self;
295 $new->result_source($self->result_source);
296 $new->set_columns($changes);
298 foreach my $rel ($self->result_source->relationships) {
299 my $rel_info = $self->result_source->relationship_info($rel);
300 if ($rel_info->{attrs}{cascade_copy}) {
301 my $resolved = $self->result_source->resolve_condition(
302 $rel_info->{cond}, $rel, $new);
303 foreach my $related ($self->search_related($rel)) {
304 $related->copy($resolved);
313 $obj->store_column($col => $val);
315 Sets a column value without marking it as dirty.
320 my ($self, $column, $value) = @_;
321 $self->throw_exception( "No such column '${column}'" )
322 unless exists $self->{_column_data}{$column} || $self->has_column($column);
323 $self->throw_exception( "set_column called for ${column} without value" )
325 return $self->{_column_data}{$column} = $value;
328 =head2 inflate_result
330 Class->inflate_result($result_source, \%me, \%prefetch?)
332 Called by ResultSet to inflate a result from storage
337 my ($class, $source, $me, $prefetch) = @_;
338 #use Data::Dumper; print Dumper(@_);
340 result_source => $source,
344 bless $new, (ref $class || $class);
347 foreach my $pre (keys %{$prefetch||{}}) {
348 my $pre_val = $prefetch->{$pre};
349 my $pre_source = $source->related_source($pre);
350 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
352 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
354 foreach my $pre_rec (@$pre_val) {
355 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
356 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
359 push(@pre_objects, $pre_source->result_class->inflate_result(
360 $pre_source, @{$pre_rec}));
362 $new->related_resultset($pre)->set_cache(\@pre_objects);
363 } elsif (defined $pre_val->[0]) {
365 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
366 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
368 $fetched = $pre_source->result_class->inflate_result(
369 $pre_source, @{$pre_val});
371 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
372 $class->throw_exception("No accessor for prefetched $pre")
373 unless defined $accessor;
374 if ($accessor eq 'single') {
375 $new->{_relationship_data}{$pre} = $fetched;
376 } elsif ($accessor eq 'filter') {
377 $new->{_inflated_column}{$pre} = $fetched;
379 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
386 =head2 update_or_insert
388 $obj->update_or_insert
390 Updates the object if it's already in the db, else inserts it.
392 =head2 insert_or_update
394 $obj->insert_or_update
396 Alias for L</update_or_insert>
400 *insert_or_update = \&update_or_insert;
401 sub update_or_insert {
403 return ($self->in_storage ? $self->update : $self->insert);
408 my @changed_col_names = $obj->is_changed();
409 if ($obj->is_changed()) { ... }
411 In array context returns a list of columns with uncommited changes, or
412 in scalar context returns a true value if there are uncommitted
418 return keys %{shift->{_dirty_columns} || {}};
421 =head2 is_column_changed
423 if ($obj->is_column_changed('col')) { ... }
425 Returns a true value if the column has uncommitted changes.
429 sub is_column_changed {
430 my( $self, $col ) = @_;
431 return exists $self->{_dirty_columns}->{$col};
436 my $resultsource = $object->result_source;
438 Accessor to the ResultSource this object was created from
440 =head2 register_column
442 $column_info = { .... };
443 $class->register_column($column_name, $column_info);
445 Registers a column on the class. If the column_info has an 'accessor'
446 key, creates an accessor named after the value if defined; if there is
447 no such key, creates an accessor with the same name as the column
449 The column_info attributes are described in
450 L<DBIx::Class::ResultSource/add_columns>
454 sub register_column {
455 my ($class, $col, $info) = @_;
457 if (exists $info->{accessor}) {
458 return unless defined $info->{accessor};
459 $acc = [ $info->{accessor}, $col ];
461 $class->mk_group_accessors('column' => $acc);
465 =head2 throw_exception
467 See Schema's throw_exception.
471 sub throw_exception {
473 if (ref $self && ref $self->result_source) {
474 $self->result_source->schema->throw_exception(@_);
484 Matt S. Trout <mst@shadowcatsystems.co.uk>
488 You may distribute this code under the same terms as Perl itself.