#
# 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