SQL lexikai elemző

#!/usr/bin/env perl

use v5.018;
use utf8;
use strict;
use warnings;
use feature qw(unicode_strings);
use open qw(:std :utf8);
use HOP::Lexer 'string_lexer';

# sql keywords input file
my $KEYWD_FN = 'sql_keywords.txt';
# escaped sinqle quote placeholder
my $ESQP = 'ESCSINGQUOTPH';

### main ###

{
    my $sql = read_sql_from_file($ARGV[0]);
    my $keywords_str = read_keywords_from_file($KEYWD_FN);

    # preprocessing

    # replace any ''
    $sql =~ s/(?<!')''(?!')/$ESQP/gs;
    # replace any ''''
    $sql =~ s/(?<!')''''(?!')/$ESQP$ESQP/gs;
    # these cases are handled by the lexer:
    # '...''' or '''...' or '''...'''

    # lexing/tokenization

    my $lexer = string_lexer(
        $sql,
        # comments
        ['CMT',   qr{/\*(?:\*(?!/)|[^*])*\*/}, \&replace_phs],
        ['CMT',   qr/--\N*/, \&replace_phs],
        # string literals
        ['STR',   qr/'(?:'')?[^']+(?:'')?'/, \&replace_phs],
        # number literals
        ['NUM',   qr/\b{wb}\d+\.?\d*\b{wb}/],
        # commas
        ['COMMA', qr/,/],
        # operators
        ['OP',    qr{[-=+*/!<>|]+}],
        # parentheses
        ['PAREN', qr/\(/, sub { [shift,  1] }],
        ['PAREN', qr/\)/, sub { [shift, -1] }],
        # keywords
        ['KEYWD', qr/\b{wb}(?i:$keywords_str)\b{wb}/],
        # identifiers
        ['IDFR',  qr/(?:[\w\.]+|"\w+")/],
        # whitespace (discarded)
        ['SPACE', qr/\s*/, sub {}],
    );
    my @tokens;
    while (defined (my $token = $lexer->())) {
        push @tokens => $token;
    }

    # just print the results

    my $paren_level = 0;
    foreach my $i (0 .. $#tokens) {
        my ($label, $value) = @{$tokens[$i]};
        $paren_level += $value if 'PAREN' eq $label;
        print "$label\t$paren_level\t$value\n";
    }
}

### subroutines ###

sub read_sql_from_file {
    my $in_fn = shift // '';
    open(my $fh, '<', $in_fn)
        or die "Error: cannot open $in_fn: $!\n";
    # slurp mode
    local $/ = undef;
    my $sql = <$fh>;
    close $fh;
    return $sql
}

sub read_keywords_from_file {
    my $in_fn = shift // '';
    open(my $fh, '<', $in_fn)
        or die "Error: cannot open $in_fn: $!\n";
    my @words = <$fh>;
    close $fh;
    chomp @words;
    return join('|', @words)
}

sub replace_phs {
    my ($label, $value) = @_;
    $value =~ s/$ESQP/''/gs;
    return [$label, $value];
}

select product_id, sum(price) as "összeg"
from orders -- TODO: join products
group by product_id

KEYWD   0       select
IDFR    0       product_id
COMMA   0       ,
KEYWD   0       sum
PAREN   1       1
IDFR    1       price
PAREN   0       -1
KEYWD   0       as
IDFR    0       "összeg"
KEYWD   0       from
IDFR    0       orders
CMT     0       -- TODO: join products
KEYWD   0       group by
IDFR    0       product_id