#
# Select.yp
#
#
%{
my @Vars;
%}
%left 'or'
%left 'and'
%left '+' '-'
%left '*' '/' '%'
%right '^'
%left '||'
%nonassoc '::'
%%
miniSQL: statement
;
statement: compound_select_stmt ';'
| compound_select_stmt
;
compound_select_stmt: '(' select_stmt ')' set_operator compound_select_stmt
{ join(' ', @_[1..$#_]) }
| '(' select_stmt ')'
{ join(' ', @_[1..$#_]) }
| select_stmt
;
set_operator: 'union all' | 'union' | 'intersect' | 'except'
;
select_stmt: 'select' 'distinct' pattern_list postfix_clause_list
{ "select distinct $_[3]\n$_[4]" }
| 'select' pattern_list postfix_clause_list
{ "select $_[2]\n$_[3]" }
| 'select' pattern_list
{ join(' ', @_[1..$#_]) }
;
models: model ',' models
{ join(' ', @_[1..$#_]) }
| model
;
model: symbol
;
pattern_list: pattern ',' pattern_list
{ join(' ', @_[1..$#_]) }
| pattern
;
pattern: expr 'as' alias
{ join(' ', @_[1..$#_]) }
| expr
| '*'
;
expr: expr '||' expr
{ join(' ', @_[1..$#_]) }
| expr '*' expr
{ join(' ', @_[1..$#_]) }
| expr '/' expr
{ join(' ', @_[1..$#_]) }
| expr '%' expr
{ join(' ', @_[1..$#_]) }
| expr '+' expr
{ join(' ', @_[1..$#_]) }
| expr '-' expr
{ join(' ', @_[1..$#_]) }
| expr '^' expr
{ join(' ', @_[1..$#_]) }
| expr '::' type
{ join(' ', @_[1..$#_]) }
| '(' expr ')'
{ join(' ', @_[1..$#_]) }
| atom
;
type: symbol
;
atom: proc_call
| column
| true_literal
| true_number
;
proc_call: IDENT '(' parameter_list ')'
{ join(' ', @_[1..$#_]) }
| IDENT '(' '*' ')'
{ join(' ', @_[1..$#_]) }
;
parameter_list: parameter ',' parameter_list
{ join(' ', @_[1..$#_]) }
| parameter
;
parameter: expr2
;
expr2: expr2 '||' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '*' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '/' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '%' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '+' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '-' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '^' expr2
{ join(' ', @_[1..$#_]) }
| expr2 '::' type
{ join(' ', @_[1..$#_]) }
| '(' expr2 ')'
{ join(' ', @_[1..$#_]) }
| atom2
;
atom2: proc_call2
| column
| literal
| true_number
;
proc_call2: IDENT '(' parameter_list2 ')'
{ join(' ', @_[1..$#_]) }
| IDENT '(' '*' ')'
{ join(' ', @_[1..$#_]) }
;
parameter_list2: parameter2 ',' parameter_list2
{ join(' ', @_[1..$#_]) }
| parameter2
;
parameter2: expr2
;
variable: VAR
{
push @Vars, [$_[1], 'literal'];
$_[1];
}
;
true_number: NUM
;
number: NUM
| VAR '|' NUM
{
push @Vars, [$_[1], 'literal', $_[3]];
$_[1];
}
;
string: STRING
| VAR '|' STRING
{
push @Vars, [$_[1], 'literal', parse_string($_[3])];
$_[1];
}
;
column: qualified_symbol
| symbol
;
qualified_symbol: symbol '.' symbol
{ "$_[1].$_[3]" }
;
symbol: IDENT
| VAR '|' IDENT
{
push @Vars, [$_[1], 'symbol', $_[3]];
$_[1];
}
| VAR
{
push @Vars, [$_[1], 'symbol'];
$_[1];
}
;
alias: symbol
;
postfix_clause_list: postfix_clause postfix_clause_list
{ join("\n", @_[1..$#_]) }
| postfix_clause
;
postfix_clause: where_clause
| group_by_clause
| order_by_clause
| limit_clause
| offset_clause
| from_clause
;
from_clause: 'from' models
{ join(' ', @_[1..$#_]) }
| 'from' proc_call
{ join(' ', @_[1..$#_]) }
;
where_clause: 'where' condition
{ join(' ', @_[1..$#_]) }
;
condition: disjunction
;
disjunction: disjunction 'or' disjunction
{ join(' ', @_[1..$#_]) }
| conjunction
;
conjunction: conjunction 'and' conjunction
{ join(' ', @_[1..$#_]) }
| comparison
;
comparison: lhs_atom operator rhs_atom
{ join(' ', @_[1..$#_]) }
| '(' condition ')'
{ join(' ', @_[1..$#_]) }
;
lhs_atom: expr
| '(' condition ')'
{ join(' ', @_[1..$#_]) }
;
rhs_atom: expr2
| '(' condition ')'
{ join(' ', @_[1..$#_]) }
;
operator: '>'
| '>='
| '<='
| '<'
| '<>'
| '!='
| '='
| 'like'
| '@@'
| '<<='
| '<<'
| '>>='
| '>>'
;
true_literal: string
| number
;
literal: true_literal
| variable
;
group_by_clause: 'group by' column_list
{ join(' ', @_[1..$#_]) }
;
column_list: column ',' column_list
{ join(' ', @_[1..$#_]) }
| column
;
order_by_clause: 'order by' order_by_objects
{ join(' ', @_[1..$#_]) }
;
order_by_objects: order_by_object ',' order_by_objects
{ join(' ', @_[1..$#_]) }
| order_by_object
;
order_by_object: column order_by_modifier
{ join(' ', @_[1..$#_]) }
| column
;
order_by_modifier: 'asc' | 'desc'
;
limit_clause: 'limit' literal
{ delete $_[0]->YYData->{limit}; join(' ', @_[1..$#_]) }
;
offset_clause: 'offset' literal
{ delete $_[0]->YYData->{offset}; join(' ', @_[1..$#_]) }
;
%%
#use Smart::Comments '####';
sub _Error {
my ($value) = $_[0]->YYCurval;
my $token = 1;
## $value
my @expect = $_[0]->YYExpect;
#### expect: @expect
my ($what) = $value ? "input: \"$value\"" : "end of input";
map { $_ = "'$_'" if $_ ne '' and !/^\w+$/ } @expect;
my $expected = join " or ", @expect;
my $yydata = $_[0]->YYData;
#print substr($yydata->{input}, 0, 50);
_SyntaxError(1, "Unexpected $what".($expected?" ($expected expected)":''), $.);
}
sub _SyntaxError {
my ($level, $message, $lineno) = @_;
$message= "line $lineno: error: $message";
die $message, ".\n";
}
sub _Lexer {
my ($parser) = shift;
my $yydata = $parser->YYData;
my $source = $yydata->{source};
#local $" = "\n";
defined $yydata->{input} && $yydata->{input} =~ s/^\s+//s;
if (!defined $yydata->{input} || $yydata->{input} eq '') {
### HERE!!!
$yydata->{input} = <$source>;
}
if (!defined $yydata->{input}) {
return ('', undef);
}
## other data: <$source>
### data: $yydata->{input}
### lineno: $.
for ($yydata->{input}) {
s/^\s*('(?:\\.|''|[^'])*')//s
and return ('STRING', $1);
s/^\s*[-+]?(\.\d+|\d+\.\d*|\d+)//s
and return ('NUM', $1);
s/^\s*"(\w*)"//s
and return ('IDENT', $1);
s/^\s*(\$(\w*)\$.*?\$\2\$)//s
and return ('STRING', $1);
if (s/^\s*(\*|as|select|distinct|and|or|from|where|delete|update|set|order\s+by|asc|desc|group\s+by|limit|offset|union\s+all|union|intersect|except)\b//is) {
my $s = $1;
(my $token = $s) =~ s/\s+/ /gs;
return (lc($token), lc($s));
}
s/^\s*(<<=|<<|>>=|>>|<=|>=|<>|!=|\|\||::|like\b|\@\@)//s
and return (lc($1), lc($1));
s/^\s*([A-Za-z][A-Za-z0-9_]*)\b//s
and return ('IDENT', $1);
s/^(\$[A-Za-z]\w*)//s
and return ('VAR', $1);
s/^\s*(\S)//s
and return ($1, $1);
}
}
sub parse_string {
my $s = $_[0];
if ($s =~ /^'(.*)'$/) {
$s = $1;
$s =~ s/''/'/g;
$s =~ s/\\n/\n/g;
$s =~ s/\\t/\t/g;
$s =~ s/\\r/\r/g;
$s =~ s/\\(.)/$1/g;
return $s;
} elsif ($s =~ /^\$(\w*)\$(.*)\$\1\$$/) {
$s = $2;
return $s;
} elsif ($s =~ /^[\d\.]*$/) {
return $s;
} else {
die "Unknown string literal: $s";
}
}
sub parse {
my ($self, $sql) = @_;
open my $source, '<', \$sql;
my $yydata = $self->YYData;
$yydata->{source} = $source;
#$QuoteIdent = $params->{quote_ident};
#$self->YYData->{INPUT} = ;
### $sql
@Vars = ();
$sql = $self->YYParse( yydebug => 0 & 0x1F, yylex => \&_Lexer, yyerror => \&_Error );
close $source;
return {
vars => \@Vars,
newdef => $sql . "\n",
};
}
sub _IDENT {
(defined $_[0] && $_[0] =~ /^[A-Za-z]\w*$/) ? $_[0] : undef;
}
#my ($select) =new Select;
#my $var = $select->Run;
1;