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 $col_data = { %{$self->{_column_data}} };
240 foreach my $col (keys %$col_data) {
241 delete $col_data->{$col}
242 if $self->result_source->column_info($col)->{is_auto_increment};
244 my $new = bless({ _column_data => $col_data }, ref $self);
245 $new->set_column($_ => $changes->{$_}) for keys %$changes;
251 $obj->store_column($col => $val);
253 Sets a column value without marking it as dirty.
258 my ($self, $column, $value) = @_;
259 $self->throw_exception( "No such column '${column}'" )
260 unless exists $self->{_column_data}{$column} || $self->has_column($column);
261 $self->throw_exception( "set_column called for ${column} without value" )
263 return $self->{_column_data}{$column} = $value;
266 =head2 inflate_result
268 Class->inflate_result($result_source, \%me, \%prefetch?)
270 Called by ResultSet to inflate a result from storage
275 my ($class, $source, $me, $prefetch) = @_;
276 #use Data::Dumper; print Dumper(@_);
277 my $new = bless({ result_source => $source,
281 ref $class || $class);
283 PRE: foreach my $pre (keys %{$prefetch||{}}) {
284 my $pre_source = $source->related_source($pre);
285 $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
287 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
288 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
290 $fetched = $pre_source->result_class->inflate_result(
291 $pre_source, @{$prefetch->{$pre}});
293 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
294 $class->throw_exception("No accessor for prefetched $pre")
295 unless defined $accessor;
296 if ($accessor eq 'single') {
297 $new->{_relationship_data}{$pre} = $fetched;
298 } elsif ($accessor eq 'filter') {
299 $new->{_inflated_column}{$pre} = $fetched;
301 $class->throw_exception("Don't know how to store prefetched $pre");
307 =head2 insert_or_update
309 $obj->insert_or_update
311 Updates the object if it's already in the db, else inserts it.
315 sub insert_or_update {
317 return ($self->in_storage ? $self->update : $self->insert);
322 my @changed_col_names = $obj->is_changed
327 return keys %{shift->{_dirty_columns} || {}};
332 Accessor to the ResultSource this object was created from
334 =head2 register_column($column, $column_info)
336 Registers a column on the class. If the column_info has an 'accessor' key,
337 creates an accessor named after the value if defined; if there is no such
338 key, creates an accessor with the same name as the column
342 sub register_column {
343 my ($class, $col, $info) = @_;
345 if (exists $info->{accessor}) {
346 return unless defined $info->{accessor};
347 $acc = [ $info->{accessor}, $col ];
349 $class->mk_group_accessors('column' => $acc);
353 =head2 throw_exception
355 See Schema's throw_exception.
359 sub throw_exception {
361 if (ref $self && ref $self->result_source) {
362 $self->result_source->schema->throw_exception(@_);
372 Matt S. Trout <mst@shadowcatsystems.co.uk>
376 You may distribute this code under the same terms as Perl itself.