1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
8 use Scalar::Util 'blessed';
9 use List::Util 'first';
11 use DBIx::Class::Carp;
12 use DBIx::Class::_Util 'is_literal_value';
20 $ENV{DBIC_MULTICREATE_DEBUG}
27 __PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] );
31 DBIx::Class::Row - Basic row methods
37 This class is responsible for defining and doing basic operations on rows
38 derived from L<DBIx::Class::ResultSource> objects.
40 Result objects are returned from L<DBIx::Class::ResultSet>s using the
41 L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
42 L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
43 as well as invocations of 'single' (
44 L<belongs_to|DBIx::Class::Relationship/belongs_to>,
45 L<has_one|DBIx::Class::Relationship/has_one> or
46 L<might_have|DBIx::Class::Relationship/might_have>)
47 relationship accessors of L<Result|DBIx::Class::Manual::ResultClass> objects.
51 All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
52 object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
53 L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
54 instances, based on your application's
55 L<Result class|DBIx::Class::Manual::Glossary/Result_class>.
57 L<DBIx::Class::Row> implements most of the row-based communication with the
58 underlying storage, but a Result class B<should not inherit from it directly>.
59 Usually, Result classes inherit from L<DBIx::Class::Core>, which in turn
60 combines the methods from several classes, one of them being
61 L<DBIx::Class::Row>. Therefore, while many of the methods available to a
62 L<DBIx::Class::Core>-derived Result class are described in the following
63 documentation, it does not detail all of the methods available to Result
64 objects. Refer to L<DBIx::Class::Manual::ResultClass> for more info.
70 my $result = My::Class->new(\%attrs);
72 my $result = $schema->resultset('MySource')->new(\%colsandvalues);
76 =item Arguments: \%attrs or \%colsandvalues
78 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
82 While you can create a new result object by calling C<new> directly on
83 this class, you are better off calling it on a
84 L<DBIx::Class::ResultSet> object.
86 When calling it directly, you will not get a complete, usable row
87 object until you pass or set the C<result_source> attribute, to a
88 L<DBIx::Class::ResultSource> instance that is attached to a
89 L<DBIx::Class::Schema> with a valid connection.
91 C<$attrs> is a hashref of column name, value data. It can also contain
92 some other attributes such as the C<result_source>.
94 Passing an object, or an arrayref of objects as a value will call
95 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
96 passed a hashref or an arrayref of hashrefs as the value, these will
97 be turned into objects via new_related, and treated as if you had
100 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
102 Please note that if a value is not passed to new, no value will be sent
103 in the SQL INSERT call, and the column will therefore assume whatever
104 default value was specified in your database. While DBIC will retrieve the
105 value of autoincrement columns, it will never make an explicit database
106 trip to retrieve default values assigned by the RDBMS. You can explicitly
107 request that all values be fetched back from the database by calling
108 L</discard_changes>, or you can supply an explicit C<undef> to columns
109 with NULL as the default, and save yourself a SELECT.
113 The behavior described above will backfire if you use a foreign key column
114 with a database-defined default. If you call the relationship accessor on
115 an object that doesn't have a set value for the FK column, DBIC will throw
116 an exception, as it has no way of knowing the PK of the related object (if
121 ## 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().
122 ## This only works because DBIC doesn't yet care to check whether the new_related objects have been passed all their mandatory columns
123 ## When doing the later insert, we need to make sure the PKs are set.
124 ## using _relationship_data in new and funky ways..
125 ## check Relationship::CascadeActions and Relationship::Accessor for compat
128 sub __new_related_find_or_new_helper {
129 my ($self, $rel_name, $values) = @_;
131 my $rsrc = $self->result_source;
133 # create a mock-object so all new/set_column component overrides will run:
134 my $rel_rs = $rsrc->related_source($rel_name)->resultset;
135 my $new_rel_obj = $rel_rs->new_result($values);
136 my $proc_data = { $new_rel_obj->get_columns };
138 if ($self->__their_pk_needs_us($rel_name)) {
139 MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via new_result\n";
142 elsif ($rsrc->_pk_depends_on($rel_name, $proc_data )) {
143 if (! keys %$proc_data) {
144 # there is nothing to search for - blind create
145 MULTICREATE_DEBUG and print STDERR "MC $self constructing default-insert $rel_name\n";
148 MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via find_or_new\n";
149 # this is not *really* find or new, as we don't want to double-new the
150 # data (thus potentially double encoding or whatever)
151 my $exists = $rel_rs->find ($proc_data);
152 return $exists if $exists;
157 my $us = $rsrc->source_name;
158 $self->throw_exception (
159 "Unable to determine relationship '$rel_name' direction from '$us', "
160 . "possibly due to a missing reverse-relationship on '$rel_name' to '$us'."
165 sub __their_pk_needs_us { # this should maybe be in resultsource.
166 my ($self, $rel_name) = @_;
167 my $rsrc = $self->result_source;
168 my $reverse = $rsrc->reverse_relationship_info($rel_name);
169 my $rel_source = $rsrc->related_source($rel_name);
170 my $us = { $self->get_columns };
171 foreach my $key (keys %$reverse) {
172 # if their primary key depends on us, then we have to
173 # just create a result and we'll fill it out afterwards
174 return 1 if $rel_source->_pk_depends_on($key, $us);
180 my ($class, $attrs) = @_;
181 $class = ref $class if ref $class;
183 my $new = bless { _column_data => {}, _in_storage => 0 }, $class;
186 $new->throw_exception("attrs must be a hashref")
187 unless ref($attrs) eq 'HASH';
189 my $rsrc = delete $attrs->{-result_source};
190 if ( my $h = delete $attrs->{-source_handle} ) {
191 $rsrc ||= $h->resolve;
194 $new->result_source($rsrc) if $rsrc;
196 if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
197 @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
200 my ($related,$inflated);
202 foreach my $key (keys %$attrs) {
203 if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) {
204 ## Can we extract this lot to use with update(_or .. ) ?
205 $new->throw_exception("Can't do multi-create without result source")
207 my $info = $rsrc->relationship_info($key);
208 my $acc_type = $info->{attrs}{accessor} || '';
209 if ($acc_type eq 'single') {
210 my $rel_obj = delete $attrs->{$key};
211 if(!blessed $rel_obj) {
212 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
215 if ($rel_obj->in_storage) {
216 $new->{_rel_in_storage}{$key} = 1;
217 $new->set_from_related($key, $rel_obj);
219 MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
222 $related->{$key} = $rel_obj;
225 elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
226 my $others = delete $attrs->{$key};
227 my $total = @$others;
229 foreach my $idx (0 .. $#$others) {
230 my $rel_obj = $others->[$idx];
231 if(!blessed $rel_obj) {
232 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
235 if ($rel_obj->in_storage) {
236 $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
238 MULTICREATE_DEBUG and
239 print STDERR "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
241 push(@objects, $rel_obj);
243 $related->{$key} = \@objects;
246 elsif ($acc_type eq 'filter') {
247 ## 'filter' should disappear and get merged in with 'single' above!
248 my $rel_obj = delete $attrs->{$key};
249 if(!blessed $rel_obj) {
250 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
252 if ($rel_obj->in_storage) {
253 $new->{_rel_in_storage}{$key} = 1;
256 MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
258 $inflated->{$key} = $rel_obj;
260 } elsif ($class->has_column($key)
261 && $class->column_info($key)->{_inflate_info}) {
262 $inflated->{$key} = $attrs->{$key};
266 $new->throw_exception("No such column '$key' on $class")
267 unless $class->has_column($key);
268 $new->store_column($key => $attrs->{$key});
271 $new->{_relationship_data} = $related if $related;
272 $new->{_inflated_column} = $inflated if $inflated;
278 =head2 $column_accessor
280 # Each pair does the same thing
282 # (un-inflated, regular column)
283 my $val = $result->get_column('first_name');
284 my $val = $result->first_name;
286 $result->set_column('first_name' => $val);
287 $result->first_name($val);
289 # (inflated column via DBIx::Class::InflateColumn::DateTime)
290 my $val = $result->get_inflated_column('last_modified');
291 my $val = $result->last_modified;
293 $result->set_inflated_column('last_modified' => $val);
294 $result->last_modified($val);
298 =item Arguments: $value?
300 =item Return Value: $value
304 A column accessor method is created for each column, which is used for
305 getting/setting the value for that column.
307 The actual method name is based on the
308 L<accessor|DBIx::Class::ResultSource/accessor> name given during the
309 L<Result Class|DBIx::Class::Manual::ResultClass> L<column definition
310 |DBIx::Class::ResultSource/add_columns>. Like L</set_column>, this
311 will not store the data in the database until L</insert> or L</update>
312 is called on the row.
320 =item Arguments: none
322 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
326 Inserts an object previously created by L</new> into the database if
327 it isn't already in there. Returns the object itself. To insert an
328 entirely new row into the database, use L<DBIx::Class::ResultSet/create>.
330 To fetch an uninserted result object, call
331 L<new_result|DBIx::Class::ResultSet/new_result> on a resultset.
333 This will also insert any uninserted, related objects held inside this
334 one, see L<DBIx::Class::ResultSet/create> for more details.
340 return $self if $self->in_storage;
341 my $rsrc = $self->result_source;
342 $self->throw_exception("No result_source set on this object; can't insert")
345 my $storage = $rsrc->storage;
349 # Check if we stored uninserted relobjs here in new()
350 my %related_stuff = (%{$self->{_relationship_data} || {}},
351 %{$self->{_inflated_column} || {}});
353 # insert what needs to be inserted before us
355 for my $rel_name (keys %related_stuff) {
356 my $rel_obj = $related_stuff{$rel_name};
358 if (! $self->{_rel_in_storage}{$rel_name}) {
359 next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
361 next unless $rsrc->_pk_depends_on(
362 $rel_name, { $rel_obj->get_columns }
365 # The guard will save us if we blow out of this scope via die
366 $rollback_guard ||= $storage->txn_scope_guard;
368 MULTICREATE_DEBUG and print STDERR "MC $self pre-reconstructing $rel_name $rel_obj\n";
370 my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
373 # if there are no keys - nothing to search for
374 if (keys %$them and $existing = $self->result_source
375 ->related_source($rel_name)
379 %{$rel_obj} = %{$existing};
385 $self->{_rel_in_storage}{$rel_name} = 1;
388 $self->set_from_related($rel_name, $rel_obj);
389 delete $related_stuff{$rel_name};
392 # start a transaction here if not started yet and there is more stuff
394 if (keys %related_stuff) {
395 $rollback_guard ||= $storage->txn_scope_guard
398 MULTICREATE_DEBUG and do {
399 no warnings 'uninitialized';
400 print STDERR "MC $self inserting (".join(', ', $self->get_columns).")\n";
403 # perform the insert - the storage will return everything it is asked to
404 # (autoinc primary columns and any retrieve_on_insert columns)
405 my %current_rowdata = $self->get_columns;
406 my $returned_cols = $storage->insert(
408 { %current_rowdata }, # what to insert, copy because the storage *will* change it
411 for (keys %$returned_cols) {
412 $self->store_column($_, $returned_cols->{$_})
413 # this ensures we fire store_column only once
414 # (some asshats like overriding it)
416 (!exists $current_rowdata{$_})
418 (defined $current_rowdata{$_} xor defined $returned_cols->{$_})
420 (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
424 delete $self->{_column_data_in_storage};
425 $self->in_storage(1);
427 $self->{_dirty_columns} = {};
428 $self->{related_resultsets} = {};
430 foreach my $rel_name (keys %related_stuff) {
431 next unless $rsrc->has_relationship ($rel_name);
433 my @cands = ref $related_stuff{$rel_name} eq 'ARRAY'
434 ? @{$related_stuff{$rel_name}}
435 : $related_stuff{$rel_name}
438 if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
440 my $reverse = $rsrc->reverse_relationship_info($rel_name);
441 foreach my $obj (@cands) {
442 $obj->set_from_related($_, $self) for keys %$reverse;
443 if ($self->__their_pk_needs_us($rel_name)) {
444 if (exists $self->{_ignore_at_insert}{$rel_name}) {
445 MULTICREATE_DEBUG and print STDERR "MC $self skipping post-insert on $rel_name\n";
448 MULTICREATE_DEBUG and print STDERR "MC $self inserting $rel_name $obj\n";
452 MULTICREATE_DEBUG and print STDERR "MC $self post-inserting $obj\n";
459 delete $self->{_ignore_at_insert};
461 $rollback_guard->commit if $rollback_guard;
468 $result->in_storage; # Get value
469 $result->in_storage(1); # Set value
473 =item Arguments: none or 1|0
475 =item Return Value: 1|0
479 Indicates whether the object exists as a row in the database or
480 not. This is set to true when L<DBIx::Class::ResultSet/find>,
481 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
484 Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
485 calling L</delete> on one, sets it to false.
490 $result->update(\%columns?)
494 =item Arguments: none or a hashref
496 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
500 Throws an exception if the result object is not yet in the database,
501 according to L</in_storage>. Returns the object itself.
503 This method issues an SQL UPDATE query to commit any changes to the
504 object to the database if required (see L</get_dirty_columns>).
505 It throws an exception if a proper WHERE clause uniquely identifying
506 the database row can not be constructed (see
507 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
510 Also takes an optional hashref of C<< column_name => value >> pairs
511 to update on the object first. Be aware that the hashref will be
512 passed to C<set_inflated_columns>, which might edit it in place, so
513 don't rely on it being the same after a call to C<update>. If you
514 need to preserve the hashref, it is sufficient to pass a shallow copy
515 to C<update>, e.g. ( { %{ $href } } )
517 If the values passed or any of the column values set on the object
518 contain scalar references, e.g.:
520 $result->last_modified(\'NOW()')->update();
522 $result->update({ last_modified => \'NOW()' });
524 The update will pass the values verbatim into SQL. (See
525 L<SQL::Abstract> docs). The values in your Result object will NOT change
526 as a result of the update call, if you want the object to be updated
527 with the actual values from the database, call L</discard_changes>
530 $result->update()->discard_changes();
532 To determine before calling this method, which column values have
533 changed and will be updated, call L</get_dirty_columns>.
535 To check if any columns will be updated, call L</is_changed>.
537 To force a column to be updated, call L</make_column_dirty> before
543 my ($self, $upd) = @_;
545 $self->set_inflated_columns($upd) if $upd;
547 my %to_update = $self->get_dirty_columns
550 $self->throw_exception( "Not in database" ) unless $self->in_storage;
552 my $rows = $self->result_source->storage->update(
553 $self->result_source, \%to_update, $self->_storage_ident_condition
556 $self->throw_exception( "Can't update ${self}: row not found" );
557 } elsif ($rows > 1) {
558 $self->throw_exception("Can't update ${self}: updated more than one row");
560 $self->{_dirty_columns} = {};
561 $self->{related_resultsets} = {};
562 delete $self->{_column_data_in_storage};
572 =item Arguments: none
574 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
578 Throws an exception if the object is not in the database according to
579 L</in_storage>. Also throws an exception if a proper WHERE clause
580 uniquely identifying the database row can not be constructed (see
581 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
584 The object is still perfectly usable, but L</in_storage> will
585 now return 0 and the object must be reinserted using L</insert>
586 before it can be used to L</update> the row again.
588 If you delete an object in a class with a C<has_many> relationship, an
589 attempt is made to delete all the related objects as well. To turn
590 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
591 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
592 database-level cascade or restrict will take precedence over a
593 DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
594 main row first> and only then attempts to delete any remaining related
597 If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
598 and the transaction subsequently fails, the result object will remain marked as
599 not being in storage. If you know for a fact that the object is still in
600 storage (i.e. by inspecting the cause of the transaction's failure), you can
601 use C<< $obj->in_storage(1) >> to restore consistency between the object and
602 the database. This would allow a subsequent C<< $obj->delete >> to work
605 See also L<DBIx::Class::ResultSet/delete>.
612 $self->throw_exception( "Not in database" ) unless $self->in_storage;
614 $self->result_source->storage->delete(
615 $self->result_source, $self->_storage_ident_condition
618 delete $self->{_column_data_in_storage};
619 $self->in_storage(0);
622 my $rsrc = try { $self->result_source_instance }
623 or $self->throw_exception("Can't do class delete without a ResultSource instance");
625 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
626 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
627 $rsrc->resultset->search(@_)->delete;
634 my $val = $result->get_column($col);
638 =item Arguments: $columnname
640 =item Return Value: The value of the column
644 Throws an exception if the column name given doesn't exist according
645 to L<has_column|DBIx::Class::ResultSource/has_column>.
647 Returns a raw column value from the result object, if it has already
648 been fetched from the database or set by an accessor.
650 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
651 will be deflated and returned.
653 Note that if you used the C<columns> or the C<select/as>
654 L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
655 which C<$result> was derived, and B<did not include> C<$columnname> in the list,
656 this method will return C<undef> even if the database contains some value.
658 To retrieve all loaded column values as a hash, use L</get_columns>.
663 my ($self, $column) = @_;
664 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
666 return $self->{_column_data}{$column}
667 if exists $self->{_column_data}{$column};
669 if (exists $self->{_inflated_column}{$column}) {
670 # deflate+return cycle
671 return $self->store_column($column, $self->_deflated_column(
672 $column, $self->{_inflated_column}{$column}
676 $self->throw_exception( "No such column '${column}'" )
677 unless $self->has_column($column);
682 =head2 has_column_loaded
684 if ( $result->has_column_loaded($col) ) {
685 print "$col has been loaded from db";
690 =item Arguments: $columnname
692 =item Return Value: 0|1
696 Returns a true value if the column value has been loaded from the
697 database (or set locally).
701 sub has_column_loaded {
702 my ($self, $column) = @_;
703 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
706 exists $self->{_inflated_column}{$column}
708 exists $self->{_column_data}{$column}
714 my %data = $result->get_columns;
718 =item Arguments: none
720 =item Return Value: A hash of columnname, value pairs.
724 Returns all loaded column data as a hash, containing raw values. To
725 get just one value for a particular column, use L</get_column>.
727 See L</get_inflated_columns> to get the inflated values.
733 if (exists $self->{_inflated_column}) {
734 # deflate cycle for each inflation, including filter rels
735 foreach my $col (keys %{$self->{_inflated_column}}) {
736 unless (exists $self->{_column_data}{$col}) {
738 # if cached related_resultset is present assume this was a prefetch
740 "Returning primary keys of prefetched 'filter' rels as part of get_columns() is deprecated and will "
741 . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
743 ! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
745 defined $self->{related_resultsets}{$col}
747 defined $self->{related_resultsets}{$col}->get_cache
750 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
754 return %{$self->{_column_data}};
757 =head2 get_dirty_columns
759 my %data = $result->get_dirty_columns;
763 =item Arguments: none
765 =item Return Value: A hash of column, value pairs
769 Only returns the column, value pairs for those columns that have been
770 changed on this object since the last L</update> or L</insert> call.
772 See L</get_columns> to fetch all column/value pairs.
776 sub get_dirty_columns {
778 return map { $_ => $self->{_column_data}{$_} }
779 keys %{$self->{_dirty_columns}};
782 =head2 make_column_dirty
784 $result->make_column_dirty($col)
788 =item Arguments: $columnname
790 =item Return Value: not defined
794 Throws an exception if the column does not exist.
796 Marks a column as having been changed regardless of whether it has
801 sub make_column_dirty {
802 my ($self, $column) = @_;
804 $self->throw_exception( "No such column '${column}'" )
805 unless exists $self->{_column_data}{$column} || $self->has_column($column);
807 # the entire clean/dirty code relies on exists, not on true/false
808 return 1 if exists $self->{_dirty_columns}{$column};
810 $self->{_dirty_columns}{$column} = 1;
812 # if we are just now making the column dirty, and if there is an inflated
813 # value, force it over the deflated one
814 if (exists $self->{_inflated_column}{$column}) {
815 $self->store_column($column,
816 $self->_deflated_column(
817 $column, $self->{_inflated_column}{$column}
823 =head2 get_inflated_columns
825 my %inflated_data = $obj->get_inflated_columns;
829 =item Arguments: none
831 =item Return Value: A hash of column, object|value pairs
835 Returns a hash of all column keys and associated values. Values for any
836 columns set to use inflation will be inflated and returns as objects.
838 See L</get_columns> to get the uninflated values.
840 See L<DBIx::Class::InflateColumn> for how to setup inflation.
844 sub get_inflated_columns {
847 my $loaded_colinfo = $self->columns_info ([
848 grep { $self->has_column_loaded($_) } $self->columns
851 my %cols_to_return = ( %{$self->{_column_data}}, %$loaded_colinfo );
853 unless ($ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}) {
854 for (keys %$loaded_colinfo) {
855 # if cached related_resultset is present assume this was a prefetch
857 $loaded_colinfo->{$_}{_inflate_info}
859 defined $self->{related_resultsets}{$_}
861 defined $self->{related_resultsets}{$_}->get_cache
864 "Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
865 . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
874 ! exists $loaded_colinfo->{$_}
877 exists $loaded_colinfo->{$_}{accessor}
879 ! defined $loaded_colinfo->{$_}{accessor}
881 ) ? $self->get_column($_)
883 defined $loaded_colinfo->{$_}{accessor}
884 ? $loaded_colinfo->{$_}{accessor}
887 )} keys %cols_to_return;
890 sub _is_column_numeric {
891 my ($self, $column) = @_;
892 my $colinfo = $self->column_info ($column);
894 # cache for speed (the object may *not* have a resultsource instance)
896 ! defined $colinfo->{is_numeric}
898 my $storage = try { $self->result_source->schema->storage }
900 $colinfo->{is_numeric} =
901 $storage->is_datatype_numeric ($colinfo->{data_type})
907 return $colinfo->{is_numeric};
912 $result->set_column($col => $val);
916 =item Arguments: $columnname, $value
918 =item Return Value: $value
922 Sets a raw column value. If the new value is different from the old one,
923 the column is marked as dirty for when you next call L</update>.
925 If passed an object or reference as a value, this method will happily
926 attempt to store it, and a later L</insert> or L</update> will try and
927 stringify/numify as appropriate. To set an object to be deflated
928 instead, see L</set_inflated_columns>, or better yet, use L</$column_accessor>.
933 my ($self, $column, $new_value) = @_;
935 my $had_value = $self->has_column_loaded($column);
936 my $old_value = $self->get_column($column);
938 $new_value = $self->store_column($column, $new_value);
941 $self->{_dirty_columns}{$column}
943 $self->in_storage # no point tracking dirtyness on uninserted data
944 ? ! $self->_eq_column_values ($column, $old_value, $new_value)
949 # FIXME sadly the update code just checks for keys, not for their value
950 $self->{_dirty_columns}{$column} = 1;
952 # Clear out the relation/inflation cache related to this column
954 # FIXME - this is a quick *largely incorrect* hack, pending a more
955 # serious rework during the merge of single and filter rels
956 my $rel_names = $self->result_source->{_relationships};
957 for my $rel_name (keys %$rel_names) {
959 my $acc = $rel_names->{$rel_name}{attrs}{accessor} || '';
961 if ( $acc eq 'single' and $rel_names->{$rel_name}{attrs}{fk_columns}{$column} ) {
962 delete $self->{related_resultsets}{$rel_name};
963 delete $self->{_relationship_data}{$rel_name};
964 #delete $self->{_inflated_column}{$rel_name};
966 elsif ( $acc eq 'filter' and $rel_name eq $column) {
967 delete $self->{related_resultsets}{$rel_name};
968 #delete $self->{_relationship_data}{$rel_name};
969 delete $self->{_inflated_column}{$rel_name};
974 # value change from something (even if NULL)
977 # no storage - no storage-value
980 # no value already stored (multiple changes before commit to storage)
981 ! exists $self->{_column_data_in_storage}{$column}
983 $self->_track_storage_value($column)
985 $self->{_column_data_in_storage}{$column} = $old_value;
992 sub _eq_column_values {
993 my ($self, $col, $old, $new) = @_;
995 if (defined $old xor defined $new) {
998 elsif (not defined $old) { # both undef
1002 is_literal_value $old
1004 is_literal_value $new
1008 elsif ($old eq $new) {
1011 elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
1012 return $old == $new;
1019 # returns a boolean indicating if the passed column should have its original
1020 # value tracked between column changes and commitment to storage
1021 sub _track_storage_value {
1022 my ($self, $col) = @_;
1023 return defined first { $col eq $_ } ($self->primary_columns);
1028 $result->set_columns({ $col => $val, ... });
1032 =item Arguments: \%columndata
1034 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1038 Sets multiple column, raw value pairs at once.
1040 Works as L</set_column>.
1045 my ($self, $values) = @_;
1046 $self->set_column( $_, $values->{$_} ) for keys %$values;
1050 =head2 set_inflated_columns
1052 $result->set_inflated_columns({ $col => $val, $rel_name => $obj, ... });
1056 =item Arguments: \%columndata
1058 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1062 Sets more than one column value at once. Any inflated values are
1063 deflated and the raw values stored.
1065 Any related values passed as Result objects, using the relation name as a
1066 key, are reduced to the appropriate foreign key values and stored. If
1067 instead of related result objects, a hashref of column, value data is
1068 passed, will create the related object first then store.
1070 Will even accept arrayrefs of data as a value to a
1071 L<DBIx::Class::Relationship/has_many> key, and create the related
1072 objects if necessary.
1074 Be aware that the input hashref might be edited in place, so don't rely
1075 on it being the same after a call to C<set_inflated_columns>. If you
1076 need to preserve the hashref, it is sufficient to pass a shallow copy
1077 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
1079 See also L<DBIx::Class::Relationship::Base/set_from_related>.
1083 sub set_inflated_columns {
1084 my ( $self, $upd ) = @_;
1085 foreach my $key (keys %$upd) {
1086 if (ref $upd->{$key}) {
1087 my $info = $self->relationship_info($key);
1088 my $acc_type = $info->{attrs}{accessor} || '';
1090 if ($acc_type eq 'single') {
1091 my $rel_obj = delete $upd->{$key};
1092 $self->set_from_related($key => $rel_obj);
1093 $self->{_relationship_data}{$key} = $rel_obj;
1095 elsif ($acc_type eq 'multi') {
1096 $self->throw_exception(
1097 "Recursive update is not supported over relationships of type '$acc_type' ($key)"
1100 elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
1101 $self->set_inflated_column($key, delete $upd->{$key});
1105 $self->set_columns($upd);
1110 my $copy = $orig->copy({ change => $to, ... });
1114 =item Arguments: \%replacementdata
1116 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass> copy
1120 Inserts a new row into the database, as a copy of the original
1121 object. If a hashref of replacement data is supplied, these will take
1122 precedence over data in the original. Also any columns which have
1123 the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1124 C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1125 so that the database can insert its own autoincremented values into
1128 Relationships will be followed by the copy procedure B<only> if the
1129 relationship specifies a true value for its
1130 L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1131 is set by default on C<has_many> relationships and unset on all others.
1136 my ($self, $changes) = @_;
1138 my $col_data = { %{$self->{_column_data}} };
1140 my $colinfo = $self->columns_info([ keys %$col_data ]);
1141 foreach my $col (keys %$col_data) {
1142 delete $col_data->{$col}
1143 if $colinfo->{$col}{is_auto_increment};
1146 my $new = { _column_data => $col_data };
1147 bless $new, ref $self;
1149 $new->result_source($self->result_source);
1150 $new->set_inflated_columns($changes);
1153 # Its possible we'll have 2 relations to the same Source. We need to make
1154 # sure we don't try to insert the same row twice else we'll violate unique
1156 my $rel_names_copied = {};
1158 foreach my $rel_name ($self->result_source->relationships) {
1159 my $rel_info = $self->result_source->relationship_info($rel_name);
1161 next unless $rel_info->{attrs}{cascade_copy};
1163 my $resolved = $self->result_source->_resolve_condition(
1164 $rel_info->{cond}, $rel_name, $new, $rel_name
1167 my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
1168 foreach my $related ($self->search_related($rel_name)->all) {
1169 my $id_str = join("\0", $related->id);
1170 next if $copied->{$id_str};
1171 $copied->{$id_str} = 1;
1172 my $rel_copy = $related->copy($resolved);
1181 $result->store_column($col => $val);
1185 =item Arguments: $columnname, $value
1187 =item Return Value: The value sent to storage
1191 Set a raw value for a column without marking it as changed. This
1192 method is used internally by L</set_column> which you should probably
1195 This is the lowest level at which data is set on a result object,
1196 extend this method to catch all data setting methods.
1201 my ($self, $column, $value) = @_;
1202 $self->throw_exception( "No such column '${column}'" )
1203 unless exists $self->{_column_data}{$column} || $self->has_column($column);
1204 $self->throw_exception( "set_column called for ${column} without value" )
1206 return $self->{_column_data}{$column} = $value;
1209 =head2 inflate_result
1211 Class->inflate_result($result_source, \%me, \%prefetch?)
1215 =item Arguments: L<$result_source|DBIx::Class::ResultSource>, \%columndata, \%prefetcheddata
1217 =item Return Value: L<$result|DBIx::Class::Manual::ResultClass>
1221 All L<DBIx::Class::ResultSet> methods that retrieve data from the
1222 database and turn it into result objects call this method.
1224 Extend this method in your Result classes to hook into this process,
1225 for example to rebless the result into a different class.
1227 Reblessing can also be done more easily by setting C<result_class> in
1228 your Result class. See L<DBIx::Class::ResultSource/result_class>.
1230 Different types of results can also be created from a particular
1231 L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1235 sub inflate_result {
1236 my ($class, $rsrc, $me, $prefetch) = @_;
1239 { _column_data => $me, _result_source => $rsrc },
1240 ref $class || $class
1244 for my $rel_name ( keys %$prefetch ) {
1246 my $relinfo = $rsrc->relationship_info($rel_name) or do {
1248 "Inflation into non-existent relationship '%s' of '%s' requested",
1252 if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$rel_name}[0] || {}} ) {
1253 $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
1258 $rsrc->throw_exception($err);
1261 $class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
1262 unless $relinfo->{attrs}{accessor};
1264 my $rel_rs = $new->related_resultset($rel_name);
1268 @{ $prefetch->{$rel_name} || [] }
1270 ref($prefetch->{$rel_name}) ne $DBIx::Class::ResultSource::RowParser::Util::null_branch_class
1273 if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
1274 my $rel_rsrc = $rel_rs->result_source;
1275 my $rel_class = $rel_rs->result_class;
1276 my $rel_inflator = $rel_class->can('inflate_result');
1278 { $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
1279 @{$prefetch->{$rel_name}}
1283 @rel_objects = $rel_rs->result_class->inflate_result(
1284 $rel_rs->result_source, @{$prefetch->{$rel_name}}
1289 if ($relinfo->{attrs}{accessor} eq 'single') {
1290 $new->{_relationship_data}{$rel_name} = $rel_objects[0];
1292 elsif ($relinfo->{attrs}{accessor} eq 'filter') {
1293 $new->{_inflated_column}{$rel_name} = $rel_objects[0];
1296 $rel_rs->set_cache(\@rel_objects);
1300 $new->in_storage (1);
1304 =head2 update_or_insert
1306 $result->update_or_insert
1310 =item Arguments: none
1312 =item Return Value: Result of update or insert operation
1316 L</Update>s the object if it's already in the database, according to
1317 L</in_storage>, else L</insert>s it.
1319 =head2 insert_or_update
1321 $obj->insert_or_update
1323 Alias for L</update_or_insert>
1327 sub insert_or_update { shift->update_or_insert(@_) }
1329 sub update_or_insert {
1331 return ($self->in_storage ? $self->update : $self->insert);
1336 my @changed_col_names = $result->is_changed();
1337 if ($result->is_changed()) { ... }
1341 =item Arguments: none
1343 =item Return Value: 0|1 or @columnnames
1347 In list context returns a list of columns with uncommited changes, or
1348 in scalar context returns a true value if there are uncommitted
1354 return keys %{shift->{_dirty_columns} || {}};
1357 =head2 is_column_changed
1359 if ($result->is_column_changed('col')) { ... }
1363 =item Arguments: $columname
1365 =item Return Value: 0|1
1369 Returns a true value if the column has uncommitted changes.
1373 sub is_column_changed {
1374 my( $self, $col ) = @_;
1375 return exists $self->{_dirty_columns}->{$col};
1378 =head2 result_source
1380 my $resultsource = $result->result_source;
1384 =item Arguments: L<$result_source?|DBIx::Class::ResultSource>
1386 =item Return Value: L<$result_source|DBIx::Class::ResultSource>
1390 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1395 $_[0]->throw_exception( 'result_source can be called on instances only' )
1399 ? $_[0]->{_result_source} = $_[1]
1401 # note this is a || not a ||=, the difference is important
1402 : $_[0]->{_result_source} || do {
1403 my $class = ref $_[0];
1404 $_[0]->can('result_source_instance')
1405 ? $_[0]->result_source_instance
1406 : $_[0]->throw_exception(
1407 "No result source instance registered for $class, did you forget to call $class->table(...) ?"
1413 =head2 register_column
1415 $column_info = { .... };
1416 $class->register_column($column_name, $column_info);
1420 =item Arguments: $columnname, \%columninfo
1422 =item Return Value: not defined
1426 Registers a column on the class. If the column_info has an 'accessor'
1427 key, creates an accessor named after the value if defined; if there is
1428 no such key, creates an accessor with the same name as the column
1430 The column_info attributes are described in
1431 L<DBIx::Class::ResultSource/add_columns>
1435 sub register_column {
1436 my ($class, $col, $info) = @_;
1438 if (exists $info->{accessor}) {
1439 return unless defined $info->{accessor};
1440 $acc = [ $info->{accessor}, $col ];
1442 $class->mk_group_accessors('column' => $acc);
1445 =head2 get_from_storage
1447 my $copy = $result->get_from_storage($attrs)
1451 =item Arguments: \%attrs
1453 =item Return Value: A Result object
1457 Fetches a fresh copy of the Result object from the database and returns it.
1458 Throws an exception if a proper WHERE clause identifying the database row
1459 can not be constructed (i.e. if the original object does not contain its
1461 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1462 ). If passed the \%attrs argument, will first apply these attributes to
1463 the resultset used to find the row.
1465 This copy can then be used to compare to an existing result object, to
1466 determine if any changes have been made in the database since it was
1469 To just update your Result object with any latest changes from the
1470 database, use L</discard_changes> instead.
1472 The \%attrs argument should be compatible with
1473 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1477 sub get_from_storage {
1478 my $self = shift @_;
1479 my $attrs = shift @_;
1480 my $resultset = $self->result_source->resultset;
1482 if(defined $attrs) {
1483 $resultset = $resultset->search(undef, $attrs);
1486 return $resultset->find($self->_storage_ident_condition);
1489 =head2 discard_changes
1491 $result->discard_changes
1495 =item Arguments: none or $attrs
1497 =item Return Value: self (updates object in-place)
1501 Re-selects the row from the database, losing any changes that had
1502 been made. Throws an exception if a proper C<WHERE> clause identifying
1503 the database row can not be constructed (i.e. if the original object
1504 does not contain its entire
1505 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1507 This method can also be used to refresh from storage, retrieving any
1508 changes made since the row was last read from storage.
1510 $attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1511 second argument to C<< $resultset->search($cond, $attrs) >>;
1513 Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1514 storage, a default of
1515 L<< C<< { force_pool => 'master' } >>
1516 |DBIx::Class::Storage::DBI::Replicated/SYNOPSIS >> is automatically set for
1517 you. Prior to C<< DBIx::Class 0.08109 >> (before 2010) one would have been
1518 required to explicitly wrap the entire operation in a transaction to guarantee
1519 that up-to-date results are read from the master database.
1523 sub discard_changes {
1524 my ($self, $attrs) = @_;
1525 return unless $self->in_storage; # Don't reload if we aren't real!
1527 # add a replication default to read from the master only
1528 $attrs = { force_pool => 'master', %{$attrs||{}} };
1530 if( my $current_storage = $self->get_from_storage($attrs)) {
1532 # Set $self to the current.
1533 %$self = %$current_storage;
1535 # Avoid a possible infinite loop with
1536 # sub DESTROY { $_[0]->discard_changes }
1537 bless $current_storage, 'Do::Not::Exist';
1542 $self->in_storage(0);
1547 =head2 throw_exception
1549 See L<DBIx::Class::Schema/throw_exception>.
1553 sub throw_exception {
1556 if (ref $self && ref $self->result_source ) {
1557 $self->result_source->throw_exception(@_)
1560 DBIx::Class::Exception->throw(@_);
1566 my @pk = $result->id;
1570 =item Arguments: none
1572 =item Returns: A list of primary key values
1576 Returns the primary key(s) for a row. Can't be called as a class method.
1577 Actually implemented in L<DBIx::Class::PK>
1579 =head1 AUTHOR AND CONTRIBUTORS
1581 See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
1585 You may distribute this code under the same terms as Perl itself.