changes to allow subclass tables identical to superclass
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
CommitLineData
84012a55 1package SQL::Translator::Parser::PostgreSQL;
4422e22a 2
3# -------------------------------------------------------------------
c7ea1132 4# $Id: PostgreSQL.pm,v 1.45 2005-07-06 05:37:32 allenday Exp $
4422e22a 5# -------------------------------------------------------------------
90075866 6# Copyright (C) 2002-4 SQLFairy Authors
4422e22a 7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU General Public License as
10# published by the Free Software Foundation; version 2.
11#
12# This program is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15# General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
0efb6e1b 19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
4422e22a 20# 02111-1307 USA
21# -------------------------------------------------------------------
22
23=head1 NAME
24
84012a55 25SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
4422e22a 26
27=head1 SYNOPSIS
28
29 use SQL::Translator;
84012a55 30 use SQL::Translator::Parser::PostgreSQL;
4422e22a 31
32 my $translator = SQL::Translator->new;
84012a55 33 $translator->parser("SQL::Translator::Parser::PostgreSQL");
4422e22a 34
35=head1 DESCRIPTION
36
0efb6e1b 37The grammar was started from the MySQL parsers. Here is the description
38from PostgreSQL:
39
40Table:
629b76f9 41(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createtable.html)
42
43 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
44 { column_name data_type [ DEFAULT default_expr ]
45 [ column_constraint [, ... ] ]
46 | table_constraint } [, ... ]
47 )
48 [ INHERITS ( parent_table [, ... ] ) ]
49 [ WITH OIDS | WITHOUT OIDS ]
50
51 where column_constraint is:
52
53 [ CONSTRAINT constraint_name ]
54 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
55 CHECK (expression) |
56 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
57 [ ON DELETE action ] [ ON UPDATE action ] }
58 [ DEFERRABLE | NOT DEFERRABLE ]
59 [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
60
61 and table_constraint is:
62
63 [ CONSTRAINT constraint_name ]
64 { UNIQUE ( column_name [, ... ] ) |
65 PRIMARY KEY ( column_name [, ... ] ) |
66 CHECK ( expression ) |
67 FOREIGN KEY ( column_name [, ... ] )
68 REFERENCES reftable [ ( refcolumn [, ... ] ) ]
69 [ MATCH FULL | MATCH PARTIAL ]
70 [ ON DELETE action ] [ ON UPDATE action ] }
71 [ DEFERRABLE | NOT DEFERRABLE ]
72 [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
0efb6e1b 73
74Index:
629b76f9 75(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createindex.html)
0efb6e1b 76
629b76f9 77 CREATE [ UNIQUE ] INDEX index_name ON table
78 [ USING acc_method ] ( column [ ops_name ] [, ...] )
79 [ WHERE predicate ]
80 CREATE [ UNIQUE ] INDEX index_name ON table
81 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
82 [ WHERE predicate ]
4422e22a 83
0012a163 84Alter table:
85
86 ALTER TABLE [ ONLY ] table [ * ]
87 ADD [ COLUMN ] column type [ column_constraint [ ... ] ]
88 ALTER TABLE [ ONLY ] table [ * ]
89 ALTER [ COLUMN ] column { SET DEFAULT value | DROP DEFAULT }
90 ALTER TABLE [ ONLY ] table [ * ]
91 ALTER [ COLUMN ] column SET STATISTICS integer
92 ALTER TABLE [ ONLY ] table [ * ]
93 RENAME [ COLUMN ] column TO newcolumn
94 ALTER TABLE table
95 RENAME TO new_table
96 ALTER TABLE table
97 ADD table_constraint_definition
98 ALTER TABLE [ ONLY ] table
99 DROP CONSTRAINT constraint { RESTRICT | CASCADE }
100 ALTER TABLE table
101 OWNER TO new_owner
102
3022f45b 103View table:
104
105 CREATE [ OR REPLACE ] VIEW view [ ( column name list ) ] AS SELECT query
106
4422e22a 107=cut
108
109use strict;
110use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
c7ea1132 111$VERSION = sprintf "%d.%02d", q$Revision: 1.45 $ =~ /(\d+)\.(\d+)/;
4422e22a 112$DEBUG = 0 unless defined $DEBUG;
113
114use Data::Dumper;
115use Parse::RecDescent;
116use Exporter;
117use base qw(Exporter);
118
119@EXPORT_OK = qw(parse);
120
121# Enable warnings within the Parse::RecDescent module.
122$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
123$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
124$::RD_HINT = 1; # Give out hints to help fix problems.
125
126my $parser; # should we do this? There's no programmic way to
127 # change the grammar, so I think this is safe.
128
129$GRAMMAR = q!
130
00ef67ea 131{ my ( %tables, $table_order, $field_order, @table_comments) }
4422e22a 132
629b76f9 133#
134# The "eofile" rule makes the parser fail if any "statement" rule
135# fails. Otherwise, the first successful match by a "statement"
136# won't cause the failure needed to know that the parse, as a whole,
137# failed. -ky
138#
0efb6e1b 139startrule : statement(s) eofile { \%tables }
4422e22a 140
0efb6e1b 141eofile : /^\Z/
e4a9818d 142
0efb6e1b 143
144statement : create
ac397a49 145 | comment_on_table
146 | comment_on_column
e4a9818d 147 | comment_on_other
0efb6e1b 148 | comment
0012a163 149 | alter
0efb6e1b 150 | grant
151 | revoke
4422e22a 152 | drop
4d2da1f7 153 | insert
0efb6e1b 154 | connect
4d2da1f7 155 | update
0012a163 156 | set
4422e22a 157 | <error>
158
0efb6e1b 159connect : /^\s*\\\connect.*\n/
160
f04713db 161set : /set/i /[^;]*/ ';'
0012a163 162
0d51cd9e 163revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_name /from/i name_with_opt_quotes(s /,/) ';'
0efb6e1b 164 {
165 my $table_name = $item{'table_name'};
166 push @{ $tables{ $table_name }{'permissions'} }, {
167 type => 'revoke',
168 actions => $item[2],
91c75eab 169 users => $item[7],
0efb6e1b 170 }
171 }
172
0d51cd9e 173grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_name /to/i name_with_opt_quotes(s /,/) ';'
0efb6e1b 174 {
175 my $table_name = $item{'table_name'};
176 push @{ $tables{ $table_name }{'permissions'} }, {
177 type => 'grant',
178 actions => $item[2],
91c75eab 179 users => $item[7],
0efb6e1b 180 }
181 }
182
183drop : /drop/i /[^;]*/ ';'
4422e22a 184
4d2da1f7 185insert : /insert/i /[^;]*/ ';'
186
187update : /update/i /[^;]*/ ';'
188
0012a163 189#
190# Create table.
191#
c7ea1132 192create : create_table table_name '(' create_definition(s? /,/) ')' table_option(s?) ';'
0efb6e1b 193 {
194 my $table_name = $item{'table_name'};
195 $tables{ $table_name }{'order'} = ++$table_order;
196 $tables{ $table_name }{'table_name'} = $table_name;
197
ac397a49 198 if ( @table_comments ) {
199 $tables{ $table_name }{'comments'} = [ @table_comments ];
200 @table_comments = ();
201 }
202
0efb6e1b 203 my @constraints;
204 for my $definition ( @{ $item[4] } ) {
b3384294 205 if ( $definition->{'supertype'} eq 'field' ) {
0efb6e1b 206 my $field_name = $definition->{'name'};
207 $tables{ $table_name }{'fields'}{ $field_name } =
00ef67ea 208 { %$definition, order => $field_order++ };
4422e22a 209
0138f7bb 210 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
211 $constraint->{'fields'} = [ $field_name ];
7d5bcab8 212 push @{ $tables{ $table_name }{'constraints'} },
0138f7bb 213 $constraint;
0efb6e1b 214 }
215 }
b3384294 216 elsif ( $definition->{'supertype'} eq 'constraint' ) {
217 push @{ $tables{ $table_name }{'constraints'} }, $definition;
0efb6e1b 218 }
b3384294 219 elsif ( $definition->{'supertype'} eq 'index' ) {
0efb6e1b 220 push @{ $tables{ $table_name }{'indices'} }, $definition;
221 }
222 }
223
224 for my $option ( @{ $item[6] } ) {
3022f45b 225 $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } =
0efb6e1b 226 $option;
227 }
228
229 1;
230 }
231
211e2e90 232create : CREATE unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
4422e22a 233 {
234 push @{ $tables{ $item{'table_name'} }{'indices'} },
235 {
b3384294 236 name => $item{'index_name'},
237 supertype => $item{'unique'}[0] ? 'constraint' : 'index',
238 type => $item{'unique'}[0] ? 'unique' : 'normal',
239 fields => $item[9],
240 method => $item{'using_method'}[0],
4422e22a 241 }
242 ;
ac397a49 243
4422e22a 244 }
245
0012a163 246#
211e2e90 247# Create anything else (e.g., domain, etc.)
0012a163 248#
211e2e90 249create : CREATE WORD /[^;]+/ ';'
ac397a49 250 { @table_comments = (); }
0012a163 251
0efb6e1b 252using_method : /using/i WORD { $item[2] }
253
254where_predicate : /where/i /[^;]+/
255
256create_definition : field
0efb6e1b 257 | table_constraint
4422e22a 258 | <error>
259
a82fa2cb 260comment : /^\s*(?:#|-{2})(.*)\n/
261 {
262 my $comment = $item[1];
263 $comment =~ s/^\s*(#|-*)\s*//;
264 $comment =~ s/\s*$//;
ac397a49 265 $return = $comment;
266 push @table_comments, $comment;
267 }
268
ac397a49 269comment_on_table : /comment/i /on/i /table/i table_name /is/i comment_phrase ';'
270 {
271 push @{ $tables{ $item{'table_name'} }{'comments'} }, $item{'comment_phrase'};
272 }
273
274comment_on_column : /comment/i /on/i /column/i column_name /is/i comment_phrase ';'
275 {
276 my $table_name = $item[4]->{'table'};
277 my $field_name = $item[4]->{'field'};
e1fa2c52 278 if ($tables{ $table_name }{'fields'}{ $field_name } ) {
279 push @{ $tables{ $table_name }{'fields'}{ $field_name }{'comments'} },
280 $item{'comment_phrase'};
281 }
282 else {
283 die "No such column as $table_name.$field_name";
284 }
ac397a49 285 }
286
e4a9818d 287comment_on_other : /comment/i /on/i /\w+/ /\w+/ /is/i comment_phrase ';'
288 {
289 push(@table_comments, $item{'comment_phrase'});
290 }
291
292# [added by cjm 20041019]
293# [TODO: other comment-on types]
294# for now we just have a general mechanism for handling other
295# kinds of comments than table/column; I'm not sure of the best
296# way to incorporate these into the datamodel
297#
298# this is the exhaustive list of types of comment:
299#COMMENT ON DATABASE my_database IS 'Development Database';
300#COMMENT ON INDEX my_index IS 'Enforces uniqueness on employee id';
301#COMMENT ON RULE my_rule IS 'Logs UPDATES of employee records';
302#COMMENT ON SEQUENCE my_sequence IS 'Used to generate primary keys';
303#COMMENT ON TABLE my_table IS 'Employee Information';
304#COMMENT ON TYPE my_type IS 'Complex Number support';
305#COMMENT ON VIEW my_view IS 'View of departmental costs';
306#COMMENT ON COLUMN my_table.my_field IS 'Employee ID number';
307#COMMENT ON TRIGGER my_trigger ON my_table IS 'Used for R.I.';
308#
309# this is tested by test 08
310
ac397a49 311column_name : NAME '.' NAME
312 { $return = { table => $item[1], field => $item[3] } }
313
e4a9818d 314comment_phrase : /null/i
315 { $return = 'NULL' }
316
317comment_phrase : /'/ comment_phrase_unquoted(s) /'/
318 { my $phrase = join(' ', @{ $item[2] });
319 $return = $phrase}
320
321# [cjm TODO: double-single quotes in a comment_phrase]
322comment_phrase_unquoted : /[^\']*/
323 { $return = $item[1] }
324
325
326xxxcomment_phrase : /'.*?'|NULL/
ac397a49 327 {
8e9e79dc 328 my $val = $item[1] || '';
ac397a49 329 $val =~ s/^'|'$//g;
330 $return = $val;
331 }
332
a82fa2cb 333field : field_comment(s?) field_name data_type field_meta(s?) field_comment(s?)
4422e22a 334 {
3022f45b 335 my ( $default, @constraints, $is_pk );
00ef67ea 336 my $is_nullable = 1;
41fc9cb3 337 for my $meta ( @{ $item[4] } ) {
82968eb9 338 if ( $meta->{'type'} eq 'default' ) {
339 $default = $meta;
340 next;
341 }
342 elsif ( $meta->{'type'} eq 'not_null' ) {
00ef67ea 343 $is_nullable = 0;
82968eb9 344 }
345 elsif ( $meta->{'type'} eq 'primary_key' ) {
346 $is_pk = 1;
347 }
4422e22a 348
82968eb9 349 push @constraints, $meta if $meta->{'supertype'} eq 'constraint';
350 }
0efb6e1b 351
f2f71b8e 352 my @comments = ( @{ $item[1] }, @{ $item[5] } );
353
0a7fc605 354 $return = {
b3384294 355 supertype => 'field',
7eac5e12 356 name => $item{'field_name'},
357 data_type => $item{'data_type'}{'type'},
358 size => $item{'data_type'}{'size'},
00ef67ea 359 is_nullable => $is_nullable,
7eac5e12 360 default => $default->{'value'},
361 constraints => [ @constraints ],
362 comments => [ @comments ],
363 is_primary_key => $is_pk || 0,
364 is_auto_increment => $item{'data_type'}{'is_auto_increment'},
4422e22a 365 }
366 }
367 | <error>
368
a82fa2cb 369field_comment : /^\s*(?:#|-{2})(.*)\n/
370 {
371 my $comment = $item[1];
372 $comment =~ s/^\s*(#|-*)\s*//;
373 $comment =~ s/\s*$//;
374 $return = $comment;
375 }
376
0efb6e1b 377field_meta : default_val
82968eb9 378 | column_constraint
4422e22a 379
0efb6e1b 380column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
381 {
382 my $desc = $item{'column_constraint_type'};
383 my $type = $desc->{'type'};
384 my $fields = $desc->{'fields'} || [];
385 my $expression = $desc->{'expression'} || '';
386
387 $return = {
82968eb9 388 supertype => 'constraint',
0efb6e1b 389 name => $item{'constraint_name'}[0] || '',
390 type => $type,
391 expression => $type eq 'check' ? $expression : '',
f04713db 392 deferrable => $item{'deferrable'},
0efb6e1b 393 deferred => $item{'deferred'},
394 reference_table => $desc->{'reference_table'},
395 reference_fields => $desc->{'reference_fields'},
396 match_type => $desc->{'match_type'},
100684f3 397 on_delete => $desc->{'on_delete'} || $desc->{'on_delete_do'},
398 on_update => $desc->{'on_update'} || $desc->{'on_update_do'},
4422e22a 399 }
400 }
401
0efb6e1b 402constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
403
404column_constraint_type : /not null/i { $return = { type => 'not_null' } }
405 |
f04713db 406 /null/i
0efb6e1b 407 { $return = { type => 'null' } }
408 |
f04713db 409 /unique/i
0efb6e1b 410 { $return = { type => 'unique' } }
411 |
412 /primary key/i
413 { $return = { type => 'primary_key' } }
414 |
415 /check/i '(' /[^)]+/ ')'
b3384294 416 { $return = { type => 'check', expression => $item[3] } }
0efb6e1b 417 |
3022f45b 418 /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 419 {
3022f45b 420 my ( $on_delete, $on_update );
421 for my $action ( @{ $item[5] || [] } ) {
422 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
423 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
424 }
425
0efb6e1b 426 $return = {
427 type => 'foreign_key',
428 reference_table => $item[2],
0138f7bb 429 reference_fields => $item[3][0],
0efb6e1b 430 match_type => $item[4][0],
100684f3 431 on_delete => $on_delete,
432 on_update => $on_update,
ba1a1626 433 }
4422e22a 434 }
435
0efb6e1b 436table_name : name_with_opt_quotes
4422e22a 437
0efb6e1b 438field_name : name_with_opt_quotes
4422e22a 439
0012a163 440name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
4422e22a 441
0efb6e1b 442double_quote: /"/
4422e22a 443
0efb6e1b 444index_name : WORD
4422e22a 445
0efb6e1b 446data_type : pg_data_type parens_value_list(?)
4422e22a 447 {
3022f45b 448 my $data_type = $item[1];
ba1a1626 449
0efb6e1b 450 #
451 # We can deduce some sizes from the data type's name.
452 #
44ffdb73 453 if ( my $size = $item[2][0] ) {
454 $data_type->{'size'} = $size;
455 }
4422e22a 456
3022f45b 457 $return = $data_type;
4422e22a 458 }
459
0efb6e1b 460pg_data_type :
50840472 461 /(bigint|int8)/i
3022f45b 462 {
463 $return = {
50840472 464 type => 'integer',
b8ea6076 465 size => 20,
3022f45b 466 };
467 }
0efb6e1b 468 |
1bbd4a2b 469 /(smallint|int2)/i
3022f45b 470 {
471 $return = {
472 type => 'integer',
b8ea6076 473 size => 5,
3022f45b 474 };
475 }
0efb6e1b 476 |
c4c363bb 477 /interval/i
478 {
479 $return = { type => 'interval' };
480 }
481 |
50840472 482 /(integer|int4?)/i # interval must come before this
3022f45b 483 {
484 $return = {
485 type => 'integer',
b8ea6076 486 size => 10,
3022f45b 487 };
488 }
50840472 489 |
490 /(real|float4)/i
491 {
492 $return = {
493 type => 'real',
b8ea6076 494 size => 10,
50840472 495 };
496 }
0efb6e1b 497 |
1bbd4a2b 498 /(double precision|float8?)/i
3022f45b 499 {
500 $return = {
501 type => 'float',
b8ea6076 502 size => 20,
3022f45b 503 };
504 }
0efb6e1b 505 |
50840472 506 /(bigserial|serial8)/i
3022f45b 507 {
50840472 508 $return = {
7eac5e12 509 type => 'integer',
b8ea6076 510 size => 20,
7eac5e12 511 is_auto_increment => 1,
3022f45b 512 };
513 }
0efb6e1b 514 |
1bbd4a2b 515 /serial4?/i
3022f45b 516 {
517 $return = {
7eac5e12 518 type => 'integer',
b8ea6076 519 size => 11,
7eac5e12 520 is_auto_increment => 1,
3022f45b 521 };
522 }
0efb6e1b 523 |
1bbd4a2b 524 /(bit varying|varbit)/i
3022f45b 525 {
526 $return = { type => 'varbit' };
527 }
0efb6e1b 528 |
1bbd4a2b 529 /character varying/i
3022f45b 530 {
531 $return = { type => 'varchar' };
532 }
0efb6e1b 533 |
1bbd4a2b 534 /char(acter)?/i
3022f45b 535 {
536 $return = { type => 'char' };
537 }
0efb6e1b 538 |
1bbd4a2b 539 /bool(ean)?/i
3022f45b 540 {
541 $return = { type => 'boolean' };
542 }
0efb6e1b 543 |
1bbd4a2b 544 /bytea/i
3022f45b 545 {
82968eb9 546 $return = { type => 'bytea' };
3022f45b 547 }
0efb6e1b 548 |
c4c363bb 549 /(timestamptz|timestamp)( with time zone)?/i
550 {
551 $return = { type => 'timestamp' };
552 }
553 |
429f639c 554 /(timestamptz|timestamp)( without time zone)?/i
3022f45b 555 {
556 $return = { type => 'timestamp' };
557 }
0efb6e1b 558 |
38a6a4f9 559 /text/i
560 {
561 $return = {
562 type => 'text',
563 size => 64_000,
564 };
565 }
566 |
c4c363bb 567 /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|timetz|time|varchar)/i
3022f45b 568 {
569 $return = { type => $item[1] };
570 }
0efb6e1b 571
4422e22a 572parens_value_list : '(' VALUE(s /,/) ')'
573 { $item[2] }
574
0efb6e1b 575parens_word_list : '(' WORD(s /,/) ')'
576 { $item[2] }
4422e22a 577
0efb6e1b 578field_size : '(' num_range ')' { $item{'num_range'} }
4422e22a 579
0efb6e1b 580num_range : DIGITS ',' DIGITS
4422e22a 581 { $return = $item[1].','.$item[3] }
582 | DIGITS
583 { $return = $item[1] }
584
f2f71b8e 585table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
0efb6e1b 586 {
587 my $desc = $item{'table_constraint_type'};
588 my $type = $desc->{'type'};
589 my $fields = $desc->{'fields'};
590 my $expression = $desc->{'expression'};
f2f71b8e 591 my @comments = ( @{ $item[1] }, @{ $item[-1] } );
0efb6e1b 592
593 $return = {
594 name => $item{'constraint_name'}[0] || '',
b3384294 595 supertype => 'constraint',
596 type => $type,
0efb6e1b 597 fields => $type ne 'check' ? $fields : [],
598 expression => $type eq 'check' ? $expression : '',
f04713db 599 deferrable => $item{'deferrable'},
0efb6e1b 600 deferred => $item{'deferred'},
601 reference_table => $desc->{'reference_table'},
602 reference_fields => $desc->{'reference_fields'},
603 match_type => $desc->{'match_type'}[0],
100684f3 604 on_delete => $desc->{'on_delete'} || $desc->{'on_delete_do'},
605 on_update => $desc->{'on_update'} || $desc->{'on_update_do'},
f2f71b8e 606 comments => [ @comments ],
0efb6e1b 607 }
608 }
4422e22a 609
0efb6e1b 610table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
611 {
612 $return = {
613 type => 'primary_key',
614 fields => $item[3],
615 }
616 }
617 |
618 /unique/i '(' name_with_opt_quotes(s /,/) ')'
619 {
620 $return = {
621 type => 'unique',
622 fields => $item[3],
623 }
624 }
625 |
b3384294 626 /check/i '(' /[^)]+/ ')'
0efb6e1b 627 {
628 $return = {
629 type => 'check',
630 expression => $item[3],
631 }
632 }
633 |
3022f45b 634 /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 635 {
3022f45b 636 my ( $on_delete, $on_update );
637 for my $action ( @{ $item[9] || [] } ) {
638 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
639 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
640 }
641
0efb6e1b 642 $return = {
b3384294 643 supertype => 'constraint',
0efb6e1b 644 type => 'foreign_key',
645 fields => $item[3],
646 reference_table => $item[6],
647 reference_fields => $item[7][0],
648 match_type => $item[8][0],
100684f3 649 on_delete => $on_delete || '',
650 on_update => $on_update || '',
0efb6e1b 651 }
652 }
653
654deferrable : /not/i /deferrable/i
655 {
656 $return = ( $item[1] =~ /not/i ) ? 0 : 1;
657 }
4422e22a 658
0efb6e1b 659deferred : /initially/i /(deferred|immediate)/i { $item[2] }
4422e22a 660
0efb6e1b 661match_type : /match full/i { 'match_full' }
662 |
663 /match partial/i { 'match_partial' }
664
3022f45b 665key_action : key_delete
666 |
667 key_update
0efb6e1b 668
3022f45b 669key_delete : /on delete/i key_mutation
670 {
8c12c406 671 $return = {
3022f45b 672 type => 'delete',
673 action => $item[2],
674 };
675 }
676
677key_update : /on update/i key_mutation
678 {
8c12c406 679 $return = {
3022f45b 680 type => 'update',
681 action => $item[2],
682 };
683 }
684
685key_mutation : /no action/i { $return = 'no_action' }
686 |
687 /restrict/i { $return = 'restrict' }
688 |
689 /cascade/i { $return = 'cascade' }
690 |
38a6a4f9 691 /set null/i { $return = 'set null' }
3022f45b 692 |
38a6a4f9 693 /set default/i { $return = 'set default' }
0efb6e1b 694
00ef67ea 695alter : alter_table table_name add_column field ';'
696 {
697 my $field_def = $item[4];
698 $tables{ $item[2] }{'fields'}{ $field_def->{'name'} } = {
699 %$field_def, order => $field_order++
700 };
701 1;
702 }
703
704alter : alter_table table_name ADD table_constraint ';'
0012a163 705 {
706 my $table_name = $item[2];
707 my $constraint = $item[4];
0012a163 708 push @{ $tables{ $table_name }{'constraints'} }, $constraint;
00ef67ea 709 1;
0012a163 710 }
711
00ef67ea 712alter : alter_table table_name drop_column NAME restrict_or_cascade(?) ';'
713 {
714 $tables{ $item[2] }{'fields'}{ $item[4] }{'drop'} = 1;
715 1;
716 }
0012a163 717
00ef67ea 718alter : alter_table table_name alter_column NAME alter_default_val ';'
719 {
720 $tables{ $item[2] }{'fields'}{ $item[4] }{'default'} =
721 $item[5]->{'value'};
722 1;
723 }
724
725#
726# These will just parse for now but won't affect the structure. - ky
727#
728alter : alter_table table_name /rename/i /to/i NAME ';'
729 { 1 }
730
731alter : alter_table table_name alter_column NAME SET /statistics/i INTEGER ';'
732 { 1 }
733
734alter : alter_table table_name alter_column NAME SET /storage/i storage_type ';'
735 { 1 }
736
737alter : alter_table table_name rename_column NAME /to/i NAME ';'
738 { 1 }
739
740alter : alter_table table_name DROP /constraint/i NAME restrict_or_cascade ';'
741 { 1 }
742
743alter : alter_table table_name /owner/i /to/i NAME ';'
744 { 1 }
745
746storage_type : /(plain|external|extended|main)/i
747
748alter_default_val : SET default_val
749 {
750 $return = { value => $item[2]->{'value'} }
751 }
752 | DROP DEFAULT
753 {
754 $return = { value => undef }
755 }
756
757#
758# This is a little tricky to get right, at least WRT to making the
759# tests pass. The problem is that the constraints are stored just as
760# a list (no name access), and the tests expect the constraints in a
761# particular order. I'm going to leave the rule but disable the code
762# for now. - ky
763#
764alter : alter_table table_name alter_column NAME alter_nullable ';'
765 {
766# my $table_name = $item[2];
767# my $field_name = $item[4];
768# my $is_nullable = $item[5]->{'is_nullable'};
769#
770# $tables{ $table_name }{'fields'}{ $field_name }{'is_nullable'} =
771# $is_nullable;
772#
773# if ( $is_nullable ) {
774# 1;
775# push @{ $tables{ $table_name }{'constraints'} }, {
776# type => 'not_null',
777# fields => [ $field_name ],
778# };
779# }
780# else {
781# for my $i (
782# 0 .. $#{ $tables{ $table_name }{'constraints'} || [] }
783# ) {
784# my $c = $tables{ $table_name }{'constraints'}[ $i ] or next;
785# my $fields = join( '', @{ $c->{'fields'} || [] } ) or next;
786# if ( $c->{'type'} eq 'not_null' && $fields eq $field_name ) {
787# delete $tables{ $table_name }{'constraints'}[ $i ];
788# last;
789# }
790# }
791# }
792
793 1;
794 }
795
796alter_nullable : SET not_null
797 {
798 $return = { is_nullable => 0 }
799 }
800 | DROP not_null
801 {
802 $return = { is_nullable => 1 }
803 }
804
805not_null : /not/i /null/i
806
807add_column : ADD COLUMN(?)
808
809alter_table : ALTER TABLE ONLY(?)
810
811drop_column : DROP COLUMN(?)
812
813alter_column : ALTER COLUMN(?)
814
815rename_column : /rename/i COLUMN(?)
816
817restrict_or_cascade : /restrict/i |
818 /cascade/i
819
820#
821# End basically useless stuff. - ky
822#
0012a163 823
211e2e90 824create_table : CREATE TABLE
0efb6e1b 825
211e2e90 826create_index : CREATE /index/i
4422e22a 827
00ef67ea 828default_val : DEFAULT /(\d+|'[^']*'|\w+\(.*?\))|\w+/
4422e22a 829 {
f04713db 830 my $val = defined $item[2] ? $item[2] : '';
831 $val =~ s/^'|'$//g;
0efb6e1b 832 $return = {
82968eb9 833 supertype => 'constraint',
834 type => 'default',
0efb6e1b 835 value => $val,
836 }
4422e22a 837 }
f27085c9 838 | /null/i
839 {
840 $return = {
841 supertype => 'constraint',
842 type => 'default',
843 value => 'NULL',
844 }
845 }
4422e22a 846
4422e22a 847name_with_opt_paren : NAME parens_value_list(s?)
0efb6e1b 848 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
4422e22a 849
850unique : /unique/i { 1 }
851
852key : /key/i | /index/i
853
0efb6e1b 854table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
4422e22a 855 {
0efb6e1b 856 $return = { type => 'inherits', table_name => $item[3] }
857 }
858 |
859 /with(out)? oids/i
860 {
861 $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
4422e22a 862 }
863
00ef67ea 864ADD : /add/i
865
866ALTER : /alter/i
867
211e2e90 868CREATE : /create/i
869
00ef67ea 870ONLY : /only/i
871
872DEFAULT : /default/i
873
874DROP : /drop/i
875
876COLUMN : /column/i
877
0d51cd9e 878TABLE : /table/i
879
0efb6e1b 880SEMICOLON : /\s*;\n?/
881
00ef67ea 882INTEGER : /\d+/
883
4422e22a 884WORD : /\w+/
885
886DIGITS : /\d+/
887
888COMMA : ','
889
00ef67ea 890SET : /set/i
891
4422e22a 892NAME : "`" /\w+/ "`"
893 { $item[2] }
894 | /\w+/
895 { $item[1] }
0012a163 896 | /[\$\w]+/
897 { $item[1] }
4422e22a 898
899VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
900 { $item[1] }
901 | /'.*?'/ # XXX doesn't handle embedded quotes
902 { $item[1] }
f04713db 903 | /null/i
4422e22a 904 { 'NULL' }
905
906!;
907
908# -------------------------------------------------------------------
909sub parse {
910 my ( $translator, $data ) = @_;
911 $parser ||= Parse::RecDescent->new($GRAMMAR);
912
913 $::RD_TRACE = $translator->trace ? 1 : undef;
914 $DEBUG = $translator->debug;
915
916 unless (defined $parser) {
917 return $translator->error("Error instantiating Parse::RecDescent ".
918 "instance: Bad grammer");
919 }
920
921 my $result = $parser->startrule($data);
922 die "Parse failed.\n" unless defined $result;
923 warn Dumper($result) if $DEBUG;
82968eb9 924
925 my $schema = $translator->schema;
926 my @tables = sort {
429f639c 927 ( $result->{ $a }{'order'} || 0 ) <=> ( $result->{ $b }{'order'} || 0 )
82968eb9 928 } keys %{ $result };
929
930 for my $table_name ( @tables ) {
931 my $tdata = $result->{ $table_name };
932 my $table = $schema->add_table(
933 name => $tdata->{'table_name'},
d7fcc1d6 934 ) or die "Couldn't create table '$table_name': " . $schema->error;
82968eb9 935
a82fa2cb 936 $table->comments( $tdata->{'comments'} );
937
82968eb9 938 my @fields = sort {
429f639c 939 $tdata->{'fields'}{ $a }{'order'}
82968eb9 940 <=>
429f639c 941 $tdata->{'fields'}{ $b }{'order'}
82968eb9 942 } keys %{ $tdata->{'fields'} };
943
944 for my $fname ( @fields ) {
945 my $fdata = $tdata->{'fields'}{ $fname };
00ef67ea 946 next if $fdata->{'drop'};
82968eb9 947 my $field = $table->add_field(
948 name => $fdata->{'name'},
949 data_type => $fdata->{'data_type'},
950 size => $fdata->{'size'},
951 default_value => $fdata->{'default'},
7eac5e12 952 is_auto_increment => $fdata->{'is_auto_increment'},
00ef67ea 953 is_nullable => $fdata->{'is_nullable'},
a82fa2cb 954 comments => $fdata->{'comments'},
82968eb9 955 ) or die $table->error;
956
957 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
958
959 for my $cdata ( @{ $fdata->{'constraints'} } ) {
960 next unless $cdata->{'type'} eq 'foreign_key';
961 $cdata->{'fields'} ||= [ $field->name ];
962 push @{ $tdata->{'constraints'} }, $cdata;
963 }
964 }
965
966 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
967 my $index = $table->add_index(
968 name => $idata->{'name'},
969 type => uc $idata->{'type'},
970 fields => $idata->{'fields'},
971 ) or die $table->error;
972 }
973
974 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
975 my $constraint = $table->add_constraint(
976 name => $cdata->{'name'},
977 type => $cdata->{'type'},
978 fields => $cdata->{'fields'},
979 reference_table => $cdata->{'reference_table'},
980 reference_fields => $cdata->{'reference_fields'},
981 match_type => $cdata->{'match_type'} || '',
100684f3 982 on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
983 on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'},
b3384294 984 expression => $cdata->{'expression'},
985 ) or die "Can't add constraint of type '" .
986 $cdata->{'type'} . "' to table '" . $table->name .
987 "': " . $table->error;
82968eb9 988 }
989 }
990
f62bd16c 991 return 1;
4422e22a 992}
993
9941;
995
82968eb9 996# -------------------------------------------------------------------
997# Rescue the drowning and tie your shoestrings.
998# Henry David Thoreau
999# -------------------------------------------------------------------
4422e22a 1000
1001=pod
1002
0efb6e1b 1003=head1 AUTHORS
4422e22a 1004
1005Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
b8ea6076 1006Allen Day E<lt>allenday@ucla.eduE<gt>.
4422e22a 1007
1008=head1 SEE ALSO
1009
1010perl(1), Parse::RecDescent.
1011
1012=cut