1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
8 use DBIx::Class::Exception;
9 use Scalar::Util 'blessed';
10 use List::Util 'first';
19 $ENV{DBIC_MULTICREATE_DEBUG}
28 DBIx::Class::Row - Basic row methods
34 This class is responsible for defining and doing basic operations on rows
35 derived from L<DBIx::Class::ResultSource> objects.
37 Result objects are returned from L<DBIx::Class::ResultSet>s using the
38 L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
39 L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
40 as well as invocations of 'single' (
41 L<belongs_to|DBIx::Class::Relationship/belongs_to>,
42 L<has_one|DBIx::Class::Relationship/has_one> or
43 L<might_have|DBIx::Class::Relationship/might_have>)
44 relationship accessors of L<Result|DBIx::Class::Manual::ResultClass> objects.
48 All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
49 object (such as a typical C<< L<search|DBIx::Class::ResultSet/search
50 >->L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
51 instances, based on your application's
52 L<Result class|DBIx::Class::Manual::Glossary/Result_class>.
54 L<DBIx::Class::Row> implements most of the row-based communication with the
55 underlying storage, but a Result class B<should not inherit from it directly>.
56 Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
57 combines the methods from several classes, one of them being
58 L<DBIx::Class::Row>. Therefore, while many of the methods available to a
59 L<DBIx::Class::Core>-derived Result class are described in the following
60 documentation, it does not detail all of the methods available to Result
61 objects. Refer to L<DBIx::Class::Manual::ResultClass> for more info.
67 my $row = My::Class->new(\%attrs);
69 my $row = $schema->resultset('MySource')->new(\%colsandvalues);
73 =item Arguments: \%attrs or \%colsandvalues
75 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
79 While you can create a new result object by calling C<new> directly on
80 this class, you are better off calling it on a
81 L<DBIx::Class::ResultSet> object.
83 When calling it directly, you will not get a complete, usable row
84 object until you pass or set the C<result_source> attribute, to a
85 L<DBIx::Class::ResultSource> instance that is attached to a
86 L<DBIx::Class::Schema> with a valid connection.
88 C<$attrs> is a hashref of column name, value data. It can also contain
89 some other attributes such as the C<result_source>.
91 Passing an object, or an arrayref of objects as a value will call
92 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
93 passed a hashref or an arrayref of hashrefs as the value, these will
94 be turned into objects via new_related, and treated as if you had
97 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
99 Please note that if a value is not passed to new, no value will be sent
100 in the SQL INSERT call, and the column will therefore assume whatever
101 default value was specified in your database. While DBIC will retrieve the
102 value of autoincrement columns, it will never make an explicit database
103 trip to retrieve default values assigned by the RDBMS. You can explicitly
104 request that all values be fetched back from the database by calling
105 L</discard_changes>, or you can supply an explicit C<undef> to columns
106 with NULL as the default, and save yourself a SELECT.
110 The behavior described above will backfire if you use a foreign key column
111 with a database-defined default. If you call the relationship accessor on
112 an object that doesn't have a set value for the FK column, DBIC will throw
113 an exception, as it has no way of knowing the PK of the related object (if
118 ## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
119 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
120 ## When doing the later insert, we need to make sure the PKs are set.
121 ## using _relationship_data in new and funky ways..
122 ## check Relationship::CascadeActions and Relationship::Accessor for compat
125 sub __new_related_find_or_new_helper {
126 my ($self, $relname, $data) = @_;
128 my $rsrc = $self->result_source;
130 # create a mock-object so all new/set_column component overrides will run:
131 my $rel_rs = $rsrc->related_source($relname)->resultset;
132 my $new_rel_obj = $rel_rs->new_result($data);
133 my $proc_data = { $new_rel_obj->get_columns };
135 if ($self->__their_pk_needs_us($relname)) {
136 MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
139 elsif ($rsrc->_pk_depends_on($relname, $proc_data )) {
140 if (! keys %$proc_data) {
141 # there is nothing to search for - blind create
142 MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname";
145 MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
146 # this is not *really* find or new, as we don't want to double-new the
147 # data (thus potentially double encoding or whatever)
148 my $exists = $rel_rs->find ($proc_data);
149 return $exists if $exists;
154 my $us = $rsrc->source_name;
155 $self->throw_exception (
156 "Unable to determine relationship '$relname' direction from '$us', "
157 . "possibly due to a missing reverse-relationship on '$relname' to '$us'."
162 sub __their_pk_needs_us { # this should maybe be in resultsource.
163 my ($self, $relname) = @_;
164 my $source = $self->result_source;
165 my $reverse = $source->reverse_relationship_info($relname);
166 my $rel_source = $source->related_source($relname);
167 my $us = { $self->get_columns };
168 foreach my $key (keys %$reverse) {
169 # if their primary key depends on us, then we have to
170 # just create a result and we'll fill it out afterwards
171 return 1 if $rel_source->_pk_depends_on($key, $us);
177 my ($class, $attrs) = @_;
178 $class = ref $class if ref $class;
180 my $new = bless { _column_data => {} }, $class;
183 $new->throw_exception("attrs must be a hashref")
184 unless ref($attrs) eq 'HASH';
186 my $source = delete $attrs->{-result_source};
187 if ( my $h = delete $attrs->{-source_handle} ) {
188 $source ||= $h->resolve;
191 $new->result_source($source) if $source;
193 if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
194 @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
197 my ($related,$inflated);
199 foreach my $key (keys %$attrs) {
200 if (ref $attrs->{$key}) {
201 ## Can we extract this lot to use with update(_or .. ) ?
202 $new->throw_exception("Can't do multi-create without result source")
204 my $info = $source->relationship_info($key);
205 my $acc_type = $info->{attrs}{accessor} || '';
206 if ($acc_type eq 'single') {
207 my $rel_obj = delete $attrs->{$key};
208 if(!blessed $rel_obj) {
209 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
212 if ($rel_obj->in_storage) {
213 $new->{_rel_in_storage}{$key} = 1;
214 $new->set_from_related($key, $rel_obj);
216 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
219 $related->{$key} = $rel_obj;
222 elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
223 my $others = delete $attrs->{$key};
224 my $total = @$others;
226 foreach my $idx (0 .. $#$others) {
227 my $rel_obj = $others->[$idx];
228 if(!blessed $rel_obj) {
229 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
232 if ($rel_obj->in_storage) {
233 $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
235 MULTICREATE_DEBUG and
236 warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
238 push(@objects, $rel_obj);
240 $related->{$key} = \@objects;
243 elsif ($acc_type eq 'filter') {
244 ## 'filter' should disappear and get merged in with 'single' above!
245 my $rel_obj = delete $attrs->{$key};
246 if(!blessed $rel_obj) {
247 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
249 if ($rel_obj->in_storage) {
250 $new->{_rel_in_storage}{$key} = 1;
253 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
255 $inflated->{$key} = $rel_obj;
257 } elsif ($class->has_column($key)
258 && $class->column_info($key)->{_inflate_info}) {
259 $inflated->{$key} = $attrs->{$key};
263 $new->throw_exception("No such column $key on $class")
264 unless $class->has_column($key);
265 $new->store_column($key => $attrs->{$key});
268 $new->{_relationship_data} = $related if $related;
269 $new->{_inflated_column} = $inflated if $inflated;
275 =head2 $column_accessor
277 # Each pair does the same thing
279 # (un-inflated, regular column)
280 my $val = $row->get_column('first_name');
281 my $val = $row->first_name;
283 $row->set_column('first_name' => $val);
284 $row->first_name($val);
286 # (inflated column via DBIx::Class::InflateColumn::DateTime)
287 my $val = $row->get_inflated_column('last_modified');
288 my $val = $row->last_modified;
290 $row->set_inflated_column('last_modified' => $val);
291 $row->last_modified($val);
295 =item Arguments: $value?
297 =item Return Value: $value
301 A column accessor method is created for each column, which is used for
302 getting/setting the value for that column.
304 The actual method name is based on the L<accessor|DBIx::Class::ResultSource/accessor>
305 name given in the table definition. Like L</set_column>, this will
306 not store the data until L</insert> or L</update> is called on the row.
314 =item Arguments: none
316 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
320 Inserts an object previously created by L</new> into the database if
321 it isn't already in there. Returns the object itself. To insert an
322 entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
324 To fetch an uninserted result object, call
325 L<new|DBIx::Class::ResultSet/new> on a resultset.
327 This will also insert any uninserted, related objects held inside this
328 one, see L<DBIx::Class::ResultSet/create> for more details.
334 return $self if $self->in_storage;
335 my $source = $self->result_source;
336 $self->throw_exception("No result_source set on this object; can't insert")
339 my $storage = $source->storage;
343 # Check if we stored uninserted relobjs here in new()
344 my %related_stuff = (%{$self->{_relationship_data} || {}},
345 %{$self->{_inflated_column} || {}});
347 # insert what needs to be inserted before us
349 for my $relname (keys %related_stuff) {
350 my $rel_obj = $related_stuff{$relname};
352 if (! $self->{_rel_in_storage}{$relname}) {
353 next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
355 next unless $source->_pk_depends_on(
356 $relname, { $rel_obj->get_columns }
359 # The guard will save us if we blow out of this scope via die
360 $rollback_guard ||= $storage->txn_scope_guard;
362 MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
364 my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
367 # if there are no keys - nothing to search for
368 if (keys %$them and $existing = $self->result_source
369 ->related_source($relname)
373 %{$rel_obj} = %{$existing};
379 $self->{_rel_in_storage}{$relname} = 1;
382 $self->set_from_related($relname, $rel_obj);
383 delete $related_stuff{$relname};
386 # start a transaction here if not started yet and there is more stuff
388 if (keys %related_stuff) {
389 $rollback_guard ||= $storage->txn_scope_guard
392 MULTICREATE_DEBUG and do {
393 no warnings 'uninitialized';
394 warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
397 # perform the insert - the storage will return everything it is asked to
398 # (autoinc primary columns and any retrieve_on_insert columns)
399 my %current_rowdata = $self->get_columns;
400 my $returned_cols = $storage->insert(
402 { %current_rowdata }, # what to insert, copy because the storage *will* change it
405 for (keys %$returned_cols) {
406 $self->store_column($_, $returned_cols->{$_})
407 # this ensures we fire store_column only once
408 # (some asshats like overriding it)
410 (!exists $current_rowdata{$_})
412 (defined $current_rowdata{$_} xor defined $returned_cols->{$_})
414 (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
418 delete $self->{_column_data_in_storage};
419 $self->in_storage(1);
421 $self->{_dirty_columns} = {};
422 $self->{related_resultsets} = {};
424 foreach my $relname (keys %related_stuff) {
425 next unless $source->has_relationship ($relname);
427 my @cands = ref $related_stuff{$relname} eq 'ARRAY'
428 ? @{$related_stuff{$relname}}
429 : $related_stuff{$relname}
432 if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
434 my $reverse = $source->reverse_relationship_info($relname);
435 foreach my $obj (@cands) {
436 $obj->set_from_related($_, $self) for keys %$reverse;
437 if ($self->__their_pk_needs_us($relname)) {
438 if (exists $self->{_ignore_at_insert}{$relname}) {
439 MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
442 MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj";
446 MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
453 delete $self->{_ignore_at_insert};
455 $rollback_guard->commit if $rollback_guard;
462 $row->in_storage; # Get value
463 $row->in_storage(1); # Set value
467 =item Arguments: none or 1|0
469 =item Return Value: 1|0
473 Indicates whether the object exists as a row in the database or
474 not. This is set to true when L<DBIx::Class::ResultSet/find>,
475 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
478 Creating a result object using L<DBIx::Class::ResultSet/new>, or calling
479 L</delete> on one, sets it to false.
484 my ($self, $val) = @_;
485 $self->{_in_storage} = $val if @_ > 1;
486 return $self->{_in_storage} ? 1 : 0;
491 $row->update(\%columns?)
495 =item Arguments: none or a hashref
497 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
501 Throws an exception if the result object is not yet in the database,
502 according to L</in_storage>.
504 This method issues an SQL UPDATE query to commit any changes to the
505 object to the database if required (see L</get_dirty_columns>).
506 It throws an exception if a proper WHERE clause uniquely identifying
507 the database row can not be constructed (see
508 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
511 Also takes an optional hashref of C<< column_name => value >> pairs
512 to update on the object first. Be aware that the hashref will be
513 passed to C<set_inflated_columns>, which might edit it in place, so
514 don't rely on it being the same after a call to C<update>. If you
515 need to preserve the hashref, it is sufficient to pass a shallow copy
516 to C<update>, e.g. ( { %{ $href } } )
518 If the values passed or any of the column values set on the object
519 contain scalar references, e.g.:
521 $row->last_modified(\'NOW()')->update();
523 $row->update({ last_modified => \'NOW()' });
525 The update will pass the values verbatim into SQL. (See
526 L<SQL::Abstract> docs). The values in your Result object will NOT change
527 as a result of the update call, if you want the object to be updated
528 with the actual values from the database, call L</discard_changes>
531 $row->update()->discard_changes();
533 To determine before calling this method, which column values have
534 changed and will be updated, call L</get_dirty_columns>.
536 To check if any columns will be updated, call L</is_changed>.
538 To force a column to be updated, call L</make_column_dirty> before
544 my ($self, $upd) = @_;
546 $self->set_inflated_columns($upd) if $upd;
548 my %to_update = $self->get_dirty_columns
551 $self->throw_exception( "Not in database" ) unless $self->in_storage;
553 my $rows = $self->result_source->storage->update(
554 $self->result_source, \%to_update, $self->_storage_ident_condition
557 $self->throw_exception( "Can't update ${self}: row not found" );
558 } elsif ($rows > 1) {
559 $self->throw_exception("Can't update ${self}: updated more than one row");
561 $self->{_dirty_columns} = {};
562 $self->{related_resultsets} = {};
563 delete $self->{_column_data_in_storage};
573 =item Arguments: none
575 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
579 Throws an exception if the object is not in the database according to
580 L</in_storage>. Also throws an exception if a proper WHERE clause
581 uniquely identifying the database row can not be constructed (see
582 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
585 The object is still perfectly usable, but L</in_storage> will
586 now return 0 and the object must be reinserted using L</insert>
587 before it can be used to L</update> the row again.
589 If you delete an object in a class with a C<has_many> relationship, an
590 attempt is made to delete all the related objects as well. To turn
591 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
592 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
593 database-level cascade or restrict will take precedence over a
594 DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
595 main row first> and only then attempts to delete any remaining related
598 If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
599 and the transaction subsequently fails, the result object will remain marked as
600 not being in storage. If you know for a fact that the object is still in
601 storage (i.e. by inspecting the cause of the transaction's failure), you can
602 use C<< $obj->in_storage(1) >> to restore consistency between the object and
603 the database. This would allow a subsequent C<< $obj->delete >> to work
606 See also L<DBIx::Class::ResultSet/delete>.
613 $self->throw_exception( "Not in database" ) unless $self->in_storage;
615 $self->result_source->storage->delete(
616 $self->result_source, $self->_storage_ident_condition
619 delete $self->{_column_data_in_storage};
620 $self->in_storage(undef);
623 my $rsrc = try { $self->result_source_instance }
624 or $self->throw_exception("Can't do class delete without a ResultSource instance");
626 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
627 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
628 $rsrc->resultset->search(@_)->delete;
635 my $val = $row->get_column($col);
639 =item Arguments: $columnname
641 =item Return Value: The value of the column
645 Throws an exception if the column name given doesn't exist according
646 to L<has_column|DBIx::Class::ResultSource/has_column>.
648 Returns a raw column value from the result object, if it has already
649 been fetched from the database or set by an accessor.
651 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
652 will be deflated and returned.
654 Note that if you used the C<columns> or the C<select/as>
655 L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
656 which C<$row> was derived, and B<did not include> C<$columnname> in the list,
657 this method will return C<undef> even if the database contains some value.
659 To retrieve all loaded column values as a hash, use L</get_columns>.
664 my ($self, $column) = @_;
665 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
666 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
667 if (exists $self->{_inflated_column}{$column}) {
668 return $self->store_column($column,
669 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
671 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
675 =head2 has_column_loaded
677 if ( $row->has_column_loaded($col) ) {
678 print "$col has been loaded from db";
683 =item Arguments: $columnname
685 =item Return Value: 0|1
689 Returns a true value if the column value has been loaded from the
690 database (or set locally).
694 sub has_column_loaded {
695 my ($self, $column) = @_;
696 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
697 return 1 if exists $self->{_inflated_column}{$column};
698 return exists $self->{_column_data}{$column};
703 my %data = $row->get_columns;
707 =item Arguments: none
709 =item Return Value: A hash of columnname, value pairs.
713 Returns all loaded column data as a hash, containing raw values. To
714 get just one value for a particular column, use L</get_column>.
716 See L</get_inflated_columns> to get the inflated values.
722 if (exists $self->{_inflated_column}) {
723 foreach my $col (keys %{$self->{_inflated_column}}) {
724 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
725 unless exists $self->{_column_data}{$col};
728 return %{$self->{_column_data}};
731 =head2 get_dirty_columns
733 my %data = $row->get_dirty_columns;
737 =item Arguments: none
739 =item Return Value: A hash of column, value pairs
743 Only returns the column, value pairs for those columns that have been
744 changed on this object since the last L</update> or L</insert> call.
746 See L</get_columns> to fetch all column/value pairs.
750 sub get_dirty_columns {
752 return map { $_ => $self->{_column_data}{$_} }
753 keys %{$self->{_dirty_columns}};
756 =head2 make_column_dirty
758 $row->make_column_dirty($col)
762 =item Arguments: $columnname
764 =item Return Value: not defined
768 Throws an exception if the column does not exist.
770 Marks a column as having been changed regardless of whether it has
774 sub make_column_dirty {
775 my ($self, $column) = @_;
777 $self->throw_exception( "No such column '${column}'" )
778 unless exists $self->{_column_data}{$column} || $self->has_column($column);
780 # the entire clean/dirty code relies on exists, not on true/false
781 return 1 if exists $self->{_dirty_columns}{$column};
783 $self->{_dirty_columns}{$column} = 1;
785 # if we are just now making the column dirty, and if there is an inflated
786 # value, force it over the deflated one
787 if (exists $self->{_inflated_column}{$column}) {
788 $self->store_column($column,
789 $self->_deflated_column(
790 $column, $self->{_inflated_column}{$column}
796 =head2 get_inflated_columns
798 my %inflated_data = $obj->get_inflated_columns;
802 =item Arguments: none
804 =item Return Value: A hash of column, object|value pairs
808 Returns a hash of all column keys and associated values. Values for any
809 columns set to use inflation will be inflated and returns as objects.
811 See L</get_columns> to get the uninflated values.
813 See L<DBIx::Class::InflateColumn> for how to setup inflation.
817 sub get_inflated_columns {
820 my $loaded_colinfo = $self->columns_info ([
821 grep { $self->has_column_loaded($_) } $self->columns
825 for my $col (keys %$loaded_colinfo) {
826 if (exists $loaded_colinfo->{$col}{accessor}) {
827 my $acc = $loaded_colinfo->{$col}{accessor};
828 $inflated{$col} = $self->$acc if defined $acc;
831 $inflated{$col} = $self->$col;
835 # return all loaded columns with the inflations overlayed on top
836 return %{ { $self->get_columns, %inflated } };
839 sub _is_column_numeric {
840 my ($self, $column) = @_;
841 my $colinfo = $self->column_info ($column);
843 # cache for speed (the object may *not* have a resultsource instance)
845 ! defined $colinfo->{is_numeric}
847 my $storage = try { $self->result_source->schema->storage }
849 $colinfo->{is_numeric} =
850 $storage->is_datatype_numeric ($colinfo->{data_type})
856 return $colinfo->{is_numeric};
861 $row->set_column($col => $val);
865 =item Arguments: $columnname, $value
867 =item Return Value: $value
871 Sets a raw column value. If the new value is different from the old one,
872 the column is marked as dirty for when you next call L</update>.
874 If passed an object or reference as a value, this method will happily
875 attempt to store it, and a later L</insert> or L</update> will try and
876 stringify/numify as appropriate. To set an object to be deflated
877 instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
882 my ($self, $column, $new_value) = @_;
884 my $had_value = $self->has_column_loaded($column);
885 my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
888 $new_value = $self->store_column($column, $new_value);
891 $self->{_dirty_columns}{$column}
893 $in_storage # no point tracking dirtyness on uninserted data
894 ? ! $self->_eq_column_values ($column, $old_value, $new_value)
899 # FIXME sadly the update code just checks for keys, not for their value
900 $self->{_dirty_columns}{$column} = 1;
902 # Clear out the relation/inflation cache related to this column
904 # FIXME - this is a quick *largely incorrect* hack, pending a more
905 # serious rework during the merge of single and filter rels
906 my $rels = $self->result_source->{_relationships};
907 for my $rel (keys %$rels) {
909 my $acc = $rels->{$rel}{attrs}{accessor} || '';
911 if ( $acc eq 'single' and $rels->{$rel}{attrs}{fk_columns}{$column} ) {
912 delete $self->{related_resultsets}{$rel};
913 delete $self->{_relationship_data}{$rel};
914 #delete $self->{_inflated_column}{$rel};
916 elsif ( $acc eq 'filter' and $rel eq $column) {
917 delete $self->{related_resultsets}{$rel};
918 #delete $self->{_relationship_data}{$rel};
919 delete $self->{_inflated_column}{$rel};
924 # value change from something (even if NULL)
927 # no storage - no storage-value
930 # no value already stored (multiple changes before commit to storage)
931 ! exists $self->{_column_data_in_storage}{$column}
933 $self->_track_storage_value($column)
935 $self->{_column_data_in_storage}{$column} = $old_value;
942 sub _eq_column_values {
943 my ($self, $col, $old, $new) = @_;
945 if (defined $old xor defined $new) {
948 elsif (not defined $old) { # both undef
951 elsif ($old eq $new) {
954 elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
962 # returns a boolean indicating if the passed column should have its original
963 # value tracked between column changes and commitment to storage
964 sub _track_storage_value {
965 my ($self, $col) = @_;
966 return defined first { $col eq $_ } ($self->primary_columns);
971 $row->set_columns({ $col => $val, ... });
975 =item Arguments: \%columndata
977 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
981 Sets multiple column, raw value pairs at once.
983 Works as L</set_column>.
988 my ($self,$data) = @_;
989 foreach my $col (keys %$data) {
990 $self->set_column($col,$data->{$col});
995 =head2 set_inflated_columns
997 $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
1001 =item Arguments: \%columndata
1003 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1007 Sets more than one column value at once. Any inflated values are
1008 deflated and the raw values stored.
1010 Any related values passed as Result objects, using the relation name as a
1011 key, are reduced to the appropriate foreign key values and stored. If
1012 instead of related result objects, a hashref of column, value data is
1013 passed, will create the related object first then store.
1015 Will even accept arrayrefs of data as a value to a
1016 L<DBIx::Class::Relationship/has_many> key, and create the related
1017 objects if necessary.
1019 Be aware that the input hashref might be edited in place, so don't rely
1020 on it being the same after a call to C<set_inflated_columns>. If you
1021 need to preserve the hashref, it is sufficient to pass a shallow copy
1022 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
1024 See also L<DBIx::Class::Relationship::Base/set_from_related>.
1028 sub set_inflated_columns {
1029 my ( $self, $upd ) = @_;
1030 foreach my $key (keys %$upd) {
1031 if (ref $upd->{$key}) {
1032 my $info = $self->relationship_info($key);
1033 my $acc_type = $info->{attrs}{accessor} || '';
1034 if ($acc_type eq 'single') {
1035 my $rel = delete $upd->{$key};
1036 $self->set_from_related($key => $rel);
1037 $self->{_relationship_data}{$key} = $rel;
1039 elsif ($acc_type eq 'multi') {
1040 $self->throw_exception(
1041 "Recursive update is not supported over relationships of type '$acc_type' ($key)"
1044 elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
1045 $self->set_inflated_column($key, delete $upd->{$key});
1049 $self->set_columns($upd);
1054 my $copy = $orig->copy({ change => $to, ... });
1058 =item Arguments: \%replacementdata
1060 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> copy
1064 Inserts a new row into the database, as a copy of the original
1065 object. If a hashref of replacement data is supplied, these will take
1066 precedence over data in the original. Also any columns which have
1067 the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1068 C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1069 so that the database can insert its own autoincremented values into
1072 Relationships will be followed by the copy procedure B<only> if the
1073 relationship specifies a true value for its
1074 L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1075 is set by default on C<has_many> relationships and unset on all others.
1080 my ($self, $changes) = @_;
1082 my $col_data = { %{$self->{_column_data}} };
1084 my $colinfo = $self->columns_info([ keys %$col_data ]);
1085 foreach my $col (keys %$col_data) {
1086 delete $col_data->{$col}
1087 if $colinfo->{$col}{is_auto_increment};
1090 my $new = { _column_data => $col_data };
1091 bless $new, ref $self;
1093 $new->result_source($self->result_source);
1094 $new->set_inflated_columns($changes);
1097 # Its possible we'll have 2 relations to the same Source. We need to make
1098 # sure we don't try to insert the same row twice else we'll violate unique
1100 my $rels_copied = {};
1102 foreach my $rel ($self->result_source->relationships) {
1103 my $rel_info = $self->result_source->relationship_info($rel);
1105 next unless $rel_info->{attrs}{cascade_copy};
1107 my $resolved = $self->result_source->_resolve_condition(
1108 $rel_info->{cond}, $rel, $new, $rel
1111 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
1112 foreach my $related ($self->search_related($rel)) {
1113 my $id_str = join("\0", $related->id);
1114 next if $copied->{$id_str};
1115 $copied->{$id_str} = 1;
1116 my $rel_copy = $related->copy($resolved);
1125 $row->store_column($col => $val);
1129 =item Arguments: $columnname, $value
1131 =item Return Value: The value sent to storage
1135 Set a raw value for a column without marking it as changed. This
1136 method is used internally by L</set_column> which you should probably
1139 This is the lowest level at which data is set on a result object,
1140 extend this method to catch all data setting methods.
1145 my ($self, $column, $value) = @_;
1146 $self->throw_exception( "No such column '${column}'" )
1147 unless exists $self->{_column_data}{$column} || $self->has_column($column);
1148 $self->throw_exception( "set_column called for ${column} without value" )
1150 return $self->{_column_data}{$column} = $value;
1153 =head2 inflate_result
1155 Class->inflate_result($result_source, \%me, \%prefetch?)
1159 =item Arguments: L<$result_source|DBIx::Class::ResultSource>, \%columndata, \%prefetcheddata
1161 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1165 All L<DBIx::Class::ResultSet> methods that retrieve data from the
1166 database and turn it into result objects call this method.
1168 Extend this method in your Result classes to hook into this process,
1169 for example to rebless the result into a different class.
1171 Reblessing can also be done more easily by setting C<result_class> in
1172 your Result class. See L<DBIx::Class::ResultSource/result_class>.
1174 Different types of results can also be created from a particular
1175 L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1179 sub inflate_result {
1180 my ($class, $source, $me, $prefetch) = @_;
1182 $source = $source->resolve
1183 if $source->isa('DBIx::Class::ResultSourceHandle');
1186 { _column_data => $me, _result_source => $source },
1187 ref $class || $class
1190 foreach my $pre (keys %{$prefetch||{}}) {
1192 my (@pre_vals, $is_multi);
1193 if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
1195 @pre_vals = @{$prefetch->{$pre}};
1198 @pre_vals = $prefetch->{$pre};
1201 my $pre_source = try {
1202 $source->related_source($pre)
1205 $class->throw_exception(sprintf
1207 "Can't inflate manual prefetch into non-existent relationship '%s' from '%s', "
1208 . "check the inflation specification (columns/as) ending in '%s.%s'.",
1211 $source->source_name,
1213 (keys %{$pre_vals[0][0]})[0] || 'something.something...',
1217 my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
1218 or $class->throw_exception("No accessor type declared for prefetched $pre");
1220 if (! $is_multi and $accessor eq 'multi') {
1221 $class->throw_exception("Manual prefetch (via select/columns) not supported with accessor 'multi'");
1225 for my $me_pref (@pre_vals) {
1227 # FIXME - this should not be necessary
1228 # the collapser currently *could* return bogus elements with all
1229 # columns set to undef
1231 for (values %{$me_pref->[0]}) {
1237 next unless $has_def;
1239 push @pre_objects, $pre_source->result_class->inflate_result(
1240 $pre_source, @$me_pref
1244 if ($accessor eq 'single') {
1245 $new->{_relationship_data}{$pre} = $pre_objects[0];
1247 elsif ($accessor eq 'filter') {
1248 $new->{_inflated_column}{$pre} = $pre_objects[0];
1251 $new->related_resultset($pre)->set_cache(\@pre_objects);
1254 $new->in_storage (1);
1258 =head2 update_or_insert
1260 $row->update_or_insert
1264 =item Arguments: none
1266 =item Return Value: Result of update or insert operation
1270 L</Update>s the object if it's already in the database, according to
1271 L</in_storage>, else L</insert>s it.
1273 =head2 insert_or_update
1275 $obj->insert_or_update
1277 Alias for L</update_or_insert>
1281 sub insert_or_update { shift->update_or_insert(@_) }
1283 sub update_or_insert {
1285 return ($self->in_storage ? $self->update : $self->insert);
1290 my @changed_col_names = $row->is_changed();
1291 if ($row->is_changed()) { ... }
1295 =item Arguments: none
1297 =item Return Value: 0|1 or @columnnames
1301 In list context returns a list of columns with uncommited changes, or
1302 in scalar context returns a true value if there are uncommitted
1308 return keys %{shift->{_dirty_columns} || {}};
1311 =head2 is_column_changed
1313 if ($row->is_column_changed('col')) { ... }
1317 =item Arguments: $columname
1319 =item Return Value: 0|1
1323 Returns a true value if the column has uncommitted changes.
1327 sub is_column_changed {
1328 my( $self, $col ) = @_;
1329 return exists $self->{_dirty_columns}->{$col};
1332 =head2 result_source
1334 my $resultsource = $row->result_source;
1338 =item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1340 =item Return Value: L<$result_source|DBIx::Class::ResultSource>
1344 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1349 $_[0]->throw_exception( 'result_source can be called on instances only' )
1353 ? $_[0]->{_result_source} = $_[1]
1355 # note this is a || not a ||=, the difference is important
1356 : $_[0]->{_result_source} || do {
1357 my $class = ref $_[0];
1358 $_[0]->can('result_source_instance')
1359 ? $_[0]->result_source_instance
1360 : $_[0]->throw_exception(
1361 "No result source instance registered for $class, did you forget to call $class->table(...) ?"
1367 =head2 register_column
1369 $column_info = { .... };
1370 $class->register_column($column_name, $column_info);
1374 =item Arguments: $columnname, \%columninfo
1376 =item Return Value: not defined
1380 Registers a column on the class. If the column_info has an 'accessor'
1381 key, creates an accessor named after the value if defined; if there is
1382 no such key, creates an accessor with the same name as the column
1384 The column_info attributes are described in
1385 L<DBIx::Class::ResultSource/add_columns>
1389 sub register_column {
1390 my ($class, $col, $info) = @_;
1392 if (exists $info->{accessor}) {
1393 return unless defined $info->{accessor};
1394 $acc = [ $info->{accessor}, $col ];
1396 $class->mk_group_accessors('column' => $acc);
1399 =head2 get_from_storage
1401 my $copy = $row->get_from_storage($attrs)
1405 =item Arguments: \%attrs
1407 =item Return Value: A Result object
1411 Fetches a fresh copy of the Result object from the database and returns it.
1412 Throws an exception if a proper WHERE clause identifying the database row
1413 can not be constructed (i.e. if the original object does not contain its
1415 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1416 ). If passed the \%attrs argument, will first apply these attributes to
1417 the resultset used to find the row.
1419 This copy can then be used to compare to an existing result object, to
1420 determine if any changes have been made in the database since it was
1423 To just update your Result object with any latest changes from the
1424 database, use L</discard_changes> instead.
1426 The \%attrs argument should be compatible with
1427 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1431 sub get_from_storage {
1432 my $self = shift @_;
1433 my $attrs = shift @_;
1434 my $resultset = $self->result_source->resultset;
1436 if(defined $attrs) {
1437 $resultset = $resultset->search(undef, $attrs);
1440 return $resultset->find($self->_storage_ident_condition);
1443 =head2 discard_changes
1445 $row->discard_changes
1449 =item Arguments: none or $attrs
1451 =item Return Value: self (updates object in-place)
1455 Re-selects the row from the database, losing any changes that had
1456 been made. Throws an exception if a proper C<WHERE> clause identifying
1457 the database row can not be constructed (i.e. if the original object
1458 does not contain its entire
1459 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1461 This method can also be used to refresh from storage, retrieving any
1462 changes made since the row was last read from storage.
1464 $attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1465 second argument to C<< $resultset->search($cond, $attrs) >>;
1467 Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1468 storage, please kept in mind that if you L</discard_changes> on a row that you
1469 just updated or created, you should wrap the entire bit inside a transaction.
1470 Otherwise you run the risk that you insert or update to the master database
1471 but read from a replicant database that has not yet been updated from the
1472 master. This will result in unexpected results.
1476 sub discard_changes {
1477 my ($self, $attrs) = @_;
1478 return unless $self->in_storage; # Don't reload if we aren't real!
1480 # add a replication default to read from the master only
1481 $attrs = { force_pool => 'master', %{$attrs||{}} };
1483 if( my $current_storage = $self->get_from_storage($attrs)) {
1485 # Set $self to the current.
1486 %$self = %$current_storage;
1488 # Avoid a possible infinite loop with
1489 # sub DESTROY { $_[0]->discard_changes }
1490 bless $current_storage, 'Do::Not::Exist';
1495 $self->in_storage(0);
1500 =head2 throw_exception
1502 See L<DBIx::Class::Schema/throw_exception>.
1506 sub throw_exception {
1509 if (ref $self && ref $self->result_source ) {
1510 $self->result_source->throw_exception(@_)
1513 DBIx::Class::Exception->throw(@_);
1523 =item Arguments: none
1525 =item Returns: A list of primary key values
1529 Returns the primary key(s) for a row. Can't be called as a class method.
1530 Actually implemented in L<DBIx::Class::PK>
1532 =head1 AUTHOR AND CONTRIBUTORS
1534 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
1538 You may distribute this code under the same terms as Perl itself.