if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
-
+
my ($related,$inflated);
## Pretend all the rels are actual objects, unset below if not, for insert() to fix
$new->{_rel_in_storage} = 1;
}
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
- $new->store_column($key => $attrs->{$key});
+ $new->store_column($key => $attrs->{$key});
}
$new->{_relationship_data} = $related if $related;
my $rollback_guard;
# Check if we stored uninserted relobjs here in new()
- my %related_stuff = (%{$self->{_relationship_data} || {}},
+ my %related_stuff = (%{$self->{_relationship_data} || {}},
%{$self->{_inflated_column} || {}});
if(!$self->{_rel_in_storage}) {
## PK::Auto
my @auto_pri = grep {
- !defined $self->get_column($_) ||
+ !defined $self->get_column($_) ||
ref($self->get_column($_)) eq 'SCALAR'
} $self->primary_columns;
Indicates whether the object exists as a row in the database or
not. This is set to true when L<DBIx::Class::ResultSet/find>,
L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
-are used.
+are used.
Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
L</delete> on one, sets it to false.
The object is still perfectly usable, but L</in_storage> will
now return 0 and the object must be reinserted using L</insert>
-before it can be used to L</update> the row again.
+before it can be used to L</update> the row again.
If you delete an object in a class with a C<has_many> relationship, an
attempt is made to delete all the related objects as well. To turn
this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::Class::Relationship>. Any
database-level cascade or restrict will take precedence over a
-DBIx-Class-based cascading delete.
+DBIx-Class-based cascading delete.
If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
and the transaction subsequently fails, the row object will remain marked as
return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
if (exists $self->{_inflated_column}{$column}) {
return $self->store_column($column,
- $self->_deflated_column($column, $self->{_inflated_column}{$column}));
+ $self->_deflated_column($column, $self->{_inflated_column}{$column}));
}
$self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
return undef;
Returns all loaded column data as a hash, containing raw values. To
get just one value for a particular column, use L</get_column>.
+See L</get_inflated_columns> to get the inflated values.
+
=cut
sub get_columns {
Throws an exception if the column does not exist.
Marks a column as having been changed regardless of whether it has
-really changed.
+really changed.
=cut
sub make_column_dirty {
$self->throw_exception( "No such column '${column}'" )
unless exists $self->{_column_data}{$column} || $self->has_column($column);
+
+ # the entire clean/dirty code relies on exists, not on true/false
+ return 1 if exists $self->{_dirty_columns}{$column};
+
$self->{_dirty_columns}{$column} = 1;
+
+ # if we are just now making the column dirty, and if there is an inflated
+ # value, force it over the deflated one
+ if (exists $self->{_inflated_column}{$column}) {
+ $self->store_column($column,
+ $self->_deflated_column(
+ $column, $self->{_inflated_column}{$column}
+ )
+ );
+ }
}
=head2 get_inflated_columns
$self->store_column($column, $new_value);
my $dirty;
- if (defined $old_value xor defined $new_value) {
+ if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
+ $dirty = 1;
+ }
+ elsif (defined $old_value xor defined $new_value) {
$dirty = 1;
}
elsif (not defined $old_value) { # both undef
else { # do a numeric comparison if datatype allows it
my $colinfo = $self->column_info ($column);
- # cache for speed
- if (not defined $colinfo->{is_numeric}) {
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
$colinfo->{is_numeric} =
$self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
? 1
}
if ($colinfo->{is_numeric}) {
- $dirty = $old_value <=> $new_value;
+ $dirty = $old_value != $new_value;
}
else {
$dirty = 1;
$row->set_columns({ $col => $val, ... });
-=over
+=over
=item Arguments: \%columndata
=back
Sets more than one column value at once. Any inflated values are
-deflated and the raw values stored.
+deflated and the raw values stored.
Any related values passed as Row objects, using the relation name as a
key, are reduced to the appropriate foreign key values and stored. If
}
}
}
- $self->set_columns($upd);
+ $self->set_columns($upd);
}
=head2 copy
Inserts a new row into the database, as a copy of the original
object. If a hashref of replacement data is supplied, these will take
-precedence over data in the original.
+precedence over data in the original. Also any columns which have
+the L<column info attribute|DBIx::Class::ResultSource/add_columns>
+C<< is_auto_increment => 1 >> are explicitly removed before the copy,
+so that the database can insert its own autoincremented values into
+the new object.
Relationships will be followed by the copy procedure B<only> if the
relationship specifes a true value for its
$new->set_inflated_columns($changes);
$new->insert;
- # Its possible we'll have 2 relations to the same Source. We need to make
+ # Its possible we'll have 2 relations to the same Source. We need to make
# sure we don't try to insert the same row twice esle we'll violate unique
# constraints
my $rels_copied = {};
my $rel_info = $self->result_source->relationship_info($rel);
next unless $rel_info->{attrs}{cascade_copy};
-
+
my $resolved = $self->result_source->_resolve_condition(
$rel_info->{cond}, $rel, $new
);
$copied->{$id_str} = 1;
my $rel_copy = $related->copy($resolved);
}
-
+
}
return $new;
}
my $new = {
_source_handle => $source_handle,
_column_data => $me,
- _in_storage => 1
};
bless $new, (ref $class || $class);
unless $pre_source;
if (ref($pre_val->[0]) eq 'ARRAY') { # multi
my @pre_objects;
- foreach my $pre_rec (@$pre_val) {
- unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
- and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
- next;
+
+ for my $me_pref (@$pre_val) {
+
+ # the collapser currently *could* return bogus elements with all
+ # columns set to undef
+ my $has_def;
+ for (values %{$me_pref->[0]}) {
+ if (defined $_) {
+ $has_def++;
+ last;
+ }
}
- push(@pre_objects, $pre_source->result_class->inflate_result(
- $pre_source, @{$pre_rec}));
+ next unless $has_def;
+
+ push @pre_objects, $pre_source->result_class->inflate_result(
+ $pre_source, @$me_pref
+ );
}
+
$new->related_resultset($pre)->set_cache(\@pre_objects);
} elsif (defined $pre_val->[0]) {
my $fetched;
} elsif ($accessor eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
} else {
- $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+ $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'");
}
$new->related_resultset($pre)->set_cache([ $fetched ]);
}
}
+
+ $new->in_storage (1);
return $new;
}
my $self = shift @_;
my $attrs = shift @_;
my $resultset = $self->result_source->resultset;
-
+
if(defined $attrs) {
$resultset = $resultset->search(undef, $attrs);
}
-
+
return $resultset->find($self->{_orig_ident} || $self->ident_condition);
}
projects / dbsrgits/DBIx-Class.git / blobdiff