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 $rows = $self->result_source->storage->update(
102 $self->result_source->from, \%to_update, $self->ident_condition);
104 $self->throw_exception( "Can't update ${self}: row not found" );
105 } elsif ($rows > 1) {
106 $self->throw_exception("Can't update ${self}: updated more than one row");
108 $self->{_dirty_columns} = {};
116 Deletes the object from the database. The object is still perfectly usable
117 accessor-wise etc. but ->in_storage will now return 0 and the object must
118 be re ->insert'ed before it can be ->update'ed
125 $self->throw_exception( "Not in database" ) unless $self->in_storage;
126 $self->result_source->storage->delete(
127 $self->result_source->from, $self->ident_condition);
128 $self->in_storage(undef);
130 $self->throw_exception("Can't do class delete without a ResultSource instance")
131 unless $self->can('result_source_instance');
133 if (@_ > 1 && ref $_[$#_] eq 'HASH') {
134 $attrs = { %{ pop(@_) } };
136 my $query = (ref $_[0] eq 'HASH' ? $_[0] : {@_});
137 $self->result_source_instance->resultset->search(@_)->delete;
144 my $val = $obj->get_column($col);
146 Gets a column value from a row object. Currently, does not do
147 any queries; the column must have already been fetched from
148 the database and stored in the object.
153 my ($self, $column) = @_;
154 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
155 return $self->{_column_data}{$column}
156 if exists $self->{_column_data}{$column};
157 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
163 my %data = $obj->get_columns;
165 Does C<get_column>, for all column values at once.
171 return %{$self->{_column_data}};
174 =head2 get_dirty_columns
176 my %data = $obj->get_dirty_columns;
178 Identical to get_columns but only returns those that have been changed.
182 sub get_dirty_columns {
184 return map { $_ => $self->{_column_data}{$_} }
185 keys %{$self->{_dirty_columns}};
190 $obj->set_column($col => $val);
192 Sets a column value. If the new value is different from the old one,
193 the column is marked as dirty for when you next call $obj->update.
200 my $old = $self->get_column($column);
201 my $ret = $self->store_column(@_);
202 $self->{_dirty_columns}{$column} = 1
203 if (defined $old ^ defined $ret) || (defined $old && $old ne $ret);
209 my $copy = $orig->set_columns({ $col => $val, ... });
211 Sets more than one column value at once.
216 my ($self,$data) = @_;
217 while (my ($col,$val) = each %$data) {
218 $self->set_column($col,$val);
225 my $copy = $orig->copy({ change => $to, ... });
227 Inserts a new row with the specified changes.
232 my ($self, $changes) = @_;
233 my $new = bless({ _column_data => { %{$self->{_column_data}}} }, ref $self);
234 $new->set_column($_ => $changes->{$_}) for keys %$changes;
240 $obj->store_column($col => $val);
242 Sets a column value without marking it as dirty.
247 my ($self, $column, $value) = @_;
248 $self->throw_exception( "No such column '${column}'" )
249 unless exists $self->{_column_data}{$column} || $self->has_column($column);
250 $self->throw_exception( "set_column called for ${column} without value" )
252 return $self->{_column_data}{$column} = $value;
255 =head2 inflate_result
257 Class->inflate_result($result_source, \%me, \%prefetch?)
259 Called by ResultSet to inflate a result from storage
264 my ($class, $source, $me, $prefetch) = @_;
265 #use Data::Dumper; print Dumper(@_);
266 my $new = bless({ result_source => $source,
270 ref $class || $class);
272 PRE: foreach my $pre (keys %{$prefetch||{}}) {
273 my $pre_source = $source->related_source($pre);
274 $class->throw_exception("Can't prefetch non-existant relationship ${pre}") unless $pre_source;
275 my $fetched = $pre_source->result_class->inflate_result(
276 $pre_source, @{$prefetch->{$pre}});
277 my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
278 $class->throw_exception("No accessor for prefetched $pre")
279 unless defined $accessor;
280 PRIMARY: foreach my $pri ($pre_source->primary_columns) {
281 unless (defined $fetched->get_column($pri)) {
286 if ($accessor eq 'single') {
287 $new->{_relationship_data}{$pre} = $fetched;
288 } elsif ($accessor eq 'filter') {
289 $new->{_inflated_column}{$pre} = $fetched;
291 $class->throw_exception("Don't know how to store prefetched $pre");
297 =head2 insert_or_update
299 $obj->insert_or_update
301 Updates the object if it's already in the db, else inserts it.
305 sub insert_or_update {
307 return ($self->in_storage ? $self->update : $self->insert);
312 my @changed_col_names = $obj->is_changed
317 return keys %{shift->{_dirty_columns} || {}};
322 Accessor to the ResultSource this object was created from
324 =head2 register_column($column, $column_info)
326 Registers a column on the class. If the column_info has an 'accessor' key,
327 creates an accessor named after the value if defined; if there is no such
328 key, creates an accessor with the same name as the column
332 sub register_column {
333 my ($class, $col, $info) = @_;
335 if (exists $info->{accessor}) {
336 return unless defined $info->{accessor};
337 $acc = [ $info->{accessor}, $col ];
339 $class->mk_group_accessors('column' => $acc);
343 =head2 throw_exception
345 See Schema's throw_exception.
349 sub throw_exception {
351 if (ref $self && ref $self->result_source) {
352 $self->result_source->schema->throw_exception(@_);
362 Matt S. Trout <mst@shadowcatsystems.co.uk>
366 You may distribute this code under the same terms as Perl itself.