1 package DBIx::Class::Row;
6 use base qw/DBIx::Class/;
8 use DBIx::Class::Exception;
17 $ENV{DBIC_MULTICREATE_DEBUG}
22 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
26 DBIx::Class::Row - Basic row methods
32 This class is responsible for defining and doing basic operations on rows
33 derived from L<DBIx::Class::ResultSource> objects.
35 Row objects are returned from L<DBIx::Class::ResultSet>s using the
36 L<create|DBIx::Class::ResultSet/create>, L<find|DBIx::Class::ResultSet/find>,
37 L<next|DBIx::Class::ResultSet/next> and L<all|DBIx::Class::ResultSet/all> methods,
38 as well as invocations of 'single' (
39 L<belongs_to|DBIx::Class::Relationship/belongs_to>,
40 L<has_one|DBIx::Class::Relationship/has_one> or
41 L<might_have|DBIx::Class::Relationship/might_have>)
42 relationship accessors of L<DBIx::Class::Row> objects.
48 my $row = My::Class->new(\%attrs);
50 my $row = $schema->resultset('MySource')->new(\%colsandvalues);
54 =item Arguments: \%attrs or \%colsandvalues
56 =item Returns: A Row object
60 While you can create a new row object by calling C<new> directly on
61 this class, you are better off calling it on a
62 L<DBIx::Class::ResultSet> object.
64 When calling it directly, you will not get a complete, usable row
65 object until you pass or set the C<source_handle> attribute, to a
66 L<DBIx::Class::ResultSource> instance that is attached to a
67 L<DBIx::Class::Schema> with a valid connection.
69 C<$attrs> is a hashref of column name, value data. It can also contain
70 some other attributes such as the C<source_handle>.
72 Passing an object, or an arrayref of objects as a value will call
73 L<DBIx::Class::Relationship::Base/set_from_related> for you. When
74 passed a hashref or an arrayref of hashrefs as the value, these will
75 be turned into objects via new_related, and treated as if you had
78 For a more involved explanation, see L<DBIx::Class::ResultSet/create>.
80 Please note that if a value is not passed to new, no value will be sent
81 in the SQL INSERT call, and the column will therefore assume whatever
82 default value was specified in your database. While DBIC will retrieve the
83 value of autoincrement columns, it will never make an explicit database
84 trip to retrieve default values assigned by the RDBMS. You can explicitly
85 request that all values be fetched back from the database by calling
86 L</discard_changes>, or you can supply an explicit C<undef> to columns
87 with NULL as the default, and save yourself a SELECT.
91 The behavior described above will backfire if you use a foreign key column
92 with a database-defined default. If you call the relationship accessor on
93 an object that doesn't have a set value for the FK column, DBIC will throw
94 an exception, as it has no way of knowing the PK of the related object (if
99 ## 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().
100 ## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
101 ## When doing the later insert, we need to make sure the PKs are set.
102 ## using _relationship_data in new and funky ways..
103 ## check Relationship::CascadeActions and Relationship::Accessor for compat
106 sub __new_related_find_or_new_helper {
107 my ($self, $relname, $data) = @_;
108 if ($self->__their_pk_needs_us($relname, $data)) {
109 MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
110 return $self->result_source
111 ->related_source($relname)
115 if ($self->result_source->_pk_depends_on($relname, $data)) {
116 MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
117 return $self->result_source
118 ->related_source($relname)
120 ->find_or_new($data);
122 MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new_related";
123 return $self->find_or_new_related($relname, $data);
126 sub __their_pk_needs_us { # this should maybe be in resultsource.
127 my ($self, $relname, $data) = @_;
128 my $source = $self->result_source;
129 my $reverse = $source->reverse_relationship_info($relname);
130 my $rel_source = $source->related_source($relname);
131 my $us = { $self->get_columns };
132 foreach my $key (keys %$reverse) {
133 # if their primary key depends on us, then we have to
134 # just create a result and we'll fill it out afterwards
135 return 1 if $rel_source->_pk_depends_on($key, $us);
141 my ($class, $attrs) = @_;
142 $class = ref $class if ref $class;
149 if (my $handle = delete $attrs->{-source_handle}) {
150 $new->_source_handle($handle);
154 if ($source = delete $attrs->{-result_source}) {
155 $new->result_source($source);
158 if (my $related = delete $attrs->{-cols_from_relations}) {
159 @{$new->{_ignore_at_insert}={}}{@$related} = ();
163 $new->throw_exception("attrs must be a hashref")
164 unless ref($attrs) eq 'HASH';
166 my ($related,$inflated);
168 foreach my $key (keys %$attrs) {
169 if (ref $attrs->{$key}) {
170 ## Can we extract this lot to use with update(_or .. ) ?
171 $new->throw_exception("Can't do multi-create without result source")
173 my $info = $source->relationship_info($key);
174 my $acc_type = $info->{attrs}{accessor} || '';
175 if ($acc_type eq 'single') {
176 my $rel_obj = delete $attrs->{$key};
177 if(!Scalar::Util::blessed($rel_obj)) {
178 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
181 if ($rel_obj->in_storage) {
182 $new->{_rel_in_storage}{$key} = 1;
183 $new->set_from_related($key, $rel_obj);
185 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
188 $related->{$key} = $rel_obj;
191 elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
192 my $others = delete $attrs->{$key};
193 my $total = @$others;
195 foreach my $idx (0 .. $#$others) {
196 my $rel_obj = $others->[$idx];
197 if(!Scalar::Util::blessed($rel_obj)) {
198 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
201 if ($rel_obj->in_storage) {
202 $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
204 MULTICREATE_DEBUG and
205 warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
207 push(@objects, $rel_obj);
209 $related->{$key} = \@objects;
212 elsif ($acc_type eq 'filter') {
213 ## 'filter' should disappear and get merged in with 'single' above!
214 my $rel_obj = delete $attrs->{$key};
215 if(!Scalar::Util::blessed($rel_obj)) {
216 $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
218 if ($rel_obj->in_storage) {
219 $new->{_rel_in_storage}{$key} = 1;
222 MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
224 $inflated->{$key} = $rel_obj;
226 } elsif ($class->has_column($key)
227 && $class->column_info($key)->{_inflate_info}) {
228 $inflated->{$key} = $attrs->{$key};
232 $new->throw_exception("No such column $key on $class")
233 unless $class->has_column($key);
234 $new->store_column($key => $attrs->{$key});
237 $new->{_relationship_data} = $related if $related;
238 $new->{_inflated_column} = $inflated if $inflated;
250 =item Arguments: none
252 =item Returns: The Row object
256 Inserts an object previously created by L</new> into the database if
257 it isn't already in there. Returns the object itself. Requires the
258 object's result source to be set, or the class to have a
259 result_source_instance method. To insert an entirely new row into
260 the database, use C<create> (see L<DBIx::Class::ResultSet/create>).
262 To fetch an uninserted row object, call
263 L<new|DBIx::Class::ResultSet/new> on a resultset.
265 This will also insert any uninserted, related objects held inside this
266 one, see L<DBIx::Class::ResultSet/create> for more details.
272 return $self if $self->in_storage;
273 my $source = $self->result_source;
274 $source ||= $self->result_source($self->result_source_instance)
275 if $self->can('result_source_instance');
276 $self->throw_exception("No result_source set on this object; can't insert")
281 # Check if we stored uninserted relobjs here in new()
282 my %related_stuff = (%{$self->{_relationship_data} || {}},
283 %{$self->{_inflated_column} || {}});
285 # insert what needs to be inserted before us
287 for my $relname (keys %related_stuff) {
288 my $rel_obj = $related_stuff{$relname};
290 if (! $self->{_rel_in_storage}{$relname}) {
291 next unless (Scalar::Util::blessed($rel_obj)
292 && $rel_obj->isa('DBIx::Class::Row'));
294 next unless $source->_pk_depends_on(
295 $relname, { $rel_obj->get_columns }
298 # The guard will save us if we blow out of this scope via die
299 $rollback_guard ||= $source->storage->txn_scope_guard;
301 MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
303 my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns };
304 my $re = $self->result_source
305 ->related_source($relname)
307 ->find_or_create($them);
309 %{$rel_obj} = %{$re};
310 $self->{_rel_in_storage}{$relname} = 1;
313 $self->set_from_related($relname, $rel_obj);
314 delete $related_stuff{$relname};
317 # start a transaction here if not started yet and there is more stuff
319 if (keys %related_stuff) {
320 $rollback_guard ||= $source->storage->txn_scope_guard
323 MULTICREATE_DEBUG and do {
324 no warnings 'uninitialized';
325 warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
327 my $updated_cols = $source->storage->insert($source, { $self->get_columns });
328 foreach my $col (keys %$updated_cols) {
329 $self->store_column($col, $updated_cols->{$col});
333 my @auto_pri = grep {
334 (not defined $self->get_column($_))
336 (ref($self->get_column($_)) eq 'SCALAR')
337 } $self->primary_columns;
340 MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
341 my $storage = $self->result_source->storage;
342 $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
343 unless $storage->can('last_insert_id');
344 my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
345 $self->throw_exception( "Can't get last insert id" )
346 unless (@ids == @auto_pri);
347 $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
351 $self->{_dirty_columns} = {};
352 $self->{related_resultsets} = {};
354 foreach my $relname (keys %related_stuff) {
355 next unless $source->has_relationship ($relname);
357 my @cands = ref $related_stuff{$relname} eq 'ARRAY'
358 ? @{$related_stuff{$relname}}
359 : $related_stuff{$relname}
363 && Scalar::Util::blessed($cands[0])
364 && $cands[0]->isa('DBIx::Class::Row')
366 my $reverse = $source->reverse_relationship_info($relname);
367 foreach my $obj (@cands) {
368 $obj->set_from_related($_, $self) for keys %$reverse;
369 my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
370 if ($self->__their_pk_needs_us($relname, $them)) {
371 if (exists $self->{_ignore_at_insert}{$relname}) {
372 MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
374 MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
375 my $re = $self->result_source
376 ->related_source($relname)
380 MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
383 MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
390 $self->in_storage(1);
391 delete $self->{_orig_ident};
392 delete $self->{_ignore_at_insert};
393 $rollback_guard->commit if $rollback_guard;
400 $row->in_storage; # Get value
401 $row->in_storage(1); # Set value
405 =item Arguments: none or 1|0
411 Indicates whether the object exists as a row in the database or
412 not. This is set to true when L<DBIx::Class::ResultSet/find>,
413 L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
416 Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
417 L</delete> on one, sets it to false.
422 my ($self, $val) = @_;
423 $self->{_in_storage} = $val if @_ > 1;
424 return $self->{_in_storage} ? 1 : 0;
429 $row->update(\%columns?)
433 =item Arguments: none or a hashref
435 =item Returns: The Row object
439 Throws an exception if the row object is not yet in the database,
440 according to L</in_storage>.
442 This method issues an SQL UPDATE query to commit any changes to the
443 object to the database if required.
445 Also takes an optional hashref of C<< column_name => value> >> pairs
446 to update on the object first. Be aware that the hashref will be
447 passed to C<set_inflated_columns>, which might edit it in place, so
448 don't rely on it being the same after a call to C<update>. If you
449 need to preserve the hashref, it is sufficient to pass a shallow copy
450 to C<update>, e.g. ( { %{ $href } } )
452 If the values passed or any of the column values set on the object
453 contain scalar references, e.g.:
455 $row->last_modified(\'NOW()');
457 $row->update({ last_modified => \'NOW()' });
459 The update will pass the values verbatim into SQL. (See
460 L<SQL::Abstract> docs). The values in your Row object will NOT change
461 as a result of the update call, if you want the object to be updated
462 with the actual values from the database, call L</discard_changes>
465 $row->update()->discard_changes();
467 To determine before calling this method, which column values have
468 changed and will be updated, call L</get_dirty_columns>.
470 To check if any columns will be updated, call L</is_changed>.
472 To force a column to be updated, call L</make_column_dirty> before
478 my ($self, $upd) = @_;
479 $self->throw_exception( "Not in database" ) unless $self->in_storage;
481 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
483 $self->throw_exception('Unable to update a row with incomplete or no identity')
484 if ! keys %$ident_cond;
486 $self->set_inflated_columns($upd) if $upd;
487 my %to_update = $self->get_dirty_columns;
488 return $self unless keys %to_update;
489 my $rows = $self->result_source->storage->update(
490 $self->result_source, \%to_update, $ident_cond
493 $self->throw_exception( "Can't update ${self}: row not found" );
494 } elsif ($rows > 1) {
495 $self->throw_exception("Can't update ${self}: updated more than one row");
497 $self->{_dirty_columns} = {};
498 $self->{related_resultsets} = {};
499 delete $self->{_orig_ident};
509 =item Arguments: none
511 =item Returns: The Row object
515 Throws an exception if the object is not in the database according to
516 L</in_storage>. Runs an SQL DELETE statement using the primary key
517 values to locate the row.
519 The object is still perfectly usable, but L</in_storage> will
520 now return 0 and the object must be reinserted using L</insert>
521 before it can be used to L</update> the row again.
523 If you delete an object in a class with a C<has_many> relationship, an
524 attempt is made to delete all the related objects as well. To turn
525 this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
526 hashref of the relationship, see L<DBIx::Class::Relationship>. Any
527 database-level cascade or restrict will take precedence over a
528 DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
529 main row first> and only then attempts to delete any remaining related
532 If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
533 and the transaction subsequently fails, the row object will remain marked as
534 not being in storage. If you know for a fact that the object is still in
535 storage (i.e. by inspecting the cause of the transaction's failure), you can
536 use C<< $obj->in_storage(1) >> to restore consistency between the object and
537 the database. This would allow a subsequent C<< $obj->delete >> to work
540 See also L<DBIx::Class::ResultSet/delete>.
547 $self->throw_exception( "Not in database" ) unless $self->in_storage;
549 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
550 $self->throw_exception('Unable to delete a row with incomplete or no identity')
551 if ! keys %$ident_cond;
553 $self->result_source->storage->delete(
554 $self->result_source, $ident_cond
557 delete $self->{_orig_ident};
558 $self->in_storage(undef);
561 $self->throw_exception("Can't do class delete without a ResultSource instance")
562 unless $self->can('result_source_instance');
563 my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
564 my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
565 $self->result_source_instance->resultset->search(@_)->delete;
572 my $val = $row->get_column($col);
576 =item Arguments: $columnname
578 =item Returns: The value of the column
582 Throws an exception if the column name given doesn't exist according
585 Returns a raw column value from the row object, if it has already
586 been fetched from the database or set by an accessor.
588 If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
589 will be deflated and returned.
591 Note that if you used the C<columns> or the C<select/as>
592 L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
593 which C<$row> was derived, and B<did not include> C<$columnname> in the list,
594 this method will return C<undef> even if the database contains some value.
596 To retrieve all loaded column values as a hash, use L</get_columns>.
601 my ($self, $column) = @_;
602 $self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
603 return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
604 if (exists $self->{_inflated_column}{$column}) {
605 return $self->store_column($column,
606 $self->_deflated_column($column, $self->{_inflated_column}{$column}));
608 $self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
612 =head2 has_column_loaded
614 if ( $row->has_column_loaded($col) ) {
615 print "$col has been loaded from db";
620 =item Arguments: $columnname
626 Returns a true value if the column value has been loaded from the
627 database (or set locally).
631 sub has_column_loaded {
632 my ($self, $column) = @_;
633 $self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
634 return 1 if exists $self->{_inflated_column}{$column};
635 return exists $self->{_column_data}{$column};
640 my %data = $row->get_columns;
644 =item Arguments: none
646 =item Returns: A hash of columnname, value pairs.
650 Returns all loaded column data as a hash, containing raw values. To
651 get just one value for a particular column, use L</get_column>.
653 See L</get_inflated_columns> to get the inflated values.
659 if (exists $self->{_inflated_column}) {
660 foreach my $col (keys %{$self->{_inflated_column}}) {
661 $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
662 unless exists $self->{_column_data}{$col};
665 return %{$self->{_column_data}};
668 =head2 get_dirty_columns
670 my %data = $row->get_dirty_columns;
674 =item Arguments: none
676 =item Returns: A hash of column, value pairs
680 Only returns the column, value pairs for those columns that have been
681 changed on this object since the last L</update> or L</insert> call.
683 See L</get_columns> to fetch all column/value pairs.
687 sub get_dirty_columns {
689 return map { $_ => $self->{_column_data}{$_} }
690 keys %{$self->{_dirty_columns}};
693 =head2 make_column_dirty
695 $row->make_column_dirty($col)
699 =item Arguments: $columnname
701 =item Returns: undefined
705 Throws an exception if the column does not exist.
707 Marks a column as having been changed regardless of whether it has
711 sub make_column_dirty {
712 my ($self, $column) = @_;
714 $self->throw_exception( "No such column '${column}'" )
715 unless exists $self->{_column_data}{$column} || $self->has_column($column);
717 # the entire clean/dirty code relies on exists, not on true/false
718 return 1 if exists $self->{_dirty_columns}{$column};
720 $self->{_dirty_columns}{$column} = 1;
722 # if we are just now making the column dirty, and if there is an inflated
723 # value, force it over the deflated one
724 if (exists $self->{_inflated_column}{$column}) {
725 $self->store_column($column,
726 $self->_deflated_column(
727 $column, $self->{_inflated_column}{$column}
733 =head2 get_inflated_columns
735 my %inflated_data = $obj->get_inflated_columns;
739 =item Arguments: none
741 =item Returns: A hash of column, object|value pairs
745 Returns a hash of all column keys and associated values. Values for any
746 columns set to use inflation will be inflated and returns as objects.
748 See L</get_columns> to get the uninflated values.
750 See L<DBIx::Class::InflateColumn> for how to setup inflation.
754 sub get_inflated_columns {
757 my %loaded_colinfo = (map
758 { $_ => $self->column_info($_) }
759 (grep { $self->has_column_loaded($_) } $self->columns)
763 for my $col (keys %loaded_colinfo) {
764 if (exists $loaded_colinfo{$col}{accessor}) {
765 my $acc = $loaded_colinfo{$col}{accessor};
766 $inflated{$col} = $self->$acc if defined $acc;
769 $inflated{$col} = $self->$col;
773 # return all loaded columns with the inflations overlayed on top
774 return ($self->get_columns, %inflated);
777 sub _is_column_numeric {
778 my ($self, $column) = @_;
779 my $colinfo = $self->column_info ($column);
781 # cache for speed (the object may *not* have a resultsource instance)
782 if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
783 $colinfo->{is_numeric} =
784 $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
790 return $colinfo->{is_numeric};
795 $row->set_column($col => $val);
799 =item Arguments: $columnname, $value
801 =item Returns: $value
805 Sets a raw column value. If the new value is different from the old one,
806 the column is marked as dirty for when you next call L</update>.
808 If passed an object or reference as a value, this method will happily
809 attempt to store it, and a later L</insert> or L</update> will try and
810 stringify/numify as appropriate. To set an object to be deflated
811 instead, see L</set_inflated_columns>.
816 my ($self, $column, $new_value) = @_;
818 # if we can't get an ident condition on first try - mark the object as unidentifiable
819 $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {};
821 my $old_value = $self->get_column($column);
822 $new_value = $self->store_column($column, $new_value);
825 if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
828 elsif (defined $old_value xor defined $new_value) {
831 elsif (not defined $old_value) { # both undef
834 elsif ($old_value eq $new_value) {
837 else { # do a numeric comparison if datatype allows it
838 if ($self->_is_column_numeric($column)) {
839 $dirty = $old_value != $new_value;
846 # sadly the update code just checks for keys, not for their value
847 $self->{_dirty_columns}{$column} = 1 if $dirty;
849 # XXX clear out the relation cache for this column
850 delete $self->{related_resultsets}{$column};
857 $row->set_columns({ $col => $val, ... });
861 =item Arguments: \%columndata
863 =item Returns: The Row object
867 Sets multiple column, raw value pairs at once.
869 Works as L</set_column>.
874 my ($self,$data) = @_;
875 foreach my $col (keys %$data) {
876 $self->set_column($col,$data->{$col});
881 =head2 set_inflated_columns
883 $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
887 =item Arguments: \%columndata
889 =item Returns: The Row object
893 Sets more than one column value at once. Any inflated values are
894 deflated and the raw values stored.
896 Any related values passed as Row objects, using the relation name as a
897 key, are reduced to the appropriate foreign key values and stored. If
898 instead of related row objects, a hashref of column, value data is
899 passed, will create the related object first then store.
901 Will even accept arrayrefs of data as a value to a
902 L<DBIx::Class::Relationship/has_many> key, and create the related
903 objects if necessary.
905 Be aware that the input hashref might be edited in place, so don't rely
906 on it being the same after a call to C<set_inflated_columns>. If you
907 need to preserve the hashref, it is sufficient to pass a shallow copy
908 to C<set_inflated_columns>, e.g. ( { %{ $href } } )
910 See also L<DBIx::Class::Relationship::Base/set_from_related>.
914 sub set_inflated_columns {
915 my ( $self, $upd ) = @_;
916 foreach my $key (keys %$upd) {
917 if (ref $upd->{$key}) {
918 my $info = $self->relationship_info($key);
919 my $acc_type = $info->{attrs}{accessor} || '';
920 if ($acc_type eq 'single') {
921 my $rel = delete $upd->{$key};
922 $self->set_from_related($key => $rel);
923 $self->{_relationship_data}{$key} = $rel;
925 elsif ($acc_type eq 'multi') {
926 $self->throw_exception(
927 "Recursive update is not supported over relationships of type '$acc_type' ($key)"
930 elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
931 $self->set_inflated_column($key, delete $upd->{$key});
935 $self->set_columns($upd);
940 my $copy = $orig->copy({ change => $to, ... });
944 =item Arguments: \%replacementdata
946 =item Returns: The Row object copy
950 Inserts a new row into the database, as a copy of the original
951 object. If a hashref of replacement data is supplied, these will take
952 precedence over data in the original. Also any columns which have
953 the L<column info attribute|DBIx::Class::ResultSource/add_columns>
954 C<< is_auto_increment => 1 >> are explicitly removed before the copy,
955 so that the database can insert its own autoincremented values into
958 Relationships will be followed by the copy procedure B<only> if the
959 relationship specifies a true value for its
960 L<cascade_copy|DBIx::Class::Relationship::Base> attribute. C<cascade_copy>
961 is set by default on C<has_many> relationships and unset on all others.
966 my ($self, $changes) = @_;
968 my $col_data = { %{$self->{_column_data}} };
969 foreach my $col (keys %$col_data) {
970 delete $col_data->{$col}
971 if $self->result_source->column_info($col)->{is_auto_increment};
974 my $new = { _column_data => $col_data };
975 bless $new, ref $self;
977 $new->result_source($self->result_source);
978 $new->set_inflated_columns($changes);
981 # Its possible we'll have 2 relations to the same Source. We need to make
982 # sure we don't try to insert the same row twice else we'll violate unique
984 my $rels_copied = {};
986 foreach my $rel ($self->result_source->relationships) {
987 my $rel_info = $self->result_source->relationship_info($rel);
989 next unless $rel_info->{attrs}{cascade_copy};
991 my $resolved = $self->result_source->_resolve_condition(
992 $rel_info->{cond}, $rel, $new
995 my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
996 foreach my $related ($self->search_related($rel)) {
997 my $id_str = join("\0", $related->id);
998 next if $copied->{$id_str};
999 $copied->{$id_str} = 1;
1000 my $rel_copy = $related->copy($resolved);
1009 $row->store_column($col => $val);
1013 =item Arguments: $columnname, $value
1015 =item Returns: The value sent to storage
1019 Set a raw value for a column without marking it as changed. This
1020 method is used internally by L</set_column> which you should probably
1023 This is the lowest level at which data is set on a row object,
1024 extend this method to catch all data setting methods.
1029 my ($self, $column, $value) = @_;
1030 $self->throw_exception( "No such column '${column}'" )
1031 unless exists $self->{_column_data}{$column} || $self->has_column($column);
1032 $self->throw_exception( "set_column called for ${column} without value" )
1034 return $self->{_column_data}{$column} = $value;
1037 =head2 inflate_result
1039 Class->inflate_result($result_source, \%me, \%prefetch?)
1043 =item Arguments: $result_source, \%columndata, \%prefetcheddata
1045 =item Returns: A Row object
1049 All L<DBIx::Class::ResultSet> methods that retrieve data from the
1050 database and turn it into row objects call this method.
1052 Extend this method in your Result classes to hook into this process,
1053 for example to rebless the result into a different class.
1055 Reblessing can also be done more easily by setting C<result_class> in
1056 your Result class. See L<DBIx::Class::ResultSource/result_class>.
1058 Different types of results can also be created from a particular
1059 L<DBIx::Class::ResultSet>, see L<DBIx::Class::ResultSet/result_class>.
1063 sub inflate_result {
1064 my ($class, $source, $me, $prefetch) = @_;
1066 my ($source_handle) = $source;
1068 if ($source->isa('DBIx::Class::ResultSourceHandle')) {
1069 $source = $source_handle->resolve
1072 $source_handle = $source->handle
1076 _source_handle => $source_handle,
1077 _column_data => $me,
1079 bless $new, (ref $class || $class);
1081 foreach my $pre (keys %{$prefetch||{}}) {
1083 my $pre_source = $source->related_source($pre)
1084 or $class->throw_exception("Can't prefetch non-existent relationship ${pre}");
1086 my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
1087 or $class->throw_exception("No accessor for prefetched $pre");
1090 if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
1091 @pre_vals = @{$prefetch->{$pre}};
1093 elsif ($accessor eq 'multi') {
1094 $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor 'multi'");
1097 @pre_vals = $prefetch->{$pre};
1101 for my $me_pref (@pre_vals) {
1103 # FIXME - this should not be necessary
1104 # the collapser currently *could* return bogus elements with all
1105 # columns set to undef
1107 for (values %{$me_pref->[0]}) {
1113 next unless $has_def;
1115 push @pre_objects, $pre_source->result_class->inflate_result(
1116 $pre_source, @$me_pref
1120 if ($accessor eq 'single') {
1121 $new->{_relationship_data}{$pre} = $pre_objects[0];
1123 elsif ($accessor eq 'filter') {
1124 $new->{_inflated_column}{$pre} = $pre_objects[0];
1127 $new->related_resultset($pre)->set_cache(\@pre_objects);
1130 $new->in_storage (1);
1134 =head2 update_or_insert
1136 $row->update_or_insert
1140 =item Arguments: none
1142 =item Returns: Result of update or insert operation
1146 L</Update>s the object if it's already in the database, according to
1147 L</in_storage>, else L</insert>s it.
1149 =head2 insert_or_update
1151 $obj->insert_or_update
1153 Alias for L</update_or_insert>
1157 sub insert_or_update { shift->update_or_insert(@_) }
1159 sub update_or_insert {
1161 return ($self->in_storage ? $self->update : $self->insert);
1166 my @changed_col_names = $row->is_changed();
1167 if ($row->is_changed()) { ... }
1171 =item Arguments: none
1173 =item Returns: 0|1 or @columnnames
1177 In list context returns a list of columns with uncommited changes, or
1178 in scalar context returns a true value if there are uncommitted
1184 return keys %{shift->{_dirty_columns} || {}};
1187 =head2 is_column_changed
1189 if ($row->is_column_changed('col')) { ... }
1193 =item Arguments: $columname
1199 Returns a true value if the column has uncommitted changes.
1203 sub is_column_changed {
1204 my( $self, $col ) = @_;
1205 return exists $self->{_dirty_columns}->{$col};
1208 =head2 result_source
1210 my $resultsource = $row->result_source;
1214 =item Arguments: none
1216 =item Returns: a ResultSource instance
1220 Accessor to the L<DBIx::Class::ResultSource> this object was created from.
1228 $self->_source_handle($_[0]->handle);
1230 $self->_source_handle->resolve;
1234 =head2 register_column
1236 $column_info = { .... };
1237 $class->register_column($column_name, $column_info);
1241 =item Arguments: $columnname, \%columninfo
1243 =item Returns: undefined
1247 Registers a column on the class. If the column_info has an 'accessor'
1248 key, creates an accessor named after the value if defined; if there is
1249 no such key, creates an accessor with the same name as the column
1251 The column_info attributes are described in
1252 L<DBIx::Class::ResultSource/add_columns>
1256 sub register_column {
1257 my ($class, $col, $info) = @_;
1259 if (exists $info->{accessor}) {
1260 return unless defined $info->{accessor};
1261 $acc = [ $info->{accessor}, $col ];
1263 $class->mk_group_accessors('column' => $acc);
1266 =head2 get_from_storage
1268 my $copy = $row->get_from_storage($attrs)
1272 =item Arguments: \%attrs
1274 =item Returns: A Row object
1278 Fetches a fresh copy of the Row object from the database and returns it.
1280 If passed the \%attrs argument, will first apply these attributes to
1281 the resultset used to find the row.
1283 This copy can then be used to compare to an existing row object, to
1284 determine if any changes have been made in the database since it was
1287 To just update your Row object with any latest changes from the
1288 database, use L</discard_changes> instead.
1290 The \%attrs argument should be compatible with
1291 L<DBIx::Class::ResultSet/ATTRIBUTES>.
1295 sub get_from_storage {
1296 my $self = shift @_;
1297 my $attrs = shift @_;
1298 my $resultset = $self->result_source->resultset;
1300 if(defined $attrs) {
1301 $resultset = $resultset->search(undef, $attrs);
1304 my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
1306 $self->throw_exception('Unable to requery a row with incomplete or no identity')
1307 if ! keys %$ident_cond;
1309 return $resultset->find($ident_cond);
1312 =head2 discard_changes ($attrs)
1314 Re-selects the row from the database, losing any changes that had
1317 This method can also be used to refresh from storage, retrieving any
1318 changes made since the row was last read from storage.
1320 $attrs is expected to be a hashref of attributes suitable for passing as the
1321 second argument to $resultset->search($cond, $attrs);
1325 sub discard_changes {
1326 my ($self, $attrs) = @_;
1327 delete $self->{_dirty_columns};
1328 return unless $self->in_storage; # Don't reload if we aren't real!
1330 # add a replication default to read from the master only
1331 $attrs = { force_pool => 'master', %{$attrs||{}} };
1333 if( my $current_storage = $self->get_from_storage($attrs)) {
1335 # Set $self to the current.
1336 %$self = %$current_storage;
1338 # Avoid a possible infinite loop with
1339 # sub DESTROY { $_[0]->discard_changes }
1340 bless $current_storage, 'Do::Not::Exist';
1345 $self->in_storage(0);
1351 =head2 throw_exception
1353 See L<DBIx::Class::Schema/throw_exception>.
1357 sub throw_exception {
1360 if (ref $self && ref $self->result_source && $self->result_source->schema) {
1361 $self->result_source->schema->throw_exception(@_)
1364 DBIx::Class::Exception->throw(@_);
1374 =item Arguments: none
1376 =item Returns: A list of primary key values
1380 Returns the primary key(s) for a row. Can't be called as a class method.
1381 Actually implemented in L<DBIx::Class::PK>
1383 =head2 discard_changes
1385 $row->discard_changes
1389 =item Arguments: none
1391 =item Returns: nothing (updates object in-place)
1395 Retrieves and sets the row object data from the database, losing any
1398 This method can also be used to refresh from storage, retrieving any
1399 changes made since the row was last read from storage. Actually
1400 implemented in L<DBIx::Class::PK>
1402 Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
1403 storage, please kept in mind that if you L</discard_changes> on a row that you
1404 just updated or created, you should wrap the entire bit inside a transaction.
1405 Otherwise you run the risk that you insert or update to the master database
1406 but read from a replicant database that has not yet been updated from the
1407 master. This will result in unexpected results.
1415 Matt S. Trout <mst@shadowcatsystems.co.uk>
1419 You may distribute this code under the same terms as Perl itself.