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")
40 unless ref($attrs) eq 'HASH';
41 while (my ($k, $v) = each %$attrs) {
42 $new->throw_exception("No such column $k on $class")
43 unless $class->has_column($k);
44 $new->store_column($k => $v);
54 Inserts an object into the database if it isn't already in there. Returns
55 the object itself. Requires the object's result source to be set, or the
56 class to have a result_source_instance method.
62 return $self if $self->in_storage;
63 $self->{result_source} ||= $self->result_source_instance
64 if $self->can('result_source_instance');
65 my $source = $self->{result_source};
66 $self->throw_exception("No result_source set on this object; can't insert")
68 #use Data::Dumper; warn Dumper($self);
69 $source->storage->insert($source->from, { $self->get_columns });
71 $self->{_dirty_columns} = {};
72 $self->{related_resultsets} = {};
78 $obj->in_storage; # Get value
79 $obj->in_storage(1); # Set value
81 Indicated whether the object exists as a row in the database or not
86 my ($self, $val) = @_;
87 $self->{_in_storage} = $val if @_ > 1;
88 return $self->{_in_storage};
95 Must be run on an object that is already in the database; issues an SQL
96 UPDATE query to commit any changes to the object to the db if required.
101 my ($self, $upd) = @_;
102 $self->throw_exception( "Not in database" ) unless $self->in_storage;
103 $self->set_columns($upd) if $upd;
104 my %to_update = $self->get_dirty_columns;
105 return $self unless keys %to_update;
106 my $ident_cond = $self->ident_condition;
107 $self->throw_exception("Cannot safely update a row in a PK-less table")
108 if ! keys %$ident_cond;
109 my $rows = $self->result_source->storage->update(
110 $self->result_source->from, \%to_update, $ident_cond);
112 $self->throw_exception( "Can't update ${self}: row not found" );
113 } elsif ($rows > 1) {
114 $self->throw_exception("Can't update ${self}: updated more than one row");
116 $self->{_dirty_columns} = {};
117 $self->{related_resultsets} = {};
125 Deletes the object from the database. The object is still perfectly usable,
126 but ->in_storage() will now return 0 and the object must re inserted using
127 ->insert() before ->update() can be used on it.
134 $self->throw_exception( "Not in database" ) unless $self->in_storage;
135 my $ident_cond = $self->ident_condition;
136 $self->throw_exception("Cannot safely delete a row in a PK-less table")
137 if ! keys %$ident_cond;
138 foreach my $column (keys %$ident_cond) {
139 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
140 unless exists $self->{_column_data}{$column};
142 $self->result_source->storage->delete(
143 $self->result_source->from, $ident_cond);
144 $self->in_storage(undef);
146 $self->throw_exception("Can't do class delete without a ResultSource instance")
147 unless $self->can('result_source_instance');
148 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
149 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
150 $self->result_source_instance->resultset->search(@_)->delete;
157 my $val = $obj->get_column($col);
159 Gets a column value from a row object. Currently, does not do
160 any queries; the column must have already been fetched from
161 the database and stored in the object.
166 my ($self, $column) = @_;
167 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
168 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
169 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
173 sub has_column_loaded {
174 my ($self, $column) = @_;
175 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
176 return exists $self->{_column_data}{$column};
181 my %data = $obj->get_columns;
183 Does C<get_column>, for all column values at once.
189 return %{$self->{_column_data}};
192 =head2 get_dirty_columns
194 my %data = $obj->get_dirty_columns;
196 Identical to get_columns but only returns those that have been changed.
200 sub get_dirty_columns {
202 return map { $_ => $self->{_column_data}{$_} }
203 keys %{$self->{_dirty_columns}};
208 $obj->set_column($col => $val);
210 Sets a column value. If the new value is different from the old one,
211 the column is marked as dirty for when you next call $obj->update.
218 my $old = $self->get_column($column);
219 my $ret = $self->store_column(@_);
220 $self->{_dirty_columns}{$column} = 1
221 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
227 my $copy = $orig->set_columns({ $col => $val, ... });
229 Sets more than one column value at once.
234 my ($self,$data) = @_;
235 while (my ($col,$val) = each %$data) {
236 $self->set_column($col,$val);
243 my $copy = $orig->copy({ change => $to, ... });
245 Inserts a new row with the specified changes.
250 my ($self, $changes) = @_;
252 my $col_data = { %{$self->{_column_data}} };
253 foreach my $col (keys %$col_data) {
254 delete $col_data->{$col}
255 if $self->result_source->column_info($col)->{is_auto_increment};
257 my $new = bless { _column_data => $col_data }, ref $self;
258 $new->set_columns($changes);
260 foreach my $rel ($self->result_source->relationships) {
261 my $rel_info = $self->result_source->relationship_info($rel);
262 if ($rel_info->{attrs}{cascade_copy}) {
263 my $resolved = $self->result_source->resolve_condition(
264 $rel_info->{cond}, $rel, $new);
265 foreach my $related ($self->search_related($rel)) {
266 $related->copy($resolved);
275 $obj->store_column($col => $val);
277 Sets a column value without marking it as dirty.
282 my ($self, $column, $value) = @_;
283 $self->throw_exception( "No such column '${column}'" )
284 unless exists $self->{_column_data}{$column} || $self->has_column($column);
285 $self->throw_exception( "set_column called for ${column} without value" )
287 return $self->{_column_data}{$column} = $value;
290 =head2 inflate_result
292 Class->inflate_result($result_source, \%me, \%prefetch?)
294 Called by ResultSet to inflate a result from storage
299 my ($class, $source, $me, $prefetch) = @_;
300 #use Data::Dumper; print Dumper(@_);
301 my $new = bless({ result_source => $source,
305 ref $class || $class);
307 foreach my $pre (keys %{$prefetch||{}}) {
308 my $pre_val = $prefetch->{$pre};
309 my $pre_source = $source->related_source($pre);
310 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
312 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
314 foreach my $pre_rec (@$pre_val) {
315 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
316 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
319 push(@pre_objects, $pre_source->result_class->inflate_result(
320 $pre_source, @{$pre_rec}));
322 $new->related_resultset($pre)->set_cache(\@pre_objects);
323 } elsif (defined $pre_val->[0]) {
325 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
326 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
328 $fetched = $pre_source->result_class->inflate_result(
329 $pre_source, @{$pre_val});
331 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
332 $class->throw_exception("No accessor for prefetched $pre")
333 unless defined $accessor;
334 if ($accessor eq 'single') {
335 $new->{_relationship_data}{$pre} = $fetched;
336 } elsif ($accessor eq 'filter') {
337 $new->{_inflated_column}{$pre} = $fetched;
339 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
346 =head2 update_or_insert
348 $obj->update_or_insert
350 Updates the object if it's already in the db, else inserts it.
354 *insert_or_update = \&update_or_insert;
355 sub update_or_insert {
357 return ($self->in_storage ? $self->update : $self->insert);
362 my @changed_col_names = $obj->is_changed
367 return keys %{shift->{_dirty_columns} || {}};
372 Accessor to the ResultSource this object was created from
374 =head2 register_column
378 =item Arguments: ($column, $column_info)
382 Registers a column on the class. If the column_info has an 'accessor' key,
383 creates an accessor named after the value if defined; if there is no such
384 key, creates an accessor with the same name as the column
388 sub register_column {
389 my ($class, $col, $info) = @_;
391 if (exists $info->{accessor}) {
392 return unless defined $info->{accessor};
393 $acc = [ $info->{accessor}, $col ];
395 $class->mk_group_accessors('column' => $acc);
399 =head2 throw_exception
401 See Schema's throw_exception.
405 sub throw_exception {
407 if (ref $self && ref $self->result_source) {
408 $self->result_source->schema->throw_exception(@_);
418 Matt S. Trout <mst@shadowcatsystems.co.uk>
422 You may distribute this code under the same terms as Perl itself.