projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Added validation code.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
CommitLineData
84012a55 1package SQL::Translator::Parser::PostgreSQL;
4422e22a 2
3# -------------------------------------------------------------------
f27085c9 4# $Id: PostgreSQL.pm,v 1.16 2003-06-09 02:41:31 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 ];
f27085c9 114$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\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
0efb6e1b 134{ our ( %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
0efb6e1b 152 | connect
0012a163 153 | set
4422e22a 154 | <error>
155
0efb6e1b 156connect : /^\s*\\\connect.*\n/
157
0012a163 158set : /SET/ /[^;]*/ ';'
159
0efb6e1b 160revoke : /revoke/i WORD(s /,/) /on/i table_name /from/i name_with_opt_quotes(s /,/) ';'
161 {
162 my $table_name = $item{'table_name'};
163 push @{ $tables{ $table_name }{'permissions'} }, {
164 type => 'revoke',
165 actions => $item[2],
166 users => $item[6],
167 }
168 }
169
170grant : /grant/i WORD(s /,/) /on/i table_name /to/i name_with_opt_quotes(s /,/) ';'
171 {
172 my $table_name = $item{'table_name'};
173 push @{ $tables{ $table_name }{'permissions'} }, {
174 type => 'grant',
175 actions => $item[2],
176 users => $item[6],
177 }
178 }
179
180drop : /drop/i /[^;]*/ ';'
4422e22a 181
0012a163 182#
183# Create table.
184#
ba1a1626 185create : create_table table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
0efb6e1b 186 {
187 my $table_name = $item{'table_name'};
188 $tables{ $table_name }{'order'} = ++$table_order;
189 $tables{ $table_name }{'table_name'} = $table_name;
190
191 my $i = 1;
192 my @constraints;
193 for my $definition ( @{ $item[4] } ) {
194 if ( $definition->{'type'} eq 'field' ) {
195 my $field_name = $definition->{'name'};
196 $tables{ $table_name }{'fields'}{ $field_name } =
197 { %$definition, order => $i };
198 $i++;
4422e22a 199
0138f7bb 200 for my $constraint ( @{ $definition->{'constraints'} || [] } ) {
201 $constraint->{'fields'} = [ $field_name ];
7d5bcab8 202 push @{ $tables{ $table_name }{'constraints'} },
0138f7bb 203 $constraint;
0efb6e1b 204 }
205 }
206 elsif ( $definition->{'type'} eq 'constraint' ) {
207 $definition->{'type'} = $definition->{'constraint_type'};
0138f7bb 208 # group FKs at the field level
82968eb9 209# if ( $definition->{'type'} eq 'foreign_key' ) {
210# for my $fld ( @{ $definition->{'fields'} || [] } ) {
211# push @{
212# $tables{$table_name}{'fields'}{$fld}{'constraints'}
213# }, $definition;
214# }
215# }
216# else {
0138f7bb 217 push @{ $tables{ $table_name }{'constraints'} },
218 $definition;
82968eb9 219# }
0efb6e1b 220 }
221 else {
222 push @{ $tables{ $table_name }{'indices'} }, $definition;
223 }
224 }
225
226 for my $option ( @{ $item[6] } ) {
3022f45b 227 $tables{ $table_name }{'table_options(s?)'}{ $option->{'type'} } =
0efb6e1b 228 $option;
229 }
230
231 1;
232 }
233
0012a163 234#
235# Create index.
236#
0efb6e1b 237create : /create/i unique(?) /(index|key)/i index_name /on/i table_name using_method(?) '(' field_name(s /,/) ')' where_predicate(?) ';'
4422e22a 238 {
239 push @{ $tables{ $item{'table_name'} }{'indices'} },
240 {
0efb6e1b 241 name => $item{'index_name'},
242 type => $item{'unique'}[0] ? 'unique' : 'normal',
243 fields => $item[9],
244 method => $item{'using_method'}[0],
4422e22a 245 }
246 ;
247 }
248
0012a163 249#
250# Create anything else (e.g., domain, function, etc.)
251#
252create : /create/i WORD /[^;]+/ ';'
253
0efb6e1b 254using_method : /using/i WORD { $item[2] }
255
256where_predicate : /where/i /[^;]+/
257
258create_definition : field
0efb6e1b 259 | table_constraint
4422e22a 260 | <error>
261
262comment : /^\s*(?:#|-{2}).*\n/
263
f2f71b8e 264field : comment(s?) field_name data_type field_meta(s?) comment(s?)
4422e22a 265 {
3022f45b 266 my ( $default, @constraints, $is_pk );
82968eb9 267 my $null = 1;
41fc9cb3 268 for my $meta ( @{ $item[4] } ) {
82968eb9 269 if ( $meta->{'type'} eq 'default' ) {
270 $default = $meta;
271 next;
272 }
273 elsif ( $meta->{'type'} eq 'not_null' ) {
274 $null = 0;
275 next;
276 }
277 elsif ( $meta->{'type'} eq 'primary_key' ) {
278 $is_pk = 1;
279 }
4422e22a 280
82968eb9 281 push @constraints, $meta if $meta->{'supertype'} eq 'constraint';
282 }
0efb6e1b 283
f2f71b8e 284 my @comments = ( @{ $item[1] }, @{ $item[5] } );
285
0a7fc605 286 $return = {
4422e22a 287 type => 'field',
288 name => $item{'field_name'},
289 data_type => $item{'data_type'}{'type'},
290 size => $item{'data_type'}{'size'},
4422e22a 291 null => $null,
0efb6e1b 292 default => $default->{'value'},
293 constraints => [ @constraints ],
f2f71b8e 294 comments => [ @comments ],
3022f45b 295 is_primary_key => $is_pk || 0,
4422e22a 296 }
297 }
298 | <error>
299
0efb6e1b 300field_meta : default_val
82968eb9 301 | column_constraint
4422e22a 302
0efb6e1b 303column_constraint : constraint_name(?) column_constraint_type deferrable(?) deferred(?)
304 {
305 my $desc = $item{'column_constraint_type'};
306 my $type = $desc->{'type'};
307 my $fields = $desc->{'fields'} || [];
308 my $expression = $desc->{'expression'} || '';
309
310 $return = {
82968eb9 311 supertype => 'constraint',
0efb6e1b 312 name => $item{'constraint_name'}[0] || '',
313 type => $type,
314 expression => $type eq 'check' ? $expression : '',
315 deferreable => $item{'deferrable'},
316 deferred => $item{'deferred'},
317 reference_table => $desc->{'reference_table'},
318 reference_fields => $desc->{'reference_fields'},
319 match_type => $desc->{'match_type'},
320 on_delete_do => $desc->{'on_delete_do'},
321 on_update_do => $desc->{'on_update_do'},
4422e22a 322 }
323 }
324
0efb6e1b 325constraint_name : /constraint/i name_with_opt_quotes { $item[2] }
326
327column_constraint_type : /not null/i { $return = { type => 'not_null' } }
328 |
329 /null/
330 { $return = { type => 'null' } }
331 |
332 /unique/
333 { $return = { type => 'unique' } }
334 |
335 /primary key/i
336 { $return = { type => 'primary_key' } }
337 |
338 /check/i '(' /[^)]+/ ')'
339 { $return = { type => 'check', expression => $item[2] } }
340 |
3022f45b 341 /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 342 {
3022f45b 343 my ( $on_delete, $on_update );
344 for my $action ( @{ $item[5] || [] } ) {
345 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
346 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
347 }
348
0efb6e1b 349 $return = {
350 type => 'foreign_key',
351 reference_table => $item[2],
0138f7bb 352 reference_fields => $item[3][0],
0efb6e1b 353 match_type => $item[4][0],
3022f45b 354 on_delete_do => $on_delete,
355 on_update_do => $on_update,
ba1a1626 356 }
4422e22a 357 }
358
0efb6e1b 359table_name : name_with_opt_quotes
4422e22a 360
0efb6e1b 361field_name : name_with_opt_quotes
4422e22a 362
0012a163 363name_with_opt_quotes : double_quote(?) NAME double_quote(?) { $item[2] }
4422e22a 364
0efb6e1b 365double_quote: /"/
4422e22a 366
0efb6e1b 367index_name : WORD
4422e22a 368
0efb6e1b 369data_type : pg_data_type parens_value_list(?)
4422e22a 370 {
3022f45b 371 my $data_type = $item[1];
ba1a1626 372
0efb6e1b 373 #
374 # We can deduce some sizes from the data type's name.
375 #
82968eb9 376 $data_type->{'size'} ||= $item[2][0];
4422e22a 377
3022f45b 378 $return = $data_type;
4422e22a 379 }
380
0efb6e1b 381pg_data_type :
3022f45b 382 /(bigint|int8|bigserial|serial8)/
383 {
384 $return = {
385 type => 'integer',
7a88750c 386 size => [8],
3022f45b 387 auto_increment => 1,
388 };
389 }
0efb6e1b 390 |
3022f45b 391 /(smallint|int2)/
392 {
393 $return = {
394 type => 'integer',
7a88750c 395 size => [2],
3022f45b 396 };
397 }
0efb6e1b 398 |
3022f45b 399 /int(eger)?|int4/
400 {
401 $return = {
402 type => 'integer',
7a88750c 403 size => [4],
3022f45b 404 };
405 }
0efb6e1b 406 |
3022f45b 407 /(double precision|float8?)/
408 {
409 $return = {
410 type => 'float',
7a88750c 411 size => [8],
3022f45b 412 };
413 }
0efb6e1b 414 |
3022f45b 415 /(real|float4)/
416 {
417 $return = {
418 type => 'real',
7a88750c 419 size => [4],
3022f45b 420 };
421 }
0efb6e1b 422 |
3022f45b 423 /serial4?/
424 {
425 $return = {
426 type => 'integer',
7a88750c 427 size => [4],
3022f45b 428 auto_increment => 1,
429 };
430 }
0efb6e1b 431 |
3022f45b 432 /bigserial/
433 {
434 $return = {
435 type => 'integer',
7a88750c 436 size => [8],
3022f45b 437 auto_increment => 1,
438 };
439 }
0efb6e1b 440 |
3022f45b 441 /(bit varying|varbit)/
442 {
443 $return = { type => 'varbit' };
444 }
0efb6e1b 445 |
3022f45b 446 /character varying/
447 {
448 $return = { type => 'varchar' };
449 }
0efb6e1b 450 |
3022f45b 451 /char(acter)?/
452 {
453 $return = { type => 'char' };
454 }
0efb6e1b 455 |
3022f45b 456 /bool(ean)?/
457 {
458 $return = { type => 'boolean' };
459 }
0efb6e1b 460 |
82968eb9 461 /bytea/
3022f45b 462 {
82968eb9 463 $return = { type => 'bytea' };
3022f45b 464 }
0efb6e1b 465 |
3022f45b 466 /timestampz?/
467 {
468 $return = { type => 'timestamp' };
469 }
0efb6e1b 470 |
471 /(bit|box|cidr|circle|date|inet|interval|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|text|time|varchar)/
3022f45b 472 {
473 $return = { type => $item[1] };
474 }
0efb6e1b 475
4422e22a 476parens_value_list : '(' VALUE(s /,/) ')'
477 { $item[2] }
478
0efb6e1b 479parens_word_list : '(' WORD(s /,/) ')'
480 { $item[2] }
4422e22a 481
0efb6e1b 482field_size : '(' num_range ')' { $item{'num_range'} }
4422e22a 483
0efb6e1b 484num_range : DIGITS ',' DIGITS
4422e22a 485 { $return = $item[1].','.$item[3] }
486 | DIGITS
487 { $return = $item[1] }
488
f2f71b8e 489table_constraint : comment(s?) constraint_name(?) table_constraint_type deferrable(?) deferred(?) comment(s?)
0efb6e1b 490 {
491 my $desc = $item{'table_constraint_type'};
492 my $type = $desc->{'type'};
493 my $fields = $desc->{'fields'};
494 my $expression = $desc->{'expression'};
f2f71b8e 495 my @comments = ( @{ $item[1] }, @{ $item[-1] } );
0efb6e1b 496
497 $return = {
498 name => $item{'constraint_name'}[0] || '',
499 type => 'constraint',
500 constraint_type => $type,
501 fields => $type ne 'check' ? $fields : [],
502 expression => $type eq 'check' ? $expression : '',
503 deferreable => $item{'deferrable'},
504 deferred => $item{'deferred'},
505 reference_table => $desc->{'reference_table'},
506 reference_fields => $desc->{'reference_fields'},
507 match_type => $desc->{'match_type'}[0],
0012a163 508 on_delete_do => $desc->{'on_delete_do'},
509 on_update_do => $desc->{'on_update_do'},
f2f71b8e 510 comments => [ @comments ],
0efb6e1b 511 }
512 }
4422e22a 513
0efb6e1b 514table_constraint_type : /primary key/i '(' name_with_opt_quotes(s /,/) ')'
515 {
516 $return = {
517 type => 'primary_key',
518 fields => $item[3],
519 }
520 }
521 |
522 /unique/i '(' name_with_opt_quotes(s /,/) ')'
523 {
524 $return = {
525 type => 'unique',
526 fields => $item[3],
527 }
528 }
529 |
530 /check/ '(' /(.+)/ ')'
531 {
532 $return = {
533 type => 'check',
534 expression => $item[3],
535 }
536 }
537 |
3022f45b 538 /foreign key/i '(' name_with_opt_quotes(s /,/) ')' /references/i table_name parens_word_list(?) match_type(?) key_action(s?)
0efb6e1b 539 {
3022f45b 540 my ( $on_delete, $on_update );
541 for my $action ( @{ $item[9] || [] } ) {
542 $on_delete = $action->{'action'} if $action->{'type'} eq 'delete';
543 $on_update = $action->{'action'} if $action->{'type'} eq 'update';
544 }
545
0efb6e1b 546 $return = {
547 type => 'foreign_key',
548 fields => $item[3],
549 reference_table => $item[6],
550 reference_fields => $item[7][0],
551 match_type => $item[8][0],
3022f45b 552 on_delete_do => $on_delete || '',
553 on_update_do => $on_update || '',
0efb6e1b 554 }
555 }
556
557deferrable : /not/i /deferrable/i
558 {
559 $return = ( $item[1] =~ /not/i ) ? 0 : 1;
560 }
4422e22a 561
0efb6e1b 562deferred : /initially/i /(deferred|immediate)/i { $item[2] }
4422e22a 563
0efb6e1b 564match_type : /match full/i { 'match_full' }
565 |
566 /match partial/i { 'match_partial' }
567
3022f45b 568key_action : key_delete
569 |
570 key_update
0efb6e1b 571
3022f45b 572key_delete : /on delete/i key_mutation
573 {
574 $return => {
575 type => 'delete',
576 action => $item[2],
577 };
578 }
579
580key_update : /on update/i key_mutation
581 {
582 $return => {
583 type => 'update',
584 action => $item[2],
585 };
586 }
587
588key_mutation : /no action/i { $return = 'no_action' }
589 |
590 /restrict/i { $return = 'restrict' }
591 |
592 /cascade/i { $return = 'cascade' }
593 |
594 /set null/i { $return = 'set_null' }
595 |
596 /set default/i { $return = 'set_default' }
0efb6e1b 597
0012a163 598alter : alter_table table_name /add/i table_constraint ';'
599 {
600 my $table_name = $item[2];
601 my $constraint = $item[4];
602 $constraint->{'type'} = $constraint->{'constraint_type'};
603 push @{ $tables{ $table_name }{'constraints'} }, $constraint;
604 }
605
606alter_table : /alter/i /table/i only(?)
607
608only : /only/i
609
0efb6e1b 610create_table : /create/i /table/i
611
612create_index : /create/i /index/i
4422e22a 613
614default_val : /default/i /(?:')?[\w\d.-]*(?:')?/
615 {
0efb6e1b 616 my $val = $item[2] || '';
617 $val =~ s/'//g;
618 $return = {
82968eb9 619 supertype => 'constraint',
620 type => 'default',
0efb6e1b 621 value => $val,
622 }
4422e22a 623 }
f27085c9 624 | /null/i
625 {
626 $return = {
627 supertype => 'constraint',
628 type => 'default',
629 value => 'NULL',
630 }
631 }
4422e22a 632
4422e22a 633name_with_opt_paren : NAME parens_value_list(s?)
0efb6e1b 634 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
4422e22a 635
636unique : /unique/i { 1 }
637
638key : /key/i | /index/i
639
0efb6e1b 640table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
4422e22a 641 {
0efb6e1b 642 $return = { type => 'inherits', table_name => $item[3] }
643 }
644 |
645 /with(out)? oids/i
646 {
647 $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
4422e22a 648 }
649
0efb6e1b 650SEMICOLON : /\s*;\n?/
651
4422e22a 652WORD : /\w+/
653
654DIGITS : /\d+/
655
656COMMA : ','
657
658NAME : "`" /\w+/ "`"
659 { $item[2] }
660 | /\w+/
661 { $item[1] }
0012a163 662 | /[\$\w]+/
663 { $item[1] }
4422e22a 664
665VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
666 { $item[1] }
667 | /'.*?'/ # XXX doesn't handle embedded quotes
668 { $item[1] }
669 | /NULL/
670 { 'NULL' }
671
672!;
673
674# -------------------------------------------------------------------
675sub parse {
676 my ( $translator, $data ) = @_;
677 $parser ||= Parse::RecDescent->new($GRAMMAR);
678
679 $::RD_TRACE = $translator->trace ? 1 : undef;
680 $DEBUG = $translator->debug;
681
682 unless (defined $parser) {
683 return $translator->error("Error instantiating Parse::RecDescent ".
684 "instance: Bad grammer");
685 }
686
687 my $result = $parser->startrule($data);
688 die "Parse failed.\n" unless defined $result;
689 warn Dumper($result) if $DEBUG;
82968eb9 690
691 my $schema = $translator->schema;
692 my @tables = sort {
693 $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
694 } keys %{ $result };
695
696 for my $table_name ( @tables ) {
697 my $tdata = $result->{ $table_name };
698 my $table = $schema->add_table(
699 name => $tdata->{'table_name'},
700 ) or die $schema->error;
701
702 my @fields = sort {
703 $tdata->{'fields'}->{$a}->{'order'}
704 <=>
705 $tdata->{'fields'}->{$b}->{'order'}
706 } keys %{ $tdata->{'fields'} };
707
708 for my $fname ( @fields ) {
709 my $fdata = $tdata->{'fields'}{ $fname };
710 my $field = $table->add_field(
711 name => $fdata->{'name'},
712 data_type => $fdata->{'data_type'},
713 size => $fdata->{'size'},
714 default_value => $fdata->{'default'},
715 is_auto_increment => $fdata->{'is_auto_inc'},
716 is_nullable => $fdata->{'null'},
717 ) or die $table->error;
718
719 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
720
721 for my $cdata ( @{ $fdata->{'constraints'} } ) {
722 next unless $cdata->{'type'} eq 'foreign_key';
723 $cdata->{'fields'} ||= [ $field->name ];
724 push @{ $tdata->{'constraints'} }, $cdata;
725 }
726 }
727
728 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
729 my $index = $table->add_index(
730 name => $idata->{'name'},
731 type => uc $idata->{'type'},
732 fields => $idata->{'fields'},
733 ) or die $table->error;
734 }
735
736 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
737 my $constraint = $table->add_constraint(
738 name => $cdata->{'name'},
739 type => $cdata->{'type'},
740 fields => $cdata->{'fields'},
741 reference_table => $cdata->{'reference_table'},
742 reference_fields => $cdata->{'reference_fields'},
743 match_type => $cdata->{'match_type'} || '',
744 on_delete => $cdata->{'on_delete_do'},
745 on_update => $cdata->{'on_update_do'},
746 ) or die $table->error;
747 }
748 }
749
4422e22a 750 return $result;
751}
752
7531;
754
82968eb9 755# -------------------------------------------------------------------
756# Rescue the drowning and tie your shoestrings.
757# Henry David Thoreau
758# -------------------------------------------------------------------
4422e22a 759
760=pod
761
0efb6e1b 762=head1 AUTHORS
4422e22a 763
764Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
0a7fc605 765Allen Day <allenday@ucla.edu>.
4422e22a 766
767=head1 SEE ALSO
768
769perl(1), Parse::RecDescent.
770
771=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)