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::Table> 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;
281 my $fetched = $pre_source->result_class->inflate_result(
282 $pre_source, @{$prefetch->{$pre}});
283 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
284 $class->throw_exception("No accessor for prefetched $pre")
285 unless defined $accessor;
286 PRIMARY: foreach my $pri ($pre_source->primary_columns) {
287 unless (defined $fetched->get_column($pri)) {
292 if ($accessor eq 'single') {
293 $new->{_relationship_data}{$pre} = $fetched;
294 } elsif ($accessor eq 'filter') {
295 $new->{_inflated_column}{$pre} = $fetched;
297 $class->throw_exception("Don't know how to store prefetched $pre");
303 =head2 insert_or_update
305 $obj->insert_or_update
307 Updates the object if it's already in the db, else inserts it.
311 sub insert_or_update {
313 return ($self->in_storage ? $self->update : $self->insert);
318 my @changed_col_names = $obj->is_changed
323 return keys %{shift->{_dirty_columns} || {}};
328 Accessor to the ResultSource this object was created from
330 =head2 register_column($column, $column_info)
332 Registers a column on the class. If the column_info has an 'accessor' key,
333 creates an accessor named after the value if defined; if there is no such
334 key, creates an accessor with the same name as the column
338 sub register_column {
339 my ($class, $col, $info) = @_;
341 if (exists $info->{accessor}) {
342 return unless defined $info->{accessor};
343 $acc = [ $info->{accessor}, $col ];
345 $class->mk_group_accessors('column' => $acc);
349 =head2 throw_exception
351 See Schema's throw_exception.
355 sub throw_exception {
357 if (ref $self && ref $self->result_source) {
358 $self->result_source->schema->throw_exception(@_);
368 Matt S. Trout <mst@shadowcatsystems.co.uk>
372 You may distribute this code under the same terms as Perl itself.