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_column($_ => $changes->{$_}) for keys %$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 # if first prefetch item is arrayref, assume this is a has_many prefetch
301 # and that objects are pre inflated (TODO: check arrayref contents using "ref" to make sure)
302 if( ref $pre_val->[0] eq 'ARRAY' ) {
303 $new->related_resultset($pre)->set_cache( $pre_val->[0] );
306 my $pre_source = $source->related_source($pre);
307 $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source;
309 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
310 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
312 $fetched = $pre_source->result_class->inflate_result(
313 $pre_source, @{$prefetch->{$pre}});
315 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
316 $class->throw_exception("No accessor for prefetched $pre")
317 unless defined $accessor;
318 if ($accessor eq 'single') {
319 $new->{_relationship_data}{$pre} = $fetched;
320 } elsif ($accessor eq 'filter') {
321 $new->{_inflated_column}{$pre} = $fetched;
322 } elsif ($accessor eq 'multi') {
323 $class->throw_exception("Cache must be enabled for has_many prefetch '$pre'");
325 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
332 =head2 insert_or_update
334 $obj->insert_or_update
336 Updates the object if it's already in the db, else inserts it.
340 sub insert_or_update {
342 return ($self->in_storage ? $self->update : $self->insert);
347 my @changed_col_names = $obj->is_changed
352 return keys %{shift->{_dirty_columns} || {}};
357 Accessor to the ResultSource this object was created from
359 =head2 register_column($column, $column_info)
361 Registers a column on the class. If the column_info has an 'accessor' key,
362 creates an accessor named after the value if defined; if there is no such
363 key, creates an accessor with the same name as the column
367 sub register_column {
368 my ($class, $col, $info) = @_;
370 if (exists $info->{accessor}) {
371 return unless defined $info->{accessor};
372 $acc = [ $info->{accessor}, $col ];
374 $class->mk_group_accessors('column' => $acc);
378 =head2 throw_exception
380 See Schema's throw_exception.
384 sub throw_exception {
386 if (ref $self && ref $self->result_source) {
387 $self->result_source->schema->throw_exception(@_);
397 Matt S. Trout <mst@shadowcatsystems.co.uk>
401 You may distribute this code under the same terms as Perl itself.