))
};
-our @EXPORT_OK = keys our %CONST;
+our @EXPORT = keys our %CONST;
1;
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 {
+{
}
}
-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;
}
}
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 {
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 {
my @arg_final;
while (my $arg = shift @argq) {
- unless ($arg->{type} eq DQ_OPERATOR) {
+ unless (is_Operator($arg)) {
push @arg_final, $arg;
next;
}
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 {
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
# 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}}
);
# 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} ] })
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}))
: ())
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),
);
my $from;
while ($from = $dq->{from}) {
- last unless $from->{type} eq DQ_ORDER;
+ last unless is_Order $from;
$dq = $from;
push @ret, (
',',
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 {
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) {
$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}
$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 {
$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,
]
: \@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);
}
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};
sub _run_expr {
local $_ = Data::Query::ExprBuilder::Identifier->new({
- expr => identifier()
+ expr => Identifier(),
});
$_[0]->();
}
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})
};
}
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] };
projects / dbsrgits/Data-Query.git / commitdiff