sql-to-teng-schema-dsl.pl

use strict;
use warnings;
use 5.010;
use DBIx::MyParsePP;

my %TYPES = (
    DECIMAL_SYM => 3,
    INT_SYM => 4,
    BIGINT => 4,
    SMALLINT => 4,
    TINYINT => 4,
    FLOAT_SYM => 4,
    VARCHAR => 12,
    ENUM => 12,
    TEXT_SYM => 12,
    MEDIUMTEXT => 12,
    LONGTEXT => 12,
    CHAR_SYM => 12,
    DATETIME => 11,
    TIMESTAMP => 11,
    TIME_SYM => 10,
    DATE_SYM => 9,
);

sub sql_to_schema {
    my ($sql) = @_;

    my $first = 1;
    for my $single_sql (split(';', $sql)) {
        my $schema = single_sql_to_schema($single_sql) or next;
        if ($first) {
            $first = 0;
        } else {
            print "\n\n";
        }
        print $schema;
    }
}

sub single_sql_to_schema {
    my ($sql) = @_;
    my $parser = DBIx::MyParsePP->new;
    my $root = $parser->parse($sql)->root;
    die "failed to parse: $sql" unless $root;

    my $name;
    my @primary_keys;
    my @columns;

    my $node;

    $node = $root->[1];
    if (is_token($node)) {
        return;
    }
    $node = $node->[1][1];
    if ($node->name ne 'create') {
        return;
    }

    $name = identity_name($node->[5]);

    $node = $node->[6][2][1];
    for my $item (list_items($node, 'field_list_item')) {
        if ($item->name eq 'column_def') {
            my $ident = identity_name($item->[1][1]);
            my $type = type_sym($item->[1][2])->type;
            my $type_code = $TYPES{$type};
            unless (defined $type_code) {
                warn "unknown type: $type";
                $type_code = -1;
            }
            push @columns, {
                name => $ident,
                type => $type_code,
            };
        } elsif ($item->name eq 'key_def') {
            if (find_token_by_type($item, 'PRIMARY_SYM')) {
                my @keys;
                my $key_list = find_rule_by_name($item, 'key_list');
                for my $key_part (list_items($key_list, 'key_part')) {
                    push @primary_keys, identity_name($key_part);
                }
            }
        }
    }

    my $out = "table {\n";
    my $indent = ' ' x 4;
    $out .= $indent . "name '$name';\n";
    $out .= $indent . "pk " .
        join(', ', map { "'$_'" } @primary_keys) . ";\n" if @primary_keys;
    $out .= $indent . "columns (\n";
    for my $col (@columns) {
        my $q_name = quote($col->{name});
        my $type = $col->{type};
        $out .= ($indent x 2) . "{name => $q_name, type => $type},\n";
    }
    $out .= $indent . ");\n";
    $out .= '};';
}

sub quote {
    my ($name) = @_;
    return "'$name'";
}

sub is_token {
    my ($node) = @_;
    return $node->isa(DBIx::MyParsePP::Token::);
}

sub identity_name {
    my ($node) = @_;
    while (defined $node) {
        if (is_token($node) &&
                ($node->type eq 'IDENT' || $node->type eq 'IDENT_QUOTED')) {
            return $node->value;
        }
        $node = $node->[1];
    }
}

sub list_items {
    my ($node, $list_item_type) = @_;

    return () unless defined $node;
    return $node->[1] if $node->name eq $list_item_type;

    return (
        list_items($node->[1], $list_item_type),
        list_items($node->[3], $list_item_type));
}

sub type_sym {
    my ($node) = @_;
    if ($node->[1]->isa(DBIx::MyParsePP::Token::)) {
        return $node->[1];
    }
    return $node->[1]->[1];
}

sub find_token_by_type {
    my ($node, $type) = @_;
    if ($node->isa(DBIx::MyParsePP::Token::)) {
        if ($node->type eq $type) {
            return $node;
        }
        return;
    }
    for my $child ($node->children) {
        my $result = find_token_by_type($child, $type);
        return $result if $result;
    }
}

sub find_rule_by_name {
    my ($node, $name) = @_;
    if ($node->isa(DBIx::MyParsePP::Token::)) {
        return;
    }
    return $node if $node->name eq $name;
    for my $child ($node->children) {
        my $result = find_rule_by_name($child, $name);
        return $result if $result;
    }
}

my $sql = '';
while (my $line = <STDIN>) {
    $sql .= $line;
}
print sql_to_schema($sql);