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} = {};
74 $obj->in_storage; # Get value
75 $obj->in_storage(1); # Set value
77 Indicated whether the object exists as a row in the database or not
82 my ($self, $val) = @_;
83 $self->{_in_storage} = $val if @_ > 1;
84 return $self->{_in_storage};
91 Must be run on an object that is already in the database; issues an SQL
92 UPDATE query to commit any changes to the object to the db if required.
97 my ($self, $upd) = @_;
98 $self->throw_exception( "Not in database" ) unless $self->in_storage;
99 my %to_update = $self->get_dirty_columns;
100 return $self unless keys %to_update;
101 my $ident_cond = $self->ident_condition;
102 $self->throw_exception("Cannot safely update a row in a PK-less table")
103 if ! keys %$ident_cond;
104 my $rows = $self->result_source->storage->update(
105 $self->result_source->from, \%to_update, $ident_cond);
107 $self->throw_exception( "Can't update ${self}: row not found" );
108 } elsif ($rows > 1) {
109 $self->throw_exception("Can't update ${self}: updated more than one row");
111 $self->{_dirty_columns} = {};
119 Deletes the object from the database. The object is still perfectly usable
120 accessor-wise etc. but ->in_storage will now return 0 and the object must
121 be re ->insert'ed before it can be ->update'ed
128 $self->throw_exception( "Not in database" ) unless $self->in_storage;
129 my $ident_cond = $self->ident_condition;
130 $self->throw_exception("Cannot safely delete a row in a PK-less table")
131 if ! keys %$ident_cond;
132 $self->result_source->storage->delete(
133 $self->result_source->from, $ident_cond);
134 $self->in_storage(undef);
136 $self->throw_exception("Can't do class delete without a ResultSource instance")
137 unless $self->can('result_source_instance');
139 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
140 $attrs = { %{ pop(@_) } };
142 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
143 $self->result_source_instance->resultset->search(@_)->delete;
150 my $val = $obj->get_column($col);
152 Gets a column value from a row object. Currently, does not do
153 any queries; the column must have already been fetched from
154 the database and stored in the object.
159 my ($self, $column) = @_;
160 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
161 return $self->{_column_data}{$column}
162 if exists $self->{_column_data}{$column};
163 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
169 my %data = $obj->get_columns;
171 Does C<get_column>, for all column values at once.
177 return %{$self->{_column_data}};
180 =head2 get_dirty_columns
182 my %data = $obj->get_dirty_columns;
184 Identical to get_columns but only returns those that have been changed.
188 sub get_dirty_columns {
190 return map { $_ => $self->{_column_data}{$_} }
191 keys %{$self->{_dirty_columns}};
196 $obj->set_column($col => $val);
198 Sets a column value. If the new value is different from the old one,
199 the column is marked as dirty for when you next call $obj->update.
206 my $old = $self->get_column($column);
207 my $ret = $self->store_column(@_);
208 $self->{_dirty_columns}{$column} = 1
209 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
215 my $copy = $orig->set_columns({ $col => $val, ... });
217 Sets more than one column value at once.
222 my ($self,$data) = @_;
223 while (my ($col,$val) = each %$data) {
224 $self->set_column($col,$val);
231 my $copy = $orig->copy({ change => $to, ... });
233 Inserts a new row with the specified changes.
238 my ($self, $changes) = @_;
240 my $col_data = { %{$self->{_column_data}} };
241 foreach my $col (keys %$col_data) {
242 delete $col_data->{$col}
243 if $self->result_source->column_info($col)->{is_auto_increment};
245 my $new = bless({ _column_data => $col_data }, ref $self);
246 $new->set_column($_ => $changes->{$_}) for keys %$changes;
248 foreach my $rel ($self->result_source->relationships) {
249 my $rel_info = $self->result_source->relationship_info($rel);
250 if ($rel_info->{attrs}{cascade_copy}) {
251 my $resolved = $self->result_source->resolve_condition(
252 $rel_info->{cond}, $rel, $new);
253 foreach my $related ($self->search_related($rel)) {
254 $related->copy($resolved);
263 $obj->store_column($col => $val);
265 Sets a column value without marking it as dirty.
270 my ($self, $column, $value) = @_;
271 $self->throw_exception( "No such column '${column}'" )
272 unless exists $self->{_column_data}{$column} || $self->has_column($column);
273 $self->throw_exception( "set_column called for ${column} without value" )
275 return $self->{_column_data}{$column} = $value;
278 =head2 inflate_result
280 Class->inflate_result($result_source, \%me, \%prefetch?)
282 Called by ResultSet to inflate a result from storage
287 my ($class, $source, $me, $prefetch) = @_;
288 #use Data::Dumper; print Dumper(@_);
289 my $new = bless({ result_source => $source,
293 ref $class || $class);
295 PRE: foreach my $pre (keys %{$prefetch||{}}) {
296 my $pre_source = $source->related_source($pre);
297 $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
299 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
300 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
302 $fetched = $pre_source->result_class->inflate_result(
303 $pre_source, @{$prefetch->{$pre}});
305 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
306 $class->throw_exception("No accessor for prefetched $pre")
307 unless defined $accessor;
308 if ($accessor eq 'single') {
309 $new->{_relationship_data}{$pre} = $fetched;
310 } elsif ($accessor eq 'filter') {
311 $new->{_inflated_column}{$pre} = $fetched;
313 $class->throw_exception("Don't know how to store prefetched $pre");
319 =head2 insert_or_update
321 $obj->insert_or_update
323 Updates the object if it's already in the db, else inserts it.
327 sub insert_or_update {
329 return ($self->in_storage ? $self->update : $self->insert);
334 my @changed_col_names = $obj->is_changed
339 return keys %{shift->{_dirty_columns} || {}};
344 Accessor to the ResultSource this object was created from
346 =head2 register_column($column, $column_info)
348 Registers a column on the class. If the column_info has an 'accessor' key,
349 creates an accessor named after the value if defined; if there is no such
350 key, creates an accessor with the same name as the column
354 sub register_column {
355 my ($class, $col, $info) = @_;
357 if (exists $info->{accessor}) {
358 return unless defined $info->{accessor};
359 $acc = [ $info->{accessor}, $col ];
361 $class->mk_group_accessors('column' => $acc);
365 =head2 throw_exception
367 See Schema's throw_exception.
371 sub throw_exception {
373 if (ref $self && ref $self->result_source) {
374 $self->result_source->schema->throw_exception(@_);
384 Matt S. Trout <mst@shadowcatsystems.co.uk>
388 You may distribute this code under the same terms as Perl itself.