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;
|