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