#
# Select.yp
#
#
%{
my (
@Models, @Columns, @OutVars,
$InVals, %Defaults, $Quote, $QuoteIdent,
@Unbound,
);
%}
%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
{ join(' ', @_[1..$#_]) }
| 'select' pattern_list postfix_clause_list
{ join(' ', @_[1..$#_]) }
| 'select' pattern_list
{ join(' ', @_[1..$#_]) }
;
joined_obj_list: joined_obj ',' joined_obj_list
{ join(' ', @_[1..$#_]) }
| joined_obj
;
joined_obj: model 'as' symbol
{ join(' ', @_[1..$#_]) }
| proc_call 'as' '(' col_decl_list ')'
{ join(' ', @_[1..$#_]) }
| proc_call 'as' symbol
{ join(' ', @_[1..$#_]) }
| proc_call
{ join(' ', @_[1..$#_]) }
| model
| subquery 'as' symbol
{ join(' ', @_[1..$#_]) }
;
col_decl_list: col_decl ',' col_decl_list
{ join(' ', @_[1..$#_]) }
| col_decl
;
col_decl: IDENT IDENT
{ join(' ', @_[1..$#_]) }
;
subquery: '(' select_stmt ')'
{ join(' ', @_[1..$#_]) }
;
model: symbol { push @Models, $_[1]; $QuoteIdent->($_[1]) }
;
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
| array_index
| column
| true_literal
| true_number
;
array_index: column '[' expr ']'
{ join(' ', @_[1..$#_]) }
| '(' expr ')' '[' expr ']'
{ join(' ', @_[1..$#_]) }
;
array_index2: column '[' expr2 ']'
{ join(' ', @_[1..$#_]) }
| '(' expr2 ')' '[' expr2 ']'
{ join(' ', @_[1..$#_]) }
;
proc_call: IDENT '(' ')'
{ join(' ', @_[1..$#_]) }
| 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
| array_index2
;
proc_call2: IDENT '(' ')'
{ join(' ', @_[1..$#_]) }
| IDENT '(' parameter_list2 ')'
{ join(' ', @_[1..$#_]) }
| IDENT '(' '*' ')'
{ join(' ', @_[1..$#_]) }
;
parameter_list2: parameter2 ',' parameter_list2
{ join(' ', @_[1..$#_]) }
| parameter2
;
parameter2: expr2
;
variable: VAR
{
push @OutVars, $_[1];
my $val = $InVals->{$_[1]};
if (!defined $val) {
push @Unbound, $_[1];
return $Quote->("");
}
$Quote->($val);
}
;
true_number: NUM
;
number: NUM
| VAR '|' NUM
{
push @OutVars, $_[1];
my $val = $InVals->{$_[1]};
if (!defined $val) {
my $default;
$Defaults{$_[1]} = $default = $_[3];
return $default;
}
$Quote->($val);
}
;
string: STRING { $Quote->(parse_string($_[1])) }
| VAR '|' STRING
{ push @OutVars, $_[1];
my $val = $InVals->{$_[1]};
if (!defined $val) {
my $default;
$Defaults{$_[1]} = $default = parse_string($_[3]);
return $Quote->($default);
}
$Quote->($val);
}
;
column: qualified_symbol
| symbol { push @Columns, $_[1]; $QuoteIdent->($_[1]) }
;
qualified_symbol: symbol '.' symbol
{
#push @Models, $_[1];
push @Columns, $_[3];
$QuoteIdent->($_[1]).'.'.$QuoteIdent->($_[3]);
}
;
symbol: IDENT
| VAR '|' IDENT
{ push @OutVars, $_[1];
my $val = $InVals->{$_[1]};
if (!defined $val) {
my $default;
$Defaults{$_[1]} = $default = $_[3];
_IDENT($default) or die "Bad symbol: $default\n";
return $default;
}
_IDENT($val) or die "Bad symbol: $val\n";
$val;
}
| VAR
{ push @OutVars, $_[1];
my $val = $InVals->{$_[1]};
if (!defined $val) {
push @Unbound, $_[1];
return '';
}
#warn _IDENT($val);
_IDENT($val) or die "Bad symbol: $val\n";
$val;
}
;
alias: symbol
;
postfix_clause_list: postfix_clause postfix_clause_list
{ join(' ', @_[1..$#_]) }
| postfix_clause
;
postfix_clause: where_clause
| group_by_clause
| order_by_clause
| limit_clause
| offset_clause
| from_clause
;
from_clause: 'from' joined_obj_list
{ 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: 'null'
| expr2
| '(' condition ')'
{ join(' ', @_[1..$#_]) }
| subquery
;
operator: '>'
| '>='
| '<='
| '<'
| '<>'
| '!='
| '='
| 'like'
| '@@'
| '@>'
| '<<='
| '<<'
| '>>='
| '>>'
| '@'
| '~'
| 'in'
| 'is' 'not'
{ join(' ', @_[1..$#_]) }
| 'is'
;
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: order_by_atom order_by_modifier
{ join(' ', @_[1..$#_]) }
| order_by_atom
;
order_by_atom: column
| proc_call2
;
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|is|not|null|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*(<<=|<<|>>=|>>|<=|>=|<>|!=|\|\||::|\blike\b|\bin\b|\@[>\@]|\@\b|~\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*|_ACCOUNT|_ROLE)\b//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, $params) = @_;
open my $source, '<', \$sql;
my $yydata = $self->YYData;
$yydata->{source} = $source;
$yydata->{limit} = $params->{limit};
$yydata->{offset} = $params->{offset};
$Quote = $params->{quote} || sub { "''" };
$QuoteIdent = $params->{quote_ident} || sub { '""' };
$InVals = $params->{vars} || {};
#$QuoteIdent = $params->{quote_ident};
#$self->YYData->{INPUT} = ;
### $sql
@Unbound = ();
@Models = ();
@Columns = ();
@OutVars = ();
%Defaults = ();
$sql = $self->YYParse( yydebug => 0 & 0x1F, yylex => \&_Lexer, yyerror => \&_Error );
close $source;
return {
limit => $yydata->{limit},
offset => $yydata->{offset},
models => [@Models],
columns => [@Columns],
sql => $sql,
vars => [@OutVars],
defaults => {%Defaults},
unbound => [@Unbound],
};
}
sub _IDENT {
(defined $_[0] && $_[0] =~ /^[A-Za-z]\w*$/) ? $_[0] : undef;
}
#my ($select) =new Select;
#my $var = $select->Run;
1;
__END__
=head1 NAME
OpenResty::RestyScript::View - RestyScript (for Views) compiler in pure Perl
=head1 SYNOPSIS
use OpenResty::RestyScript::View;
my $restyscript = OpenResty::RestyScript::View->new;
my $res = $restyscript->parse(
'select * from Post where $col > $val',
{
quote => sub { $dbh->quote(@_) },
quote_ident => sub { $dbh->quote_identifier(@_) },
}
);
=head1 DESCRIPTION
This compiler class is generated automatically by L<Parse::Yapp> from the grammar file F<grammar/restyscript-view.yp>.
=head1 AUTHOR
Agent Zhang (agentzh) C<< <agentzh at yahoo dot cn> >>
=head1 SEE ALSO
L<OpenResty::Handler::View>, L<OpenResty>.
=cut