projects / dbsrgits/SQL-Translator.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Added sorting of tables, other cosmetic changes.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / PostgreSQL.pm
CommitLineData
84012a55 1package SQL::Translator::Parser::PostgreSQL;
4422e22a 2
3# -------------------------------------------------------------------
82968eb9 4# $Id: PostgreSQL.pm,v 1.15 2003-06-06 22:27:46 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 ];
82968eb9 114$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\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 }
624
4422e22a 625name_with_opt_paren : NAME parens_value_list(s?)
0efb6e1b 626 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
4422e22a 627
628unique : /unique/i { 1 }
629
630key : /key/i | /index/i
631
0efb6e1b 632table_option : /inherits/i '(' name_with_opt_quotes(s /,/) ')'
4422e22a 633 {
0efb6e1b 634 $return = { type => 'inherits', table_name => $item[3] }
635 }
636 |
637 /with(out)? oids/i
638 {
639 $return = { type => $item[1] =~ /out/i ? 'without_oids' : 'with_oids' }
4422e22a 640 }
641
0efb6e1b 642SEMICOLON : /\s*;\n?/
643
4422e22a 644WORD : /\w+/
645
646DIGITS : /\d+/
647
648COMMA : ','
649
650NAME : "`" /\w+/ "`"
651 { $item[2] }
652 | /\w+/
653 { $item[1] }
0012a163 654 | /[\$\w]+/
655 { $item[1] }
4422e22a 656
657VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
658 { $item[1] }
659 | /'.*?'/ # XXX doesn't handle embedded quotes
660 { $item[1] }
661 | /NULL/
662 { 'NULL' }
663
664!;
665
666# -------------------------------------------------------------------
667sub parse {
668 my ( $translator, $data ) = @_;
669 $parser ||= Parse::RecDescent->new($GRAMMAR);
670
671 $::RD_TRACE = $translator->trace ? 1 : undef;
672 $DEBUG = $translator->debug;
673
674 unless (defined $parser) {
675 return $translator->error("Error instantiating Parse::RecDescent ".
676 "instance: Bad grammer");
677 }
678
679 my $result = $parser->startrule($data);
680 die "Parse failed.\n" unless defined $result;
681 warn Dumper($result) if $DEBUG;
82968eb9 682
683 my $schema = $translator->schema;
684 my @tables = sort {
685 $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
686 } keys %{ $result };
687
688 for my $table_name ( @tables ) {
689 my $tdata = $result->{ $table_name };
690 my $table = $schema->add_table(
691 name => $tdata->{'table_name'},
692 ) or die $schema->error;
693
694 my @fields = sort {
695 $tdata->{'fields'}->{$a}->{'order'}
696 <=>
697 $tdata->{'fields'}->{$b}->{'order'}
698 } keys %{ $tdata->{'fields'} };
699
700 for my $fname ( @fields ) {
701 my $fdata = $tdata->{'fields'}{ $fname };
702 my $field = $table->add_field(
703 name => $fdata->{'name'},
704 data_type => $fdata->{'data_type'},
705 size => $fdata->{'size'},
706 default_value => $fdata->{'default'},
707 is_auto_increment => $fdata->{'is_auto_inc'},
708 is_nullable => $fdata->{'null'},
709 ) or die $table->error;
710
711 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
712
713 for my $cdata ( @{ $fdata->{'constraints'} } ) {
714 next unless $cdata->{'type'} eq 'foreign_key';
715 $cdata->{'fields'} ||= [ $field->name ];
716 push @{ $tdata->{'constraints'} }, $cdata;
717 }
718 }
719
720 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
721 my $index = $table->add_index(
722 name => $idata->{'name'},
723 type => uc $idata->{'type'},
724 fields => $idata->{'fields'},
725 ) or die $table->error;
726 }
727
728 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
729 my $constraint = $table->add_constraint(
730 name => $cdata->{'name'},
731 type => $cdata->{'type'},
732 fields => $cdata->{'fields'},
733 reference_table => $cdata->{'reference_table'},
734 reference_fields => $cdata->{'reference_fields'},
735 match_type => $cdata->{'match_type'} || '',
736 on_delete => $cdata->{'on_delete_do'},
737 on_update => $cdata->{'on_update_do'},
738 ) or die $table->error;
739 }
740 }
741
4422e22a 742 return $result;
743}
744
7451;
746
82968eb9 747# -------------------------------------------------------------------
748# Rescue the drowning and tie your shoestrings.
749# Henry David Thoreau
750# -------------------------------------------------------------------
4422e22a 751
752=pod
753
0efb6e1b 754=head1 AUTHORS
4422e22a 755
756Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
0a7fc605 757Allen Day <allenday@ucla.edu>.
4422e22a 758
759=head1 SEE ALSO
760
761perl(1), Parse::RecDescent.
762
763=cut
DDL Tool (dbsrgits@git.shadowcat.co.uk:SQL-Translator.git)