projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Added test for check constraint.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
CommitLineData
84012a55 1package SQL::Translator::Parser::PostgreSQL;
4422e22a 2
3# -------------------------------------------------------------------
b8ea6076 4# $Id: PostgreSQL.pm,v 1.30 2003-08-21 02:28:38 kycl4rk Exp $
4422e22a 5# -------------------------------------------------------------------
6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
0efb6e1b 7# Allen Day <allenday@users.sourceforge.net>,
4422e22a 8# darren chamberlain <darren@cpan.org>,
9# Chris Mungall <cjm@fruitfly.org>
10#
11# This program is free software; you can redistribute it and/or
12# modify it under the terms of the GNU General Public License as
13# published by the Free Software Foundation; version 2.
14#
15# This program is distributed in the hope that it will be useful, but
16# WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18# General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
0efb6e1b 22# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
4422e22a 23# 02111-1307 USA
24# -------------------------------------------------------------------
25
26=head1 NAME
27
84012a55 28SQL::Translator::Parser::PostgreSQL - parser for PostgreSQL
4422e22a 29
30=head1 SYNOPSIS
31
32 use SQL::Translator;
84012a55 33 use SQL::Translator::Parser::PostgreSQL;
4422e22a 34
35 my $translator = SQL::Translator->new;
84012a55 36 $translator->parser("SQL::Translator::Parser::PostgreSQL");
4422e22a 37
38=head1 DESCRIPTION
39
0efb6e1b 40The grammar was started from the MySQL parsers. Here is the description
41from PostgreSQL:
42
43Table:
629b76f9 44(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createtable.html)
45
46 CREATE [ [ LOCAL ] { TEMPORARY | TEMP } ] TABLE table_name (
47 { column_name data_type [ DEFAULT default_expr ]
48 [ column_constraint [, ... ] ]
49 | table_constraint } [, ... ]
50 )
51 [ INHERITS ( parent_table [, ... ] ) ]
52 [ WITH OIDS | WITHOUT OIDS ]
53
54 where column_constraint is:
55
56 [ CONSTRAINT constraint_name ]
57 { NOT NULL | NULL | UNIQUE | PRIMARY KEY |
58 CHECK (expression) |
59 REFERENCES reftable [ ( refcolumn ) ] [ MATCH FULL | MATCH PARTIAL ]
60 [ ON DELETE action ] [ ON UPDATE action ] }
61 [ DEFERRABLE | NOT DEFERRABLE ]
62 [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
63
64 and table_constraint is:
65
66 [ CONSTRAINT constraint_name ]
67 { UNIQUE ( column_name [, ... ] ) |
68 PRIMARY KEY ( column_name [, ... ] ) |
69 CHECK ( expression ) |
70 FOREIGN KEY ( column_name [, ... ] )
71 REFERENCES reftable [ ( refcolumn [, ... ] ) ]
72 [ MATCH FULL | MATCH PARTIAL ]
73 [ ON DELETE action ] [ ON UPDATE action ] }
74 [ DEFERRABLE | NOT DEFERRABLE ]
75 [ INITIALLY DEFERRED | INITIALLY IMMEDIATE ]
0efb6e1b 76
77Index:
629b76f9 78(http://www.postgresql.org/docs/view.php?version=7.3&idoc=1&file=sql-createindex.html)
0efb6e1b 79
629b76f9 80 CREATE [ UNIQUE ] INDEX index_name ON table
81 [ USING acc_method ] ( column [ ops_name ] [, ...] )
82 [ WHERE predicate ]
83 CREATE [ UNIQUE ] INDEX index_name ON table
84 [ USING acc_method ] ( func_name( column [, ... ]) [ ops_name ] )
85 [ WHERE predicate ]
4422e22a 86
0012a163 87Alter table:
88
89 ALTER TABLE [ ONLY ] table [ * ]
90 ADD [ COLUMN ] column type [ column_constraint [ ... ] ]
91 ALTER TABLE [ ONLY ] table [ * ]
92 ALTER [ COLUMN ] column { SET DEFAULT value | DROP DEFAULT }
93 ALTER TABLE [ ONLY ] table [ * ]
94 ALTER [ COLUMN ] column SET STATISTICS integer
95 ALTER TABLE [ ONLY ] table [ * ]
96 RENAME [ COLUMN ] column TO newcolumn
97 ALTER TABLE table
98 RENAME TO new_table
99 ALTER TABLE table
100 ADD table_constraint_definition
101 ALTER TABLE [ ONLY ] table
102 DROP CONSTRAINT constraint { RESTRICT | CASCADE }
103 ALTER TABLE table
104 OWNER TO new_owner
105
3022f45b 106View table:
107
108 CREATE [ OR REPLACE ] VIEW view [ ( column name list ) ] AS SELECT query
109
4422e22a 110=cut
111
112use strict;
113use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
b8ea6076 114$VERSION = sprintf "%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;
4422e22a 115$DEBUG = 0 unless defined $DEBUG;
116
117use Data::Dumper;
118use Parse::RecDescent;
119use Exporter;
120use base qw(Exporter);
121
122@EXPORT_OK = qw(parse);
123
124# Enable warnings within the Parse::RecDescent module.
125$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
126$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
127$::RD_HINT = 1; # Give out hints to help fix problems.
128
129my $parser; # should we do this? There's no programmic way to
130 # change the grammar, so I think this is safe.
131
132$GRAMMAR = q!
133
b8ea6076 134{ my ( %tables, $table_order ) }
4422e22a 135
629b76f9 136#
137# The "eofile" rule makes the parser fail if any "statement" rule
138# fails. Otherwise, the first successful match by a "statement"
139# won't cause the failure needed to know that the parse, as a whole,
140# failed. -ky
141#
0efb6e1b 142startrule : statement(s) eofile { \%tables }
4422e22a 143
0efb6e1b 144eofile : /^\Z/
145
146statement : create
147 | comment
0012a163 148 | alter
0efb6e1b 149 | grant
150 | revoke
4422e22a 151 | drop
4d2da1f7 152 | insert
0efb6e1b 153 | connect
4d2da1f7 154 | update
0012a163 155 | set
4422e22a 156 | <error>
157
0efb6e1b 158connect : /^\s*\\\connect.*\n/
159
f04713db 160set : /set/i /[^;]*/ ';'
0012a163 161
0d51cd9e 162revoke : /revoke/i WORD(s /,/) /on/i TABLE(?) table_name /from/i name_with_opt_quotes(s /,/) ';'
0efb6e1b 163 {
164 my $table_name = $item{'table_name'};
165 push @{ $tables{ $table_name }{'permissions'} }, {
166 type => 'revoke',
167 actions => $item[2],
91c75eab 168 users => $item[7],
0efb6e1b 169 }
170 }
171
0d51cd9e 172grant : /grant/i WORD(s /,/) /on/i TABLE(?) table_name /to/i name_with_opt_quotes(s /,/) ';'
0efb6e1b 173 {
174 my $table_name = $item{'table_name'};
175 push @{ $tables{ $table_name }{'permissions'} }, {
176 type => 'grant',
177 actions => $item[2],
91c75eab 178 users => $item[7],
0efb6e1b 179 }
180 }
181
182drop : /drop/i /[^;]*/ ';'
4422e22a 183
4d2da1f7 184insert : /insert/i /[^;]*/ ';'
185
186update : /update/i /[^;]*/ ';'
187
0012a163 188#
189# Create table.
190#
ba1a1626 191create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
0efb6e1b 192 {
193 my $table_name = $item{'table_name'};
194 $tables{ $table_name }{'order'} = ++$table_order;
195 $tables{ $table_name }{'table_name'} = $table_name;
196
197 my $i = 1;
198 my @constraints;
199 for my $definition ( @{ $item[4] } ) {
200 if ( $definition->{'type'} eq 'field' ) {
201 my $field_name = $definition->{'name'};
202 $tables{ $table_name }{'fields'}{ $field_name } =
203 { %$definition, order => $i };
204 $i++;
4422e22a 205
0138f7bb 206 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
207 $constraint->{'fields'} = [ $field_name ];
7d5bcab8 208 push @{ $tables{ $table_name }{'constraints'} },
0138f7bb 209 $constraint;
0efb6e1b 210 }
211 }
212 elsif ( $definition->{'type'} eq 'constraint' ) {
213 $definition->{'type'} = $definition->{'constraint_type'};
0138f7bb 214 # group FKs at the field level
82968eb9 215# if ( $definition->{'type'} eq 'foreign_key' ) {
216# for my $fld ( @{ $definition->{'fields'} || [] } ) {
217# push @{
218# $tables{$table_name}{'fields'}{$fld}{'constraints'}
219# }, $definition;
220# }
221# }
222# else {
0138f7bb 223 push @{ $tables{ $table_name }{'constraints'} },
224 $definition;
82968eb9 225# }
0efb6e1b 226 }
227 else {
228 push @{ $tables{ $table_name }{'indices'} }, $definition;
229 }
230 }
231
232 for my $option ( @{ $item[6] } ) {
3022f45b 233 $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } =
0efb6e1b 234 $option;
235 }
236
237 1;
238 }
239
0012a163 240#
241# Create index.
242#
0efb6e1b 243create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
4422e22a 244 {
245 push @{ $tables{ $item{'table_name'} }{'indices'} },
246 {
0efb6e1b 247 name => $item{'index_name'},
248 type => $item{'unique'}[0] ? 'unique' : 'normal',
249 fields => $item[9],
250 method => $item{'using_method'}[0],
4422e22a 251 }
252 ;
253 }
254
0012a163 255#
256# Create anything else (e.g., domain, function, etc.)
257#
258create : /create/i WORD /[^;]+/ ';'
259
0efb6e1b 260using_method : /using/i WORD { $item[2] }
261
262where_predicate : /where/i /[^;]+/
263
264create_definition : field
0efb6e1b 265 | table_constraint
4422e22a 266 | <error>
267
268comment : /^\s*(?:#|-{2}).*\n/
269
f2f71b8e 270field : comment(s?) field_name data_type field_meta(s?) comment(s?)
4422e22a 271 {
3022f45b 272 my ( $default, @constraints, $is_pk );
82968eb9 273 my $null = 1;
41fc9cb3 274 for my $meta ( @{ $item[4] } ) {
82968eb9 275 if ( $meta->{'type'} eq 'default' ) {
276 $default = $meta;
277 next;
278 }
279 elsif ( $meta->{'type'} eq 'not_null' ) {
280 $null = 0;
f04713db 281# next;
82968eb9 282 }
283 elsif ( $meta->{'type'} eq 'primary_key' ) {
284 $is_pk = 1;
285 }
4422e22a 286
82968eb9 287 push @constraints, $meta if $meta->{'supertype'} eq 'constraint';
288 }
0efb6e1b 289
f2f71b8e 290 my @comments = ( @{ $item[1] }, @{ $item[5] } );
291
0a7fc605 292 $return = {
7eac5e12 293 type => 'field',
294 name => $item{'field_name'},
295 data_type => $item{'data_type'}{'type'},
296 size => $item{'data_type'}{'size'},
297 null => $null,
298 default => $default->{'value'},
299 constraints => [ @constraints ],
300 comments => [ @comments ],
301 is_primary_key => $is_pk || 0,
302 is_auto_increment => $item{'data_type'}{'is_auto_increment'},
4422e22a 303 }
304 }
305 | <error>
306
0efb6e1b 307field_meta : default_val
82968eb9 308 | column_constraint
4422e22a 309
0efb6e1b 310column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
311 {
312 my $desc = $item{'column_constraint_type'};
313 my $type = $desc->{'type'};
314 my $fields = $desc->{'fields'} || [];
315 my $expression = $desc->{'expression'} || '';
316
317 $return = {
82968eb9 318 supertype => 'constraint',
0efb6e1b 319 name => $item{'constraint_name'}[0] || '',
320 type => $type,
321 expression => $type eq 'check' ? $expression : '',
f04713db 322 deferrable => $item{'deferrable'},
0efb6e1b 323 deferred => $item{'deferred'},
324 reference_table => $desc->{'reference_table'},
325 reference_fields => $desc->{'reference_fields'},
326 match_type => $desc->{'match_type'},
327 on_delete_do => $desc->{'on_delete_do'},
328 on_update_do => $desc->{'on_update_do'},
4422e22a 329 }
330 }
331
0efb6e1b 332constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
333
334column_constraint_type : /not null/i { $return = { type => 'not_null' } }
335 |
f04713db 336 /null/i
0efb6e1b 337 { $return = { type => 'null' } }
338 |
f04713db 339 /unique/i
0efb6e1b 340 { $return = { type => 'unique' } }
341 |
342 /primary key/i
343 { $return = { type => 'primary_key' } }
344 |
345 /check/i '(' /[^)]+/ ')'
346 { $return = { type => 'check', expression => $item[2] } }
347 |
3022f45b 348 /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 349 {
3022f45b 350 my ( $on_delete, $on_update );
351 for my $action ( @{ $item[5] || [] } ) {
352 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
353 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
354 }
355
0efb6e1b 356 $return = {
357 type => 'foreign_key',
358 reference_table => $item[2],
0138f7bb 359 reference_fields => $item[3][0],
0efb6e1b 360 match_type => $item[4][0],
3022f45b 361 on_delete_do => $on_delete,
362 on_update_do => $on_update,
ba1a1626 363 }
4422e22a 364 }
365
0efb6e1b 366table_name : name_with_opt_quotes
4422e22a 367
0efb6e1b 368field_name : name_with_opt_quotes
4422e22a 369
0012a163 370name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
4422e22a 371
0efb6e1b 372double_quote: /"/
4422e22a 373
0efb6e1b 374index_name : WORD
4422e22a 375
0efb6e1b 376data_type : pg_data_type parens_value_list(?)
4422e22a 377 {
3022f45b 378 my $data_type = $item[1];
ba1a1626 379
0efb6e1b 380 #
381 # We can deduce some sizes from the data type's name.
382 #
82968eb9 383 $data_type->{'size'} ||= $item[2][0];
4422e22a 384
3022f45b 385 $return = $data_type;
4422e22a 386 }
387
0efb6e1b 388pg_data_type :
50840472 389 /(bigint|int8)/i
3022f45b 390 {
391 $return = {
50840472 392 type => 'integer',
b8ea6076 393 size => 20,
3022f45b 394 };
395 }
0efb6e1b 396 |
1bbd4a2b 397 /(smallint|int2)/i
3022f45b 398 {
399 $return = {
400 type => 'integer',
b8ea6076 401 size => 5,
3022f45b 402 };
403 }
0efb6e1b 404 |
50840472 405 /(integer|int4?)/i # interval must come before this
3022f45b 406 {
407 $return = {
408 type => 'integer',
b8ea6076 409 size => 10,
3022f45b 410 };
411 }
50840472 412 |
413 /(real|float4)/i
414 {
415 $return = {
416 type => 'real',
b8ea6076 417 size => 10,
50840472 418 };
419 }
0efb6e1b 420 |
1bbd4a2b 421 /(double precision|float8?)/i
3022f45b 422 {
423 $return = {
424 type => 'float',
b8ea6076 425 size => 20,
3022f45b 426 };
427 }
0efb6e1b 428 |
50840472 429 /(bigserial|serial8)/i
3022f45b 430 {
50840472 431 $return = {
7eac5e12 432 type => 'integer',
b8ea6076 433 size => 20,
7eac5e12 434 is_auto_increment => 1,
3022f45b 435 };
436 }
0efb6e1b 437 |
1bbd4a2b 438 /serial4?/i
3022f45b 439 {
440 $return = {
7eac5e12 441 type => 'integer',
b8ea6076 442 size => 11,
7eac5e12 443 is_auto_increment => 1,
3022f45b 444 };
445 }
0efb6e1b 446 |
1bbd4a2b 447 /(bit varying|varbit)/i
3022f45b 448 {
449 $return = { type => 'varbit' };
450 }
0efb6e1b 451 |
1bbd4a2b 452 /character varying/i
3022f45b 453 {
454 $return = { type => 'varchar' };
455 }
0efb6e1b 456 |
1bbd4a2b 457 /char(acter)?/i
3022f45b 458 {
459 $return = { type => 'char' };
460 }
0efb6e1b 461 |
1bbd4a2b 462 /bool(ean)?/i
3022f45b 463 {
464 $return = { type => 'boolean' };
465 }
0efb6e1b 466 |
1bbd4a2b 467 /bytea/i
3022f45b 468 {
82968eb9 469 $return = { type => 'bytea' };
3022f45b 470 }
0efb6e1b 471 |
50840472 472 /(timestamptz|timestamp)/i
3022f45b 473 {
474 $return = { type => 'timestamp' };
475 }
0efb6e1b 476 |
38a6a4f9 477 /text/i
478 {
479 $return = {
480 type => 'text',
481 size => 64_000,
482 };
483 }
484 |
485 /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|timetz|time|varchar)/i
3022f45b 486 {
487 $return = { type => $item[1] };
488 }
0efb6e1b 489
4422e22a 490parens_value_list : '(' VALUE(s /,/) ')'
491 { $item[2] }
492
0efb6e1b 493parens_word_list : '(' WORD(s /,/) ')'
494 { $item[2] }
4422e22a 495
0efb6e1b 496field_size : '(' num_range ')' { $item{'num_range'} }
4422e22a 497
0efb6e1b 498num_range : DIGITS ',' DIGITS
4422e22a 499 { $return = $item[1].','.$item[3] }
500 | DIGITS
501 { $return = $item[1] }
502
f2f71b8e 503table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
0efb6e1b 504 {
505 my $desc = $item{'table_constraint_type'};
506 my $type = $desc->{'type'};
507 my $fields = $desc->{'fields'};
508 my $expression = $desc->{'expression'};
f2f71b8e 509 my @comments = ( @{ $item[1] }, @{ $item[-1] } );
0efb6e1b 510
511 $return = {
512 name => $item{'constraint_name'}[0] || '',
513 type => 'constraint',
514 constraint_type => $type,
515 fields => $type ne 'check' ? $fields : [],
516 expression => $type eq 'check' ? $expression : '',
f04713db 517 deferrable => $item{'deferrable'},
0efb6e1b 518 deferred => $item{'deferred'},
519 reference_table => $desc->{'reference_table'},
520 reference_fields => $desc->{'reference_fields'},
521 match_type => $desc->{'match_type'}[0],
0012a163 522 on_delete_do => $desc->{'on_delete_do'},
523 on_update_do => $desc->{'on_update_do'},
f2f71b8e 524 comments => [ @comments ],
0efb6e1b 525 }
526 }
4422e22a 527
0efb6e1b 528table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
529 {
530 $return = {
531 type => 'primary_key',
532 fields => $item[3],
533 }
534 }
535 |
536 /unique/i '(' name_with_opt_quotes(s /,/) ')'
537 {
538 $return = {
539 type => 'unique',
540 fields => $item[3],
541 }
542 }
543 |
f04713db 544 /check/i '(' /(.+)/ ')'
0efb6e1b 545 {
546 $return = {
547 type => 'check',
548 expression => $item[3],
549 }
550 }
551 |
3022f45b 552 /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 553 {
3022f45b 554 my ( $on_delete, $on_update );
555 for my $action ( @{ $item[9] || [] } ) {
556 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
557 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
558 }
559
0efb6e1b 560 $return = {
561 type => 'foreign_key',
562 fields => $item[3],
563 reference_table => $item[6],
564 reference_fields => $item[7][0],
565 match_type => $item[8][0],
3022f45b 566 on_delete_do => $on_delete || '',
567 on_update_do => $on_update || '',
0efb6e1b 568 }
569 }
570
571deferrable : /not/i /deferrable/i
572 {
573 $return = ( $item[1] =~ /not/i ) ? 0 : 1;
574 }
4422e22a 575
0efb6e1b 576deferred : /initially/i /(deferred|immediate)/i { $item[2] }
4422e22a 577
0efb6e1b 578match_type : /match full/i { 'match_full' }
579 |
580 /match partial/i { 'match_partial' }
581
3022f45b 582key_action : key_delete
583 |
584 key_update
0efb6e1b 585
3022f45b 586key_delete : /on delete/i key_mutation
587 {
588 $return => {
589 type => 'delete',
590 action => $item[2],
591 };
592 }
593
594key_update : /on update/i key_mutation
595 {
596 $return => {
597 type => 'update',
598 action => $item[2],
599 };
600 }
601
602key_mutation : /no action/i { $return = 'no_action' }
603 |
604 /restrict/i { $return = 'restrict' }
605 |
606 /cascade/i { $return = 'cascade' }
607 |
38a6a4f9 608 /set null/i { $return = 'set null' }
3022f45b 609 |
38a6a4f9 610 /set default/i { $return = 'set default' }
0efb6e1b 611
0012a163 612alter : alter_table table_name /add/i table_constraint ';'
613 {
614 my $table_name = $item[2];
615 my $constraint = $item[4];
616 $constraint->{'type'} = $constraint->{'constraint_type'};
617 push @{ $tables{ $table_name }{'constraints'} }, $constraint;
618 }
619
620alter_table : /alter/i /table/i only(?)
621
622only : /only/i
623
0d51cd9e 624create_table : /create/i TABLE
0efb6e1b 625
626create_index : /create/i /index/i
4422e22a 627
d7fcc1d6 628default_val : /default/i /(\d+|'[^']*'|\w+\(.*?\))|\w+/
4422e22a 629 {
f04713db 630 my $val = defined $item[2] ? $item[2] : '';
631 $val =~ s/^'|'$//g;
0efb6e1b 632 $return = {
82968eb9 633 supertype => 'constraint',
634 type => 'default',
0efb6e1b 635 value => $val,
636 }
4422e22a 637 }
f27085c9 638 | /null/i
639 {
640 $return = {
641 supertype => 'constraint',
642 type => 'default',
643 value => 'NULL',
644 }
645 }
4422e22a 646
4422e22a 647name_with_opt_paren : NAME parens_value_list(s?)
0efb6e1b 648 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
4422e22a 649
650unique : /unique/i { 1 }
651
652key : /key/i | /index/i
653
0efb6e1b 654table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
4422e22a 655 {
0efb6e1b 656 $return = { type => 'inherits', table_name => $item[3] }
657 }
658 |
659 /with(out)? oids/i
660 {
661 $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
4422e22a 662 }
663
0d51cd9e 664TABLE : /table/i
665
0efb6e1b 666SEMICOLON : /\s*;\n?/
667
4422e22a 668WORD : /\w+/
669
670DIGITS : /\d+/
671
672COMMA : ','
673
674NAME : "`" /\w+/ "`"
675 { $item[2] }
676 | /\w+/
677 { $item[1] }
0012a163 678 | /[\$\w]+/
679 { $item[1] }
4422e22a 680
681VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
682 { $item[1] }
683 | /'.*?'/ # XXX doesn't handle embedded quotes
684 { $item[1] }
f04713db 685 | /null/i
4422e22a 686 { 'NULL' }
687
688!;
689
690# -------------------------------------------------------------------
691sub parse {
692 my ( $translator, $data ) = @_;
693 $parser ||= Parse::RecDescent->new($GRAMMAR);
694
695 $::RD_TRACE = $translator->trace ? 1 : undef;
696 $DEBUG = $translator->debug;
697
698 unless (defined $parser) {
699 return $translator->error("Error instantiating Parse::RecDescent ".
700 "instance: Bad grammer");
701 }
702
703 my $result = $parser->startrule($data);
704 die "Parse failed.\n" unless defined $result;
705 warn Dumper($result) if $DEBUG;
82968eb9 706
707 my $schema = $translator->schema;
708 my @tables = sort {
709 $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
710 } keys %{ $result };
711
712 for my $table_name ( @tables ) {
713 my $tdata = $result->{ $table_name };
714 my $table = $schema->add_table(
715 name => $tdata->{'table_name'},
d7fcc1d6 716 ) or die "Couldn't create table '$table_name': " . $schema->error;
82968eb9 717
718 my @fields = sort {
719 $tdata->{'fields'}->{$a}->{'order'}
720 <=>
721 $tdata->{'fields'}->{$b}->{'order'}
722 } keys %{ $tdata->{'fields'} };
723
724 for my $fname ( @fields ) {
725 my $fdata = $tdata->{'fields'}{ $fname };
726 my $field = $table->add_field(
727 name => $fdata->{'name'},
728 data_type => $fdata->{'data_type'},
729 size => $fdata->{'size'},
730 default_value => $fdata->{'default'},
7eac5e12 731 is_auto_increment => $fdata->{'is_auto_increment'},
82968eb9 732 is_nullable => $fdata->{'null'},
733 ) or die $table->error;
734
735 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
736
737 for my $cdata ( @{ $fdata->{'constraints'} } ) {
738 next unless $cdata->{'type'} eq 'foreign_key';
739 $cdata->{'fields'} ||= [ $field->name ];
740 push @{ $tdata->{'constraints'} }, $cdata;
741 }
742 }
743
744 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
745 my $index = $table->add_index(
746 name => $idata->{'name'},
747 type => uc $idata->{'type'},
748 fields => $idata->{'fields'},
749 ) or die $table->error;
750 }
751
752 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
753 my $constraint = $table->add_constraint(
754 name => $cdata->{'name'},
755 type => $cdata->{'type'},
756 fields => $cdata->{'fields'},
757 reference_table => $cdata->{'reference_table'},
758 reference_fields => $cdata->{'reference_fields'},
759 match_type => $cdata->{'match_type'} || '',
760 on_delete => $cdata->{'on_delete_do'},
761 on_update => $cdata->{'on_update_do'},
762 ) or die $table->error;
763 }
764 }
765
f62bd16c 766 return 1;
4422e22a 767}
768
7691;
770
82968eb9 771# -------------------------------------------------------------------
772# Rescue the drowning and tie your shoestrings.
773# Henry David Thoreau
774# -------------------------------------------------------------------
4422e22a 775
776=pod
777
0efb6e1b 778=head1 AUTHORS
4422e22a 779
780Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
b8ea6076 781Allen Day E<lt>allenday@ucla.eduE<gt>.
4422e22a 782
783=head1 SEE ALSO
784
785perl(1), Parse::RecDescent.
786
787=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)