From: Matt S Trout Date: Sun, 14 Apr 2019 19:08:58 +0000 (+0000) Subject: clean up op/func handling, add exists, add de-inconsistency switch X-Git-Tag: v1.90_01~220 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7250aa13440fae80201e48286f4a5939abc97ee7;p=dbsrgits%2FSQL-Abstract.git clean up op/func handling, add exists, add de-inconsistency switch --- diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm index 68a7327..0e41ffd 100644 --- a/lib/SQL/Abstract.pm +++ b/lib/SQL/Abstract.pm @@ -724,33 +724,29 @@ sub _expand_hashpair_op { return { $k => $v }; } - # hashref RHS values get expanded and used as op/func args + my $type = $self->{unknown_unop_always_func} ? -func : -op; - if ( - ref($v) eq 'HASH' - and keys %$v == 1 - and (keys %$v)[0] =~ /^-/ - ) { - my ($func) = $k =~ /^-(.*)$/; - { # Old SQLA compat - if (List::Util::first { $func =~ $_->{regex} } @{$self->{special_ops}}) { - return +{ -op => [ $func, $self->_expand_expr($v) ] }; - } - } - return +{ -func => [ - $func, - map $self->_expand_expr($_), - ref($v) eq 'ARRAY' ? @$v : $v - ] }; - } - - # scalars and literals get simply expanded + { # Old SQLA compat - if (!ref($v) or is_literal_value($v)) { - return +{ -op => [ $op, $self->_expand_expr($v) ] }; + if ( + ref($v) eq 'HASH' + and keys %$v == 1 + and (keys %$v)[0] =~ /^-/ + ) { + $type = ( + (List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}}) + ? -op + : -func + ) + } } - die "notreached"; + return +{ $type => [ + $op, + ($type eq -func and ref($v) eq 'ARRAY') + ? map $self->_expand_expr($_), @$v + : $self->_expand_expr($v) + ] }; } sub _expand_hashpair_cmp { diff --git a/lib/SQL/Abstract/Clauses.pm b/lib/SQL/Abstract/Clauses.pm index 4900dfa..1b9bfd5 100644 --- a/lib/SQL/Abstract/Clauses.pm +++ b/lib/SQL/Abstract/Clauses.pm @@ -71,6 +71,9 @@ sub register_defaults { }; $self->{expand}{values} = '_expand_values'; $self->{render}{values} = '_render_values'; + $self->{expand}{exists} = sub { + $_[0]->_expand_op(undef, [ exists => $_[2] ]); + }; return $self; } diff --git a/xt/clauses.t b/xt/clauses.t index 4e934f8..37ef057 100644 --- a/xt/clauses.t +++ b/xt/clauses.t @@ -4,10 +4,10 @@ use Test::More; use SQL::Abstract::Test import => [ qw(is_same_sql_bind is_same_sql) ]; use SQL::Abstract::ExtraClauses; -my $sqlac = SQL::Abstract::ExtraClauses->new; +my $sqlac = SQL::Abstract::ExtraClauses->new(unknown_unop_always_func => 1); my ($sql, @bind) = $sqlac->select({ - select => [ qw(artist.id artist.name), { -func => [ json_agg => 'cd' ] } ], + select => [ qw(artist.id artist.name), { -json_agg => 'cd' } ], from => [ { artists => { -as => 'artist' } }, -join => [ cds => as => 'cd' => on => { 'cd.artist_id' => 'artist.id' } ], @@ -15,7 +15,7 @@ my ($sql, @bind) = $sqlac->select({ where => { 'artist.genres', => { '@>', { -value => [ 'Rock' ] } } }, order_by => 'artist.name', group_by => 'artist.id', - having => { '>' => [ { -func => [ count => 'cd.id' ] }, 3 ] } + having => { '>' => [ { -count => 'cd.id' }, 3 ] } }); is_same_sql_bind( @@ -115,4 +115,20 @@ is_same_sql_bind( [ 1..6 ], ); +is_same_sql( + $sqlac->select({ + select => '*', + from => 'foo', + where => { -not_exists => { + -select => { + select => \1, + from => 'bar', + where => { 'foo.id' => { -ident => 'bar.foo_id' } } + }, + } }, + }), + q{SELECT * FROM foo + WHERE NOT EXISTS (SELECT 1 FROM bar WHERE foo.id = bar.foo_id)}, +); + done_testing;