line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SQL::Translator::Parser::PostgreSQL; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use SQL::Translator; |
10
|
|
|
|
|
|
|
use SQL::Translator::Parser::PostgreSQL; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $translator = SQL::Translator->new; |
13
|
|
|
|
|
|
|
$translator->parser("SQL::Translator::Parser::PostgreSQL"); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 DESCRIPTION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
The grammar was started from the MySQL parsers. Here is the description |
18
|
|
|
|
|
|
|
from PostgreSQL: |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Table: |
21
|
|
|
|
|
|
|
(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createtable.html) |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name ( |
24
|
|
|
|
|
|
|
{ column_name data_type [ DEFAULT default_expr ] |
25
|
|
|
|
|
|
|
[ column_constraint [, ... ] ] |
26
|
|
|
|
|
|
|
| table_constraint } [, ... ] |
27
|
|
|
|
|
|
|
) |
28
|
|
|
|
|
|
|
[ INHERITS ( parent_table [, ... ] ) ] |
29
|
|
|
|
|
|
|
[ WITH OIDS | WITHOUT OIDS ] |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
where column_constraint is: |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
[ CONSTRAINT constraint_name ] |
34
|
|
|
|
|
|
|
{ NOT NULL | NULL | UNIQUE | PRIMARY KEY | |
35
|
|
|
|
|
|
|
CHECK (expression) | |
36
|
|
|
|
|
|
|
REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ] |
37
|
|
|
|
|
|
|
[ ON DELETE action ] [ ON UPDATE action ] } |
38
|
|
|
|
|
|
|
[ DEFERRABLE | NOT DEFERRABLE ] |
39
|
|
|
|
|
|
|
[ INITIALLY DEFERRED | INITIALLY IMMEDIATE ] |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
and table_constraint is: |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
[ CONSTRAINT constraint_name ] |
44
|
|
|
|
|
|
|
{ UNIQUE ( column_name [, ... ] ) | |
45
|
|
|
|
|
|
|
PRIMARY KEY ( column_name [, ... ] ) | |
46
|
|
|
|
|
|
|
CHECK ( expression ) | |
47
|
|
|
|
|
|
|
FOREIGN KEY ( column_name [, ... ] ) |
48
|
|
|
|
|
|
|
REFERENCES reftable [ ( refcolumn [, ... ] ) ] |
49
|
|
|
|
|
|
|
[ MATCH FULL | MATCH PARTIAL ] |
50
|
|
|
|
|
|
|
[ ON DELETE action ] [ ON UPDATE action ] } |
51
|
|
|
|
|
|
|
[ DEFERRABLE | NOT DEFERRABLE ] |
52
|
|
|
|
|
|
|
[ INITIALLY DEFERRED | INITIALLY IMMEDIATE ] |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Index: |
55
|
|
|
|
|
|
|
(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createindex.html) |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
CREATE [ UNIQUE ] INDEX index_name ON table |
58
|
|
|
|
|
|
|
[ USING acc_method ] ( column [ ops_name ] [, ...] ) |
59
|
|
|
|
|
|
|
[ WHERE predicate ] |
60
|
|
|
|
|
|
|
CREATE [ UNIQUE ] INDEX index_name ON table |
61
|
|
|
|
|
|
|
[ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] ) |
62
|
|
|
|
|
|
|
[ WHERE predicate ] |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
Alter table: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
ALTER TABLE [ ONLY ] table [ * ] |
67
|
|
|
|
|
|
|
ADD [ COLUMN ] column type [ column_constraint [ ... ] ] |
68
|
|
|
|
|
|
|
ALTER TABLE [ ONLY ] table [ * ] |
69
|
|
|
|
|
|
|
ALTER [ COLUMN ] column { SET DEFAULT value | DROP DEFAULT } |
70
|
|
|
|
|
|
|
ALTER TABLE [ ONLY ] table [ * ] |
71
|
|
|
|
|
|
|
ALTER [ COLUMN ] column SET STATISTICS integer |
72
|
|
|
|
|
|
|
ALTER TABLE [ ONLY ] table [ * ] |
73
|
|
|
|
|
|
|
RENAME [ COLUMN ] column TO newcolumn |
74
|
|
|
|
|
|
|
ALTER TABLE table |
75
|
|
|
|
|
|
|
RENAME TO new_table |
76
|
|
|
|
|
|
|
ALTER TABLE table |
77
|
|
|
|
|
|
|
ADD table_constraint_definition |
78
|
|
|
|
|
|
|
ALTER TABLE [ ONLY ] table |
79
|
|
|
|
|
|
|
DROP CONSTRAINT constraint { RESTRICT | CASCADE } |
80
|
|
|
|
|
|
|
ALTER TABLE table |
81
|
|
|
|
|
|
|
OWNER TO new_owner |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
View table: |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
CREATE [ OR REPLACE ] VIEW view [ ( column name list ) ] AS SELECT query |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
3
|
|
|
3
|
|
1285
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
96
|
|
90
|
3
|
|
|
3
|
|
23
|
use warnings; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
184
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
our $VERSION = '1.62'; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
our $DEBUG; |
95
|
|
|
|
|
|
|
$DEBUG = 0 unless defined $DEBUG; |
96
|
|
|
|
|
|
|
|
97
|
3
|
|
|
3
|
|
20
|
use Data::Dumper; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
158
|
|
98
|
3
|
|
|
3
|
|
19
|
use SQL::Translator::Utils qw/ddl_parser_instance/; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
180
|
|
99
|
|
|
|
|
|
|
|
100
|
3
|
|
|
3
|
|
27
|
use base qw(Exporter); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
3600
|
|
101
|
|
|
|
|
|
|
our @EXPORT_OK = qw(parse); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
our $GRAMMAR = <<'END_OF_GRAMMAR'; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
{ my ( %tables, @views, @triggers, $table_order, $field_order, @table_comments) } |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# |
108
|
|
|
|
|
|
|
# The "eofile" rule makes the parser fail if any "statement" rule |
109
|
|
|
|
|
|
|
# fails. Otherwise, the first successful match by a "statement" |
110
|
|
|
|
|
|
|
# won't cause the failure needed to know that the parse, as a whole, |
111
|
|
|
|
|
|
|
# failed. -ky |
112
|
|
|
|
|
|
|
# |
113
|
|
|
|
|
|
|
startrule : statement(s) eofile { |
114
|
|
|
|
|
|
|
{ |
115
|
|
|
|
|
|
|
tables => \%tables, |
116
|
|
|
|
|
|
|
views => \@views, |
117
|
|
|
|
|
|
|
triggers => \@triggers, |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
eofile : /^\Z/ |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
statement : create |
124
|
|
|
|
|
|
|
| comment_on_table |
125
|
|
|
|
|
|
|
| comment_on_column |
126
|
|
|
|
|
|
|
| comment_on_other |
127
|
|
|
|
|
|
|
| comment |
128
|
|
|
|
|
|
|
| alter |
129
|
|
|
|
|
|
|
| grant |
130
|
|
|
|
|
|
|
| revoke |
131
|
|
|
|
|
|
|
| drop |
132
|
|
|
|
|
|
|
| insert |
133
|
|
|
|
|
|
|
| connect |
134
|
|
|
|
|
|
|
| update |
135
|
|
|
|
|
|
|
| set |
136
|
|
|
|
|
|
|
| select |
137
|
|
|
|
|
|
|
| copy |
138
|
|
|
|
|
|
|
| readin_symbol |
139
|
|
|
|
|
|
|
| commit |
140
|
|
|
|
|
|
|
| |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
commit : /commit/i ';' |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
connect : /^\s*\\connect.*\n/ |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
set : /set/i /[^;]*/ ';' |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_id /from/i NAME(s /,/) ';' |
149
|
|
|
|
|
|
|
{ |
150
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
151
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
152
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
153
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'permissions'} }, { |
154
|
|
|
|
|
|
|
type => 'revoke', |
155
|
|
|
|
|
|
|
actions => $item[2], |
156
|
|
|
|
|
|
|
users => $item[7], |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
revoke : /revoke/i WORD(s /,/) /on/i SCHEMA(?) schema_name /from/i NAME(s /,/) ';' |
161
|
|
|
|
|
|
|
{ 1 } |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_id /to/i NAME(s /,/) ';' |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
166
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
167
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
168
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'permissions'} }, { |
169
|
|
|
|
|
|
|
type => 'grant', |
170
|
|
|
|
|
|
|
actions => $item[2], |
171
|
|
|
|
|
|
|
users => $item[7], |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
grant : /grant/i WORD(s /,/) /on/i SCHEMA(?) schema_name /to/i NAME(s /,/) ';' |
176
|
|
|
|
|
|
|
{ 1 } |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
drop : /drop/i /[^;]*/ ';' |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
string : |
181
|
|
|
|
|
|
|
/'(\.|''|[^\\'])*'/ |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
nonstring : /[^;\'"]+/ |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
statement_body : string | nonstring |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
insert : /insert/i statement_body(s?) ';' |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
update : /update/i statement_body(s?) ';' |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# |
192
|
|
|
|
|
|
|
# Create table. |
193
|
|
|
|
|
|
|
# |
194
|
|
|
|
|
|
|
create : CREATE temporary(?) TABLE table_id '(' create_definition(s? /,/) ')' table_option(s?) ';' |
195
|
|
|
|
|
|
|
{ |
196
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
197
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
198
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
199
|
|
|
|
|
|
|
$tables{ $table_name }{'order'} = ++$table_order; |
200
|
|
|
|
|
|
|
$tables{ $table_name }{'schema_name'} = $schema_name; |
201
|
|
|
|
|
|
|
$tables{ $table_name }{'table_name'} = $table_name; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
$tables{ $table_name }{'temporary'} = $item[2][0]; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
if ( @table_comments ) { |
206
|
|
|
|
|
|
|
$tables{ $table_name }{'comments'} = [ @table_comments ]; |
207
|
|
|
|
|
|
|
@table_comments = (); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my @constraints; |
211
|
|
|
|
|
|
|
for my $definition ( @{ $item[6] } ) { |
212
|
|
|
|
|
|
|
if ( $definition->{'supertype'} eq 'field' ) { |
213
|
|
|
|
|
|
|
my $field_name = $definition->{'name'}; |
214
|
|
|
|
|
|
|
$tables{ $table_name }{'fields'}{ $field_name } = |
215
|
|
|
|
|
|
|
{ %$definition, order => $field_order++ }; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
for my $constraint ( @{ $definition->{'constraints'} || [] } ) { |
218
|
|
|
|
|
|
|
$constraint->{'fields'} = [ $field_name ]; |
219
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'constraints'} }, |
220
|
|
|
|
|
|
|
$constraint; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
elsif ( $definition->{'supertype'} eq 'constraint' ) { |
224
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'constraints'} }, $definition; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
elsif ( $definition->{'supertype'} eq 'index' ) { |
227
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'indices'} }, $definition; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
for my $option ( @{ $item[8] } ) { |
232
|
|
|
|
|
|
|
$tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } = |
233
|
|
|
|
|
|
|
$option; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
1; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
create : CREATE unique(?) /(index|key)/i index_name /on/i table_id using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';' |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
242
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
243
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
244
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'indices'} }, |
245
|
|
|
|
|
|
|
{ |
246
|
|
|
|
|
|
|
name => $item{'index_name'}, |
247
|
|
|
|
|
|
|
supertype => $item{'unique'}[0] ? 'constraint' : 'index', |
248
|
|
|
|
|
|
|
type => $item{'unique'}[0] ? 'unique' : 'normal', |
249
|
|
|
|
|
|
|
fields => $item[9], |
250
|
|
|
|
|
|
|
method => $item{'using_method(?)'}[0], |
251
|
|
|
|
|
|
|
where => $item{'where_predicate(?)'}[0], |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
create : CREATE or_replace(?) temporary(?) VIEW view_id view_fields(?) /AS/i view_target ';' |
257
|
|
|
|
|
|
|
{ |
258
|
|
|
|
|
|
|
push @views, { |
259
|
|
|
|
|
|
|
schema_name => $item{view_id}{schema_name}, |
260
|
|
|
|
|
|
|
view_name => $item{view_id}{view_name}, |
261
|
|
|
|
|
|
|
sql => $item{view_target}, |
262
|
|
|
|
|
|
|
fields => $item[6], |
263
|
|
|
|
|
|
|
is_temporary => $item[3][0], |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
trigger_name : NAME |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
trigger_scope : /FOR/i /EACH/i /(ROW|STATEMENT)/i { $return = lc $1 } |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
before_or_after : /(before|after)/i { $return = lc $1 } |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
trigger_action : /.+/ |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
database_event : /insert|update|delete/i |
276
|
|
|
|
|
|
|
database_events : database_event(s /OR/) |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
create : CREATE /TRIGGER/i trigger_name before_or_after database_events /ON/i table_id trigger_scope(?) trigger_action |
279
|
|
|
|
|
|
|
{ |
280
|
|
|
|
|
|
|
# Hack to pass roundtrip tests which have trigger statements terminated by double semicolon |
281
|
|
|
|
|
|
|
# and expect the returned data to have the same |
282
|
|
|
|
|
|
|
my $action = $item{trigger_action}; |
283
|
|
|
|
|
|
|
$action =~ s/;$//; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
push @triggers, { |
286
|
|
|
|
|
|
|
name => $item{trigger_name}, |
287
|
|
|
|
|
|
|
perform_action_when => $item{before_or_after}, |
288
|
|
|
|
|
|
|
database_events => $item{database_events}, |
289
|
|
|
|
|
|
|
on_table => $item{table_id}{table_name}, |
290
|
|
|
|
|
|
|
scope => $item{'trigger_scope(?)'}[0], |
291
|
|
|
|
|
|
|
action => $action, |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# |
296
|
|
|
|
|
|
|
# Create anything else (e.g., domain, etc.) |
297
|
|
|
|
|
|
|
# |
298
|
|
|
|
|
|
|
create : CREATE WORD /[^;]+/ ';' |
299
|
|
|
|
|
|
|
{ @table_comments = (); } |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
using_method : /using/i WORD { $item[2] } |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
where_predicate : /where/i /[^;]+/ |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
create_definition : field |
306
|
|
|
|
|
|
|
| table_constraint |
307
|
|
|
|
|
|
|
| |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
comment : /^\s*(?:#|-{2})(.*)\n/ |
310
|
|
|
|
|
|
|
{ |
311
|
|
|
|
|
|
|
my $comment = $item[1]; |
312
|
|
|
|
|
|
|
$comment =~ s/^\s*(#|-*)\s*//; |
313
|
|
|
|
|
|
|
$comment =~ s/\s*$//; |
314
|
|
|
|
|
|
|
$return = $comment; |
315
|
|
|
|
|
|
|
push @table_comments, $comment; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
comment_on_table : /comment/i /on/i /table/i table_id /is/i comment_phrase ';' |
319
|
|
|
|
|
|
|
{ |
320
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
321
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
322
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
323
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'comments'} }, $item{'comment_phrase'}; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
comment_on_column : /comment/i /on/i /column/i column_name /is/i comment_phrase ';' |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
my $table_name = $item[4]->{'table'}; |
329
|
|
|
|
|
|
|
my $field_name = $item[4]->{'field'}; |
330
|
|
|
|
|
|
|
if ($tables{ $table_name }{'fields'}{ $field_name } ) { |
331
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} }, |
332
|
|
|
|
|
|
|
$item{'comment_phrase'}; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
else { |
335
|
|
|
|
|
|
|
die "No such column as $table_name.$field_name"; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
comment_on_other : /comment/i /on/i /\w+/ /\w+/ /is/i comment_phrase ';' |
340
|
|
|
|
|
|
|
{ |
341
|
|
|
|
|
|
|
push(@table_comments, $item{'comment_phrase'}); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# [added by cjm 20041019] |
345
|
|
|
|
|
|
|
# [TODO: other comment-on types] |
346
|
|
|
|
|
|
|
# for now we just have a general mechanism for handling other |
347
|
|
|
|
|
|
|
# kinds of comments than table/column; I'm not sure of the best |
348
|
|
|
|
|
|
|
# way to incorporate these into the datamodel |
349
|
|
|
|
|
|
|
# |
350
|
|
|
|
|
|
|
# this is the exhaustive list of types of comment: |
351
|
|
|
|
|
|
|
#COMMENT ON DATABASE my_database IS 'Development Database'; |
352
|
|
|
|
|
|
|
#COMMENT ON INDEX my_index IS 'Enforces uniqueness on employee id'; |
353
|
|
|
|
|
|
|
#COMMENT ON RULE my_rule IS 'Logs UPDATES of employee records'; |
354
|
|
|
|
|
|
|
#COMMENT ON SEQUENCE my_sequence IS 'Used to generate primary keys'; |
355
|
|
|
|
|
|
|
#COMMENT ON TABLE my_table IS 'Employee Information'; |
356
|
|
|
|
|
|
|
#COMMENT ON TYPE my_type IS 'Complex Number support'; |
357
|
|
|
|
|
|
|
#COMMENT ON VIEW my_view IS 'View of departmental costs'; |
358
|
|
|
|
|
|
|
#COMMENT ON COLUMN my_table.my_field IS 'Employee ID number'; |
359
|
|
|
|
|
|
|
#COMMENT ON TRIGGER my_trigger ON my_table IS 'Used for R.I.'; |
360
|
|
|
|
|
|
|
# |
361
|
|
|
|
|
|
|
# this is tested by test 08 |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
column_name : NAME '.' NAME |
364
|
|
|
|
|
|
|
{ $return = { table => $item[1], field => $item[3] } } |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
comment_phrase : /null/i |
367
|
|
|
|
|
|
|
{ $return = 'NULL' } |
368
|
|
|
|
|
|
|
| SQSTRING |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?) |
371
|
|
|
|
|
|
|
{ |
372
|
|
|
|
|
|
|
my ( $default, @constraints, $is_pk ); |
373
|
|
|
|
|
|
|
my $is_nullable = 1; |
374
|
|
|
|
|
|
|
for my $meta ( @{ $item[4] } ) { |
375
|
|
|
|
|
|
|
if ( $meta->{'type'} eq 'default' ) { |
376
|
|
|
|
|
|
|
$default = $meta; |
377
|
|
|
|
|
|
|
next; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
elsif ( $meta->{'type'} eq 'not_null' ) { |
380
|
|
|
|
|
|
|
$is_nullable = 0; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
elsif ( $meta->{'type'} eq 'primary_key' ) { |
383
|
|
|
|
|
|
|
$is_pk = 1; |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
push @constraints, $meta if $meta->{'supertype'} eq 'constraint'; |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
my @comments = ( @{ $item[1] }, @{ $item[5] } ); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
$return = { |
392
|
|
|
|
|
|
|
supertype => 'field', |
393
|
|
|
|
|
|
|
name => $item{'field_name'}, |
394
|
|
|
|
|
|
|
data_type => $item{'data_type'}{'type'}, |
395
|
|
|
|
|
|
|
size => $item{'data_type'}{'size'}, |
396
|
|
|
|
|
|
|
is_nullable => $is_nullable, |
397
|
|
|
|
|
|
|
default => $default->{'value'}, |
398
|
|
|
|
|
|
|
constraints => [ @constraints ], |
399
|
|
|
|
|
|
|
comments => [ @comments ], |
400
|
|
|
|
|
|
|
is_primary_key => $is_pk || 0, |
401
|
|
|
|
|
|
|
is_auto_increment => $item{'data_type'}{'is_auto_increment'}, |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
| |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
field_comment : /^\s*(?:#|-{2})(.*)\n/ |
407
|
|
|
|
|
|
|
{ |
408
|
|
|
|
|
|
|
my $comment = $item[1]; |
409
|
|
|
|
|
|
|
$comment =~ s/^\s*(#|-*)\s*//; |
410
|
|
|
|
|
|
|
$comment =~ s/\s*$//; |
411
|
|
|
|
|
|
|
$return = $comment; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
field_meta : default_val |
415
|
|
|
|
|
|
|
| column_constraint |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
view_fields : '(' field_name(s /,/) ')' |
418
|
|
|
|
|
|
|
{ $return = join (',', @{$item[2]} ) } |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?) |
421
|
|
|
|
|
|
|
{ |
422
|
|
|
|
|
|
|
my $desc = $item{'column_constraint_type'}; |
423
|
|
|
|
|
|
|
my $type = $desc->{'type'}; |
424
|
|
|
|
|
|
|
my $fields = $desc->{'fields'} || []; |
425
|
|
|
|
|
|
|
my $expression = $desc->{'expression'} || ''; |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
$return = { |
428
|
|
|
|
|
|
|
supertype => 'constraint', |
429
|
|
|
|
|
|
|
name => $item{'constraint_name'}[0] || '', |
430
|
|
|
|
|
|
|
type => $type, |
431
|
|
|
|
|
|
|
expression => $type eq 'check' ? $expression : '', |
432
|
|
|
|
|
|
|
deferrable => $item{'deferrable'}, |
433
|
|
|
|
|
|
|
deferred => $item{'deferred'}, |
434
|
|
|
|
|
|
|
reference_table => $desc->{'reference_table'}, |
435
|
|
|
|
|
|
|
reference_fields => $desc->{'reference_fields'}, |
436
|
|
|
|
|
|
|
match_type => $desc->{'match_type'}, |
437
|
|
|
|
|
|
|
on_delete => $desc->{'on_delete'} || $desc->{'on_delete_do'}, |
438
|
|
|
|
|
|
|
on_update => $desc->{'on_update'} || $desc->{'on_update_do'}, |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
constraint_name : /constraint/i NAME { $item[2] } |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
column_constraint_type : /not null/i { $return = { type => 'not_null' } } |
445
|
|
|
|
|
|
|
| |
446
|
|
|
|
|
|
|
/null/i |
447
|
|
|
|
|
|
|
{ $return = { type => 'null' } } |
448
|
|
|
|
|
|
|
| |
449
|
|
|
|
|
|
|
/unique/i |
450
|
|
|
|
|
|
|
{ $return = { type => 'unique' } } |
451
|
|
|
|
|
|
|
| |
452
|
|
|
|
|
|
|
/primary key/i |
453
|
|
|
|
|
|
|
{ $return = { type => 'primary_key' } } |
454
|
|
|
|
|
|
|
| |
455
|
|
|
|
|
|
|
/check/i '(' /[^)]+/ ')' |
456
|
|
|
|
|
|
|
{ $return = { type => 'check', expression => $item[3] } } |
457
|
|
|
|
|
|
|
| |
458
|
|
|
|
|
|
|
/references/i table_id parens_word_list(?) match_type(?) key_action(s?) |
459
|
|
|
|
|
|
|
{ |
460
|
|
|
|
|
|
|
my $table_info = $item{'table_id'}; |
461
|
|
|
|
|
|
|
my $schema_name = $table_info->{'schema_name'}; |
462
|
|
|
|
|
|
|
my $table_name = $table_info->{'table_name'}; |
463
|
|
|
|
|
|
|
my ( $on_delete, $on_update ); |
464
|
|
|
|
|
|
|
for my $action ( @{ $item[5] || [] } ) { |
465
|
|
|
|
|
|
|
$on_delete = $action->{'action'} if $action->{'type'} eq 'delete'; |
466
|
|
|
|
|
|
|
$on_update = $action->{'action'} if $action->{'type'} eq 'update'; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
$return = { |
470
|
|
|
|
|
|
|
type => 'foreign_key', |
471
|
|
|
|
|
|
|
reference_table => $table_name, |
472
|
|
|
|
|
|
|
reference_fields => $item[3][0], |
473
|
|
|
|
|
|
|
match_type => $item[4][0], |
474
|
|
|
|
|
|
|
on_delete => $on_delete, |
475
|
|
|
|
|
|
|
on_update => $on_update, |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
table_id : schema_qualification(?) NAME { |
480
|
|
|
|
|
|
|
$return = { schema_name => $item[1][0], table_name => $item[2] } |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
view_id : schema_qualification(?) NAME { |
484
|
|
|
|
|
|
|
$return = { schema_name => $item[1][0], view_name => $item[2] } |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
view_target : /select|with/i /[^;]+/ { |
488
|
|
|
|
|
|
|
$return = "$item[1] $item[2]"; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# SELECT views _may_ support outer parens, and we used to produce |
492
|
|
|
|
|
|
|
# such sql, although non-standard. Use ugly lookeahead to parse |
493
|
|
|
|
|
|
|
view_target : '(' /select/i / [^;]+ (?= \) ) /x ')' { |
494
|
|
|
|
|
|
|
$return = "$item[2] $item[3]" |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
view_target_spec : |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
schema_qualification : NAME '.' |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
schema_name : NAME |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
field_name : NAME |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
double_quote: /"/ |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
index_name : NAME |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
array_indicator : '[' ']' |
510
|
|
|
|
|
|
|
{ $return = $item[1].$item[2] } |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
data_type : pg_data_type parens_value_list(?) array_indicator(?) |
513
|
|
|
|
|
|
|
{ |
514
|
|
|
|
|
|
|
my $data_type = $item[1]; |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
$data_type->{type} .= $item[3][0] if $item[3][0]; |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
# |
519
|
|
|
|
|
|
|
# We can deduce some sizes from the data type's name. |
520
|
|
|
|
|
|
|
# |
521
|
|
|
|
|
|
|
if ( my @size = @{$item[2]} ) { |
522
|
|
|
|
|
|
|
$data_type->{'size'} = (@size == 1 ? $size[0] : \@size); |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
$return = $data_type; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
pg_data_type : |
529
|
|
|
|
|
|
|
/(bigint|int8)/i |
530
|
|
|
|
|
|
|
{ |
531
|
|
|
|
|
|
|
$return = { |
532
|
|
|
|
|
|
|
type => 'integer', |
533
|
|
|
|
|
|
|
size => 20, |
534
|
|
|
|
|
|
|
}; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
| |
537
|
|
|
|
|
|
|
/(smallint|int2)/i |
538
|
|
|
|
|
|
|
{ |
539
|
|
|
|
|
|
|
$return = { |
540
|
|
|
|
|
|
|
type => 'integer', |
541
|
|
|
|
|
|
|
size => 5, |
542
|
|
|
|
|
|
|
}; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
| |
545
|
|
|
|
|
|
|
/interval/i |
546
|
|
|
|
|
|
|
{ |
547
|
|
|
|
|
|
|
$return = { type => 'interval' }; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
| |
550
|
|
|
|
|
|
|
/(integer|int4?)/i # interval must come before this |
551
|
|
|
|
|
|
|
{ |
552
|
|
|
|
|
|
|
$return = { |
553
|
|
|
|
|
|
|
type => 'integer', |
554
|
|
|
|
|
|
|
size => 10, |
555
|
|
|
|
|
|
|
}; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
| |
558
|
|
|
|
|
|
|
/(real|float4)/i |
559
|
|
|
|
|
|
|
{ |
560
|
|
|
|
|
|
|
$return = { |
561
|
|
|
|
|
|
|
type => 'real', |
562
|
|
|
|
|
|
|
size => 10, |
563
|
|
|
|
|
|
|
}; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
| |
566
|
|
|
|
|
|
|
/(double precision|float8?)/i |
567
|
|
|
|
|
|
|
{ |
568
|
|
|
|
|
|
|
$return = { |
569
|
|
|
|
|
|
|
type => 'float', |
570
|
|
|
|
|
|
|
size => 20, |
571
|
|
|
|
|
|
|
}; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
| |
574
|
|
|
|
|
|
|
/(bigserial|serial8)/i |
575
|
|
|
|
|
|
|
{ |
576
|
|
|
|
|
|
|
$return = { |
577
|
|
|
|
|
|
|
type => 'integer', |
578
|
|
|
|
|
|
|
size => 20, |
579
|
|
|
|
|
|
|
is_auto_increment => 1, |
580
|
|
|
|
|
|
|
}; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
| |
583
|
|
|
|
|
|
|
/serial4?/i |
584
|
|
|
|
|
|
|
{ |
585
|
|
|
|
|
|
|
$return = { |
586
|
|
|
|
|
|
|
type => 'integer', |
587
|
|
|
|
|
|
|
size => 11, |
588
|
|
|
|
|
|
|
is_auto_increment => 1, |
589
|
|
|
|
|
|
|
}; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
| |
592
|
|
|
|
|
|
|
/(bit varying|varbit)/i |
593
|
|
|
|
|
|
|
{ |
594
|
|
|
|
|
|
|
$return = { type => 'varbit' }; |
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
| |
597
|
|
|
|
|
|
|
/character varying/i |
598
|
|
|
|
|
|
|
{ |
599
|
|
|
|
|
|
|
$return = { type => 'varchar' }; |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
| |
602
|
|
|
|
|
|
|
/char(acter)?/i |
603
|
|
|
|
|
|
|
{ |
604
|
|
|
|
|
|
|
$return = { type => 'char' }; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
| |
607
|
|
|
|
|
|
|
/bool(ean)?/i |
608
|
|
|
|
|
|
|
{ |
609
|
|
|
|
|
|
|
$return = { type => 'boolean' }; |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
| |
612
|
|
|
|
|
|
|
/bytea/i |
613
|
|
|
|
|
|
|
{ |
614
|
|
|
|
|
|
|
$return = { type => 'bytea' }; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
| |
617
|
|
|
|
|
|
|
/ ( timestamp (?:tz)? ) (?: \( \d \) )? ( \s with (?:out)? \s time \s zone )? /ix |
618
|
|
|
|
|
|
|
{ |
619
|
|
|
|
|
|
|
$return = { type => 'timestamp' . ($2||'') }; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
| |
622
|
|
|
|
|
|
|
/ ( time (?:tz)? ) (?: \( \d \) )? ( \s with (?:out)? \s time \s zone )? /ix |
623
|
|
|
|
|
|
|
{ |
624
|
|
|
|
|
|
|
$return = { type => 'time' . ($2||'') }; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
| |
627
|
|
|
|
|
|
|
/text/i |
628
|
|
|
|
|
|
|
{ |
629
|
|
|
|
|
|
|
$return = { |
630
|
|
|
|
|
|
|
type => 'text', |
631
|
|
|
|
|
|
|
size => 64_000, |
632
|
|
|
|
|
|
|
}; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
| |
635
|
|
|
|
|
|
|
/(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|varchar|json|hstore|uuid)/i |
636
|
|
|
|
|
|
|
{ |
637
|
|
|
|
|
|
|
$return = { type => $item[1] }; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
parens_value_list : '(' VALUE(s /,/) ')' |
641
|
|
|
|
|
|
|
{ $item[2] } |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
parens_word_list : '(' NAME(s /,/) ')' |
645
|
|
|
|
|
|
|
{ $item[2] } |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
field_size : '(' num_range ')' { $item{'num_range'} } |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
num_range : DIGITS ',' DIGITS |
650
|
|
|
|
|
|
|
{ $return = $item[1].','.$item[3] } |
651
|
|
|
|
|
|
|
| DIGITS |
652
|
|
|
|
|
|
|
{ $return = $item[1] } |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?) |
655
|
|
|
|
|
|
|
{ |
656
|
|
|
|
|
|
|
my $desc = $item{'table_constraint_type'}; |
657
|
|
|
|
|
|
|
my $type = $desc->{'type'}; |
658
|
|
|
|
|
|
|
my $fields = $desc->{'fields'}; |
659
|
|
|
|
|
|
|
my $expression = $desc->{'expression'}; |
660
|
|
|
|
|
|
|
my @comments = ( @{ $item[1] }, @{ $item[-1] } ); |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
$return = { |
663
|
|
|
|
|
|
|
name => $item[2][0] || '', |
664
|
|
|
|
|
|
|
supertype => 'constraint', |
665
|
|
|
|
|
|
|
type => $type, |
666
|
|
|
|
|
|
|
fields => $type ne 'check' ? $fields : [], |
667
|
|
|
|
|
|
|
expression => $type eq 'check' ? $expression : '', |
668
|
|
|
|
|
|
|
deferrable => $item{'deferrable'}, |
669
|
|
|
|
|
|
|
deferred => $item{'deferred'}, |
670
|
|
|
|
|
|
|
reference_table => $desc->{'reference_table'}, |
671
|
|
|
|
|
|
|
reference_fields => $desc->{'reference_fields'}, |
672
|
|
|
|
|
|
|
match_type => $desc->{'match_type'}, |
673
|
|
|
|
|
|
|
on_delete => $desc->{'on_delete'} || $desc->{'on_delete_do'}, |
674
|
|
|
|
|
|
|
on_update => $desc->{'on_update'} || $desc->{'on_update_do'}, |
675
|
|
|
|
|
|
|
comments => [ @comments ], |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
table_constraint_type : /primary key/i '(' NAME(s /,/) ')' |
680
|
|
|
|
|
|
|
{ |
681
|
|
|
|
|
|
|
$return = { |
682
|
|
|
|
|
|
|
type => 'primary_key', |
683
|
|
|
|
|
|
|
fields => $item[3], |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
| |
687
|
|
|
|
|
|
|
/unique/i '(' NAME(s /,/) ')' |
688
|
|
|
|
|
|
|
{ |
689
|
|
|
|
|
|
|
$return = { |
690
|
|
|
|
|
|
|
type => 'unique', |
691
|
|
|
|
|
|
|
fields => $item[3], |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
| |
695
|
|
|
|
|
|
|
/check/i '(' /[^)]+/ ')' |
696
|
|
|
|
|
|
|
{ |
697
|
|
|
|
|
|
|
$return = { |
698
|
|
|
|
|
|
|
type => 'check', |
699
|
|
|
|
|
|
|
expression => $item[3], |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
| |
703
|
|
|
|
|
|
|
/foreign key/i '(' NAME(s /,/) ')' /references/i table_id parens_word_list(?) match_type(?) key_action(s?) |
704
|
|
|
|
|
|
|
{ |
705
|
|
|
|
|
|
|
my ( $on_delete, $on_update ); |
706
|
|
|
|
|
|
|
for my $action ( @{ $item[9] || [] } ) { |
707
|
|
|
|
|
|
|
$on_delete = $action->{'action'} if $action->{'type'} eq 'delete'; |
708
|
|
|
|
|
|
|
$on_update = $action->{'action'} if $action->{'type'} eq 'update'; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
$return = { |
712
|
|
|
|
|
|
|
supertype => 'constraint', |
713
|
|
|
|
|
|
|
type => 'foreign_key', |
714
|
|
|
|
|
|
|
fields => $item[3], |
715
|
|
|
|
|
|
|
reference_table => $item[6]->{'table_name'}, |
716
|
|
|
|
|
|
|
reference_fields => $item[7][0], |
717
|
|
|
|
|
|
|
match_type => $item[8][0], |
718
|
|
|
|
|
|
|
on_delete => $on_delete || '', |
719
|
|
|
|
|
|
|
on_update => $on_update || '', |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
deferrable : not(?) /deferrable/i |
724
|
|
|
|
|
|
|
{ |
725
|
|
|
|
|
|
|
$return = ( $item[1] =~ /not/i ) ? 0 : 1; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
deferred : /initially/i /(deferred|immediate)/i { $item[2] } |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
match_type : /match/i /partial|full|simple/i { $item[2] } |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
key_action : key_delete |
733
|
|
|
|
|
|
|
| |
734
|
|
|
|
|
|
|
key_update |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
key_delete : /on delete/i key_mutation |
737
|
|
|
|
|
|
|
{ |
738
|
|
|
|
|
|
|
$return = { |
739
|
|
|
|
|
|
|
type => 'delete', |
740
|
|
|
|
|
|
|
action => $item[2], |
741
|
|
|
|
|
|
|
}; |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
key_update : /on update/i key_mutation |
745
|
|
|
|
|
|
|
{ |
746
|
|
|
|
|
|
|
$return = { |
747
|
|
|
|
|
|
|
type => 'update', |
748
|
|
|
|
|
|
|
action => $item[2], |
749
|
|
|
|
|
|
|
}; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
key_mutation : /no action/i { $return = 'no_action' } |
753
|
|
|
|
|
|
|
| |
754
|
|
|
|
|
|
|
/restrict/i { $return = 'restrict' } |
755
|
|
|
|
|
|
|
| |
756
|
|
|
|
|
|
|
/cascade/i { $return = 'cascade' } |
757
|
|
|
|
|
|
|
| |
758
|
|
|
|
|
|
|
/set null/i { $return = 'set null' } |
759
|
|
|
|
|
|
|
| |
760
|
|
|
|
|
|
|
/set default/i { $return = 'set default' } |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
alter : alter_table table_id add_column field ';' |
763
|
|
|
|
|
|
|
{ |
764
|
|
|
|
|
|
|
my $field_def = $item[4]; |
765
|
|
|
|
|
|
|
$tables{ $item[2]->{'table_name'} }{'fields'}{ $field_def->{'name'} } = { |
766
|
|
|
|
|
|
|
%$field_def, order => $field_order++ |
767
|
|
|
|
|
|
|
}; |
768
|
|
|
|
|
|
|
1; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
alter : alter_table table_id ADD table_constraint ';' |
772
|
|
|
|
|
|
|
{ |
773
|
|
|
|
|
|
|
my $table_name = $item[2]->{'table_name'}; |
774
|
|
|
|
|
|
|
my $constraint = $item[4]; |
775
|
|
|
|
|
|
|
push @{ $tables{ $table_name }{'constraints'} }, $constraint; |
776
|
|
|
|
|
|
|
1; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
alter : alter_table table_id drop_column NAME restrict_or_cascade(?) ';' |
780
|
|
|
|
|
|
|
{ |
781
|
|
|
|
|
|
|
$tables{ $item[2]->{'table_name'} }{'fields'}{ $item[4] }{'drop'} = 1; |
782
|
|
|
|
|
|
|
1; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
alter : alter_table table_id alter_column NAME alter_default_val ';' |
786
|
|
|
|
|
|
|
{ |
787
|
|
|
|
|
|
|
$tables{ $item[2]->{'table_name'} }{'fields'}{ $item[4] }{'default'} = |
788
|
|
|
|
|
|
|
$item[5]->{'value'}; |
789
|
|
|
|
|
|
|
1; |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# |
793
|
|
|
|
|
|
|
# These will just parse for now but won't affect the structure. - ky |
794
|
|
|
|
|
|
|
# |
795
|
|
|
|
|
|
|
alter : alter_table table_id /rename/i /to/i NAME ';' |
796
|
|
|
|
|
|
|
{ 1 } |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
alter : alter_table table_id alter_column NAME SET /statistics/i INTEGER ';' |
799
|
|
|
|
|
|
|
{ 1 } |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
alter : alter_table table_id alter_column NAME SET /storage/i storage_type ';' |
802
|
|
|
|
|
|
|
{ 1 } |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
alter : alter_table table_id rename_column NAME /to/i NAME ';' |
805
|
|
|
|
|
|
|
{ 1 } |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
alter : alter_table table_id DROP /constraint/i NAME restrict_or_cascade ';' |
808
|
|
|
|
|
|
|
{ 1 } |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
alter : alter_table table_id /owner/i /to/i NAME ';' |
811
|
|
|
|
|
|
|
{ 1 } |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
alter : alter_sequence NAME /owned/i /by/i column_name ';' |
814
|
|
|
|
|
|
|
{ 1 } |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
storage_type : /(plain|external|extended|main)/i |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
temporary : /temp(orary)?\b/i |
819
|
|
|
|
|
|
|
{ |
820
|
|
|
|
|
|
|
1; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
or_replace : /or replace/i |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
alter_default_val : SET default_val |
826
|
|
|
|
|
|
|
{ |
827
|
|
|
|
|
|
|
$return = { value => $item[2]->{'value'} } |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
| DROP DEFAULT |
830
|
|
|
|
|
|
|
{ |
831
|
|
|
|
|
|
|
$return = { value => undef } |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
# |
835
|
|
|
|
|
|
|
# This is a little tricky to get right, at least WRT to making the |
836
|
|
|
|
|
|
|
# tests pass. The problem is that the constraints are stored just as |
837
|
|
|
|
|
|
|
# a list (no name access), and the tests expect the constraints in a |
838
|
|
|
|
|
|
|
# particular order. I'm going to leave the rule but disable the code |
839
|
|
|
|
|
|
|
# for now. - ky |
840
|
|
|
|
|
|
|
# |
841
|
|
|
|
|
|
|
alter : alter_table table_id alter_column NAME alter_nullable ';' |
842
|
|
|
|
|
|
|
{ |
843
|
|
|
|
|
|
|
# my $table_name = $item[2]->{'table_name'}; |
844
|
|
|
|
|
|
|
# my $field_name = $item[4]; |
845
|
|
|
|
|
|
|
# my $is_nullable = $item[5]->{'is_nullable'}; |
846
|
|
|
|
|
|
|
# |
847
|
|
|
|
|
|
|
# $tables{ $table_name }{'fields'}{ $field_name }{'is_nullable'} = |
848
|
|
|
|
|
|
|
# $is_nullable; |
849
|
|
|
|
|
|
|
# |
850
|
|
|
|
|
|
|
# if ( $is_nullable ) { |
851
|
|
|
|
|
|
|
# 1; |
852
|
|
|
|
|
|
|
# push @{ $tables{ $table_name }{'constraints'} }, { |
853
|
|
|
|
|
|
|
# type => 'not_null', |
854
|
|
|
|
|
|
|
# fields => [ $field_name ], |
855
|
|
|
|
|
|
|
# }; |
856
|
|
|
|
|
|
|
# } |
857
|
|
|
|
|
|
|
# else { |
858
|
|
|
|
|
|
|
# for my $i ( |
859
|
|
|
|
|
|
|
# 0 .. $#{ $tables{ $table_name }{'constraints'} || [] } |
860
|
|
|
|
|
|
|
# ) { |
861
|
|
|
|
|
|
|
# my $c = $tables{ $table_name }{'constraints'}[ $i ] or next; |
862
|
|
|
|
|
|
|
# my $fields = join( '', @{ $c->{'fields'} || [] } ) or next; |
863
|
|
|
|
|
|
|
# if ( $c->{'type'} eq 'not_null' && $fields eq $field_name ) { |
864
|
|
|
|
|
|
|
# delete $tables{ $table_name }{'constraints'}[ $i ]; |
865
|
|
|
|
|
|
|
# last; |
866
|
|
|
|
|
|
|
# } |
867
|
|
|
|
|
|
|
# } |
868
|
|
|
|
|
|
|
# } |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
1; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
alter_nullable : SET not_null |
874
|
|
|
|
|
|
|
{ |
875
|
|
|
|
|
|
|
$return = { is_nullable => 0 } |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
| DROP not_null |
878
|
|
|
|
|
|
|
{ |
879
|
|
|
|
|
|
|
$return = { is_nullable => 1 } |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
not_null : /not/i /null/i |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
not : /not/i |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
add_column : ADD COLUMN(?) |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
alter_table : ALTER TABLE ONLY(?) |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
alter_sequence : ALTER SEQUENCE |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
drop_column : DROP COLUMN(?) |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
alter_column : ALTER COLUMN(?) |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
rename_column : /rename/i COLUMN(?) |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
restrict_or_cascade : /restrict/i | |
899
|
|
|
|
|
|
|
/cascade/i |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
# Handle functions that can be called |
902
|
|
|
|
|
|
|
select : SELECT select_function ';' |
903
|
|
|
|
|
|
|
{ 1 } |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
# Read the setval function but don't do anything with it because this parser |
906
|
|
|
|
|
|
|
# isn't handling sequences |
907
|
|
|
|
|
|
|
select_function : schema_qualification(?) /setval/i '(' VALUE /,/ VALUE /,/ /(true|false)/i ')' |
908
|
|
|
|
|
|
|
{ 1 } |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# Skipping all COPY commands |
911
|
|
|
|
|
|
|
copy : COPY WORD /[^;]+/ ';' { 1 } |
912
|
|
|
|
|
|
|
{ 1 } |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
# The "\." allows reading in from STDIN but this isn't needed for schema |
915
|
|
|
|
|
|
|
# creation, so it is skipped. |
916
|
|
|
|
|
|
|
readin_symbol : '\.' |
917
|
|
|
|
|
|
|
{1} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
# |
920
|
|
|
|
|
|
|
# End basically useless stuff. - ky |
921
|
|
|
|
|
|
|
# |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
create_table : CREATE TABLE |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
create_index : CREATE /index/i |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
default_val : DEFAULT DEFAULT_VALUE ( '::' data_type )(?) |
928
|
|
|
|
|
|
|
{ |
929
|
|
|
|
|
|
|
my $val = $item[2]; |
930
|
|
|
|
|
|
|
$val =~ s/^\((\d+)\)\z/$1/; # for example (0)::smallint |
931
|
|
|
|
|
|
|
$return = { |
932
|
|
|
|
|
|
|
supertype => 'constraint', |
933
|
|
|
|
|
|
|
type => 'default', |
934
|
|
|
|
|
|
|
value => $val, |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
| /null/i |
938
|
|
|
|
|
|
|
{ |
939
|
|
|
|
|
|
|
$return = { |
940
|
|
|
|
|
|
|
supertype => 'constraint', |
941
|
|
|
|
|
|
|
type => 'default', |
942
|
|
|
|
|
|
|
value => 'NULL', |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
DEFAULT_VALUE : VALUE |
947
|
|
|
|
|
|
|
| /\w+\(.*\)/ |
948
|
|
|
|
|
|
|
| /\w+/ |
949
|
|
|
|
|
|
|
| /\(\d+\)/ |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
name_with_opt_paren : NAME parens_value_list(s?) |
952
|
|
|
|
|
|
|
{ $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] } |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
unique : /unique/i { 1 } |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
key : /key/i | /index/i |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
table_option : /inherits/i '(' NAME(s /,/) ')' |
959
|
|
|
|
|
|
|
{ |
960
|
|
|
|
|
|
|
$return = { type => 'inherits', table_name => $item[3] } |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
| |
963
|
|
|
|
|
|
|
/with(out)? oids/i |
964
|
|
|
|
|
|
|
{ |
965
|
|
|
|
|
|
|
$return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' } |
966
|
|
|
|
|
|
|
} |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
ADD : /add/i |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
ALTER : /alter/i |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
CREATE : /create/i |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
ONLY : /only/i |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
DEFAULT : /default/i |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
DROP : /drop/i |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
COLUMN : /column/i |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
TABLE : /table/i |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
VIEW : /view/i |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
SCHEMA : /schema/i |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
SEMICOLON : /\s*;\n?/ |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
SEQUENCE : /sequence/i |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
SELECT : /select/i |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
COPY : /copy/i |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
INTEGER : /\d+/ |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
WORD : /\w+/ |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
DIGITS : /\d+/ |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
COMMA : ',' |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
SET : /set/i |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
NAME : DQSTRING |
1007
|
|
|
|
|
|
|
| /\w+/ |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
DQSTRING : '"' /((?:[^"]|"")+)/ '"' |
1010
|
|
|
|
|
|
|
{ ($return = $item[3]) =~ s/""/"/g; } |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
SQSTRING : "'" /((?:[^']|'')*)/ "'" |
1013
|
|
|
|
|
|
|
{ ($return = $item[3]) =~ s/''/'/g } |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
DOLLARSTRING : /\$[^\$]*\$/ /.*?(?=\Q$item[1]\E)/s "$item[1]" |
1016
|
|
|
|
|
|
|
{ $return = $item[3]; } |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/ |
1019
|
|
|
|
|
|
|
| SQSTRING |
1020
|
|
|
|
|
|
|
| DOLLARSTRING |
1021
|
|
|
|
|
|
|
| /null/i |
1022
|
|
|
|
|
|
|
{ 'NULL' } |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
END_OF_GRAMMAR |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
sub parse { |
1027
|
3
|
|
|
3
|
0
|
48
|
my ( $translator, $data ) = @_; |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
# Enable warnings within the Parse::RecDescent module. |
1030
|
3
|
100
|
|
|
|
18
|
local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error |
1031
|
3
|
100
|
|
|
|
15
|
local $::RD_WARN = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c. |
1032
|
3
|
50
|
|
|
|
13
|
local $::RD_HINT = 1 unless defined $::RD_HINT; # Give out hints to help fix problems. |
1033
|
|
|
|
|
|
|
|
1034
|
3
|
50
|
|
|
|
62
|
local $::RD_TRACE = $translator->trace ? 1 : undef; |
1035
|
3
|
|
|
|
|
54
|
local $DEBUG = $translator->debug; |
1036
|
|
|
|
|
|
|
|
1037
|
3
|
|
|
|
|
51
|
my $parser = ddl_parser_instance('PostgreSQL'); |
1038
|
|
|
|
|
|
|
|
1039
|
3
|
|
|
|
|
2662164
|
my $result = $parser->startrule($data); |
1040
|
3
|
50
|
|
|
|
1384336
|
die "Parse failed.\n" unless defined $result; |
1041
|
3
|
50
|
|
|
|
18
|
warn Dumper($result) if $DEBUG; |
1042
|
|
|
|
|
|
|
|
1043
|
3
|
|
|
|
|
97
|
my $schema = $translator->schema; |
1044
|
|
|
|
|
|
|
my @tables = sort { |
1045
|
25
|
|
50
|
|
|
198
|
( $result->{tables}{ $a }{'order'} || 0 ) <=> ( $result->{tables}{ $b }{'order'} || 0 ) |
|
|
|
50
|
|
|
|
|
1046
|
3
|
|
|
|
|
231
|
} keys %{ $result->{tables} }; |
|
3
|
|
|
|
|
32
|
|
1047
|
|
|
|
|
|
|
|
1048
|
3
|
|
|
|
|
16
|
for my $table_name ( @tables ) { |
1049
|
15
|
|
|
|
|
49
|
my $tdata = $result->{tables}{ $table_name }; |
1050
|
|
|
|
|
|
|
my $table = $schema->add_table( |
1051
|
|
|
|
|
|
|
#schema => $tdata->{'schema_name'}, |
1052
|
15
|
50
|
|
|
|
85
|
name => $tdata->{'table_name'}, |
1053
|
|
|
|
|
|
|
) or die "Couldn't create table '$table_name': " . $schema->error; |
1054
|
|
|
|
|
|
|
|
1055
|
15
|
100
|
|
|
|
393
|
$table->extra(temporary => 1) if $tdata->{'temporary'}; |
1056
|
|
|
|
|
|
|
|
1057
|
15
|
|
|
|
|
344
|
$table->comments( $tdata->{'comments'} ); |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
my @fields = sort { |
1060
|
|
|
|
|
|
|
$tdata->{'fields'}{ $a }{'order'} |
1061
|
|
|
|
|
|
|
<=> |
1062
|
141
|
|
|
|
|
358
|
$tdata->{'fields'}{ $b }{'order'} |
1063
|
15
|
|
|
|
|
36
|
} keys %{ $tdata->{'fields'} }; |
|
15
|
|
|
|
|
119
|
|
1064
|
|
|
|
|
|
|
|
1065
|
15
|
|
|
|
|
40
|
for my $fname ( @fields ) { |
1066
|
72
|
|
|
|
|
177
|
my $fdata = $tdata->{'fields'}{ $fname }; |
1067
|
72
|
100
|
|
|
|
189
|
next if $fdata->{'drop'}; |
1068
|
|
|
|
|
|
|
my $field = $table->add_field( |
1069
|
|
|
|
|
|
|
name => $fdata->{'name'}, |
1070
|
|
|
|
|
|
|
data_type => $fdata->{'data_type'}, |
1071
|
|
|
|
|
|
|
size => $fdata->{'size'}, |
1072
|
|
|
|
|
|
|
default_value => $fdata->{'default'}, |
1073
|
|
|
|
|
|
|
is_auto_increment => $fdata->{'is_auto_increment'}, |
1074
|
|
|
|
|
|
|
is_nullable => $fdata->{'is_nullable'}, |
1075
|
71
|
50
|
|
|
|
386
|
comments => $fdata->{'comments'}, |
1076
|
|
|
|
|
|
|
) or die $table->error; |
1077
|
|
|
|
|
|
|
|
1078
|
71
|
100
|
|
|
|
1555
|
$table->primary_key( $field->name ) if $fdata->{'is_primary_key'}; |
1079
|
|
|
|
|
|
|
|
1080
|
71
|
|
|
|
|
118
|
for my $cdata ( @{ $fdata->{'constraints'} } ) { |
|
71
|
|
|
|
|
273
|
|
1081
|
29
|
100
|
|
|
|
143
|
next unless $cdata->{'type'} eq 'foreign_key'; |
1082
|
1
|
|
50
|
|
|
5
|
$cdata->{'fields'} ||= [ $field->name ]; |
1083
|
1
|
|
|
|
|
2
|
push @{ $tdata->{'constraints'} }, $cdata; |
|
1
|
|
|
|
|
6
|
|
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
15
|
100
|
|
|
|
31
|
for my $idata ( @{ $tdata->{'indices'} || [] } ) { |
|
15
|
|
|
|
|
89
|
|
1088
|
14
|
|
|
|
|
35
|
my @options = (); |
1089
|
14
|
100
|
|
|
|
65
|
push @options, { using => $idata->{'method'} } if $idata->{method}; |
1090
|
14
|
100
|
|
|
|
42
|
push @options, { where => $idata->{'where'} } if $idata->{where}; |
1091
|
|
|
|
|
|
|
my $index = $table->add_index( |
1092
|
|
|
|
|
|
|
name => $idata->{'name'}, |
1093
|
|
|
|
|
|
|
type => uc $idata->{'type'}, |
1094
|
14
|
50
|
|
|
|
98
|
fields => $idata->{'fields'}, |
1095
|
|
|
|
|
|
|
options => \@options |
1096
|
|
|
|
|
|
|
) or die $table->error . ' ' . $table->name; |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
|
1099
|
15
|
100
|
|
|
|
36
|
for my $cdata ( @{ $tdata->{'constraints'} || [] } ) { |
|
15
|
|
|
|
|
71
|
|
1100
|
|
|
|
|
|
|
my $constraint = $table->add_constraint( |
1101
|
|
|
|
|
|
|
name => $cdata->{'name'}, |
1102
|
|
|
|
|
|
|
type => $cdata->{'type'}, |
1103
|
|
|
|
|
|
|
fields => $cdata->{'fields'}, |
1104
|
|
|
|
|
|
|
reference_table => $cdata->{'reference_table'}, |
1105
|
|
|
|
|
|
|
reference_fields => $cdata->{'reference_fields'}, |
1106
|
|
|
|
|
|
|
match_type => $cdata->{'match_type'} || '', |
1107
|
|
|
|
|
|
|
on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'}, |
1108
|
|
|
|
|
|
|
on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'}, |
1109
|
|
|
|
|
|
|
expression => $cdata->{'expression'}, |
1110
|
|
|
|
|
|
|
) or die "Can't add constraint of type '" . |
1111
|
62
|
50
|
100
|
|
|
782
|
$cdata->{'type'} . "' to table '" . $table->name . |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
1112
|
|
|
|
|
|
|
"': " . $table->error; |
1113
|
|
|
|
|
|
|
} |
1114
|
|
|
|
|
|
|
} |
1115
|
|
|
|
|
|
|
|
1116
|
3
|
|
|
|
|
8
|
for my $vinfo (@{$result->{views}}) { |
|
3
|
|
|
|
|
14
|
|
1117
|
1
|
|
|
|
|
3
|
my $sql = $vinfo->{sql}; |
1118
|
1
|
|
|
|
|
13
|
$sql =~ s/\A\s+|\s+\z//g; |
1119
|
|
|
|
|
|
|
my $view = $schema->add_view ( |
1120
|
|
|
|
|
|
|
name => $vinfo->{view_name}, |
1121
|
|
|
|
|
|
|
sql => $sql, |
1122
|
|
|
|
|
|
|
fields => $vinfo->{fields}, |
1123
|
1
|
|
|
|
|
9
|
); |
1124
|
|
|
|
|
|
|
|
1125
|
1
|
50
|
|
|
|
6
|
$view->extra ( temporary => 1 ) if $vinfo->{is_temporary}; |
1126
|
|
|
|
|
|
|
} |
1127
|
|
|
|
|
|
|
|
1128
|
3
|
|
|
|
|
9
|
for my $trigger (@{ $result->{triggers} }) { |
|
3
|
|
|
|
|
12
|
|
1129
|
4
|
|
|
|
|
28
|
$schema->add_trigger( %$trigger ); |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
|
1132
|
3
|
|
|
|
|
40
|
return 1; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
1; |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1138
|
|
|
|
|
|
|
# Rescue the drowning and tie your shoestrings. |
1139
|
|
|
|
|
|
|
# Henry David Thoreau |
1140
|
|
|
|
|
|
|
# ------------------------------------------------------------------- |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=pod |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=head1 AUTHORS |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
Ken Y. Clark Ekclark@cpan.orgE, |
1147
|
|
|
|
|
|
|
Allen Day Eallenday@ucla.eduE. |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=head1 SEE ALSO |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
perl(1), Parse::RecDescent. |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=cut |