sub __new_related_find_or_new_helper {
my ($self, $relname, $data) = @_;
- if ($self->__their_pk_needs_us($relname, $data)) {
+
+ my $rsrc = $self->result_source;
+
+ # create a mock-object so all new/set_column component overrides will run:
+ 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 };
+
+ if ($self->__their_pk_needs_us($relname)) {
MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
- return $self->result_source
- ->related_source($relname)
- ->resultset
- ->new_result($data);
+ return $new_rel_obj;
+ }
+ 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";
+ }
+ else {
+ MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
+ # this is not *really* find or new, as we don't want to double-new the
+ # data (thus potentially double encoding or whatever)
+ my $exists = $rel_rs->find ($proc_data);
+ return $exists if $exists;
+ }
+ return $new_rel_obj;
}
- if ($self->result_source->_pk_depends_on($relname, $data)) {
- MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
- return $self->result_source
- ->related_source($relname)
- ->resultset
- ->find_or_new($data);
+ else {
+ my $us = $rsrc->source_name;
+ $self->throw_exception ("'$us' neither depends nor is depended on by '$relname', something is wrong...");
}
- MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new_related";
- return $self->find_or_new_related($relname, $data);
}
sub __their_pk_needs_us { # this should maybe be in resultsource.
- my ($self, $relname, $data) = @_;
+ my ($self, $relname) = @_;
my $source = $self->result_source;
my $reverse = $source->reverse_relationship_info($relname);
my $rel_source = $source->related_source($relname);
MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns };
- my $re = $self->result_source
- ->related_source($relname)
- ->resultset
- ->find_or_create($them);
+ my $existing;
+
+ # if there are no keys - nothing to search for
+ if (keys %$them and $existing = $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->find($them)
+ ) {
+ %{$rel_obj} = %{$existing};
+ }
+ else {
+ $rel_obj->insert;
+ }
- %{$rel_obj} = %{$re};
$self->{_rel_in_storage}{$relname} = 1;
}
$rollback_guard ||= $source->storage->txn_scope_guard
}
+ ## PK::Auto
+ my %auto_pri;
+ my $auto_idx = 0;
+ for ($self->primary_columns) {
+ if (
+ not defined $self->get_column($_)
+ ||
+ (ref($self->get_column($_)) eq 'SCALAR')
+ ) {
+ my $col_info = $source->column_info($_);
+ $auto_pri{$_} = $auto_idx++ unless $col_info->{auto_nextval}; # auto_nextval's are pre-fetched in the storage
+ }
+ }
+
MULTICREATE_DEBUG and do {
no warnings 'uninitialized';
warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
};
- my $updated_cols = $source->storage->insert($source, { $self->get_columns });
+ my $updated_cols = $source->storage->insert(
+ $source,
+ { $self->get_columns },
+ (keys %auto_pri) && $source->storage->_supports_insert_returning
+ ? { returning => [ sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri ] }
+ : ()
+ ,
+ );
+
foreach my $col (keys %$updated_cols) {
$self->store_column($col, $updated_cols->{$col});
+ delete $auto_pri{$col};
}
- ## PK::Auto
- my @auto_pri = grep {
- (not defined $self->get_column($_))
- ||
- (ref($self->get_column($_)) eq 'SCALAR')
- } $self->primary_columns;
-
- if (@auto_pri) {
- MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
+ if (keys %auto_pri) {
+ my @missing = sort { $auto_pri{$a} <=> $auto_pri{$b} } keys %auto_pri;
+ MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @missing )."\n";
my $storage = $self->result_source->storage;
$self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
unless $storage->can('last_insert_id');
- my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
+ my @ids = $storage->last_insert_id($self->result_source, @missing);
$self->throw_exception( "Can't get last insert id" )
- unless (@ids == @auto_pri);
- $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
+ unless (@ids == @missing);
+ $self->store_column($missing[$_] => $ids[$_]) for 0 .. $#missing;
}
$self->{_dirty_columns} = {};
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, $them)) {
+ 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 {
according to L</in_storage>.
This method issues an SQL UPDATE query to commit any changes to the
-object to the database if required.
+object to the database if required (see L</get_dirty_columns>).
+It throws an exception if a proper WHERE clause uniquely identifying
+the database row can not be constructed (see
+L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
+for more details).
-Also takes an optional hashref of C<< column_name => value> >> pairs
+Also takes an optional hashref of C<< column_name => value >> pairs
to update on the object first. Be aware that the hashref will be
passed to C<set_inflated_columns>, which might edit it in place, so
don't rely on it being the same after a call to C<update>. If you
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('Unable to update a row with incomplete or no identity')
+ if ! keys %$ident_cond;
+
my $rows = $self->result_source->storage->update(
$self->result_source, \%to_update, $ident_cond
);
=back
Throws an exception if the object is not in the database according to
-L</in_storage>. Runs an SQL DELETE statement using the primary key
-values to locate the row.
+L</in_storage>. Also throws an exception if a proper WHERE clause
+uniquely identifying the database row can not be constructed (see
+L<significance of primary keys|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
+for more details).
The object is still perfectly usable, but L</in_storage> will
now return 0 and the object must be reinserted using L</insert>
=back
Fetches a fresh copy of the Row object from the database and returns it.
-
-If passed the \%attrs argument, will first apply these attributes to
+Throws an exception if a proper WHERE clause identifying the database row
+can not be constructed (i.e. if the original object does not contain its
+entire
+ L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
+). If passed the \%attrs argument, will first apply these attributes to
the resultset used to find the row.
This copy can then be used to compare to an existing row object, to
=head2 discard_changes ($attrs)
Re-selects the row from the database, losing any changes that had
-been made.
+been made. Throws an exception if a proper WHERE clause identifying
+the database row can not be constructed (i.e. if the original object
+does not contain its entire
+L<primary key|DBIx::Class::Manual::Intro/The Significance and Importance of Primary Keys>
+).
This method can also be used to refresh from storage, retrieving any
changes made since the row was last read from storage.