summaryrefslogtreecommitdiff
path: root/lib/VNDBSchema.pm
blob: 5865fe433c5956c85bc5fa8a5463f48a2a450da0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
# Utility functions to parse the files in util/sql/ and extract information and
# perform a few simple sanity checks.
#
# This is not a full-blown SQL parser. The code makes all kinds of assumptions
# about the formatting of the .sql files.

package VNDBSchema;

use strict;
use warnings;

# Reads schema.sql and returns a hashref with the following structure:
# {
#   vn => {
#       dbentry_type => 'v',
#       cols => [
#           {
#               name => 'id',
#               type => 'serial',
#               decl => 'id SERIAL', # full declaration, exluding comments and PRIMARY KEY marker
#               pub => 1,
#           }, ...
#       ],
#       primary => ['id'],
#   }
# }
sub schema {
    my $fn = shift;
    my %schema;
    my $table;
    open my $F, '<', $fn or die "$fn: $!";
    while(<$F>) {
        chomp;
        next if /^\s*--/ || /^\s*$/;

        if(/^\s*CREATE\s+TABLE\s+([^ ]+)/) {
            die "Unexpected 'CREATE TABLE $1'\n" if $table;
            $table = $1;
            $schema{$table}{dbentry_type} = $1 if /--.*\s+dbentry_type=(.)/;
            $schema{$table}{cols} = [];

        } elsif(/^\s*\);/) {
            $table = undef;

        } elsif(/^\s+CHECK/) {
            # ignore

        } elsif($table && /^\s+PRIMARY\s+KEY\s*\(([^\)]+)\)/i) {
            die "Double primary key for '$table'?\n" if $schema{$table}{primary};
            $schema{$table}{primary} = [ map s/\s*"?([^\s"]+)"?\s*/$1/r, split /,/, $1 ];

        } elsif($table && s/^\s+"?([^"\( ]+)"?\s+//) {
            my $col = { name => $1 };
            push @{$schema{$table}{cols}}, $col;

            $col->{pub} = /--.*\[pub\]/;
            s/,?\s*(?:--.*)?$//;

            if(s/\s+PRIMARY\s+KEY//i) {
                die "Double primary key for '$table'?\n" if $schema{$table}{primary};
                $schema{$table}{primary} = [ $col->{name} ];
            }
            $col->{decl} = "\"$col->{name}\" $_";
            $col->{type} = lc s/^([^ ]+)\s.+/$1/r;

        } else {
            die "Unrecognized line in schema.sql: $_\n";
        }
    }

    \%schema
}


# Parses types from all.sql and returns a hashref with the following structure:
# {
#   anime_type => {
#       decl => 'CREATE TYPE ..;'
#   }, ..
# }
sub types {
    my $fn = shift;
    my %types;
    open my $F, '<', $fn or die "$fn: $!";
    while(<$F>) {
        chomp;
        if(/^CREATE TYPE ([^ ]+)/) {
            $types{$1} = { decl => $_ };
        }
    }
    \%types
}


# Parses foreign key references from tableattrs.sql and returns an arrayref:
# [
#   {
#       decl => 'ALTER TABLE ..;',
#       from_table => 'vn_anime',
#       from_cols => ['id'],
#       to_table => 'vn',
#       to_cols => ['id'],
#       name => 'vn_anime_id_fkey'
#   }, ..
# ]
sub references {
    my $fn = shift;
    my @ref;
    open my $F, '<', $fn or die "$fn: $!";
    while(<$F>) {
        chomp;
        next if !/^\s*ALTER\s+TABLE\s+([^ ]+)\s+ADD\s+CONSTRAINT\s+([^ ]+)\s+FOREIGN\s+KEY\s+\(([^\)]+)\)\s+REFERENCES\s+([^ ]+)\s*\(([^\)]+)\)/;
        push @ref, {
            decl => $_,
            from_table => $1,
            name => $2,
            from_cols => [ map s/"//r, split /\s*,\s*/, $3 ],
            to_table => $4,
            to_cols => [ map s/"//r, split /\s*,\s*/, $5 ]
        };
    }
    \@ref
}

1;