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 $self->result_source->storage->delete(
136 $self->result_source->from, $ident_cond);
137 $self->in_storage(undef);
139 $self->throw_exception("Can't do class delete without a ResultSource instance")
140 unless $self->can('result_source_instance');
142 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
143 $attrs = { %{ pop(@_) } };
145 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
146 $self->result_source_instance->resultset->search(@_)->delete;
153 my $val = $obj->get_column($col);
155 Gets a column value from a row object. Currently, does not do
156 any queries; the column must have already been fetched from
157 the database and stored in the object.
162 my ($self, $column) = @_;
163 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
164 return $self->{_column_data}{$column}
165 if exists $self->{_column_data}{$column};
166 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
172 my %data = $obj->get_columns;
174 Does C<get_column>, for all column values at once.
180 return %{$self->{_column_data}};
183 =head2 get_dirty_columns
185 my %data = $obj->get_dirty_columns;
187 Identical to get_columns but only returns those that have been changed.
191 sub get_dirty_columns {
193 return map { $_ => $self->{_column_data}{$_} }
194 keys %{$self->{_dirty_columns}};
199 $obj->set_column($col => $val);
201 Sets a column value. If the new value is different from the old one,
202 the column is marked as dirty for when you next call $obj->update.
209 my $old = $self->get_column($column);
210 my $ret = $self->store_column(@_);
211 $self->{_dirty_columns}{$column} = 1
212 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
218 my $copy = $orig->set_columns({ $col => $val, ... });
220 Sets more than one column value at once.
225 my ($self,$data) = @_;
226 while (my ($col,$val) = each %$data) {
227 $self->set_column($col,$val);
234 my $copy = $orig->copy({ change => $to, ... });
236 Inserts a new row with the specified changes.
241 my ($self, $changes) = @_;
243 my $col_data = { %{$self->{_column_data}} };
244 foreach my $col (keys %$col_data) {
245 delete $col_data->{$col}
246 if $self->result_source->column_info($col)->{is_auto_increment};
248 my $new = bless({ _column_data => $col_data }, ref $self);
249 $new->set_columns($changes);
251 foreach my $rel ($self->result_source->relationships) {
252 my $rel_info = $self->result_source->relationship_info($rel);
253 if ($rel_info->{attrs}{cascade_copy}) {
254 my $resolved = $self->result_source->resolve_condition(
255 $rel_info->{cond}, $rel, $new);
256 foreach my $related ($self->search_related($rel)) {
257 $related->copy($resolved);
266 $obj->store_column($col => $val);
268 Sets a column value without marking it as dirty.
273 my ($self, $column, $value) = @_;
274 $self->throw_exception( "No such column '${column}'" )
275 unless exists $self->{_column_data}{$column} || $self->has_column($column);
276 $self->throw_exception( "set_column called for ${column} without value" )
278 return $self->{_column_data}{$column} = $value;
281 =head2 inflate_result
283 Class->inflate_result($result_source, \%me, \%prefetch?)
285 Called by ResultSet to inflate a result from storage
290 my ($class, $source, $me, $prefetch) = @_;
291 #use Data::Dumper; print Dumper(@_);
292 my $new = bless({ result_source => $source,
296 ref $class || $class);
298 foreach my $pre (keys %{$prefetch||{}}) {
299 my $pre_val = $prefetch->{$pre};
300 my $pre_source = $source->related_source($pre);
301 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
303 if (ref $pre_val->[0] eq 'ARRAY') { # multi
305 foreach my $pre_rec (@$pre_val) {
306 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
307 and !defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
310 push(@pre_objects, $pre_source->result_class->inflate_result(
311 $pre_source, @{$pre_rec}));
313 $new->related_resultset($pre)->set_cache(\@pre_objects);
316 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
317 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
319 $fetched = $pre_source->result_class->inflate_result(
320 $pre_source, @{$pre_val});
322 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
323 $class->throw_exception("No accessor for prefetched $pre")
324 unless defined $accessor;
325 if ($accessor eq 'single') {
326 $new->{_relationship_data}{$pre} = $fetched;
327 } elsif ($accessor eq 'filter') {
328 $new->{_inflated_column}{$pre} = $fetched;
330 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
337 =head2 insert_or_update
339 $obj->insert_or_update
341 Updates the object if it's already in the db, else inserts it.
345 sub insert_or_update {
347 return ($self->in_storage ? $self->update : $self->insert);
352 my @changed_col_names = $obj->is_changed
357 return keys %{shift->{_dirty_columns} || {}};
362 Accessor to the ResultSource this object was created from
364 =head2 register_column
366 =head3 Arguments: ($column, $column_info)
368 Registers a column on the class. If the column_info has an 'accessor' key,
369 creates an accessor named after the value if defined; if there is no such
370 key, creates an accessor with the same name as the column
374 sub register_column {
375 my ($class, $col, $info) = @_;
377 if (exists $info->{accessor}) {
378 return unless defined $info->{accessor};
379 $acc = [ $info->{accessor}, $col ];
381 $class->mk_group_accessors('column' => $acc);
385 =head2 throw_exception
387 See Schema's throw_exception.
391 sub throw_exception {
393 if (ref $self && ref $self->result_source) {
394 $self->result_source->schema->throw_exception(@_);
404 Matt S. Trout <mst@shadowcatsystems.co.uk>
408 You may distribute this code under the same terms as Perl itself.