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 my %to_update = $self->get_dirty_columns;
101 return $self unless keys %to_update;
102 my $ident_cond = $self->ident_condition;
103 $self->throw_exception("Cannot safely update a row in a PK-less table")
104 if ! keys %$ident_cond;
105 my $rows = $self->result_source->storage->update(
106 $self->result_source->from, \%to_update, $ident_cond);
108 $self->throw_exception( "Can't update ${self}: row not found" );
109 } elsif ($rows > 1) {
110 $self->throw_exception("Can't update ${self}: updated more than one row");
112 $self->{_dirty_columns} = {};
113 $self->{related_resultsets} = {};
121 Deletes the object from the database. The object is still perfectly usable
122 accessor-wise etc. but ->in_storage will now return 0 and the object must
123 be re ->insert'ed before it can be ->update'ed
130 $self->throw_exception( "Not in database" ) unless $self->in_storage;
131 my $ident_cond = $self->ident_condition;
132 $self->throw_exception("Cannot safely delete a row in a PK-less table")
133 if ! keys %$ident_cond;
134 $self->result_source->storage->delete(
135 $self->result_source->from, $ident_cond);
136 $self->in_storage(undef);
138 $self->throw_exception("Can't do class delete without a ResultSource instance")
139 unless $self->can('result_source_instance');
141 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
142 $attrs = { %{ pop(@_) } };
144 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
145 $self->result_source_instance->resultset->search(@_)->delete;
152 my $val = $obj->get_column($col);
154 Gets a column value from a row object. Currently, does not do
155 any queries; the column must have already been fetched from
156 the database and stored in the object.
161 my ($self, $column) = @_;
162 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
163 return $self->{_column_data}{$column}
164 if exists $self->{_column_data}{$column};
165 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
171 my %data = $obj->get_columns;
173 Does C<get_column>, for all column values at once.
179 return %{$self->{_column_data}};
182 =head2 get_dirty_columns
184 my %data = $obj->get_dirty_columns;
186 Identical to get_columns but only returns those that have been changed.
190 sub get_dirty_columns {
192 return map { $_ => $self->{_column_data}{$_} }
193 keys %{$self->{_dirty_columns}};
198 $obj->set_column($col => $val);
200 Sets a column value. If the new value is different from the old one,
201 the column is marked as dirty for when you next call $obj->update.
208 my $old = $self->get_column($column);
209 my $ret = $self->store_column(@_);
210 $self->{_dirty_columns}{$column} = 1
211 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
217 my $copy = $orig->set_columns({ $col => $val, ... });
219 Sets more than one column value at once.
224 my ($self,$data) = @_;
225 while (my ($col,$val) = each %$data) {
226 $self->set_column($col,$val);
233 my $copy = $orig->copy({ change => $to, ... });
235 Inserts a new row with the specified changes.
240 my ($self, $changes) = @_;
242 my $col_data = { %{$self->{_column_data}} };
243 foreach my $col (keys %$col_data) {
244 delete $col_data->{$col}
245 if $self->result_source->column_info($col)->{is_auto_increment};
247 my $new = bless({ _column_data => $col_data }, ref $self);
248 $new->set_column($_ => $changes->{$_}) for keys %$changes;
250 foreach my $rel ($self->result_source->relationships) {
251 my $rel_info = $self->result_source->relationship_info($rel);
252 if ($rel_info->{attrs}{cascade_copy}) {
253 my $resolved = $self->result_source->resolve_condition(
254 $rel_info->{cond}, $rel, $new);
255 foreach my $related ($self->search_related($rel)) {
256 $related->copy($resolved);
265 $obj->store_column($col => $val);
267 Sets a column value without marking it as dirty.
272 my ($self, $column, $value) = @_;
273 $self->throw_exception( "No such column '${column}'" )
274 unless exists $self->{_column_data}{$column} || $self->has_column($column);
275 $self->throw_exception( "set_column called for ${column} without value" )
277 return $self->{_column_data}{$column} = $value;
280 =head2 inflate_result
282 Class->inflate_result($result_source, \%me, \%prefetch?)
284 Called by ResultSet to inflate a result from storage
289 my ($class, $source, $me, $prefetch) = @_;
290 #use Data::Dumper; print Dumper(@_);
291 my $new = bless({ result_source => $source,
295 ref $class || $class);
297 foreach my $pre (keys %{$prefetch||{}}) {
298 my $pre_val = $prefetch->{$pre};
299 # if first prefetch item is arrayref, assume this is a has_many prefetch
300 # and that objects are pre inflated (TODO: check arrayref contents using "ref" to make sure)
301 if( ref $pre_val->[0] eq 'ARRAY' ) {
302 $new->related_resultset($pre)->set_cache( $pre_val->[0] );
305 my $pre_source = $source->related_source($pre);
306 $class->throw_exception("Can't prefetch non-existent relationship ${pre}") unless $pre_source;
308 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
309 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
311 $fetched = $pre_source->result_class->inflate_result(
312 $pre_source, @{$prefetch->{$pre}});
314 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
315 $class->throw_exception("No accessor for prefetched $pre")
316 unless defined $accessor;
317 if ($accessor eq 'single') {
318 $new->{_relationship_data}{$pre} = $fetched;
319 } elsif ($accessor eq 'filter') {
320 $new->{_inflated_column}{$pre} = $fetched;
321 } elsif ($accessor eq 'multi') {
322 $class->throw_exception("Cache must be enabled for has_many prefetch '$pre'");
324 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
331 =head2 insert_or_update
333 $obj->insert_or_update
335 Updates the object if it's already in the db, else inserts it.
339 sub insert_or_update {
341 return ($self->in_storage ? $self->update : $self->insert);
346 my @changed_col_names = $obj->is_changed
351 return keys %{shift->{_dirty_columns} || {}};
356 Accessor to the ResultSource this object was created from
358 =head2 register_column($column, $column_info)
360 Registers a column on the class. If the column_info has an 'accessor' key,
361 creates an accessor named after the value if defined; if there is no such
362 key, creates an accessor with the same name as the column
366 sub register_column {
367 my ($class, $col, $info) = @_;
369 if (exists $info->{accessor}) {
370 return unless defined $info->{accessor};
371 $acc = [ $info->{accessor}, $col ];
373 $class->mk_group_accessors('column' => $acc);
377 =head2 throw_exception
379 See Schema's throw_exception.
383 sub throw_exception {
385 if (ref $self && ref $self->result_source) {
386 $self->result_source->schema->throw_exception(@_);
396 Matt S. Trout <mst@shadowcatsystems.co.uk>
400 You may distribute this code under the same terms as Perl itself.