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
-);
+use Data::Query::ExprHelpers;
use Moo;
+use namespace::clean;
has reserved_ident_parts => (
is => 'ro', default => sub {
sub _format_keyword { $_[0]->lc_keywords ? lc($_[1]) : $_[1] }
sub _render {
+ unless (ref($_[1]) eq 'HASH') {
+ die "Expected hashref, got ".(defined($_[1])?$_[1]:'undef');
+ }
$_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
}
die "Unsure how to handle ${op_name}";
}
+sub _maybe_parenthesise {
+ my ($self, $dq) = @_;
+ for ($dq) {
+ return is_Select() || is_Group() || is_Slice() || is_Having()
+ ? [ '(', $self->_render($dq), ')' ]
+ : $self->_render($dq);
+ }
+}
+
sub _handle_op_type_binop {
my ($self, $op_name, $dq) = @_;
die "${op_name} registered as binary op but args contain "
.scalar(@{$dq->{args}})." entries"
unless @{$dq->{args}} == 2;
[
- $self->_render($dq->{args}[0]),
+ $self->_maybe_parenthesise($dq->{args}[0]),
$op_name,
- $self->_render($dq->{args}[1]),
+ $self->_maybe_parenthesise($dq->{args}[1]),
]
}
my @arg_final;
while (my $arg = shift @argq) {
- unless ($arg->{type} eq DQ_OPERATOR) {
+ unless (is_Operator($arg)) {
push @arg_final, $arg;
next;
}
[ '(',
intersperse(
$self->_format_keyword($op_name),
- map $self->_render($_), @arg_final
+ map $self->_maybe_parenthesise($_), @arg_final
),
')'
];
my ($self, $op_name, $dq) = @_;
my @args = @{$dq->{args}};
if (@args == 3) {
- my ($lhs, $rhs1, $rhs2) = (map $self->_render($_), @args);
+ 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]) {
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
};
[
"$ident(",
- intersperse(',', map $self->_render($_), @args),
+ intersperse(',', map $self->_maybe_parenthesise($_), @args),
')'
]
}
# 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}}
);
($dq->{from}
? ($self->_format_keyword('FROM'), @{$self->_render($dq->{from})})
: ()
- )
+ ),
];
}
# 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);
}
}
}
return [
- $self->_render($dq->{from}),
- $as || ' ',
+ $self->_maybe_parenthesise($dq->{from}),
+ $as || '',
$self->_render_identifier({ elements => [ $dq->{to} ] })
];
}
','
}
};
+ my $rhs = $self->_render($right);
[
- $self->_render($left), $join, $self->_render($right),
+ $self->_render($left), $join,
+ (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';
+ while (is_Where $from) {
+ $where = Operator({ 'SQL.Naive' => 'and' }, [ $where, $from->{where} ]);
+ $from = $from->{from};
+ }
+ my $keyword = (is_Group($from) ? 'HAVING' : 'WHERE');
[
($from ? $self->_render($from) : ()),
$self->_format_keyword($keyword),
]
}
+sub _order_chunk {
+ my ($self, $dq) = @_;
+ return +(
+ $self->_render($dq->{by}),
+ ($dq->{reverse}
+ ? $self->_format_keyword('DESC')
+ : ()),
+ ($dq->{nulls}
+ ? $self->_format_keyword('NULLS '.('', qw(FIRST LAST))[$dq->{nulls}])
+ : ()),
+ );
+}
+
sub _render_order {
my ($self, $dq) = @_;
my @ret = (
$self->_format_keyword('ORDER BY'),
- $self->_render($dq->{by}),
- ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+ $self->_order_chunk($dq),
);
my $from;
while ($from = $dq->{from}) {
- last unless $from->{type} eq DQ_ORDER;
+ last unless is_Order $from;
$dq = $from;
push @ret, (
',',
- $self->_render($dq->{by}),
- ($dq->{direction} ? $self->_format_keyword($dq->{direction}) : ())
+ $self->_order_chunk($dq),
);
}
unshift @ret, $self->_render($from) if $from;
# move somewhere else just yet.
my @ret = (
($dq->{from} ? $self->_render($dq->{from}) : ()),
- $self->_format_keyword('GROUP BY'),
- intersperse(',', map $self->_render($_), @{$dq->{by}})
+ (@{$dq->{by}}
+ ? (
+ $self->_format_keyword('GROUP BY'),
+ intersperse(',', map $self->_render($_), @{$dq->{by}})
+ )
+ : ())
);
\@ret;
}
($names
? ('(', intersperse(',', map $self->_render($_), @$names), ')')
: ()),
- $self->_format_keyword('VALUES'),
- intersperse(',',
- map [ '(', intersperse(',', map $self->_render($_), @$_), ')' ],
- @$values
- ),
+ (@$values && @{$values->[0]}
+ ? ($self->_format_keyword('VALUES'),
+ intersperse(',',
+ map [ '(', intersperse(',', map $self->_render($_), @$_), ')' ],
+ @$values
+ ))
+ : ($self->_insert_default_values)),
($returning
? ($self->_format_keyword('RETURNING'),
intersperse(',', map $self->_render($_), @$returning))
];
}
+sub _insert_default_values {
+ my ($self) = @_;
+ $self->_format_keyword('DEFAULT VALUES'),
+}
+
1;