X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=1174519c7eec209d7f181d027bcb3415d51a847b;hb=734868da8acee7ff14dff8b91ab18f0edc3c10df;hp=bace837cbde0a9e4943eed182a6290f21c4c0c62;hpb=22413d813c4f0347f5b44a9f9cf0e8f82157a1af;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index bace837..1174519 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -105,26 +105,40 @@ with NULL as the default, and save yourself a SELECT. sub __new_related_find_or_new_helper { my ($self, $relname, $data) = @_; - if ($self->__their_pk_needs_us($relname, $data)) { + + # create a mock-object so all new/set_column component overrides will run: + my $rel_rs = $self->result_source + ->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 ($self->result_source->_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 = $self->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); @@ -301,12 +315,20 @@ sub insert { 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; } @@ -320,52 +342,48 @@ sub insert { $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->can_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; - } - - # get non-PK auto-incs - { - my $rsrc = $self->result_source; - my %pk; - @pk{ $rsrc->primary_columns } = (); - - my @non_pk_autoincs = grep { - (not exists $pk{$_}) - && (not defined $self->get_column($_)) - && $rsrc->column_info($_)->{is_auto_increment} - } $rsrc->columns; - - if (@non_pk_autoincs) { - my @ids = $rsrc->storage->last_insert_id($rsrc, @non_pk_autoincs); - - if (@ids == @non_pk_autoincs) { - $self->store_column($non_pk_autoincs[$_] => $ids[$_]) for 0 .. $#ids; - } - } + unless (@ids == @missing); + $self->store_column($missing[$_] => $ids[$_]) for 0 .. $#missing; } $self->{_dirty_columns} = {}; @@ -387,7 +405,7 @@ sub insert { 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 { @@ -460,7 +478,11 @@ Throws an exception if the row object is not yet in the database, according to L. 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). +It throws an exception if a proper WHERE clause uniquely identifying +the database row can not be constructed (see +L +for more details). Also takes an optional hashref of C<< column_name => value> >> pairs to update on the object first. Be aware that the hashref will be @@ -497,17 +519,18 @@ this method. sub update { my ($self, $upd) = @_; $self->throw_exception( "Not in database" ) unless $self->in_storage; - my $ident_cond = $self->ident_condition; - $self->throw_exception("Cannot safely update a row in a PK-less table") + + 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; my $rows = $self->result_source->storage->update( - $self->result_source, \%to_update, - $self->{_orig_ident} || $ident_cond - ); + $self->result_source, \%to_update, $ident_cond + ); if ($rows == 0) { $self->throw_exception( "Can't update ${self}: row not found" ); } elsif ($rows > 1) { @@ -515,7 +538,7 @@ sub update { } $self->{_dirty_columns} = {}; $self->{related_resultsets} = {}; - undef $self->{_orig_ident}; + delete $self->{_orig_ident}; return $self; } @@ -532,8 +555,10 @@ sub update { =back Throws an exception if the object is not in the database according to -L. Runs an SQL DELETE statement using the primary key -values to locate the row. +L. Also throws an exception if a proper WHERE clause +uniquely identifying the database row can not be constructed (see +L +for more details). The object is still perfectly usable, but L will now return 0 and the object must be reinserted using L @@ -564,17 +589,19 @@ sub delete { my $self = shift; if (ref $self) { $self->throw_exception( "Not in database" ) unless $self->in_storage; + my $ident_cond = $self->{_orig_ident} || $self->ident_condition; - $self->throw_exception("Cannot safely delete a row in a PK-less table") + $self->throw_exception('Unable to delete a row with incomplete or no identity') if ! keys %$ident_cond; - foreach my $column (keys %$ident_cond) { - $self->throw_exception("Can't delete the object unless it has loaded the primary keys") - unless exists $self->{_column_data}{$column}; - } + $self->result_source->storage->delete( - $self->result_source, $ident_cond); + $self->result_source, $ident_cond + ); + + delete $self->{_orig_ident}; $self->in_storage(undef); - } else { + } + else { $self->throw_exception("Can't do class delete without a ResultSource instance") unless $self->can('result_source_instance'); my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {}; @@ -832,9 +859,10 @@ instead, see L. sub set_column { my ($self, $column, $new_value) = @_; - $self->{_orig_ident} ||= $self->ident_condition; - my $old_value = $self->get_column($column); + # if we can't get an ident condition on first try - mark the object as unidentifiable + $self->{_orig_ident} ||= (eval { $self->ident_condition }) || {}; + my $old_value = $self->get_column($column); $new_value = $self->store_column($column, $new_value); my $dirty; @@ -1292,8 +1320,11 @@ sub register_column { =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 +). 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 @@ -1317,13 +1348,22 @@ sub get_from_storage { $resultset = $resultset->search(undef, $attrs); } - return $resultset->find($self->{_orig_ident} || $self->ident_condition); + my $ident_cond = $self->{_orig_ident} || $self->ident_condition; + + $self->throw_exception('Unable to requery a row with incomplete or no identity') + if ! keys %$ident_cond; + + return $resultset->find($ident_cond); } =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 +). This method can also be used to refresh from storage, retrieving any changes made since the row was last read from storage.