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
126
127
128
129
130
|
# Utility functions to parse the files in 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 VNDB::Schema;
use v5.12;
use warnings;
my $ROOT = $INC{'VNDB/Schema.pm'} =~ s{/lib/VNDB/Schema\.pm}{}r;
# Reads schema.sql and returns a hashref with the following structure:
# {
# vn => {
# name => '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 %schema;
my $table;
open my $F, '<', "$ROOT/sql/schema.sql" or die "schema.sql: $!";
while(<$F>) {
chomp;
next if /^\s*--/ || /^\s*$/;
next if /^\s*CREATE\s+TYPE/;
next if /^\s*CREATE\s+SEQUENCE/;
next if /^\s*CREATE\s+FUNCTION/;
if(/^\s*CREATE\s+TABLE\s+([^ ]+)/) {
die "Unexpected 'CREATE TABLE $1'\n" if $table;
$table = $1;
$schema{$table}{name} = $table;
$schema{$table}{dbentry_type} = $1 if /--.*\s+dbentry_type=(.)/;
$schema{$table}{cols} = [];
} elsif(/^\s*\);/) {
$table = undef;
} elsif(/^\s+(?:CHECK|CONSTRAINT)/) {
# 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 schema.sql and returns a hashref with the following structure:
# {
# anime_type => {
# decl => 'CREATE TYPE ..;'
# }, ..
# }
sub types {
my %types;
open my $F, '<', "$ROOT/sql/schema.sql" or die "schema.sql: $!";
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 @ref;
open my $F, '<', "$ROOT/sql/tableattrs.sql" or die "tableattrs.sql: $!";
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;
|
