1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
8 use DBIx::Class::Exception;
9 use Scalar::Util 'blessed';
19 $ENV{DBIC_MULTICREATE_DEBUG}
24 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
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 Row 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<DBIx::Class::Row> objects.
50 my $row = My::Class->new(\%attrs);
52 my $row = $schema->resultset('MySource')->new(\%colsandvalues);
56 =item Arguments: \%attrs or \%colsandvalues
58 =item Returns: A Row object
62 While you can create a new row object by calling C<new> directly on
63 this class, you are better off calling it on a
64 L<DBIx::Class::ResultSet> object.
66 When calling it directly, you will not get a complete, usable row
67 object until you pass or set the C<source_handle> attribute, to a
68 L<DBIx::Class::ResultSource> instance that is attached to a
69 L<DBIx::Class::Schema> with a valid connection.
71 C<$attrs> is a hashref of column name, value data. It can also contain
72 some other attributes such as the C<source_handle>.
74 Passing an object, or an arrayref of objects as a value will call
75 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
76 passed a hashref or an arrayref of hashrefs as the value, these will
77 be turned into objects via new_related, and treated as if you had
80 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
82 Please note that if a value is not passed to new, no value will be sent
83 in the SQL INSERT call, and the column will therefore assume whatever
84 default value was specified in your database. While DBIC will retrieve the
85 value of autoincrement columns, it will never make an explicit database
86 trip to retrieve default values assigned by the RDBMS. You can explicitly
87 request that all values be fetched back from the database by calling
88 L</discard_changes>, or you can supply an explicit C<undef> to columns
89 with NULL as the default, and save yourself a SELECT.
93 The behavior described above will backfire if you use a foreign key column
94 with a database-defined default. If you call the relationship accessor on
95 an object that doesn't have a set value for the FK column, DBIC will throw
96 an exception, as it has no way of knowing the PK of the related object (if
101 ## 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().
102 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
103 ## When doing the later insert, we need to make sure the PKs are set.
104 ## using _relationship_data in new and funky ways..
105 ## check Relationship::CascadeActions and Relationship::Accessor for compat
108 sub __new_related_find_or_new_helper {
109 my ($self, $relname, $data) = @_;
111 my $rsrc = $self->result_source;
113 # create a mock-object so all new/set_column component overrides will run:
114 my $rel_rs = $rsrc->related_source($relname)->resultset;
115 my $new_rel_obj = $rel_rs->new_result($data);
116 my $proc_data = { $new_rel_obj->get_columns };
118 if ($self->__their_pk_needs_us($relname)) {
119 MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
122 elsif ($rsrc->_pk_depends_on($relname, $proc_data )) {
123 if (! keys %$proc_data) {
124 # there is nothing to search for - blind create
125 MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname";
128 MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
129 # this is not *really* find or new, as we don't want to double-new the
130 # data (thus potentially double encoding or whatever)
131 my $exists = $rel_rs->find ($proc_data);
132 return $exists if $exists;
137 my $us = $rsrc->source_name;
138 $self->throw_exception (
139 "Unable to determine relationship '$relname' direction from '$us', "
140 . "possibly due to a missing reverse-relationship on '$relname' to '$us'."
145 sub __their_pk_needs_us { # this should maybe be in resultsource.
146 my ($self, $relname) = @_;
147 my $source = $self->result_source;
148 my $reverse = $source->reverse_relationship_info($relname);
149 my $rel_source = $source->related_source($relname);
150 my $us = { $self->get_columns };
151 foreach my $key (keys %$reverse) {
152 # if their primary key depends on us, then we have to
153 # just create a result and we'll fill it out afterwards
154 return 1 if $rel_source->_pk_depends_on($key, $us);
160 my ($class, $attrs) = @_;
161 $class = ref $class if ref $class;
168 if (my $handle = delete $attrs->{-source_handle}) {
169 $new->_source_handle($handle);
173 if ($source = delete $attrs->{-result_source}) {
174 $new->result_source($source);
177 if (my $related = delete $attrs->{-cols_from_relations}) {
178 @{$new->{_ignore_at_insert}={}}{@$related} = ();
182 $new->throw_exception("attrs must be a hashref")
183 unless ref($attrs) eq 'HASH';
185 my ($related,$inflated);
187 foreach my $key (keys %$attrs) {
188 if (ref $attrs->{$key}) {
189 ## Can we extract this lot to use with update(_or .. ) ?
190 $new->throw_exception("Can't do multi-create without result source")
192 my $info = $source->relationship_info($key);
193 my $acc_type = $info->{attrs}{accessor} || '';
194 if ($acc_type eq 'single') {
195 my $rel_obj = delete $attrs->{$key};
196 if(!blessed $rel_obj) {
197 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
200 if ($rel_obj->in_storage) {
201 $new->{_rel_in_storage}{$key} = 1;
202 $new->set_from_related($key, $rel_obj);
204 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
207 $related->{$key} = $rel_obj;
210 elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
211 my $others = delete $attrs->{$key};
212 my $total = @$others;
214 foreach my $idx (0 .. $#$others) {
215 my $rel_obj = $others->[$idx];
216 if(!blessed $rel_obj) {
217 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
220 if ($rel_obj->in_storage) {
221 $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
223 MULTICREATE_DEBUG and
224 warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
226 push(@objects, $rel_obj);
228 $related->{$key} = \@objects;
231 elsif ($acc_type eq 'filter') {
232 ## 'filter' should disappear and get merged in with 'single' above!
233 my $rel_obj = delete $attrs->{$key};
234 if(!blessed $rel_obj) {
235 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
237 if ($rel_obj->in_storage) {
238 $new->{_rel_in_storage}{$key} = 1;
241 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
243 $inflated->{$key} = $rel_obj;
245 } elsif ($class->has_column($key)
246 && $class->column_info($key)->{_inflate_info}) {
247 $inflated->{$key} = $attrs->{$key};
251 $new->throw_exception("No such column $key on $class")
252 unless $class->has_column($key);
253 $new->store_column($key => $attrs->{$key});
256 $new->{_relationship_data} = $related if $related;
257 $new->{_inflated_column} = $inflated if $inflated;
269 =item Arguments: none
271 =item Returns: The Row object
275 Inserts an object previously created by L</new> into the database if
276 it isn't already in there. Returns the object itself. Requires the
277 object's result source to be set, or the class to have a
278 result_source_instance method. To insert an entirely new row into
279 the database, use C<create> (see L<DBIx::Class::ResultSet/create>).
281 To fetch an uninserted row object, call
282 L<new|DBIx::Class::ResultSet/new> on a resultset.
284 This will also insert any uninserted, related objects held inside this
285 one, see L<DBIx::Class::ResultSet/create> for more details.
291 return $self if $self->in_storage;
292 my $source = $self->result_source;
293 $source ||= $self->result_source($self->result_source_instance)
294 if $self->can('result_source_instance');
295 $self->throw_exception("No result_source set on this object; can't insert")
298 my $storage = $source->storage;
302 # Check if we stored uninserted relobjs here in new()
303 my %related_stuff = (%{$self->{_relationship_data} || {}},
304 %{$self->{_inflated_column} || {}});
306 # insert what needs to be inserted before us
308 for my $relname (keys %related_stuff) {
309 my $rel_obj = $related_stuff{$relname};
311 if (! $self->{_rel_in_storage}{$relname}) {
312 next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
314 next unless $source->_pk_depends_on(
315 $relname, { $rel_obj->get_columns }
318 # The guard will save us if we blow out of this scope via die
319 $rollback_guard ||= $storage->txn_scope_guard;
321 MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
323 my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
326 # if there are no keys - nothing to search for
327 if (keys %$them and $existing = $self->result_source
328 ->related_source($relname)
332 %{$rel_obj} = %{$existing};
338 $self->{_rel_in_storage}{$relname} = 1;
341 $self->set_from_related($relname, $rel_obj);
342 delete $related_stuff{$relname};
345 # start a transaction here if not started yet and there is more stuff
347 if (keys %related_stuff) {
348 $rollback_guard ||= $storage->txn_scope_guard
351 MULTICREATE_DEBUG and do {
352 no warnings 'uninitialized';
353 warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
356 my %current_rowdata = $self->get_columns;
358 # perform the insert - the storage may return some stuff for us right there
360 my $returned_cols = $storage->insert(
365 for (keys %$returned_cols) {
368 ( $current_rowdata{$_} = $returned_cols->{$_} )
372 # see if any of the pcols still need filling (or re-querying in case of scalarrefs)
373 my @missing_pri = grep
374 { ! defined $current_rowdata{$_} or ref $current_rowdata{$_} eq 'SCALAR' }
375 $self->primary_columns
379 MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing_pri )."\n";
381 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
382 unless $storage->can('last_insert_id');
384 my @pri_values = $storage->last_insert_id($self->result_source, @missing_pri);
386 $self->throw_exception( "Can't get last insert id" )
387 unless (@pri_values == @missing_pri);
389 $self->store_column($missing_pri[$_] => $pri_values[$_]) for 0 .. $#missing_pri;
392 $self->{_dirty_columns} = {};
393 $self->{related_resultsets} = {};
395 foreach my $relname (keys %related_stuff) {
396 next unless $source->has_relationship ($relname);
398 my @cands = ref $related_stuff{$relname} eq 'ARRAY'
399 ? @{$related_stuff{$relname}}
400 : $related_stuff{$relname}
403 if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
405 my $reverse = $source->reverse_relationship_info($relname);
406 foreach my $obj (@cands) {
407 $obj->set_from_related($_, $self) for keys %$reverse;
408 if ($self->__their_pk_needs_us($relname)) {
409 if (exists $self->{_ignore_at_insert}{$relname}) {
410 MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
413 MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj";
417 MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
424 $self->in_storage(1);
425 delete $self->{_orig_ident};
426 delete $self->{_orig_ident_failreason};
427 delete $self->{_ignore_at_insert};
428 $rollback_guard->commit if $rollback_guard;
435 $row->in_storage; # Get value
436 $row->in_storage(1); # Set value
440 =item Arguments: none or 1|0
446 Indicates whether the object exists as a row in the database or
447 not. This is set to true when L<DBIx::Class::ResultSet/find>,
448 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
451 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
452 L</delete> on one, sets it to false.
457 my ($self, $val) = @_;
458 $self->{_in_storage} = $val if @_ > 1;
459 return $self->{_in_storage} ? 1 : 0;
464 $row->update(\%columns?)
468 =item Arguments: none or a hashref
470 =item Returns: The Row object
474 Throws an exception if the row object is not yet in the database,
475 according to L</in_storage>.
477 This method issues an SQL UPDATE query to commit any changes to the
478 object to the database if required (see L</get_dirty_columns>).
479 It throws an exception if a proper WHERE clause uniquely identifying
480 the database row can not be constructed (see
481 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
484 Also takes an optional hashref of C<< column_name => value >> pairs
485 to update on the object first. Be aware that the hashref will be
486 passed to C<set_inflated_columns>, which might edit it in place, so
487 don't rely on it being the same after a call to C<update>. If you
488 need to preserve the hashref, it is sufficient to pass a shallow copy
489 to C<update>, e.g. ( { %{ $href } } )
491 If the values passed or any of the column values set on the object
492 contain scalar references, e.g.:
494 $row->last_modified(\'NOW()');
496 $row->update({ last_modified => \'NOW()' });
498 The update will pass the values verbatim into SQL. (See
499 L<SQL::Abstract> docs). The values in your Row object will NOT change
500 as a result of the update call, if you want the object to be updated
501 with the actual values from the database, call L</discard_changes>
504 $row->update()->discard_changes();
506 To determine before calling this method, which column values have
507 changed and will be updated, call L</get_dirty_columns>.
509 To check if any columns will be updated, call L</is_changed>.
511 To force a column to be updated, call L</make_column_dirty> before
517 my ($self, $upd) = @_;
519 $self->set_inflated_columns($upd) if $upd;
521 my %to_update = $self->get_dirty_columns
524 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
525 $self->throw_exception( "Not in database" ) unless $self->in_storage;
527 $self->throw_exception($self->{_orig_ident_failreason})
528 if ! keys %$ident_cond;
530 my $rows = $self->result_source->storage->update(
531 $self->result_source, \%to_update, $ident_cond
534 $self->throw_exception( "Can't update ${self}: row not found" );
535 } elsif ($rows > 1) {
536 $self->throw_exception("Can't update ${self}: updated more than one row");
538 $self->{_dirty_columns} = {};
539 $self->{related_resultsets} = {};
540 delete $self->{_orig_ident};
550 =item Arguments: none
552 =item Returns: The Row object
556 Throws an exception if the object is not in the database according to
557 L</in_storage>. Also throws an exception if a proper WHERE clause
558 uniquely identifying the database row can not be constructed (see
559 L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
562 The object is still perfectly usable, but L</in_storage> will
563 now return 0 and the object must be reinserted using L</insert>
564 before it can be used to L</update> the row again.
566 If you delete an object in a class with a C<has_many> relationship, an
567 attempt is made to delete all the related objects as well. To turn
568 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
569 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
570 database-level cascade or restrict will take precedence over a
571 DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
572 main row first> and only then attempts to delete any remaining related
575 If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
576 and the transaction subsequently fails, the row object will remain marked as
577 not being in storage. If you know for a fact that the object is still in
578 storage (i.e. by inspecting the cause of the transaction's failure), you can
579 use C<< $obj->in_storage(1) >> to restore consistency between the object and
580 the database. This would allow a subsequent C<< $obj->delete >> to work
583 See also L<DBIx::Class::ResultSet/delete>.
590 $self->throw_exception( "Not in database" ) unless $self->in_storage;
592 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
593 $self->throw_exception($self->{_orig_ident_failreason})
594 if ! keys %$ident_cond;
596 $self->result_source->storage->delete(
597 $self->result_source, $ident_cond
600 delete $self->{_orig_ident}; # no longer identifiable
601 $self->in_storage(undef);
604 $self->throw_exception("Can't do class delete without a ResultSource instance")
605 unless $self->can('result_source_instance');
606 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
607 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
608 $self->result_source_instance->resultset->search(@_)->delete;
615 my $val = $row->get_column($col);
619 =item Arguments: $columnname
621 =item Returns: The value of the column
625 Throws an exception if the column name given doesn't exist according
628 Returns a raw column value from the row object, if it has already
629 been fetched from the database or set by an accessor.
631 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
632 will be deflated and returned.
634 Note that if you used the C<columns> or the C<select/as>
635 L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
636 which C<$row> was derived, and B<did not include> C<$columnname> in the list,
637 this method will return C<undef> even if the database contains some value.
639 To retrieve all loaded column values as a hash, use L</get_columns>.
644 my ($self, $column) = @_;
645 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
646 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
647 if (exists $self->{_inflated_column}{$column}) {
648 return $self->store_column($column,
649 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
651 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
655 =head2 has_column_loaded
657 if ( $row->has_column_loaded($col) ) {
658 print "$col has been loaded from db";
663 =item Arguments: $columnname
669 Returns a true value if the column value has been loaded from the
670 database (or set locally).
674 sub has_column_loaded {
675 my ($self, $column) = @_;
676 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
677 return 1 if exists $self->{_inflated_column}{$column};
678 return exists $self->{_column_data}{$column};
683 my %data = $row->get_columns;
687 =item Arguments: none
689 =item Returns: A hash of columnname, value pairs.
693 Returns all loaded column data as a hash, containing raw values. To
694 get just one value for a particular column, use L</get_column>.
696 See L</get_inflated_columns> to get the inflated values.
702 if (exists $self->{_inflated_column}) {
703 foreach my $col (keys %{$self->{_inflated_column}}) {
704 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
705 unless exists $self->{_column_data}{$col};
708 return %{$self->{_column_data}};
711 =head2 get_dirty_columns
713 my %data = $row->get_dirty_columns;
717 =item Arguments: none
719 =item Returns: A hash of column, value pairs
723 Only returns the column, value pairs for those columns that have been
724 changed on this object since the last L</update> or L</insert> call.
726 See L</get_columns> to fetch all column/value pairs.
730 sub get_dirty_columns {
732 return map { $_ => $self->{_column_data}{$_} }
733 keys %{$self->{_dirty_columns}};
736 =head2 make_column_dirty
738 $row->make_column_dirty($col)
742 =item Arguments: $columnname
744 =item Returns: undefined
748 Throws an exception if the column does not exist.
750 Marks a column as having been changed regardless of whether it has
754 sub make_column_dirty {
755 my ($self, $column) = @_;
757 $self->throw_exception( "No such column '${column}'" )
758 unless exists $self->{_column_data}{$column} || $self->has_column($column);
760 # the entire clean/dirty code relies on exists, not on true/false
761 return 1 if exists $self->{_dirty_columns}{$column};
763 $self->{_dirty_columns}{$column} = 1;
765 # if we are just now making the column dirty, and if there is an inflated
766 # value, force it over the deflated one
767 if (exists $self->{_inflated_column}{$column}) {
768 $self->store_column($column,
769 $self->_deflated_column(
770 $column, $self->{_inflated_column}{$column}
776 =head2 get_inflated_columns
778 my %inflated_data = $obj->get_inflated_columns;
782 =item Arguments: none
784 =item Returns: A hash of column, object|value pairs
788 Returns a hash of all column keys and associated values. Values for any
789 columns set to use inflation will be inflated and returns as objects.
791 See L</get_columns> to get the uninflated values.
793 See L<DBIx::Class::InflateColumn> for how to setup inflation.
797 sub get_inflated_columns {
800 my $loaded_colinfo = $self->columns_info ([
801 grep { $self->has_column_loaded($_) } $self->columns
805 for my $col (keys %$loaded_colinfo) {
806 if (exists $loaded_colinfo->{$col}{accessor}) {
807 my $acc = $loaded_colinfo->{$col}{accessor};
808 $inflated{$col} = $self->$acc if defined $acc;
811 $inflated{$col} = $self->$col;
815 # return all loaded columns with the inflations overlayed on top
816 return %{ { $self->get_columns, %inflated } };
819 sub _is_column_numeric {
820 my ($self, $column) = @_;
821 my $colinfo = $self->column_info ($column);
823 # cache for speed (the object may *not* have a resultsource instance)
824 if (! defined $colinfo->{is_numeric} && $self->_source_handle) {
825 $colinfo->{is_numeric} =
826 $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
832 return $colinfo->{is_numeric};
837 $row->set_column($col => $val);
841 =item Arguments: $columnname, $value
843 =item Returns: $value
847 Sets a raw column value. If the new value is different from the old one,
848 the column is marked as dirty for when you next call L</update>.
850 If passed an object or reference as a value, this method will happily
851 attempt to store it, and a later L</insert> or L</update> will try and
852 stringify/numify as appropriate. To set an object to be deflated
853 instead, see L</set_inflated_columns>.
858 my ($self, $column, $new_value) = @_;
860 # if we can't get an ident condition on first try - mark the object as unidentifiable
861 # (by using an empty hashref) and store the error for further diag
862 unless ($self->{_orig_ident}) {
864 $self->{_orig_ident} = $self->ident_condition
867 $self->{_orig_ident_failreason} = $_;
868 $self->{_orig_ident} = {};
872 my $old_value = $self->get_column($column);
873 $new_value = $self->store_column($column, $new_value);
876 $self->{_dirty_columns}{$column}
878 $self->in_storage # no point tracking dirtyness on uninserted data
879 ? ! $self->_eq_column_values ($column, $old_value, $new_value)
884 # FIXME sadly the update code just checks for keys, not for their value
885 $self->{_dirty_columns}{$column} = 1;
887 # Clear out the relation/inflation cache related to this column
889 # FIXME - this is a quick *largely incorrect* hack, pending a more
890 # serious rework during the merge of single and filter rels
891 my $rels = $self->result_source->{_relationships};
892 for my $rel (keys %$rels) {
894 my $acc = $rels->{$rel}{attrs}{accessor} || '';
896 if ( $acc eq 'single' and $rels->{$rel}{attrs}{fk_columns}{$column} ) {
897 delete $self->{related_resultsets}{$rel};
898 delete $self->{_relationship_data}{$rel};
899 #delete $self->{_inflated_column}{$rel};
901 elsif ( $acc eq 'filter' and $rel eq $column) {
902 delete $self->{related_resultsets}{$rel};
903 #delete $self->{_relationship_data}{$rel};
904 delete $self->{_inflated_column}{$rel};
912 sub _eq_column_values {
913 my ($self, $col, $old, $new) = @_;
915 if (defined $old xor defined $new) {
918 elsif (not defined $old) { # both undef
921 elsif ($old eq $new) {
924 elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
934 $row->set_columns({ $col => $val, ... });
938 =item Arguments: \%columndata
940 =item Returns: The Row object
944 Sets multiple column, raw value pairs at once.
946 Works as L</set_column>.
951 my ($self,$data) = @_;
952 foreach my $col (keys %$data) {
953 $self->set_column($col,$data->{$col});
958 =head2 set_inflated_columns
960 $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
964 =item Arguments: \%columndata
966 =item Returns: The Row object
970 Sets more than one column value at once. Any inflated values are
971 deflated and the raw values stored.
973 Any related values passed as Row objects, using the relation name as a
974 key, are reduced to the appropriate foreign key values and stored. If
975 instead of related row objects, a hashref of column, value data is
976 passed, will create the related object first then store.
978 Will even accept arrayrefs of data as a value to a
979 L<DBIx::Class::Relationship/has_many> key, and create the related
980 objects if necessary.
982 Be aware that the input hashref might be edited in place, so don't rely
983 on it being the same after a call to C<set_inflated_columns>. If you
984 need to preserve the hashref, it is sufficient to pass a shallow copy
985 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
987 See also L<DBIx::Class::Relationship::Base/set_from_related>.
991 sub set_inflated_columns {
992 my ( $self, $upd ) = @_;
993 foreach my $key (keys %$upd) {
994 if (ref $upd->{$key}) {
995 my $info = $self->relationship_info($key);
996 my $acc_type = $info->{attrs}{accessor} || '';
997 if ($acc_type eq 'single') {
998 my $rel = delete $upd->{$key};
999 $self->set_from_related($key => $rel);
1000 $self->{_relationship_data}{$key} = $rel;
1002 elsif ($acc_type eq 'multi') {
1003 $self->throw_exception(
1004 "Recursive update is not supported over relationships of type '$acc_type' ($key)"
1007 elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
1008 $self->set_inflated_column($key, delete $upd->{$key});
1012 $self->set_columns($upd);
1017 my $copy = $orig->copy({ change => $to, ... });
1021 =item Arguments: \%replacementdata
1023 =item Returns: The Row object copy
1027 Inserts a new row into the database, as a copy of the original
1028 object. If a hashref of replacement data is supplied, these will take
1029 precedence over data in the original. Also any columns which have
1030 the L<column info attribute|DBIx::Class::ResultSource/add_columns>
1031 C<< is_auto_increment => 1 >> are explicitly removed before the copy,
1032 so that the database can insert its own autoincremented values into
1035 Relationships will be followed by the copy procedure B<only> if the
1036 relationship specifies a true value for its
1037 L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
1038 is set by default on C<has_many> relationships and unset on all others.
1043 my ($self, $changes) = @_;
1045 my $col_data = { %{$self->{_column_data}} };
1047 my $colinfo = $self->columns_info([ keys %$col_data ]);
1048 foreach my $col (keys %$col_data) {
1049 delete $col_data->{$col}
1050 if $colinfo->{$col}{is_auto_increment};
1053 my $new = { _column_data => $col_data };
1054 bless $new, ref $self;
1056 $new->result_source($self->result_source);
1057 $new->set_inflated_columns($changes);
1060 # Its possible we'll have 2 relations to the same Source. We need to make
1061 # sure we don't try to insert the same row twice else we'll violate unique
1063 my $rels_copied = {};
1065 foreach my $rel ($self->result_source->relationships) {
1066 my $rel_info = $self->result_source->relationship_info($rel);
1068 next unless $rel_info->{attrs}{cascade_copy};
1070 my $resolved = $self->result_source->_resolve_condition(
1071 $rel_info->{cond}, $rel, $new
1074 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
1075 foreach my $related ($self->search_related($rel)) {
1076 my $id_str = join("\0", $related->id);
1077 next if $copied->{$id_str};
1078 $copied->{$id_str} = 1;
1079 my $rel_copy = $related->copy($resolved);
1088 $row->store_column($col => $val);
1092 =item Arguments: $columnname, $value
1094 =item Returns: The value sent to storage
1098 Set a raw value for a column without marking it as changed. This
1099 method is used internally by L</set_column> which you should probably
1102 This is the lowest level at which data is set on a row object,
1103 extend this method to catch all data setting methods.
1108 my ($self, $column, $value) = @_;
1109 $self->throw_exception( "No such column '${column}'" )
1110 unless exists $self->{_column_data}{$column} || $self->has_column($column);
1111 $self->throw_exception( "set_column called for ${column} without value" )
1113 return $self->{_column_data}{$column} = $value;
1116 =head2 inflate_result
1118 Class->inflate_result($result_source, \%me, \%prefetch?)
1122 =item Arguments: $result_source, \%columndata, \%prefetcheddata
1124 =item Returns: A Row object
1128 All L<DBIx::Class::ResultSet> methods that retrieve data from the
1129 database and turn it into row objects call this method.
1131 Extend this method in your Result classes to hook into this process,
1132 for example to rebless the result into a different class.
1134 Reblessing can also be done more easily by setting C<result_class> in
1135 your Result class. See L<DBIx::Class::ResultSource/result_class>.
1137 Different types of results can also be created from a particular
1138 L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1142 sub inflate_result {
1143 my ($class, $source, $me, $prefetch) = @_;
1145 my ($source_handle) = $source;
1147 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
1148 $source = $source_handle->resolve
1151 $source_handle = $source->handle
1155 _source_handle => $source_handle,
1156 _column_data => $me,
1158 bless $new, (ref $class || $class);
1160 foreach my $pre (keys %{$prefetch||{}}) {
1162 my $pre_source = $source->related_source($pre)
1163 or $class->throw_exception("Can't prefetch non-existent relationship ${pre}");
1165 my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
1166 or $class->throw_exception("No accessor for prefetched $pre");
1169 if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
1170 @pre_vals = @{$prefetch->{$pre}};
1172 elsif ($accessor eq 'multi') {
1173 $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor 'multi'");
1176 @pre_vals = $prefetch->{$pre};
1180 for my $me_pref (@pre_vals) {
1182 # FIXME - this should not be necessary
1183 # the collapser currently *could* return bogus elements with all
1184 # columns set to undef
1186 for (values %{$me_pref->[0]}) {
1192 next unless $has_def;
1194 push @pre_objects, $pre_source->result_class->inflate_result(
1195 $pre_source, @$me_pref
1199 if ($accessor eq 'single') {
1200 $new->{_relationship_data}{$pre} = $pre_objects[0];
1202 elsif ($accessor eq 'filter') {
1203 $new->{_inflated_column}{$pre} = $pre_objects[0];
1206 $new->related_resultset($pre)->set_cache(\@pre_objects);
1209 $new->in_storage (1);
1213 =head2 update_or_insert
1215 $row->update_or_insert
1219 =item Arguments: none
1221 =item Returns: Result of update or insert operation
1225 L</Update>s the object if it's already in the database, according to
1226 L</in_storage>, else L</insert>s it.
1228 =head2 insert_or_update
1230 $obj->insert_or_update
1232 Alias for L</update_or_insert>
1236 sub insert_or_update { shift->update_or_insert(@_) }
1238 sub update_or_insert {
1240 return ($self->in_storage ? $self->update : $self->insert);
1245 my @changed_col_names = $row->is_changed();
1246 if ($row->is_changed()) { ... }
1250 =item Arguments: none
1252 =item Returns: 0|1 or @columnnames
1256 In list context returns a list of columns with uncommited changes, or
1257 in scalar context returns a true value if there are uncommitted
1263 return keys %{shift->{_dirty_columns} || {}};
1266 =head2 is_column_changed
1268 if ($row->is_column_changed('col')) { ... }
1272 =item Arguments: $columname
1278 Returns a true value if the column has uncommitted changes.
1282 sub is_column_changed {
1283 my( $self, $col ) = @_;
1284 return exists $self->{_dirty_columns}->{$col};
1287 =head2 result_source
1289 my $resultsource = $row->result_source;
1293 =item Arguments: none
1295 =item Returns: a ResultSource instance
1299 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1307 $self->_source_handle($_[0]->handle);
1309 $self->_source_handle->resolve;
1313 =head2 register_column
1315 $column_info = { .... };
1316 $class->register_column($column_name, $column_info);
1320 =item Arguments: $columnname, \%columninfo
1322 =item Returns: undefined
1326 Registers a column on the class. If the column_info has an 'accessor'
1327 key, creates an accessor named after the value if defined; if there is
1328 no such key, creates an accessor with the same name as the column
1330 The column_info attributes are described in
1331 L<DBIx::Class::ResultSource/add_columns>
1335 sub register_column {
1336 my ($class, $col, $info) = @_;
1338 if (exists $info->{accessor}) {
1339 return unless defined $info->{accessor};
1340 $acc = [ $info->{accessor}, $col ];
1342 $class->mk_group_accessors('column' => $acc);
1345 =head2 get_from_storage
1347 my $copy = $row->get_from_storage($attrs)
1351 =item Arguments: \%attrs
1353 =item Returns: A Row object
1357 Fetches a fresh copy of the Row object from the database and returns it.
1358 Throws an exception if a proper WHERE clause identifying the database row
1359 can not be constructed (i.e. if the original object does not contain its
1361 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
1362 ). If passed the \%attrs argument, will first apply these attributes to
1363 the resultset used to find the row.
1365 This copy can then be used to compare to an existing row object, to
1366 determine if any changes have been made in the database since it was
1369 To just update your Row object with any latest changes from the
1370 database, use L</discard_changes> instead.
1372 The \%attrs argument should be compatible with
1373 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1377 sub get_from_storage {
1378 my $self = shift @_;
1379 my $attrs = shift @_;
1380 my $resultset = $self->result_source->resultset;
1382 if(defined $attrs) {
1383 $resultset = $resultset->search(undef, $attrs);
1386 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
1388 $self->throw_exception($self->{_orig_ident_failreason})
1389 if ! keys %$ident_cond;
1391 return $resultset->find($ident_cond);
1394 =head2 discard_changes ($attrs?)
1396 $row->discard_changes
1400 =item Arguments: none or $attrs
1402 =item Returns: self (updates object in-place)
1406 Re-selects the row from the database, losing any changes that had
1407 been made. Throws an exception if a proper C<WHERE> clause identifying
1408 the database row can not be constructed (i.e. if the original object
1409 does not contain its entire
1410 L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>).
1412 This method can also be used to refresh from storage, retrieving any
1413 changes made since the row was last read from storage.
1415 $attrs, if supplied, is expected to be a hashref of attributes suitable for passing as the
1416 second argument to C<< $resultset->search($cond, $attrs) >>;
1418 Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1419 storage, please kept in mind that if you L</discard_changes> on a row that you
1420 just updated or created, you should wrap the entire bit inside a transaction.
1421 Otherwise you run the risk that you insert or update to the master database
1422 but read from a replicant database that has not yet been updated from the
1423 master. This will result in unexpected results.
1427 sub discard_changes {
1428 my ($self, $attrs) = @_;
1429 return unless $self->in_storage; # Don't reload if we aren't real!
1431 # add a replication default to read from the master only
1432 $attrs = { force_pool => 'master', %{$attrs||{}} };
1434 if( my $current_storage = $self->get_from_storage($attrs)) {
1436 # Set $self to the current.
1437 %$self = %$current_storage;
1439 # Avoid a possible infinite loop with
1440 # sub DESTROY { $_[0]->discard_changes }
1441 bless $current_storage, 'Do::Not::Exist';
1446 $self->in_storage(0);
1452 =head2 throw_exception
1454 See L<DBIx::Class::Schema/throw_exception>.
1458 sub throw_exception {
1461 if (ref $self && ref $self->result_source && $self->result_source->schema) {
1462 $self->result_source->schema->throw_exception(@_)
1465 DBIx::Class::Exception->throw(@_);
1475 =item Arguments: none
1477 =item Returns: A list of primary key values
1481 Returns the primary key(s) for a row. Can't be called as a class method.
1482 Actually implemented in L<DBIx::Class::PK>
1488 Matt S. Trout <mst@shadowcatsystems.co.uk>
1492 You may distribute this code under the same terms as Perl itself.