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 $self->set_columns($upd) if $upd;
100 my %to_update = $self->get_dirty_columns;
101 return $self unless keys %to_update;
102 my $ident_cond = $self->ident_condition;
103 $self->throw_exception("Cannot safely update a row in a PK-less table")
104 if ! keys %$ident_cond;
105 my $rows = $self->result_source->storage->update(
106 $self->result_source->from, \%to_update, $ident_cond);
108 $self->throw_exception( "Can't update ${self}: row not found" );
109 } elsif ($rows > 1) {
110 $self->throw_exception("Can't update ${self}: updated more than one row");
112 $self->{_dirty_columns} = {};
120 Deletes the object from the database. The object is still perfectly usable
121 accessor-wise etc. but ->in_storage will now return 0 and the object must
122 be re ->insert'ed before it can be ->update'ed
129 $self->throw_exception( "Not in database" ) unless $self->in_storage;
130 my $ident_cond = $self->ident_condition;
131 $self->throw_exception("Cannot safely delete a row in a PK-less table")
132 if ! keys %$ident_cond;
133 $self->result_source->storage->delete(
134 $self->result_source->from, $ident_cond);
135 $self->in_storage(undef);
137 $self->throw_exception("Can't do class delete without a ResultSource instance")
138 unless $self->can('result_source_instance');
140 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
141 $attrs = { %{ pop(@_) } };
143 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
144 $self->result_source_instance->resultset->search(@_)->delete;
151 my $val = $obj->get_column($col);
153 Gets a column value from a row object. Currently, does not do
154 any queries; the column must have already been fetched from
155 the database and stored in the object.
160 my ($self, $column) = @_;
161 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
162 return $self->{_column_data}{$column}
163 if exists $self->{_column_data}{$column};
164 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
170 my %data = $obj->get_columns;
172 Does C<get_column>, for all column values at once.
178 return %{$self->{_column_data}};
181 =head2 get_dirty_columns
183 my %data = $obj->get_dirty_columns;
185 Identical to get_columns but only returns those that have been changed.
189 sub get_dirty_columns {
191 return map { $_ => $self->{_column_data}{$_} }
192 keys %{$self->{_dirty_columns}};
197 $obj->set_column($col => $val);
199 Sets a column value. If the new value is different from the old one,
200 the column is marked as dirty for when you next call $obj->update.
207 my $old = $self->get_column($column);
208 my $ret = $self->store_column(@_);
209 $self->{_dirty_columns}{$column} = 1
210 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
216 my $copy = $orig->set_columns({ $col => $val, ... });
218 Sets more than one column value at once.
223 my ($self,$data) = @_;
224 while (my ($col,$val) = each %$data) {
225 $self->set_column($col,$val);
232 my $copy = $orig->copy({ change => $to, ... });
234 Inserts a new row with the specified changes.
239 my ($self, $changes) = @_;
240 my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
241 $new->set_column($_ => $changes->{$_}) for keys %$changes;
247 $obj->store_column($col => $val);
249 Sets a column value without marking it as dirty.
254 my ($self, $column, $value) = @_;
255 $self->throw_exception( "No such column '${column}'" )
256 unless exists $self->{_column_data}{$column} || $self->has_column($column);
257 $self->throw_exception( "set_column called for ${column} without value" )
259 return $self->{_column_data}{$column} = $value;
262 =head2 inflate_result
264 Class->inflate_result($result_source, \%me, \%prefetch?)
266 Called by ResultSet to inflate a result from storage
271 my ($class, $source, $me, $prefetch) = @_;
272 #use Data::Dumper; print Dumper(@_);
273 my $new = bless({ result_source => $source,
277 ref $class || $class);
279 PRE: foreach my $pre (keys %{$prefetch||{}}) {
280 my $pre_source = $source->related_source($pre);
281 $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
283 unless ($pre_source->primary_columns == grep { exists $prefetch->{$pre}[0]{$_}
284 and !defined $prefetch->{$pre}[0]{$_} } $pre_source->primary_columns)
286 $fetched = $pre_source->result_class->inflate_result(
287 $pre_source, @{$prefetch->{$pre}});
289 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
290 $class->throw_exception("No accessor for prefetched $pre")
291 unless defined $accessor;
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
332 =head3 Arguments: ($column, $column_info)
334 Registers a column on the class. If the column_info has an 'accessor' key,
335 creates an accessor named after the value if defined; if there is no such
336 key, creates an accessor with the same name as the column
340 sub register_column {
341 my ($class, $col, $info) = @_;
343 if (exists $info->{accessor}) {
344 return unless defined $info->{accessor};
345 $acc = [ $info->{accessor}, $col ];
347 $class->mk_group_accessors('column' => $acc);
351 =head2 throw_exception
353 See Schema's throw_exception.
357 sub throw_exception {
359 if (ref $self && ref $self->result_source) {
360 $self->result_source->schema->throw_exception(@_);
370 Matt S. Trout <mst@shadowcatsystems.co.uk>
374 You may distribute this code under the same terms as Perl itself.