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};
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
112 my ($self, $upd) = @_;
113 # Create a copy so we dont mess with original
114 $upd = { %$upd } if $upd;
116 $self->throw_exception( "Not in database" ) unless $self->in_storage;
117 my $ident_cond = $self->ident_condition;
118 $self->throw_exception("Cannot safely update a row in a PK-less table")
119 if ! keys %$ident_cond;
120 $self->set_columns($upd) if $upd;
121 my %to_update = $self->get_dirty_columns;
122 return $self unless keys %to_update;
123 my $rows = $self->result_source->storage->update(
124 $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
126 $self->throw_exception( "Can't update ${self}: row not found" );
127 } elsif ($rows > 1) {
128 $self->throw_exception("Can't update ${self}: updated more than one row");
130 $self->{_dirty_columns} = {};
131 $self->{related_resultsets} = {};
132 undef $self->{_orig_ident};
140 Deletes the object from the database. The object is still perfectly
141 usable, but C<-E<gt>in_storage()> will now return 0 and the object must
142 reinserted using C<-E<gt>insert()> before C<-E(<gt>update()> can be used
143 on it. If you delete an object in a class with a C<has_many>
144 relationship, all the related objects will be deleted as well. To turn
145 this behavior off, pass C<cascade_delete => 0> in the C<$attr>
146 hashref. Any database-level cascade or restrict will take precedence
147 over a DBIx-Class-based cascading delete. See also L<DBIx::Class::ResultSet/delete>.
154 $self->throw_exception( "Not in database" ) unless $self->in_storage;
155 my $ident_cond = $self->ident_condition;
156 $self->throw_exception("Cannot safely delete a row in a PK-less table")
157 if ! keys %$ident_cond;
158 foreach my $column (keys %$ident_cond) {
159 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
160 unless exists $self->{_column_data}{$column};
162 $self->result_source->storage->delete(
163 $self->result_source->from, $ident_cond);
164 $self->in_storage(undef);
166 $self->throw_exception("Can't do class delete without a ResultSource instance")
167 unless $self->can('result_source_instance');
168 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
169 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
170 $self->result_source_instance->resultset->search(@_)->delete;
177 my $val = $obj->get_column($col);
179 Gets a column value from a row object. Currently, does not do
180 any queries; the column must have already been fetched from
181 the database and stored in the object.
186 my ($self, $column) = @_;
187 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
188 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
189 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
193 =head2 has_column_loaded
195 if ( $obj->has_column_loaded($col) ) {
196 print "$col has been loaded from db";
199 Returns a true value if the column value has been loaded from the
200 database (or set locally).
204 sub has_column_loaded {
205 my ($self, $column) = @_;
206 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
207 return exists $self->{_column_data}{$column};
212 my %data = $obj->get_columns;
214 Does C<get_column>, for all column values at once.
220 return %{$self->{_column_data}};
223 =head2 get_dirty_columns
225 my %data = $obj->get_dirty_columns;
227 Identical to get_columns but only returns those that have been changed.
231 sub get_dirty_columns {
233 return map { $_ => $self->{_column_data}{$_} }
234 keys %{$self->{_dirty_columns}};
239 $obj->set_column($col => $val);
241 Sets a column value. If the new value is different from the old one,
242 the column is marked as dirty for when you next call $obj->update.
249 $self->{_orig_ident} ||= $self->ident_condition;
250 my $old = $self->get_column($column);
251 my $ret = $self->store_column(@_);
252 $self->{_dirty_columns}{$column} = 1
253 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
259 my $copy = $orig->set_columns({ $col => $val, ... });
261 Sets more than one column value at once.
266 my ($self,$data) = @_;
267 foreach my $col (keys %$data) {
268 $self->set_column($col,$data->{$col});
275 my $copy = $orig->copy({ change => $to, ... });
277 Inserts a new row with the specified changes.
282 my ($self, $changes) = @_;
284 my $col_data = { %{$self->{_column_data}} };
285 foreach my $col (keys %$col_data) {
286 delete $col_data->{$col}
287 if $self->result_source->column_info($col)->{is_auto_increment};
290 my $new = { _column_data => $col_data };
291 bless $new, ref $self;
293 $new->result_source($self->result_source);
294 $new->set_columns($changes);
296 foreach my $rel ($self->result_source->relationships) {
297 my $rel_info = $self->result_source->relationship_info($rel);
298 if ($rel_info->{attrs}{cascade_copy}) {
299 my $resolved = $self->result_source->resolve_condition(
300 $rel_info->{cond}, $rel, $new);
301 foreach my $related ($self->search_related($rel)) {
302 $related->copy($resolved);
311 $obj->store_column($col => $val);
313 Sets a column value without marking it as dirty.
318 my ($self, $column, $value) = @_;
319 $self->throw_exception( "No such column '${column}'" )
320 unless exists $self->{_column_data}{$column} || $self->has_column($column);
321 $self->throw_exception( "set_column called for ${column} without value" )
323 return $self->{_column_data}{$column} = $value;
326 =head2 inflate_result
328 Class->inflate_result($result_source, \%me, \%prefetch?)
330 Called by ResultSet to inflate a result from storage
335 my ($class, $source, $me, $prefetch) = @_;
336 #use Data::Dumper; print Dumper(@_);
338 result_source => $source,
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
438 =head2 register_column
440 $column_info = { .... };
441 $class->register_column($column_name, $column_info);
443 Registers a column on the class. If the column_info has an 'accessor'
444 key, creates an accessor named after the value if defined; if there is
445 no such key, creates an accessor with the same name as the column
447 The column_info attributes are described in
448 L<DBIx::Class::ResultSource/add_columns>
452 sub register_column {
453 my ($class, $col, $info) = @_;
455 if (exists $info->{accessor}) {
456 return unless defined $info->{accessor};
457 $acc = [ $info->{accessor}, $col ];
459 $class->mk_group_accessors('column' => $acc);
463 =head2 throw_exception
465 See Schema's throw_exception.
469 sub throw_exception {
471 if (ref $self && ref $self->result_source) {
472 $self->result_source->schema->throw_exception(@_);
482 Matt S. Trout <mst@shadowcatsystems.co.uk>
486 You may distribute this code under the same terms as Perl itself.