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 foreach my $column (keys %$ident_cond) {
136 $self->throw_exception("Can't delete the object unless it has loaded the primary keys")
137 unless exists $self->{_column_data}{$column};
139 $self->result_source->storage->delete(
140 $self->result_source->from, $ident_cond);
141 $self->in_storage(undef);
143 $self->throw_exception("Can't do class delete without a ResultSource instance")
144 unless $self->can('result_source_instance');
146 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
147 $attrs = { %{ 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}
169 if exists $self->{_column_data}{$column};
170 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
174 sub has_column_loaded {
175 my ($self, $column) = @_;
176 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
178 if exists $self->{_column_data}{$column};
184 my %data = $obj->get_columns;
186 Does C<get_column>, for all column values at once.
192 return %{$self->{_column_data}};
195 =head2 get_dirty_columns
197 my %data = $obj->get_dirty_columns;
199 Identical to get_columns but only returns those that have been changed.
203 sub get_dirty_columns {
205 return map { $_ => $self->{_column_data}{$_} }
206 keys %{$self->{_dirty_columns}};
211 $obj->set_column($col => $val);
213 Sets a column value. If the new value is different from the old one,
214 the column is marked as dirty for when you next call $obj->update.
221 my $old = $self->get_column($column);
222 my $ret = $self->store_column(@_);
223 $self->{_dirty_columns}{$column} = 1
224 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
230 my $copy = $orig->set_columns({ $col => $val, ... });
232 Sets more than one column value at once.
237 my ($self,$data) = @_;
238 while (my ($col,$val) = each %$data) {
239 $self->set_column($col,$val);
246 my $copy = $orig->copy({ change => $to, ... });
248 Inserts a new row with the specified changes.
253 my ($self, $changes) = @_;
255 my $col_data = { %{$self->{_column_data}} };
256 foreach my $col (keys %$col_data) {
257 delete $col_data->{$col}
258 if $self->result_source->column_info($col)->{is_auto_increment};
260 my $new = bless({ _column_data => $col_data }, ref $self);
261 $new->set_columns($changes);
263 foreach my $rel ($self->result_source->relationships) {
264 my $rel_info = $self->result_source->relationship_info($rel);
265 if ($rel_info->{attrs}{cascade_copy}) {
266 my $resolved = $self->result_source->resolve_condition(
267 $rel_info->{cond}, $rel, $new);
268 foreach my $related ($self->search_related($rel)) {
269 $related->copy($resolved);
278 $obj->store_column($col => $val);
280 Sets a column value without marking it as dirty.
285 my ($self, $column, $value) = @_;
286 $self->throw_exception( "No such column '${column}'" )
287 unless exists $self->{_column_data}{$column} || $self->has_column($column);
288 $self->throw_exception( "set_column called for ${column} without value" )
290 return $self->{_column_data}{$column} = $value;
293 =head2 inflate_result
295 Class->inflate_result($result_source, \%me, \%prefetch?)
297 Called by ResultSet to inflate a result from storage
302 my ($class, $source, $me, $prefetch) = @_;
303 #use Data::Dumper; print Dumper(@_);
304 my $new = bless({ result_source => $source,
308 ref $class || $class);
310 foreach my $pre (keys %{$prefetch||{}}) {
311 my $pre_val = $prefetch->{$pre};
312 my $pre_source = $source->related_source($pre);
313 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
315 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
317 foreach my $pre_rec (@$pre_val) {
318 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
319 and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
322 push(@pre_objects, $pre_source->result_class->inflate_result(
323 $pre_source, @{$pre_rec}));
325 $new->related_resultset($pre)->set_cache(\@pre_objects);
328 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
329 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
331 $fetched = $pre_source->result_class->inflate_result(
332 $pre_source, @{$pre_val});
334 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
335 $class->throw_exception("No accessor for prefetched $pre")
336 unless defined $accessor;
337 if ($accessor eq 'single') {
338 $new->{_relationship_data}{$pre} = $fetched;
339 } elsif ($accessor eq 'filter') {
340 $new->{_inflated_column}{$pre} = $fetched;
342 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
349 =head2 insert_or_update
351 $obj->insert_or_update
353 Updates the object if it's already in the db, else inserts it.
357 sub insert_or_update {
359 return ($self->in_storage ? $self->update : $self->insert);
364 my @changed_col_names = $obj->is_changed
369 return keys %{shift->{_dirty_columns} || {}};
374 Accessor to the ResultSource this object was created from
376 =head2 register_column
378 =head3 Arguments: ($column, $column_info)
380 Registers a column on the class. If the column_info has an 'accessor' key,
381 creates an accessor named after the value if defined; if there is no such
382 key, creates an accessor with the same name as the column
386 sub register_column {
387 my ($class, $col, $info) = @_;
389 if (exists $info->{accessor}) {
390 return unless defined $info->{accessor};
391 $acc = [ $info->{accessor}, $col ];
393 $class->mk_group_accessors('column' => $acc);
397 =head2 throw_exception
399 See Schema's throw_exception.
403 sub throw_exception {
405 if (ref $self && ref $self->result_source) {
406 $self->result_source->schema->throw_exception(@_);
416 Matt S. Trout <mst@shadowcatsystems.co.uk>
420 You may distribute this code under the same terms as Perl itself.