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>.
116 my ($self, $upd) = @_;
117 $self->throw_exception( "Not in database" ) unless $self->in_storage;
118 my $ident_cond = $self->ident_condition;
119 $self->throw_exception("Cannot safely update a row in a PK-less table")
120 if ! keys %$ident_cond;
121 $self->set_columns($upd) if $upd;
122 my %to_update = $self->get_dirty_columns;
123 return $self unless keys %to_update;
124 my $rows = $self->result_source->storage->update(
125 $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
127 $self->throw_exception( "Can't update ${self}: row not found" );
128 } elsif ($rows > 1) {
129 $self->throw_exception("Can't update ${self}: updated more than one row");
131 $self->{_dirty_columns} = {};
132 $self->{related_resultsets} = {};
133 undef $self->{_orig_ident};
141 Deletes the object from the database. The object is still perfectly
142 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
143 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
144 on it. If you delete an object in a class with a C<has_many>
145 relationship, all the related objects will be deleted as well. To turn
146 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
147 hashref. Any database-level cascade or restrict will take precedence
148 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
155 $self->throw_exception( "Not in database" ) unless $self->in_storage;
156 my $ident_cond = $self->ident_condition;
157 $self->throw_exception("Cannot safely delete a row in a PK-less table")
158 if ! keys %$ident_cond;
159 foreach my $column (keys %$ident_cond) {
160 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
161 unless exists $self->{_column_data}{$column};
163 $self->result_source->storage->delete(
164 $self->result_source->from, $ident_cond);
165 $self->in_storage(undef);
167 $self->throw_exception("Can't do class delete without a ResultSource instance")
168 unless $self->can('result_source_instance');
169 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
170 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
171 $self->result_source_instance->resultset->search(@_)->delete;
178 my $val = $obj->get_column($col);
180 Gets a column value from a row object. Currently, does not do
181 any queries; the column must have already been fetched from
182 the database and stored in the object.
187 my ($self, $column) = @_;
188 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
189 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
190 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
194 =head2 has_column_loaded
196 if ( $obj->has_column_loaded($col) ) {
197 print "$col has been loaded from db";
200 Returns a true value if the column value has been loaded from the
201 database (or set locally).
205 sub has_column_loaded {
206 my ($self, $column) = @_;
207 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
208 return exists $self->{_column_data}{$column};
213 my %data = $obj->get_columns;
215 Does C<get_column>, for all column values at once.
221 return %{$self->{_column_data}};
224 =head2 get_dirty_columns
226 my %data = $obj->get_dirty_columns;
228 Identical to get_columns but only returns those that have been changed.
232 sub get_dirty_columns {
234 return map { $_ => $self->{_column_data}{$_} }
235 keys %{$self->{_dirty_columns}};
240 $obj->set_column($col => $val);
242 Sets a column value. If the new value is different from the old one,
243 the column is marked as dirty for when you next call $obj->update.
250 $self->{_orig_ident} ||= $self->ident_condition;
251 my $old = $self->get_column($column);
252 my $ret = $self->store_column(@_);
253 $self->{_dirty_columns}{$column} = 1
254 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
260 my $copy = $orig->set_columns({ $col => $val, ... });
262 Sets more than one column value at once.
267 my ($self,$data) = @_;
268 foreach my $col (keys %$data) {
269 $self->set_column($col,$data->{$col});
276 my $copy = $orig->copy({ change => $to, ... });
278 Inserts a new row with the specified changes.
283 my ($self, $changes) = @_;
285 my $col_data = { %{$self->{_column_data}} };
286 foreach my $col (keys %$col_data) {
287 delete $col_data->{$col}
288 if $self->result_source->column_info($col)->{is_auto_increment};
291 my $new = { _column_data => $col_data };
292 bless $new, ref $self;
294 $new->result_source($self->result_source);
295 $new->set_columns($changes);
297 foreach my $rel ($self->result_source->relationships) {
298 my $rel_info = $self->result_source->relationship_info($rel);
299 if ($rel_info->{attrs}{cascade_copy}) {
300 my $resolved = $self->result_source->resolve_condition(
301 $rel_info->{cond}, $rel, $new);
302 foreach my $related ($self->search_related($rel)) {
303 $related->copy($resolved);
312 $obj->store_column($col => $val);
314 Sets a column value without marking it as dirty.
319 my ($self, $column, $value) = @_;
320 $self->throw_exception( "No such column '${column}'" )
321 unless exists $self->{_column_data}{$column} || $self->has_column($column);
322 $self->throw_exception( "set_column called for ${column} without value" )
324 return $self->{_column_data}{$column} = $value;
327 =head2 inflate_result
329 Class->inflate_result($result_source, \%me, \%prefetch?)
331 Called by ResultSet to inflate a result from storage
336 my ($class, $source, $me, $prefetch) = @_;
337 #use Data::Dumper; print Dumper(@_);
339 result_source => $source,
343 bless $new, (ref $class || $class);
346 foreach my $pre (keys %{$prefetch||{}}) {
347 my $pre_val = $prefetch->{$pre};
348 my $pre_source = $source->related_source($pre);
349 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
351 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
353 foreach my $pre_rec (@$pre_val) {
354 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
355 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
358 push(@pre_objects, $pre_source->result_class->inflate_result(
359 $pre_source, @{$pre_rec}));
361 $new->related_resultset($pre)->set_cache(\@pre_objects);
362 } elsif (defined $pre_val->[0]) {
364 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
365 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
367 $fetched = $pre_source->result_class->inflate_result(
368 $pre_source, @{$pre_val});
370 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
371 $class->throw_exception("No accessor for prefetched $pre")
372 unless defined $accessor;
373 if ($accessor eq 'single') {
374 $new->{_relationship_data}{$pre} = $fetched;
375 } elsif ($accessor eq 'filter') {
376 $new->{_inflated_column}{$pre} = $fetched;
378 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
385 =head2 update_or_insert
387 $obj->update_or_insert
389 Updates the object if it's already in the db, else inserts it.
391 =head2 insert_or_update
393 $obj->insert_or_update
395 Alias for L</update_or_insert>
399 *insert_or_update = \&update_or_insert;
400 sub update_or_insert {
402 return ($self->in_storage ? $self->update : $self->insert);
407 my @changed_col_names = $obj->is_changed();
408 if ($obj->is_changed()) { ... }
410 In array context returns a list of columns with uncommited changes, or
411 in scalar context returns a true value if there are uncommitted
417 return keys %{shift->{_dirty_columns} || {}};
420 =head2 is_column_changed
422 if ($obj->is_column_changed('col')) { ... }
424 Returns a true value if the column has uncommitted changes.
428 sub is_column_changed {
429 my( $self, $col ) = @_;
430 return exists $self->{_dirty_columns}->{$col};
435 my $resultsource = $object->result_source;
437 Accessor to the ResultSource this object was created from
439 =head2 register_column
441 $column_info = { .... };
442 $class->register_column($column_name, $column_info);
444 Registers a column on the class. If the column_info has an 'accessor'
445 key, creates an accessor named after the value if defined; if there is
446 no such key, creates an accessor with the same name as the column
448 The column_info attributes are described in
449 L<DBIx::Class::ResultSource/add_columns>
453 sub register_column {
454 my ($class, $col, $info) = @_;
456 if (exists $info->{accessor}) {
457 return unless defined $info->{accessor};
458 $acc = [ $info->{accessor}, $col ];
460 $class->mk_group_accessors('column' => $acc);
464 =head2 throw_exception
466 See Schema's throw_exception.
470 sub throw_exception {
472 if (ref $self && ref $self->result_source) {
473 $self->result_source->schema->throw_exception(@_);
483 Matt S. Trout <mst@shadowcatsystems.co.uk>
487 You may distribute this code under the same terms as Perl itself.