^ \s* go \s
/xmi;
- $opt{render} = {
- (map +("-$_", "_render_$_"), qw(op func bind ident literal list)),
- %{$opt{render}||{}}
- };
-
$opt{expand_unary} = {};
$opt{expand} = {
-or => '_expand_andor',
};
+ $opt{render_op} = our $RENDER_OP;
+
+ $opt{render} = {
+ (map +("-$_", "_render_$_"), qw(op func bind ident literal list)),
+ %{$opt{render}||{}}
+ };
+
return bless \%opt, $class;
}
return $self->_convert($self->_quote($ident));
}
-my %unop_postfix = map +($_ => 1),
- 'is null', 'is not null',
- 'asc', 'desc',
-;
-
-my %special = (
- (map +($_ => do {
- my $op = $_;
- sub {
- my ($self, $args) = @_;
- my ($left, $low, $high) = @$args;
- my ($rhsql, @rhbind) = do {
- if (@$args == 2) {
- puke "Single arg to between must be a literal"
- unless $low->{-literal};
- @{$low->{-literal}}
- } else {
- my ($l, $h) = map [ $self->render_aqt($_) ], $low, $high;
- (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
- @{$l}[1..$#$l], @{$h}[1..$#$h])
- }
- };
- my ($lhsql, @lhbind) = $self->render_aqt($left);
- return (
- join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
- @lhbind, @rhbind
- );
- }
+sub _render_list {
+ my ($self, $list) = @_;
+ my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$list;
+ return join(', ', map $_->[0], @parts), map @{$_}[1..$#$_], @parts;
+}
+
+sub _render_func {
+ my ($self, $rest) = @_;
+ my ($func, @args) = @$rest;
+ my @arg_sql;
+ my @bind = map {
+ my @x = @$_;
+ push @arg_sql, shift @x;
+ @x
+ } map [ $self->render_aqt($_) ], @args;
+ return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
+}
+
+sub _render_bind {
+ my ($self, $bind) = @_;
+ return ($self->_convert('?'), $self->_bindtype(@$bind));
+}
+
+sub _render_literal {
+ my ($self, $literal) = @_;
+ $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
+ return @$literal;
+}
+
+our $RENDER_OP = {
+ (map +($_ => sub {
+ my ($self, $op, $args) = @_;
+ my ($left, $low, $high) = @$args;
+ my ($rhsql, @rhbind) = do {
+ if (@$args == 2) {
+ puke "Single arg to between must be a literal"
+ unless $low->{-literal};
+ @{$low->{-literal}}
+ } else {
+ my ($l, $h) = map [ $self->render_aqt($_) ], $low, $high;
+ (join(' ', $l->[0], $self->_sqlcase('and'), $h->[0]),
+ @{$l}[1..$#$l], @{$h}[1..$#$h])
+ }
+ };
+ my ($lhsql, @lhbind) = $self->render_aqt($left);
+ return (
+ join(' ', '(', $lhsql, $self->_sqlcase($op), $rhsql, ')'),
+ @lhbind, @rhbind
+ );
}), 'between', 'not between'),
- (map +($_ => do {
- my $op = $_;
- sub {
- my ($self, $args) = @_;
- my ($lhs, $rhs) = @$args;
- my @in_bind;
- my @in_sql = map {
- my ($sql, @bind) = $self->render_aqt($_);
- push @in_bind, @bind;
- $sql;
- } @$rhs;
- my ($lhsql, @lbind) = $self->render_aqt($lhs);
- return (
- $lhsql.' '.$self->_sqlcase($op).' ( '
- .join(', ', @in_sql)
- .' )',
- @lbind, @in_bind
- );
- }
+ (map +($_ => sub {
+ my ($self, $op, $args) = @_;
+ my ($lhs, $rhs) = @$args;
+ my @in_bind;
+ my @in_sql = map {
+ my ($sql, @bind) = $self->render_aqt($_);
+ push @in_bind, @bind;
+ $sql;
+ } @$rhs;
+ my ($lhsql, @lbind) = $self->render_aqt($lhs);
+ return (
+ $lhsql.' '.$self->_sqlcase($op).' ( '
+ .join(', ', @in_sql)
+ .' )',
+ @lbind, @in_bind
+ );
}), 'in', 'not in'),
-);
+ (map +($_ => '_render_unop_postfix'),
+ 'is null', 'is not null', 'asc', 'desc',
+ ),
+ (not => '_render_op_not'),
+ (map +($_ => sub {
+ my ($self, $op, $args) = @_;
+ my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$args;
+ return '' unless @parts;
+ return @{$parts[0]} if @parts == 1;
+ my ($final_sql) = join(
+ ' '.$self->_sqlcase($op).' ',
+ map $_->[0], @parts
+ );
+ return (
+ '('.$final_sql.')',
+ map @{$_}[1..$#$_], @parts
+ );
+ }), qw(and or)),
+};
sub _render_op {
my ($self, $v) = @_;
my ($op, @args) = @$v;
- $op =~ s/^-// if length($op) > 1;
- $op = lc($op);
- if (my $h = $special{$op}) {
- return $self->$h(\@args);
+ if (my $r = $self->{render_op}{$op}) {
+ return $self->$r($op, \@args);
}
my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{special_ops}};
if ($us and @args > 1) {
if (my $us = List::Util::first { $op =~ $_->{regex} } @{$self->{unary_ops}}) {
return $self->${\($us->{handler})}($op, $args[0]);
}
- if (@args == 1 and $op !~ /^(and|or)$/) {
- my ($expr_sql, @bind) = $self->render_aqt($args[0]);
- my $op_sql = $self->_sqlcase($op);
- my $final_sql = (
- $unop_postfix{lc($op)}
- ? "${expr_sql} ${op_sql}"
- : "${op_sql} ${expr_sql}"
- );
- return (($op eq 'not' || $us ? '('.$final_sql.')' : $final_sql), @bind);
+ if (@args == 1) {
+ return $self->_render_unop_prefix($op, \@args);
} else {
my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @args;
return '' unless @parts;
- my $is_andor = !!($op =~ /^(and|or)$/);
- return @{$parts[0]} if $is_andor and @parts == 1;
- my ($final_sql) = map +($is_andor ? "( ${_} )" : $_), join(
+ my ($final_sql) = join(
' '.$self->_sqlcase($op).' ',
map $_->[0], @parts
);
die "unhandled";
}
-sub _render_list {
- my ($self, $list) = @_;
- my @parts = grep length($_->[0]), map [ $self->render_aqt($_) ], @$list;
- return join(', ', map $_->[0], @parts), map @{$_}[1..$#$_], @parts;
+sub _render_op_not {
+ my ($self, $op, $v) = @_;
+ my ($sql, @bind) = $self->_render_unop_prefix($op, $v);
+ return "(${sql})", @bind;
}
-sub _render_func {
- my ($self, $rest) = @_;
- my ($func, @args) = @$rest;
- my @arg_sql;
- my @bind = map {
- my @x = @$_;
- push @arg_sql, shift @x;
- @x
- } map [ $self->render_aqt($_) ], @args;
- return ($self->_sqlcase($func).'('.join(', ', @arg_sql).')', @bind);
+sub _render_unop_prefix {
+ my ($self, $op, $v) = @_;
+ my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
+ my $op_sql = $self->_sqlcase($op);
+ return ("${op_sql} ${expr_sql}", @bind);
}
-sub _render_bind {
- my ($self, $bind) = @_;
- return ($self->_convert('?'), $self->_bindtype(@$bind));
-}
-
-sub _render_literal {
- my ($self, $literal) = @_;
- $self->_assert_bindval_matches_bindtype(@{$literal}[1..$#$literal]);
- return @$literal;
+sub _render_unop_postfix {
+ my ($self, $op, $v) = @_;
+ my ($expr_sql, @bind) = $self->render_aqt($v->[0]);
+ my $op_sql = $self->_sqlcase($op);
+ return ($expr_sql.' '.$op_sql, @bind);
}
# Some databases (SQLite) treat col IN (1, 2) different from
projects / dbsrgits/SQL-Abstract.git / blobdiff