use base qw/DBIx::Class/;
use DBIx::Class::Exception;
-use Scalar::Util ();
+use Scalar::Util 'blessed';
+use Try::Tiny;
+use namespace::clean;
###
### Internal method
sub __new_related_find_or_new_helper {
my ($self, $relname, $data) = @_;
+ my $rsrc = $self->result_source;
+
# create a mock-object so all new/set_column component overrides will run:
- my $rel_rs = $self->result_source
- ->related_source($relname)
- ->resultset;
+ my $rel_rs = $rsrc->related_source($relname)->resultset;
my $new_rel_obj = $rel_rs->new_result($data);
my $proc_data = { $new_rel_obj->get_columns };
MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
return $new_rel_obj;
}
- elsif ($self->result_source->_pk_depends_on($relname, $proc_data )) {
+ elsif ($rsrc->_pk_depends_on($relname, $proc_data )) {
if (! keys %$proc_data) {
# there is nothing to search for - blind create
MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname";
return $new_rel_obj;
}
else {
- my $us = $self->source_name;
- $self->throw_exception ("'$us' neither depends nor is depended on by '$relname', something is wrong...");
+ my $us = $rsrc->source_name;
+ $self->throw_exception (
+ "Unable to determine relationship '$relname' direction from '$us', "
+ . "possibly due to a missing reverse-relationship on '$relname' to '$us'."
+ );
}
}
my $acc_type = $info->{attrs}{accessor} || '';
if ($acc_type eq 'single') {
my $rel_obj = delete $attrs->{$key};
- if(!Scalar::Util::blessed($rel_obj)) {
+ if(!blessed $rel_obj) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
my @objects;
foreach my $idx (0 .. $#$others) {
my $rel_obj = $others->[$idx];
- if(!Scalar::Util::blessed($rel_obj)) {
+ if(!blessed $rel_obj) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
elsif ($acc_type eq 'filter') {
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = delete $attrs->{$key};
- if(!Scalar::Util::blessed($rel_obj)) {
+ if(!blessed $rel_obj) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
if ($rel_obj->in_storage) {
my $rel_obj = $related_stuff{$relname};
if (! $self->{_rel_in_storage}{$relname}) {
- next unless (Scalar::Util::blessed($rel_obj)
- && $rel_obj->isa('DBIx::Class::Row'));
+ next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
next unless $source->_pk_depends_on(
$relname, { $rel_obj->get_columns }
my $updated_cols = $source->storage->insert(
$source,
{ $self->get_columns },
- (keys %auto_pri) && $source->storage->_supports_insert_returning
+ (keys %auto_pri) && $source->storage->_use_insert_returning
? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] }
: ()
,
: $related_stuff{$relname}
;
- if (@cands
- && Scalar::Util::blessed($cands[0])
- && $cands[0]->isa('DBIx::Class::Row')
+ if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
) {
my $reverse = $source->reverse_relationship_info($relname);
foreach my $obj (@cands) {
$obj->set_from_related($_, $self) for keys %$reverse;
- my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
if ($self->__their_pk_needs_us($relname)) {
if (exists $self->{_ignore_at_insert}{$relname}) {
MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
- } else {
- MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
- my $re = $self->result_source
- ->related_source($relname)
- ->resultset
- ->create($them);
- %{$obj} = %{$re};
- MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
+ }
+ else {
+ MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj";
+ $obj->insert;
}
} else {
MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
$self->in_storage(1);
delete $self->{_orig_ident};
+ delete $self->{_orig_ident_failreason};
delete $self->{_ignore_at_insert};
$rollback_guard->commit if $rollback_guard;
sub update {
my ($self, $upd) = @_;
- $self->throw_exception( "Not in database" ) unless $self->in_storage;
my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
- $self->throw_exception('Unable to update a row with incomplete or no identity')
- if ! keys %$ident_cond;
-
$self->set_inflated_columns($upd) if $upd;
my %to_update = $self->get_dirty_columns;
return $self unless keys %to_update;
+
+ $self->throw_exception( "Not in database" ) unless $self->in_storage;
+
+ $self->throw_exception($self->{_orig_ident_failreason})
+ if ! keys %$ident_cond;
+
my $rows = $self->result_source->storage->update(
$self->result_source, \%to_update, $ident_cond
);
$self->throw_exception( "Not in database" ) unless $self->in_storage;
my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
- $self->throw_exception('Unable to delete a row with incomplete or no identity')
+ $self->throw_exception($self->{_orig_ident_failreason})
if ! keys %$ident_cond;
$self->result_source->storage->delete(
$self->result_source, $ident_cond
);
- delete $self->{_orig_ident};
+ delete $self->{_orig_ident}; # no longer identifiable
$self->in_storage(undef);
}
else {
my ($self, $column, $new_value) = @_;
# if we can't get an ident condition on first try - mark the object as unidentifiable
- $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {};
+ # (by using an empty hashref) and store the error for further diag
+ unless ($self->{_orig_ident}) {
+ try {
+ $self->{_orig_ident} = $self->ident_condition
+ }
+ catch {
+ $self->{_orig_ident_failreason} = $_;
+ $self->{_orig_ident} = {};
+ };
+ }
my $old_value = $self->get_column($column);
$new_value = $self->store_column($column, $new_value);
- my $dirty;
- 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
- $dirty = 0;
- }
- elsif ($old_value eq $new_value) {
- $dirty = 0;
- }
- else { # do a numeric comparison if datatype allows it
- if ($self->_is_column_numeric($column)) {
- $dirty = $old_value != $new_value;
- }
- else {
- $dirty = 1;
- }
- }
+ my $dirty =
+ $self->{_dirty_columns}{$column}
+ ||
+ $self->in_storage # no point tracking dirtyness on uninserted data
+ ? ! $self->_eq_column_values ($column, $old_value, $new_value)
+ : 1
+ ;
- # sadly the update code just checks for keys, not for their value
+ # FIXME sadly the update code just checks for keys, not for their value
$self->{_dirty_columns}{$column} = 1 if $dirty;
# XXX clear out the relation cache for this column
return $new_value;
}
+sub _eq_column_values {
+ my ($self, $col, $old, $new) = @_;
+
+ if (defined $old xor defined $new) {
+ return 0;
+ }
+ elsif (not defined $old) { # both undef
+ return 1;
+ }
+ elsif ($old eq $new) {
+ return 1;
+ }
+ elsif ($self->_is_column_numeric($col)) { # do a numeric comparison if datatype allows it
+ return $old == $new;
+ }
+ else {
+ return 0;
+ }
+}
+
=head2 set_columns
$row->set_columns({ $col => $val, ... });
if ($source->isa('DBIx::Class::ResultSourceHandle')) {
$source = $source_handle->resolve
- }
+ }
else {
$source_handle = $source->handle
}
my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
- $self->throw_exception('Unable to requery a row with incomplete or no identity')
+ $self->throw_exception($self->{_orig_ident_failreason})
if ! keys %$ident_cond;
return $resultset->find($ident_cond);
sub discard_changes {
my ($self, $attrs) = @_;
- delete $self->{_dirty_columns};
return unless $self->in_storage; # Don't reload if we aren't real!
# add a replication default to read from the master only