regression of inserts into a Postgres / ::Replicated combination
- Missing dependency check in t/60core.t (RT#62635)
- Fix regressions in IC::DT registration logic
+ - Fix regression in select-associated bind value handling (RT#61025)
- Fix infinite loops on old perls with a recent Try::Tiny
- Improve "fork()" on Win32 by reimplementing a more robust DBIC
thread support (still problematic, pending a DBI fix)
sub _assemble_binds {
my $self = shift;
- return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/from where having order/);
+ return map { @{ (delete $self->{"${_}_bind"}) || [] } } (qw/select from where having order/);
}
my $for_syntax = {
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- return $self->_fold_sqlbind( $fields );
+ push @{$self->{select_bind}}, @{$$fields}[1..$#$$fields];
+ return $$fields->[0];
}
else {
croak($ref . qq{ unexpected in _recurse_fields()})
return $_[0]->_recurse_from(@{$_[1]});
}
elsif ($ref eq 'HASH') {
- return $_[0]->_make_as($_[1]);
+ return $_[0]->_recurse_from($_[1]);
}
}
my ($self, $join_type) = @_;
return sprintf ('%s JOIN ',
- $join_type ? ' ' . uc($join_type) : ''
+ $join_type ? ' ' . $self->_sqlcase($join_type) : ''
);
}
sub _recurse_from {
my ($self, $from, @join) = @_;
my @sqlf;
- push(@sqlf, $self->_make_as($from));
- foreach my $j (@join) {
- my ($to, $on) = @$j;
+ push @sqlf, $self->_from_chunk_to_sql($from);
+ for (@join) {
+ my ($to, $on) = @$_;
# check whether a join type exists
my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
if (ref $to eq 'ARRAY') {
push(@sqlf, '(', $self->_recurse_from(@$to), ')');
} else {
- push(@sqlf, $self->_make_as($to));
+ push(@sqlf, $self->_from_chunk_to_sql($to));
}
push(@sqlf, ' ON ', $self->_join_condition($on));
}
return join('', @sqlf);
}
-sub _fold_sqlbind {
- my ($self, $sqlbind) = @_;
-
- my @sqlbind = @$$sqlbind; # copy
- my $sql = shift @sqlbind;
- push @{$self->{from_bind}}, @sqlbind;
-
- return $sql;
-}
+sub _from_chunk_to_sql {
+ my ($self, $fromspec) = @_;
+
+ return join (' ', $self->_SWITCH_refkind($fromspec, {
+ SCALARREF => sub {
+ $$fromspec;
+ },
+ ARRAYREFREF => sub {
+ push @{$self->{from_bind}}, @{$$fromspec}[1..$#$$fromspec];
+ $$fromspec->[0];
+ },
+ HASHREF => sub {
+ my ($as, $table, $toomuch) = ( map
+ { $_ => $fromspec->{$_} }
+ ( grep { $_ !~ /^\-/ } keys %$fromspec )
+ );
-sub _make_as {
- my ($self, $from) = @_;
- return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
- : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
- : $self->_quote($_))
- } reverse each %{$self->_skip_options($from)});
-}
+ croak "Only one table/as pair expected in from-spec but an exra '$toomuch' key present"
+ if defined $toomuch;
-sub _skip_options {
- my ($self, $hash) = @_;
- my $clean_hash = {};
- $clean_hash->{$_} = $hash->{$_}
- for grep {!/^-/} keys %$hash;
- return $clean_hash;
+ ($self->_from_chunk_to_sql($table), $self->_quote($as) );
+ },
+ SCALAR => sub {
+ $self->_quote($fromspec);
+ },
+ }));
}
sub _join_condition {
my ($self, $cond) = @_;
+
if (ref $cond eq 'HASH') {
my %j;
for (keys %$cond) {
# since whatever order bindvals there are, they will be realiased
# and need to show up in front of the entire initial inner subquery
- # Unshift *from_bind* to make this happen (horrible, horrible, but
- # we don't have another mechanism yet)
- unshift @{$self->{from_bind}}, @{$self->{order_bind}};
+ # *unshift* the selector bind stack to make this happen (horrible,
+ # horrible, but we don't have another mechanism yet)
+ unshift @{$self->{select_bind}}, @{$self->{order_bind}};
}
# and this is order re-alias magic
sub _recurse_from {
my ($self, $from, @join) = @_;
- my @sqlf = $self->_make_as($from);
+ my @sqlf = $self->_from_chunk_to_sql($from);
- foreach my $j (@join) {
- my ($to, $on) = @{ $j };
+ for (@join) {
+ my ($to, $on) = @$_;
if (ref $to eq 'ARRAY') {
push (@sqlf, $self->_recurse_from(@{ $to }));
}
else {
- push (@sqlf, $self->_make_as($to));
+ push (@sqlf, $self->_from_chunk_to_sql($to));
}
}
# set up a botched SQLA
my $sql_maker = $self->sql_maker;
- local $sql_maker->{having_bind}; # these are throw away results
+ # these are throw away results, do not pollute the bind stack
+ local $sql_maker->{having_bind};
+ local $sql_maker->{select_bind};
# we can't scan properly without any quoting (\b doesn't cut it
# everywhere), so unless there is proper quoting set - use our
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+my $orig_debug = $schema->storage->debug;
+
+my $cdrs = $schema->resultset('CD')->search({ 'me.artist' => { '!=', 2 }});
+
+my $cd_data = { map {
+ $_->cdid => {
+ siblings => $cdrs->search ({ artist => $_->get_column('artist') })->count - 1,
+ track_titles => [ map { $_->title } ($_->tracks->all) ],
+ },
+} ( $cdrs->all ) };
+
+my $queries = 0;
+$schema->storage->debugcb(sub { $queries++; });
+$schema->storage->debug(1);
+
+my $c_rs = $cdrs->search ({}, {
+ prefetch => 'tracks',
+ '+columns' => { sibling_count => $cdrs->search(
+ {
+ 'siblings.artist' => { -ident => 'me.artist' },
+ 'siblings.cdid' => { '!=' => ['-and', { -ident => 'me.cdid' }, 'bogus condition'] },
+ }, { alias => 'siblings' },
+ )->count_rs->as_query,
+ },
+});
+
+is_same_sql_bind(
+ $c_rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ (SELECT COUNT( * )
+ FROM cd siblings
+ WHERE siblings.artist = me.artist
+ AND siblings.cdid != me.cdid
+ AND siblings.cdid != ?
+ AND me.artist != ?
+ ),
+ tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at
+ FROM cd me
+ LEFT JOIN track tracks
+ ON tracks.cd = me.cdid
+ WHERE me.artist != ?
+ ORDER BY tracks.cd
+ )',
+ [
+ [ 'siblings.cdid' => 'bogus condition' ],
+ [ 'me.artist' => 2 ],
+ [ 'me.artist' => 2 ],
+ ],
+ 'Expected SQL on correlated realiased subquery'
+);
+
+is_deeply (
+ { map
+ { $_->cdid => {
+ track_titles => [ map { $_->title } ($_->tracks->all) ],
+ siblings => $_->get_column ('sibling_count'),
+ } }
+ $c_rs->all
+ },
+ $cd_data,
+ 'Proper information retrieved from correlated subquery'
+);
+
+is ($queries, 1, 'Only 1 query fired to retrieve everything');
+
+$schema->storage->debug($orig_debug);
+$schema->storage->debugcb(undef);
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff