view release on metacpan or  search on metacpan

lib/SQL/Yapp.pm  view on Meta::CPAN

            return parse_table_constraint($lx);
        },
    );
}

sub parse_create_table($)
{
    my ($lx)= @_;
    return unless
        expect($lx, \@CREATE_TABLE_INITIAL);

    my $r= create($lx, ['Stmt','CreateTable'],
                  qw(subtype if_not_exists table column_def tabconstr tableopt select));
    $r->{subtype}= lexer_shift($lx);

    if ($read_dialect{mysql} &&
        looking_at($lx, 'IF NOT EXISTS', SHIFT))
    {
        $r->{if_not_exists}= 1;
    }

    return unless
        $r->{table}= parse_table($lx);

    $r->{column_def}= [];
    $r->{tabconstr}=  [];
    if (looking_at($lx, '(')) {
        return unless
            my $spec= parse_list_delim($lx, \&parse_column_def_or_option);

        $r->{column_def}= [ grep { $_->{kind} eq 'ColumnDef' } @$spec ];
        $r->{tabconstr}=  [ grep { $_->{kind} ne 'ColumnDef' } @$spec ];
    }

    return unless
        $r->{tableopt}= parse_try_list([], $lx, \&parse_table_option);

    if (looking_at($lx, 'AS', SHIFT) ||
        looking_at($lx, \@SELECT_INITIAL))
    {
        return unless
            $r->{select}= parse_select($lx);
    }

    unless (scalar(@{ $r->{column_def} }) || $r->{select}) {
        $lx->{error}= 'Either query or at least one column expected';
        return;
    }

    lock_hash %$r;
    return $r;
}

sub parse_drop_table($)
{
    my ($lx)= @_;
    return unless
        expect($lx, \@DROP_TABLE_INITIAL);

    my $r= create($lx, ['Stmt','DropTable'],
                  qw(subtype if_exists table cascade));
    $r->{subtype}= lexer_shift($lx);

    if ($read_dialect{mysql} &&
        looking_at($lx, 'IF EXISTS', SHIFT))
    {
        $r->{if_exists}= 1;
    }

    return unless
        $r->{table}= parse_list([], $lx, \&parse_table, ',');

    $r->{cascade}= looking_at($lx, ['RESTRICT','CASCADE'], SHIFT);

    lock_hash %$r;
    return $r;
}

sub parse_column_pos_perhaps($)
{
    my ($lx)= @_;
    return parse_choice($lx,
        -default => sub {
            return;
        },
        'FIRST' => sub {
            return lexer_shift($lx);
        },
        'AFTER' => sub {
            lexer_shift($lx);
            return ('AFTER', parse_column_name($lx));
        },
    );
}

sub parse_alter_table($)
{
    my ($lx)= @_;
    return unless
        expect($lx, \@ALTER_TABLE_INITIAL);

    my $r= create($lx, ['Stmt','AlterTable'],
                  qw(subtype functor subfunctor arg online ignore table only));
    $r->{subtype}= lexer_shift($lx);
    $r->{arg}=     [];

    return unless
        $r->{table}= parse_table($lx);

    $r->{only}= looking_at($lx, 'ONLY', SHIFT);

    parse_choice($lx,
        'DROP CONSTRAINT' => sub {
            $r->{functor}= lexer_shift($lx);
            return unless
                my $constraint= parse_constraint($lx);
            push @{ $r->{arg} }, $constraint, looking_at($lx, ['RESTRICT','CASCADE'], SHIFT);
        },

        'DROP COLUMN' => sub {
            $r->{functor}= lexer_shift($lx);
            return unless
                my $column= parse_column_name($lx);
            push @{ $r->{arg} }, $column, looking_at($lx, ['RESTRICT','CASCADE'], SHIFT);
        },

        'RENAME COLUMN' => sub {
            $r->{functor}= lexer_shift($lx);

            return unless
                my $column= parse_column_name($lx)
            and expect($lx, 'TO', SHIFT)
            and my $column2= parse_column_name($lx);

lib/SQL/Yapp.pm  view on Meta::CPAN

                    if (my $x= $thing->{where}) {
                        str_target_line ($str, $x->{line});
                        str_append_str   ($str, ' WHERE ');
                        str_append_thing ($str, $x, NOT_IN_LIST, NO_PARENS);
                    }
                    if (my $x= $thing->{order_by}) {
                        str_append_list ($str, $x, NO_PARENS,
                            prefix  => ' ORDER BY ',
                            result0 => ''
                        );
                    }
                    str_append_limit ($str, $thing->{limit_cnt}, $thing->{limit_offset});

                    str_append_end ($str);
                    str_append_end ($str);
                },
                'CreateTable' => sub {
                    str_append_funcall ($str, __PACKAGE__.'::Stmt->obj', $in_list);
                    str_append_join ($str, never_empty => 1);

                    str_append_str ($str, "$thing->{subtype} ");
                    if ($thing->{if_not_exists}) {
                        str_append_str ($str, 'IF NOT EXISTS ');
                    }
                    str_append_thing ($str, $thing->{table}, NOT_IN_LIST, NO_PARENS);

                    my @tabspec= (
                        @{ $thing->{column_def} },
                        @{ $thing->{tabconstr} }
                    );
                    str_append_list ($str, \@tabspec, NO_PARENS,
                        result0 => '',
                        prefix  => ' (',
                        suffix  => ')'
                    );

                    str_append_list ($str, $thing->{tableopt}, NO_PARENS,
                        result0 => '',
                        prefix  => ' ',
                        sep     => ' ',
                    );

                    if (my $x= $thing->{select}) {
                        str_append_str   ($str, ' AS ');
                        str_append_thing ($str, $x, NOT_IN_LIST, NO_PARENS);
                    }

                    str_append_end ($str);
                    str_append_end ($str);
                },
                'DropTable' => sub {
                    str_append_funcall ($str, __PACKAGE__.'::Stmt->obj', $in_list);
                    str_append_join ($str, never_empty => 1);

                    str_append_str ($str, "$thing->{subtype} ");
                    if ($thing->{if_exists}) {
                        str_append_str ($str, 'IF EXISTS ');
                    }
                    str_append_list ($str, $thing->{table}, NO_PARENS);

                    if (my $x= $thing->{cascade}) {
                        str_append_str ($str, " $x");
                    }
                    str_append_end ($str);
                    str_append_end ($str);
                },
                'AlterTable' => sub {
                    str_append_funcall ($str, __PACKAGE__.'::Stmt->obj', $in_list);
                    str_append_join ($str, never_empty => 1);

                    str_append_str ($str, "$thing->{subtype} ");
                    if ($thing->{only}) {
                        str_append_str ($str, 'ONLY ');
                    }
                    str_append_thing ($str, $thing->{table}, NOT_IN_LIST, NO_PARENS);

                    str_append_join ($str, sep => ' ', prefix => ' ');
                    for my $l ($thing->{functor}, @{ $thing->{arg} }) {
                        str_append_thing ($str, $l, NOT_IN_LIST, NO_PARENS);
                    }
                    str_append_end ($str);

                    str_append_end ($str);
                    str_append_end ($str);
                },
                'Interpol' => sub {
                    str_append_typed ($str, 'stmt', 'Stmt', $thing, $in_list);
                },
            );
        },

        'TableOption' => sub {
            switch ($thing->{type},
               'interpol' => sub {
                    str_append_typed ($str, 'tableopt', 'TableOption', $thing, $in_list);
               },
               'literal' => sub {
                    str_append_join  ($str, sep => ' ');
                    str_append_str   ($str, $thing->{name});
                    str_append_thing ($str, $thing->{value}, NOT_IN_LIST, NO_PARENS);
                    str_append_end   ($str);
               }
            );
        },

        'Keyword' => sub {
            str_append_str ($str, $thing->{keyword});
        },

        'Join' => sub {
            if ($thing->{type} eq 'interpol') {
                str_append_typed ($str, 'joinclause', 'Join', $thing, $in_list);
            }
            else {
                str_append_join ($str, result0 => '');

                if ($thing->{natural}) {
                    if ($thing->{type} eq 'INNER') {
                        str_append_str ($str, "NATURAL JOIN ");
                    }
                    else {