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}") unless $pre_source;
303 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
304 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
306 $fetched = $pre_source->result_class->inflate_result(
307 $pre_source, @{$prefetch->{$pre}});
309 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
310 $class->throw_exception("No accessor for prefetched $pre")
311 unless defined $accessor;
312 if ($accessor eq 'single') {
313 $new->{_relationship_data}{$pre} = $fetched;
314 } elsif ($accessor eq 'filter') {
315 $new->{_inflated_column}{$pre} = $fetched;
316 } elsif ($accessor eq 'multi') {
319 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
325 =head2 insert_or_update
327 $obj->insert_or_update
329 Updates the object if it's already in the db, else inserts it.
333 sub insert_or_update {
335 return ($self->in_storage ? $self->update : $self->insert);
340 my @changed_col_names = $obj->is_changed
345 return keys %{shift->{_dirty_columns} || {}};
350 Accessor to the ResultSource this object was created from
352 =head2 register_column
354 =head3 Arguments: ($column, $column_info)
356 Registers a column on the class. If the column_info has an 'accessor' key,
357 creates an accessor named after the value if defined; if there is no such
358 key, creates an accessor with the same name as the column
362 sub register_column {
363 my ($class, $col, $info) = @_;
365 if (exists $info->{accessor}) {
366 return unless defined $info->{accessor};
367 $acc = [ $info->{accessor}, $col ];
369 $class->mk_group_accessors('column' => $acc);
373 =head2 throw_exception
375 See Schema's throw_exception.
379 sub throw_exception {
381 if (ref $self && ref $self->result_source) {
382 $self->result_source->schema->throw_exception(@_);
392 Matt S. Trout <mst@shadowcatsystems.co.uk>
396 You may distribute this code under the same terms as Perl itself.