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);
176 my %data = $obj->get_columns;
178 Does C<get_column>, for all column values at once.
184 return %{$self->{_column_data}};
187 =head2 get_dirty_columns
189 my %data = $obj->get_dirty_columns;
191 Identical to get_columns but only returns those that have been changed.
195 sub get_dirty_columns {
197 return map { $_ => $self->{_column_data}{$_} }
198 keys %{$self->{_dirty_columns}};
203 $obj->set_column($col => $val);
205 Sets a column value. If the new value is different from the old one,
206 the column is marked as dirty for when you next call $obj->update.
213 my $old = $self->get_column($column);
214 my $ret = $self->store_column(@_);
215 $self->{_dirty_columns}{$column} = 1
216 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
222 my $copy = $orig->set_columns({ $col => $val, ... });
224 Sets more than one column value at once.
229 my ($self,$data) = @_;
230 while (my ($col,$val) = each %$data) {
231 $self->set_column($col,$val);
238 my $copy = $orig->copy({ change => $to, ... });
240 Inserts a new row with the specified changes.
245 my ($self, $changes) = @_;
247 my $col_data = { %{$self->{_column_data}} };
248 foreach my $col (keys %$col_data) {
249 delete $col_data->{$col}
250 if $self->result_source->column_info($col)->{is_auto_increment};
252 my $new = bless({ _column_data => $col_data }, ref $self);
253 $new->set_columns($changes);
255 foreach my $rel ($self->result_source->relationships) {
256 my $rel_info = $self->result_source->relationship_info($rel);
257 if ($rel_info->{attrs}{cascade_copy}) {
258 my $resolved = $self->result_source->resolve_condition(
259 $rel_info->{cond}, $rel, $new);
260 foreach my $related ($self->search_related($rel)) {
261 $related->copy($resolved);
270 $obj->store_column($col => $val);
272 Sets a column value without marking it as dirty.
277 my ($self, $column, $value) = @_;
278 $self->throw_exception( "No such column '${column}'" )
279 unless exists $self->{_column_data}{$column} || $self->has_column($column);
280 $self->throw_exception( "set_column called for ${column} without value" )
282 return $self->{_column_data}{$column} = $value;
285 =head2 inflate_result
287 Class->inflate_result($result_source, \%me, \%prefetch?)
289 Called by ResultSet to inflate a result from storage
294 my ($class, $source, $me, $prefetch) = @_;
295 #use Data::Dumper; print Dumper(@_);
296 my $new = bless({ result_source => $source,
300 ref $class || $class);
302 foreach my $pre (keys %{$prefetch||{}}) {
303 my $pre_val = $prefetch->{$pre};
304 my $pre_source = $source->related_source($pre);
305 $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
307 #warn Data::Dumper::Dumper($pre_val)." ";
308 if (ref($pre_val->[0]) eq 'ARRAY') { # multi
310 foreach my $pre_rec (@$pre_val) {
311 unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
312 and !defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
315 push(@pre_objects, $pre_source->result_class->inflate_result(
316 $pre_source, @{$pre_rec}));
318 $new->related_resultset($pre)->set_cache(\@pre_objects);
321 unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
322 and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
324 $fetched = $pre_source->result_class->inflate_result(
325 $pre_source, @{$pre_val});
327 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
328 $class->throw_exception("No accessor for prefetched $pre")
329 unless defined $accessor;
330 if ($accessor eq 'single') {
331 $new->{_relationship_data}{$pre} = $fetched;
332 } elsif ($accessor eq 'filter') {
333 $new->{_inflated_column}{$pre} = $fetched;
335 $class->throw_exception("Prefetch not supported with accessor '$accessor'");
342 =head2 insert_or_update
344 $obj->insert_or_update
346 Updates the object if it's already in the db, else inserts it.
350 sub insert_or_update {
352 return ($self->in_storage ? $self->update : $self->insert);
357 my @changed_col_names = $obj->is_changed
362 return keys %{shift->{_dirty_columns} || {}};
367 Accessor to the ResultSource this object was created from
369 =head2 register_column
371 =head3 Arguments: ($column, $column_info)
373 Registers a column on the class. If the column_info has an 'accessor' key,
374 creates an accessor named after the value if defined; if there is no such
375 key, creates an accessor with the same name as the column
379 sub register_column {
380 my ($class, $col, $info) = @_;
382 if (exists $info->{accessor}) {
383 return unless defined $info->{accessor};
384 $acc = [ $info->{accessor}, $col ];
386 $class->mk_group_accessors('column' => $acc);
390 =head2 throw_exception
392 See Schema's throw_exception.
396 sub throw_exception {
398 if (ref $self && ref $self->result_source) {
399 $self->result_source->schema->throw_exception(@_);
409 Matt S. Trout <mst@shadowcatsystems.co.uk>
413 You may distribute this code under the same terms as Perl itself.