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} = {};
74 $obj->in_storage; # Get value
75 $obj->in_storage(1); # Set value
77 Indicated whether the object exists as a row in the database or not
82 my ($self, $val) = @_;
83 $self->{_in_storage} = $val if @_ > 1;
84 return $self->{_in_storage};
91 Must be run on an object that is already in the database; issues an SQL
92 UPDATE query to commit any changes to the object to the db if required.
97 my ($self, $upd) = @_;
98 $self->throw_exception( "Not in database" ) unless $self->in_storage;
99 my %to_update = $self->get_dirty_columns;
100 return $self unless keys %to_update;
101 my $ident_cond = $self->ident_condition;
102 $self->throw_exception("Cannot safely update a row in a PK-less table")
103 if ! keys %$ident_cond;
104 my $rows = $self->result_source->storage->update(
105 $self->result_source->from, \%to_update, $ident_cond);
107 $self->throw_exception( "Can't update ${self}: row not found" );
108 } elsif ($rows > 1) {
109 $self->throw_exception("Can't update ${self}: updated more than one row");
111 $self->{_dirty_columns} = {};
119 Deletes the object from the database. The object is still perfectly usable
120 accessor-wise etc. but ->in_storage will now return 0 and the object must
121 be re ->insert'ed before it can be ->update'ed
128 $self->throw_exception( "Not in database" ) unless $self->in_storage;
129 my $ident_cond = $self->ident_condition;
130 $self->throw_exception("Cannot safely delete a row in a PK-less table")
131 if ! keys %$ident_cond;
132 $self->result_source->storage->delete(
133 $self->result_source->from, $ident_cond);
134 $self->in_storage(undef);
136 $self->throw_exception("Can't do class delete without a ResultSource instance")
137 unless $self->can('result_source_instance');
139 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
140 $attrs = { %{ pop(@_) } };
142 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
143 $self->result_source_instance->resultset->search(@_)->delete;
150 my $val = $obj->get_column($col);
152 Gets a column value from a row object. Currently, does not do
153 any queries; the column must have already been fetched from
154 the database and stored in the object.
159 my ($self, $column) = @_;
160 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
161 return $self->{_column_data}{$column}
162 if exists $self->{_column_data}{$column};
163 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
169 my %data = $obj->get_columns;
171 Does C<get_column>, for all column values at once.
177 return %{$self->{_column_data}};
180 =head2 get_dirty_columns
182 my %data = $obj->get_dirty_columns;
184 Identical to get_columns but only returns those that have been changed.
188 sub get_dirty_columns {
190 return map { $_ => $self->{_column_data}{$_} }
191 keys %{$self->{_dirty_columns}};
196 $obj->set_column($col => $val);
198 Sets a column value. If the new value is different from the old one,
199 the column is marked as dirty for when you next call $obj->update.
206 my $old = $self->get_column($column);
207 my $ret = $self->store_column(@_);
208 $self->{_dirty_columns}{$column} = 1
209 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
215 my $copy = $orig->set_columns({ $col => $val, ... });
217 Sets more than one column value at once.
222 my ($self,$data) = @_;
223 while (my ($col,$val) = each %$data) {
224 $self->set_column($col,$val);
231 my $copy = $orig->copy({ change => $to, ... });
233 Inserts a new row with the specified changes.
238 my ($self, $changes) = @_;
239 my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
240 $new->set_column($_ => $changes->{$_}) for keys %$changes;
246 $obj->store_column($col => $val);
248 Sets a column value without marking it as dirty.
253 my ($self, $column, $value) = @_;
254 $self->throw_exception( "No such column '${column}'" )
255 unless exists $self->{_column_data}{$column} || $self->has_column($column);
256 $self->throw_exception( "set_column called for ${column} without value" )
258 return $self->{_column_data}{$column} = $value;
261 =head2 inflate_result
263 Class->inflate_result($result_source, \%me, \%prefetch?)
265 Called by ResultSet to inflate a result from storage
270 my ($class, $source, $me, $prefetch) = @_;
271 #use Data::Dumper; print Dumper(@_);
272 my $new = bless({ result_source => $source,
276 ref $class || $class);
278 PRE: foreach my $pre (keys %{$prefetch||{}}) {
279 my $pre_source = $source->related_source($pre);
280 $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
282 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
283 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
285 $fetched = $pre_source->result_class->inflate_result(
286 $pre_source, @{$prefetch->{$pre}});
288 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
289 $class->throw_exception("No accessor for prefetched $pre")
290 unless defined $accessor;
291 if ($accessor eq 'single') {
292 $new->{_relationship_data}{$pre} = $fetched;
293 } elsif ($accessor eq 'filter') {
294 $new->{_inflated_column}{$pre} = $fetched;
296 $class->throw_exception("Don't know how to store prefetched $pre");
302 =head2 insert_or_update
304 $obj->insert_or_update
306 Updates the object if it's already in the db, else inserts it.
310 sub insert_or_update {
312 return ($self->in_storage ? $self->update : $self->insert);
317 my @changed_col_names = $obj->is_changed
322 return keys %{shift->{_dirty_columns} || {}};
327 Accessor to the ResultSource this object was created from
329 =head2 register_column($column, $column_info)
331 Registers a column on the class. If the column_info has an 'accessor' key,
332 creates an accessor named after the value if defined; if there is no such
333 key, creates an accessor with the same name as the column
337 sub register_column {
338 my ($class, $col, $info) = @_;
340 if (exists $info->{accessor}) {
341 return unless defined $info->{accessor};
342 $acc = [ $info->{accessor}, $col ];
344 $class->mk_group_accessors('column' => $acc);
348 =head2 throw_exception
350 See Schema's throw_exception.
354 sub throw_exception {
356 if (ref $self && ref $self->result_source) {
357 $self->result_source->schema->throw_exception(@_);
367 Matt S. Trout <mst@shadowcatsystems.co.uk>
371 You may distribute this code under the same terms as Perl itself.