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") unless $source;
65 #use Data::Dumper; warn Dumper($self);
66 $source->storage->insert($source->from, { $self->get_columns });
68 $self->{_dirty_columns} = {};
69 $self->{related_resultsets} = {};
75 $obj->in_storage; # Get value
76 $obj->in_storage(1); # Set value
78 Indicated whether the object exists as a row in the database or not
83 my ($self, $val) = @_;
84 $self->{_in_storage} = $val if @_ > 1;
85 return $self->{_in_storage};
92 Must be run on an object that is already in the database; issues an SQL
93 UPDATE query to commit any changes to the object to the db if required.
98 my ($self, $upd) = @_;
99 $self->throw_exception( "Not in database" ) unless $self->in_storage;
100 $self->set_columns($upd) if $upd;
101 my %to_update = $self->get_dirty_columns;
102 return $self unless keys %to_update;
103 my $ident_cond = $self->ident_condition;
104 $self->throw_exception("Cannot safely update a row in a PK-less table")
105 if ! keys %$ident_cond;
106 my $rows = $self->result_source->storage->update(
107 $self->result_source->from, \%to_update, $ident_cond);
109 $self->throw_exception( "Can't update ${self}: row not found" );
110 } elsif ($rows > 1) {
111 $self->throw_exception("Can't update ${self}: updated more than one row");
113 $self->{_dirty_columns} = {};
114 $self->{related_resultsets} = {};
122 Deletes the object from the database. The object is still perfectly usable
123 accessor-wise etc. but ->in_storage will now return 0 and the object must
124 be re ->insert'ed before it can be ->update'ed
131 $self->throw_exception( "Not in database" ) unless $self->in_storage;
132 my $ident_cond = $self->ident_condition;
133 $self->throw_exception("Cannot safely delete a row in a PK-less table")
134 if ! keys %$ident_cond;
135 foreach my $column (keys %$ident_cond) {
136 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
137 unless exists $self->{_column_data}{$column};
139 $self->result_source->storage->delete(
140 $self->result_source->from, $ident_cond);
141 $self->in_storage(undef);
143 $self->throw_exception("Can't do class delete without a ResultSource instance")
144 unless $self->can('result_source_instance');
146 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
147 $attrs = { %{ pop(@_) } };
149 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
150 $self->result_source_instance->resultset->search(@_)->delete;
157 my $val = $obj->get_column($col);
159 Gets a column value from a row object. Currently, does not do
160 any queries; the column must have already been fetched from
161 the database and stored in the object.
166 my ($self, $column) = @_;
167 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
168 return $self->{_column_data}{$column}
169 if exists $self->{_column_data}{$column};
170 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
176 my %data = $obj->get_columns;
178 Does C<get_column>, for all column values at once.
184 return %{$self->{_column_data}};
187 =head2 get_dirty_columns
189 my %data = $obj->get_dirty_columns;
191 Identical to get_columns but only returns those that have been changed.
195 sub get_dirty_columns {
197 return map { $_ => $self->{_column_data}{$_} }
198 keys %{$self->{_dirty_columns}};
203 $obj->set_column($col => $val);
205 Sets a column value. If the new value is different from the old one,
206 the column is marked as dirty for when you next call $obj->update.
213 my $old = $self->get_column($column);
214 my $ret = $self->store_column(@_);
215 $self->{_dirty_columns}{$column} = 1
216 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
222 my $copy = $orig->set_columns({ $col => $val, ... });
224 Sets more than one column value at once.
229 my ($self,$data) = @_;
230 while (my ($col,$val) = each %$data) {
231 $self->set_column($col,$val);
238 my $copy = $orig->copy({ change => $to, ... });
240 Inserts a new row with the specified changes.
245 my ($self, $changes) = @_;
247 my $col_data = { %{$self->{_column_data}} };
248 foreach my $col (keys %$col_data) {
249 delete $col_data->{$col}
250 if $self->result_source->column_info($col)->{is_auto_increment};
252 my $new = bless({ _column_data => $col_data }, ref $self);
253 $new->set_columns($changes);
255 foreach my $rel ($self->result_source->relationships) {
256 my $rel_info = $self->result_source->relationship_info($rel);
257 if ($rel_info->{attrs}{cascade_copy}) {
258 my $resolved = $self->result_source->resolve_condition(
259 $rel_info->{cond}, $rel, $new);
260 foreach my $related ($self->search_related($rel)) {
261 $related->copy($resolved);
270 $obj->store_column($col => $val);
272 Sets a column value without marking it as dirty.
277 my ($self, $column, $value) = @_;
278 $self->throw_exception( "No such column '${column}'" )
279 unless exists $self->{_column_data}{$column} || $self->has_column($column);
280 $self->throw_exception( "set_column called for ${column} without value" )
282 return $self->{_column_data}{$column} = $value;
285 =head2 inflate_result
287 Class->inflate_result($result_source, \%me, \%prefetch?)
289 Called by ResultSet to inflate a result from storage
294 my ($class, $source, $me, $prefetch) = @_;
295 #use Data::Dumper; print Dumper(@_);
296 my $new = bless({ result_source => $source,
300 ref $class || $class);
302 foreach my $pre (keys %{$prefetch||{}}) {
303 my $pre_val = $prefetch->{$pre};
304 my $pre_source = $source->related_source($pre);
305 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
307 if (ref $pre_val->[0] eq 'ARRAY') { # multi
309 foreach my $pre_rec (@$pre_val) {
310 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
311 and !defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
314 push(@pre_objects, $pre_source->result_class->inflate_result(
315 $pre_source, @{$pre_rec}));
317 $new->related_resultset($pre)->set_cache(\@pre_objects);
320 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
321 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
323 $fetched = $pre_source->result_class->inflate_result(
324 $pre_source, @{$pre_val});
326 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
327 $class->throw_exception("No accessor for prefetched $pre")
328 unless defined $accessor;
329 if ($accessor eq 'single') {
330 $new->{_relationship_data}{$pre} = $fetched;
331 } elsif ($accessor eq 'filter') {
332 $new->{_inflated_column}{$pre} = $fetched;
334 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
341 =head2 insert_or_update
343 $obj->insert_or_update
345 Updates the object if it's already in the db, else inserts it.
349 sub insert_or_update {
351 return ($self->in_storage ? $self->update : $self->insert);
356 my @changed_col_names = $obj->is_changed
361 return keys %{shift->{_dirty_columns} || {}};
366 Accessor to the ResultSource this object was created from
368 =head2 register_column
370 =head3 Arguments: ($column, $column_info)
372 Registers a column on the class. If the column_info has an 'accessor' key,
373 creates an accessor named after the value if defined; if there is no such
374 key, creates an accessor with the same name as the column
378 sub register_column {
379 my ($class, $col, $info) = @_;
381 if (exists $info->{accessor}) {
382 return unless defined $info->{accessor};
383 $acc = [ $info->{accessor}, $col ];
385 $class->mk_group_accessors('column' => $acc);
389 =head2 throw_exception
391 See Schema's throw_exception.
395 sub throw_exception {
397 if (ref $self && ref $self->result_source) {
398 $self->result_source->schema->throw_exception(@_);
408 Matt S. Trout <mst@shadowcatsystems.co.uk>
412 You may distribute this code under the same terms as Perl itself.