From: Matt S Trout Date: Sat, 28 Jul 2012 17:48:52 +0000 (+0000) Subject: first expansion to using helper subs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6b45ffe41e6668e3d22dd8444f029d0a77991d0d;p=dbsrgits%2FData-Query.git first expansion to using helper subs --- diff --git a/lib/Data/Query/Constants.pm b/lib/Data/Query/Constants.pm index eb5cd1b..f4fed77 100644 --- a/lib/Data/Query/Constants.pm +++ b/lib/Data/Query/Constants.pm @@ -22,6 +22,6 @@ use constant +{ )) }; -our @EXPORT_OK = keys our %CONST; +our @EXPORT = keys our %CONST; 1; diff --git a/lib/Data/Query/ExprHelpers.pm b/lib/Data/Query/ExprHelpers.pm index 455461e..6b2cbef 100644 --- a/lib/Data/Query/ExprHelpers.pm +++ b/lib/Data/Query/ExprHelpers.pm @@ -1,11 +1,11 @@ package Data::Query::ExprHelpers; use strictures 1; -use Data::Query::Constants qw(DQ_VALUE DQ_OPERATOR DQ_IDENTIFIER); +use Data::Query::Constants; use base qw(Exporter); -our @EXPORT_OK = qw(perl_scalar_value perl_operator identifier); +our @EXPORT = qw(perl_scalar_value perl_operator Literal Identifier); sub perl_scalar_value { +{ @@ -25,10 +25,59 @@ sub perl_operator { } } -sub identifier { - +{ +my %map = ( + Join => [ qw(left right on outer) ], + Alias => [ qw(to from) ], + Operator => [ qw(operator args) ], + Select => [ qw(select from) ], + Where => [ qw(where from) ], + Order => [ qw(by reverse from) ], + Group => [ qw(by from) ], + Delete => [ qw(where target) ], + Update => [ qw(set where target) ], + Insert => [ qw(names values target returning) ], + Slice => [ qw(offset limit from) ], +); + +sub Literal { + if (ref($_[0])) { + return +{ + type => DQ_LITERAL, + parts => @{$_[0]}, + }; + } + return +{ + type => DQ_LITERAL, + literal => $_[0], + ($_[1] ? (values => $_[1]) : ()) + }; +} + +sub Identifier { + return +{ type => DQ_IDENTIFIER, - elements => [ @_ ] + elements => [ @_ ], + }; +} + +foreach my $name (values %Data::Query::Constants::CONST) { + no strict 'refs'; + my $sub = "is_${name}"; + *$sub = sub { + my $dq = $_[0]||$_; + $dq->{type} eq $name + }; + push @EXPORT, $sub; + if ($map{$name}) { + my @map = @{$map{$name}}; + *$name = sub { + my $dq = { type => $name }; + foreach (0..$#_) { + $dq->{$map[$_]} = $_[$_] if defined $_[$_]; + } + return $dq; + }; + push @EXPORT, $name; } } diff --git a/lib/Data/Query/Renderer/SQL/Naive.pm b/lib/Data/Query/Renderer/SQL/Naive.pm index 3fa8811..7485fba 100644 --- a/lib/Data/Query/Renderer/SQL/Naive.pm +++ b/lib/Data/Query/Renderer/SQL/Naive.pm @@ -5,12 +5,11 @@ use strictures 1; sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i } use SQL::ReservedWords; -use Data::Query::Constants qw( - DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS DQ_ORDER DQ_LITERAL - DQ_GROUP DQ_SELECT DQ_SLICE -); +use Data::Query::ExprHelpers; use Moo; +no warnings; +use warnings; has reserved_ident_parts => ( is => 'ro', default => sub { @@ -143,11 +142,11 @@ sub _render_operator { sub _maybe_parenthesise { my ($self, $dq) = @_; - my %parenthesise = map +($_ => 1), DQ_SELECT, DQ_SLICE; - return - ($parenthesise{$dq->{type}} + for ($dq) { + return is_Select() || is_Slice() ? [ '(', $self->_render($dq), ')' ] - : $self->_render($dq)); + : $self->_render($dq); + } } sub _handle_op_type_binop { @@ -192,7 +191,7 @@ sub _handle_op_type_flatten { my @arg_final; while (my $arg = shift @argq) { - unless ($arg->{type} eq DQ_OPERATOR) { + unless (is_Operator($arg)) { push @arg_final, $arg; next; } @@ -234,7 +233,7 @@ sub _handle_op_type_between { if (@args == 3) { my ($lhs, $rhs1, $rhs2) = (map $self->_maybe_parenthesise($_), @args); [ '(', $lhs, $op_name, $rhs1, 'AND', $rhs2, ')' ]; - } elsif (@args == 2 and $args[1]->{type} eq DQ_LITERAL) { + } elsif (@args == 2 and is_Literal $args[1]->{type}) { my ($lhs, $rhs) = (map $self->_render($_), @args); [ '(', $lhs, $op_name, $rhs, ')' ]; } else { @@ -246,7 +245,7 @@ sub _handle_op_type_apply { my ($self, $op_name, $dq) = @_; my ($func, @args) = @{$dq->{args}}; die "Function name must be identifier" - unless $func->{type} eq DQ_IDENTIFIER; + unless is_Identifier $func; my $ident = do { # The problem we have here is that built-ins can't be quoted, generally. # I rather wonder if things like MAX(...) need to -not- be handled as @@ -283,7 +282,7 @@ sub _render_select { # to project from since many databases handle 'SELECT 1;' fine my @select = intersperse(',', - map +($_->{type} eq DQ_ALIAS + map +(is_Alias() ? $self->_render_alias($_, $self->_format_keyword('AS')) : $self->_render($_)), @{$dq->{select}} ); @@ -305,14 +304,13 @@ sub _render_alias { # FROM foo foo -> FROM foo # FROM foo.bar bar -> FROM foo.bar if ($self->collapse_aliases) { - if ($dq->{from}{type} eq DQ_IDENTIFIER) { - if ($dq->{from}{elements}[-1] eq $dq->{to}) { - return $self->_render($dq->{from}); + if (is_Identifier(my $from = $dq->{from})) { + if ($from->{elements}[-1] eq $dq->{to}) { + return $self->_render($from); } } } - my %parenthesise = map +($_ => 1), DQ_SELECT, DQ_SLICE; - return [ # XXX not sure this is the right place to detect this + return [ $self->_maybe_parenthesise($dq->{from}), $as || ' ', $self->_render_identifier({ elements => [ $dq->{to} ] }) @@ -350,7 +348,7 @@ sub _render_join { my $rhs = $self->_render($right); [ $self->_render($left), $join, - ($right->{type} eq DQ_JOIN ? ('(', $rhs, ')') : $rhs), + (is_Join($right) ? ('(', $rhs, ')') : $rhs), ($dq->{on} ? ($self->_format_keyword('ON'), $self->_render($dq->{on})) : ()) @@ -360,7 +358,7 @@ sub _render_join { sub _render_where { my ($self, $dq) = @_; my ($from, $where) = @{$dq}{qw(from where)}; - my $keyword = ($from && $from->{type} eq DQ_GROUP) ? 'HAVING' : 'WHERE'; + my $keyword = (is_Group($from) ? 'HAVING' : 'WHERE'); [ ($from ? $self->_render($from) : ()), $self->_format_keyword($keyword), @@ -379,7 +377,7 @@ sub _render_order { ); my $from; while ($from = $dq->{from}) { - last unless $from->{type} eq DQ_ORDER; + last unless is_Order $from; $dq = $from; push @ret, ( ',', diff --git a/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm index e3d8372..930c382 100644 --- a/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm +++ b/lib/Data/Query/Renderer/SQL/Slice/FetchFirst.pm @@ -1,8 +1,6 @@ package Data::Query::Renderer::SQL::Slice::FetchFirst; -use Data::Query::Constants qw( - DQ_SELECT DQ_ALIAS DQ_IDENTIFIER DQ_ORDER DQ_SLICE -); +use Data::Query::ExprHelpers; use Moo::Role; sub _render_slice_limit { @@ -26,19 +24,19 @@ sub _render_slice { die $self->_slice_type." limit style requires a stable order"; } die "Slice's inner is not a Select" - unless (my $orig_select = $dq->{from})->{type} eq DQ_SELECT; + unless is_Select my $orig_select = $dq->{from}; my %alias_map; my $gensym_count; my (@inside_select_list, @outside_select_list); my $default_inside_alias; SELECT: foreach my $s (@{$orig_select->{select}}) { my $name; - if ($s->{type} eq DQ_ALIAS) { + if (is_Alias $s) { $name = $s->{to}; $s = $s->{from}; } my $key; - if ($s->{type} eq DQ_IDENTIFIER) { + if (is_Identifier $s) { if (!$name and @{$s->{elements}} == 2) { $default_inside_alias ||= $s->{elements}[0]; if ($s->{elements}[0] eq $default_inside_alias) { @@ -55,24 +53,17 @@ sub _render_slice { $key = "$s"; } $name ||= sprintf("GENSYM__%03i",++$gensym_count); - push @inside_select_list, +{ - type => DQ_ALIAS, - from => $s, - to => $name, - }; - push @outside_select_list, $alias_map{$key} = +{ - type => DQ_IDENTIFIER, - elements => [ $name ] - }; + push @inside_select_list, Alias($name, $s); + push @outside_select_list, $alias_map{$key} = Identifier($name); } my $order = $orig_select->{from}; my $order_gensym_count; die "Slice's Select not followed by Order but order_is_stable set" - unless $order->{type} eq DQ_ORDER; + unless is_Order $order; my (@order_nodes, %order_map); - while ($order->{type} eq DQ_ORDER) { + while (is_Order $order) { my $by = $order->{by}; - if ($by->{type} eq DQ_IDENTIFIER) { + if (is_Identifier $by) { $default_inside_alias ||= $by->{elements}[0] if @{$by->{elements}} == 2; $order_map{$by} @@ -85,15 +76,8 @@ sub _render_slice { $by; } else { my $name = sprintf("ORDER__BY__%03i",++$order_gensym_count); - push @inside_select_list, +{ - type => DQ_ALIAS, - from => $by, - to => $name - }; - +{ - type => DQ_IDENTIFIER, - elements => [ $name ], - }; + push @inside_select_list, Alias($name, $by); + Identifier($name); } }; } else { @@ -103,40 +87,22 @@ sub _render_slice { $order = $order->{from}; } my $inside_order = $order; - $inside_order = +{ - type => DQ_ORDER, - by => $_->{by}, - reverse => $_->{reverse}, - from => $inside_order - } for reverse @order_nodes; - my $inside_select = +{ - type => DQ_SELECT, - select => \@inside_select_list, - from => $inside_order, - }; + $inside_order = Order($_->{by}, $_->{reverse}, $inside_order) + for reverse @order_nodes; + my $inside_select = Select(\@inside_select_list, $inside_order); my $limit_plus_offset = +{ %{$dq->{limit}}, value => $dq->{limit}{value} + $dq->{offset}{value} }; $default_inside_alias ||= 'me'; - my $bridge_from = +{ - type => DQ_ALIAS, - to => $default_inside_alias, - from => { - type => DQ_SLICE, - limit => $limit_plus_offset, - from => $inside_select, - }, - }; + my $bridge_from = Alias( + $default_inside_alias, + Slice(undef, $limit_plus_offset, $inside_select) + ); my $outside_order = $bridge_from; - $outside_order = +{ - type => DQ_ORDER, - by => $order_map{$_->{by}}, - reverse => !$_->{reverse}, - from => $outside_order - } for reverse @order_nodes; - my $outside_select = +{ - type => DQ_SELECT, - select => ( + $outside_order = Order($order_map{$_->{by}}, !$_->{reverse}, $outside_order) + for reverse @order_nodes; + my $outside_select = Select( + ( $dq->{preserve_order} ? [ @outside_select_list, @@ -144,30 +110,14 @@ sub _render_slice { ] : \@outside_select_list, ), - from => $outside_order, - }; - my $final = { - type => DQ_SLICE, - limit => $dq->{limit}, - from => $outside_select - }; + $outside_order, + ); + my $final = Slice(undef, $dq->{limit}, $outside_select); if ($dq->{preserve_order}) { - $final = { - type => DQ_ALIAS, - from => $final, - to => $default_inside_alias, - }; - $final = +{ - type => DQ_ORDER, - by => $order_map{$_->{by}}, - reverse => $_->{reverse}, - from => $final - } for reverse @order_nodes; - $final = { - type => DQ_SELECT, - select => \@outside_select_list, - from => $final, - }; + $final = Alias($default_inside_alias, $final); + $final = Order($order_map{$_->{by}}, $_->{reverse}, $final) + for reverse @order_nodes; + $final = Select(\@outside_select_list, $final); } return $self->_render($final); } diff --git a/t/expr.include b/t/expr.include index 6d80c9d..7215502 100644 --- a/t/expr.include +++ b/t/expr.include @@ -1,9 +1,7 @@ use strictures 1; use Data::Query::ExprBuilder::Identifier; -use Data::Query::Constants qw( - DQ_SELECT DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_ALIAS -); -use Data::Query::ExprHelpers qw(perl_scalar_value identifier); +use Data::Query::ExprHelpers; +use Data::Query::Constants; sub expr (&) { _run_expr($_[0])->{expr}; @@ -11,7 +9,7 @@ sub expr (&) { sub _run_expr { local $_ = Data::Query::ExprBuilder::Identifier->new({ - expr => identifier() + expr => Identifier(), }); $_[0]->(); } @@ -32,21 +30,13 @@ sub SELECT (&;@) { my $e = shift @select; push @final, (ref($select[0]) eq 'LIES::AS' - ? +{ - type => DQ_ALIAS, - from => $e->{expr}, - to => ${shift(@select)} - } + ? Alias(${shift(@select)}, $e->{expr}) : $e->{expr} ); } return +{ - expr => { - type => DQ_SELECT, - select => \@final - }, - @_ ? (from => $_[0]->{expr}) : () + expr => Select(\@final, ($_[0]||{})->{expr}) }; } @@ -56,11 +46,7 @@ sub FROM (&;@) { my @from = _run_expr(shift); if (@from == 2 and ref($from[1]) eq 'LIES::AS') { return +{ - expr => { - type => DQ_ALIAS, - source => $from[0], - alias => identifier(${$from[1]}), - } + expr => Alias(${$from[1]}, $from[0]) }; } elsif (@from == 1) { return { expr => $from[0] };