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;
37 my $new = bless { _column_data => {} }, $class;
39 $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH';
40 while (my ($k, $v) = each %$attrs) {
41 $new->throw_exception("No such column $k on $class") unless $class->has_column($k);
42 $new->store_column($k => $v);
52 Inserts an object into the database if it isn't already in there. Returns
53 the object itself. Requires the object's result source to be set, or the
54 class to have a result_source_instance method.
60 return $self if $self->in_storage;
61 $self->{result_source} ||= $self->result_source_instance
62 if $self->can('result_source_instance');
63 my $source = $self->{result_source};
64 $self->throw_exception("No result_source set on this object; can't insert")
66 #use Data::Dumper; warn Dumper($self);
67 $source->storage->insert($source->from, { $self->get_columns });
69 $self->{_dirty_columns} = {};
70 $self->{related_resultsets} = {};
76 $obj->in_storage; # Get value
77 $obj->in_storage(1); # Set value
79 Indicated whether the object exists as a row in the database or not
84 my ($self, $val) = @_;
85 $self->{_in_storage} = $val if @_ > 1;
86 return $self->{_in_storage};
93 Must be run on an object that is already in the database; issues an SQL
94 UPDATE query to commit any changes to the object to the db if required.
99 my ($self, $upd) = @_;
100 $self->throw_exception( "Not in database" ) unless $self->in_storage;
101 $self->set_columns($upd) if $upd;
102 my %to_update = $self->get_dirty_columns;
103 return $self unless keys %to_update;
104 my $ident_cond = $self->ident_condition;
105 $self->throw_exception("Cannot safely update a row in a PK-less table")
106 if ! keys %$ident_cond;
107 my $rows = $self->result_source->storage->update(
108 $self->result_source->from, \%to_update, $ident_cond);
110 $self->throw_exception( "Can't update ${self}: row not found" );
111 } elsif ($rows > 1) {
112 $self->throw_exception("Can't update ${self}: updated more than one row");
114 $self->{_dirty_columns} = {};
115 $self->{related_resultsets} = {};
123 Deletes the object from the database. The object is still perfectly usable
124 accessor-wise etc. but ->in_storage will now return 0 and the object must
125 be re ->insert'ed before it can be ->update'ed
132 $self->throw_exception( "Not in database" ) unless $self->in_storage;
133 my $ident_cond = $self->ident_condition;
134 $self->throw_exception("Cannot safely delete a row in a PK-less table")
135 if ! keys %$ident_cond;
136 foreach my $column (keys %$ident_cond) {
137 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
138 unless exists $self->{_column_data}{$column};
140 $self->result_source->storage->delete(
141 $self->result_source->from, $ident_cond);
142 $self->in_storage(undef);
144 $self->throw_exception("Can't do class delete without a ResultSource instance")
145 unless $self->can('result_source_instance');
146 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
147 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
148 $self->result_source_instance->resultset->search(@_)->delete;
155 my $val = $obj->get_column($col);
157 Gets a column value from a row object. Currently, does not do
158 any queries; the column must have already been fetched from
159 the database and stored in the object.
164 my ($self, $column) = @_;
165 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
166 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
167 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
171 sub has_column_loaded {
172 my ($self, $column) = @_;
173 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
174 return exists $self->{_column_data}{$column};
179 my %data = $obj->get_columns;
181 Does C<get_column>, for all column values at once.
187 return %{$self->{_column_data}};
190 =head2 get_dirty_columns
192 my %data = $obj->get_dirty_columns;
194 Identical to get_columns but only returns those that have been changed.
198 sub get_dirty_columns {
200 return map { $_ => $self->{_column_data}{$_} }
201 keys %{$self->{_dirty_columns}};
206 $obj->set_column($col => $val);
208 Sets a column value. If the new value is different from the old one,
209 the column is marked as dirty for when you next call $obj->update.
216 my $old = $self->get_column($column);
217 my $ret = $self->store_column(@_);
218 $self->{_dirty_columns}{$column} = 1
219 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
225 my $copy = $orig->set_columns({ $col => $val, ... });
227 Sets more than one column value at once.
232 my ($self,$data) = @_;
233 while (my ($col,$val) = each %$data) {
234 $self->set_column($col,$val);
241 my $copy = $orig->copy({ change => $to, ... });
243 Inserts a new row with the specified changes.
248 my ($self, $changes) = @_;
250 my $col_data = { %{$self->{_column_data}} };
251 foreach my $col (keys %$col_data) {
252 delete $col_data->{$col}
253 if $self->result_source->column_info($col)->{is_auto_increment};
255 my $new = bless { _column_data => $col_data }, ref $self;
256 $new->set_columns($changes);
258 foreach my $rel ($self->result_source->relationships) {
259 my $rel_info = $self->result_source->relationship_info($rel);
260 if ($rel_info->{attrs}{cascade_copy}) {
261 my $resolved = $self->result_source->resolve_condition(
262 $rel_info->{cond}, $rel, $new);
263 foreach my $related ($self->search_related($rel)) {
264 $related->copy($resolved);
273 $obj->store_column($col => $val);
275 Sets a column value without marking it as dirty.
280 my ($self, $column, $value) = @_;
281 $self->throw_exception( "No such column '${column}'" )
282 unless exists $self->{_column_data}{$column} || $self->has_column($column);
283 $self->throw_exception( "set_column called for ${column} without value" )
285 return $self->{_column_data}{$column} = $value;
288 =head2 inflate_result
290 Class->inflate_result($result_source, \%me, \%prefetch?)
292 Called by ResultSet to inflate a result from storage
297 my ($class, $source, $me, $prefetch) = @_;
298 #use Data::Dumper; print Dumper(@_);
299 my $new = bless({ result_source => $source,
303 ref $class || $class);
305 foreach my $pre (keys %{$prefetch||{}}) {
306 my $pre_val = $prefetch->{$pre};
307 my $pre_source = $source->related_source($pre);
308 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
310 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
312 foreach my $pre_rec (@$pre_val) {
313 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
314 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
317 push(@pre_objects, $pre_source->result_class->inflate_result(
318 $pre_source, @{$pre_rec}));
320 $new->related_resultset($pre)->set_cache(\@pre_objects);
321 } elsif (defined $pre_val->[0]) {
323 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
324 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
326 $fetched = $pre_source->result_class->inflate_result(
327 $pre_source, @{$pre_val});
329 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
330 $class->throw_exception("No accessor for prefetched $pre")
331 unless defined $accessor;
332 if ($accessor eq 'single') {
333 $new->{_relationship_data}{$pre} = $fetched;
334 } elsif ($accessor eq 'filter') {
335 $new->{_inflated_column}{$pre} = $fetched;
337 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
344 =head2 update_or_insert
346 $obj->update_or_insert
348 Updates the object if it's already in the db, else inserts it.
352 *insert_or_update = \&update_or_insert;
353 sub update_or_insert {
355 return ($self->in_storage ? $self->update : $self->insert);
360 my @changed_col_names = $obj->is_changed
365 return keys %{shift->{_dirty_columns} || {}};
370 Accessor to the ResultSource this object was created from
372 =head2 register_column
374 =head3 Arguments: ($column, $column_info)
376 Registers a column on the class. If the column_info has an 'accessor' key,
377 creates an accessor named after the value if defined; if there is no such
378 key, creates an accessor with the same name as the column
382 sub register_column {
383 my ($class, $col, $info) = @_;
385 if (exists $info->{accessor}) {
386 return unless defined $info->{accessor};
387 $acc = [ $info->{accessor}, $col ];
389 $class->mk_group_accessors('column' => $acc);
393 =head2 throw_exception
395 See Schema's throw_exception.
399 sub throw_exception {
401 if (ref $self && ref $self->result_source) {
402 $self->result_source->schema->throw_exception(@_);
412 Matt S. Trout <mst@shadowcatsystems.co.uk>
416 You may distribute this code under the same terms as Perl itself.