Allow skipped insert statements and trigger bodies to contain quoted semi-colons
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm
CommitLineData
16dc9970 1package SQL::Translator::Parser::MySQL;
2
49e1eb70 3# -------------------------------------------------------------------
9bf756df 4# $Id: MySQL.pm,v 1.54 2006-06-09 13:56:58 schiffbruechige Exp $
49e1eb70 5# -------------------------------------------------------------------
90075866 6# Copyright (C) 2002-4 SQLFairy Authors
077ebf34 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
19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20# 02111-1307 USA
21# -------------------------------------------------------------------
16dc9970 22
d529894e 23=head1 NAME
24
25SQL::Translator::Parser::MySQL - parser for MySQL
26
27=head1 SYNOPSIS
28
29 use SQL::Translator;
30 use SQL::Translator::Parser::MySQL;
31
32 my $translator = SQL::Translator->new;
33 $translator->parser("SQL::Translator::Parser::MySQL");
34
35=head1 DESCRIPTION
36
37The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
38
629b76f9 39Here's the word from the MySQL site
40(http://www.mysql.com/doc/en/CREATE_TABLE.html):
41
42 CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
43 [table_options] [select_statement]
44
45 or
46
47 CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
48
49 create_definition:
50 col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
51 [PRIMARY KEY] [reference_definition]
52 or PRIMARY KEY (index_col_name,...)
53 or KEY [index_name] (index_col_name,...)
54 or INDEX [index_name] (index_col_name,...)
55 or UNIQUE [INDEX] [index_name] (index_col_name,...)
56 or FULLTEXT [INDEX] [index_name] (index_col_name,...)
57 or [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
58 [reference_definition]
59 or CHECK (expr)
60
61 type:
62 TINYINT[(length)] [UNSIGNED] [ZEROFILL]
63 or SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
64 or MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
65 or INT[(length)] [UNSIGNED] [ZEROFILL]
66 or INTEGER[(length)] [UNSIGNED] [ZEROFILL]
67 or BIGINT[(length)] [UNSIGNED] [ZEROFILL]
68 or REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
69 or DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
70 or FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
71 or DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
72 or NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
73 or CHAR(length) [BINARY]
74 or VARCHAR(length) [BINARY]
75 or DATE
76 or TIME
77 or TIMESTAMP
78 or DATETIME
79 or TINYBLOB
80 or BLOB
81 or MEDIUMBLOB
82 or LONGBLOB
83 or TINYTEXT
84 or TEXT
85 or MEDIUMTEXT
86 or LONGTEXT
87 or ENUM(value1,value2,value3,...)
88 or SET(value1,value2,value3,...)
89
90 index_col_name:
91 col_name [(length)]
92
93 reference_definition:
94 REFERENCES tbl_name [(index_col_name,...)]
95 [MATCH FULL | MATCH PARTIAL]
96 [ON DELETE reference_option]
97 [ON UPDATE reference_option]
98
99 reference_option:
100 RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
101
102 table_options:
103 TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
104 or AUTO_INCREMENT = #
105 or AVG_ROW_LENGTH = #
106 or CHECKSUM = {0 | 1}
107 or COMMENT = "string"
108 or MAX_ROWS = #
109 or MIN_ROWS = #
110 or PACK_KEYS = {0 | 1 | DEFAULT}
111 or PASSWORD = "string"
112 or DELAY_KEY_WRITE = {0 | 1}
113 or ROW_FORMAT= { default | dynamic | fixed | compressed }
114 or RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=# RAID_CHUNKSIZE=#
115 or UNION = (table_name,[table_name...])
116 or INSERT_METHOD= {NO | FIRST | LAST }
117 or DATA DIRECTORY="absolute path to directory"
118 or INDEX DIRECTORY="absolute path to directory"
119
13aec984 120A subset of the ALTER TABLE syntax that allows addition of foreign keys:
121
122 ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
123
124 alter_specification:
125 ADD [CONSTRAINT [symbol]]
126 FOREIGN KEY [index_name] (index_col_name,...)
127 [reference_definition]
128
129A subset of INSERT that we ignore:
130
131 INSERT anything
132
d529894e 133=cut
134
16dc9970 135use strict;
d529894e 136use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
9bf756df 137$VERSION = sprintf "%d.%02d", q$Revision: 1.54 $ =~ /(\d+)\.(\d+)/;
8d0f3086 138$DEBUG = 0 unless defined $DEBUG;
077ebf34 139
d529894e 140use Data::Dumper;
077ebf34 141use Parse::RecDescent;
142use Exporter;
143use base qw(Exporter);
144
145@EXPORT_OK = qw(parse);
146
d529894e 147# Enable warnings within the Parse::RecDescent module.
148$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
149$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.
150$::RD_HINT = 1; # Give out hints to help fix problems.
151
9bf756df 152$GRAMMAR = << 'END_OF_GRAMMAR';
d529894e 153
8ccdeb42 154{
13aec984 155 my ( $database_name, %tables, $table_order, @table_comments );
8ccdeb42 156}
d529894e 157
629b76f9 158#
159# The "eofile" rule makes the parser fail if any "statement" rule
160# fails. Otherwise, the first successful match by a "statement"
161# won't cause the failure needed to know that the parse, as a whole,
162# failed. -ky
163#
13aec984 164startrule : statement(s) eofile {
165 { tables => \%tables, database_name => $database_name }
166}
629b76f9 167
168eofile : /^\Z/
d529894e 169
170statement : comment
dcb4fa06 171 | use
33d0d6d4 172 | set
61745327 173 | drop
d529894e 174 | create
13aec984 175 | alter
176 | insert
d529894e 177 | <error>
178
dcb4fa06 179use : /use/i WORD ';'
13aec984 180 {
181 $database_name = $item[2];
182 @table_comments = ();
183 }
dcb4fa06 184
33d0d6d4 185set : /set/i /[^;]+/ ';'
c5dabd71 186 { @table_comments = () }
734dfc91 187
2e8dfb76 188drop : /drop/i TABLE /[^;]+/ ';'
33d0d6d4 189
61745327 190drop : /drop/i WORD(s) ';'
c5dabd71 191 { @table_comments = () }
61745327 192
9bf756df 193string :
194 # MySQL strings, unlike common SQL strings, can be double-quoted or
195 # single-quoted, and you can escape the delmiters by doubling (but only the
196 # delimiter) or by backslashing.
197
198 /'(\\.|''|[^\\\'])*'/ |
199 /"(\\.|""|[^\\\"])*"/
200 # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
201
202nonstring : /[^;\'"]+/
203
204statement_body : (string | nonstring)(s?)
205
206insert : /insert/i statement_body ';'
13aec984 207
208alter : ALTER TABLE table_name alter_specification(s /,/) ';'
209 {
210 my $table_name = $item{'table_name'};
211 die "Cannot ALTER table '$table_name'; it does not exist"
212 unless $tables{ $table_name };
213 for my $definition ( @{ $item[4] } ) {
214 $definition->{'extra'}->{'alter'} = 1;
215 push @{ $tables{ $table_name }{'constraints'} }, $definition;
216 }
217 }
218
219alter_specification : ADD foreign_key_def
220 { $return = $item[2] }
221
dcb4fa06 222create : CREATE /database/i WORD ';'
c5dabd71 223 { @table_comments = () }
dcb4fa06 224
13aec984 225create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) ';'
d529894e 226 {
227 my $table_name = $item{'table_name'};
228 $tables{ $table_name }{'order'} = ++$table_order;
229 $tables{ $table_name }{'table_name'} = $table_name;
230
734dfc91 231 if ( @table_comments ) {
232 $tables{ $table_name }{'comments'} = [ @table_comments ];
233 @table_comments = ();
234 }
235
61745327 236 my $i = 1;
40c1ade1 237 for my $definition ( @{ $item[7] } ) {
f2cf1734 238 if ( $definition->{'supertype'} eq 'field' ) {
d529894e 239 my $field_name = $definition->{'name'};
240 $tables{ $table_name }{'fields'}{ $field_name } =
241 { %$definition, order => $i };
242 $i++;
243
244 if ( $definition->{'is_primary_key'} ) {
f2cf1734 245 push @{ $tables{ $table_name }{'constraints'} },
d529894e 246 {
247 type => 'primary_key',
248 fields => [ $field_name ],
16dc9970 249 }
d529894e 250 ;
251 }
dd2ef5ae 252 }
f2cf1734 253 elsif ( $definition->{'supertype'} eq 'constraint' ) {
f2cf1734 254 push @{ $tables{ $table_name }{'constraints'} }, $definition;
40c1ade1 255 }
f2cf1734 256 elsif ( $definition->{'supertype'} eq 'index' ) {
734dfc91 257 push @{ $tables{ $table_name }{'indices'} }, $definition;
dd2ef5ae 258 }
d529894e 259 }
dd2ef5ae 260
02a21f1a 261 if ( my @options = @{ $item{'table_option(s?)'} } ) {
35843e6b 262 for my $option ( @options ) {
263 my ( $key, $value ) = each %$option;
264 if ( $key eq 'comment' ) {
265 push @{ $tables{ $table_name }{'comments'} }, $value;
266 }
267 else {
268 push @{ $tables{ $table_name }{'table_options'} }, $option;
269 }
270 }
d529894e 271 }
58a88238 272
273 1;
d529894e 274 }
dd2ef5ae 275
40c1ade1 276opt_if_not_exists : /if not exists/i
277
f2cf1734 278create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
d529894e 279 {
734dfc91 280 @table_comments = ();
d529894e 281 push @{ $tables{ $item{'table_name'} }{'indices'} },
282 {
283 name => $item[4],
284 type => $item[2] ? 'unique' : 'normal',
285 fields => $item[8],
dd2ef5ae 286 }
d529894e 287 ;
288 }
dd2ef5ae 289
f2cf1734 290create_definition : constraint
291 | index
d529894e 292 | field
02a21f1a 293 | comment
d529894e 294 | <error>
295
734dfc91 296comment : /^\s*(?:#|-{2}).*\n/
297 {
298 my $comment = $item[1];
a82fa2cb 299 $comment =~ s/^\s*(#|--)\s*//;
734dfc91 300 $comment =~ s/\s*$//;
301 $return = $comment;
734dfc91 302 }
303
e78d62f2 304comment : /\/\*/ /[^\*]+/ /\*\// ';'
305 {
306 my $comment = $item[2];
307 $comment =~ s/^\s*|\s*$//g;
308 $return = $comment;
309 }
310
734dfc91 311field_comment : /^\s*(?:#|-{2}).*\n/
312 {
313 my $comment = $item[1];
a82fa2cb 314 $comment =~ s/^\s*(#|--)\s*//;
734dfc91 315 $comment =~ s/\s*$//;
316 $return = $comment;
317 }
d529894e 318
35843e6b 319
320field_comment2 : /comment/i /'.*?'/
321 {
322 my $comment = $item[2];
323 $comment =~ s/^'//;
324 $comment =~ s/'$//;
325 $return = $comment;
326 }
327
d529894e 328blank : /\s*/
329
100684f3 330field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
d529894e 331 {
734dfc91 332 my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
d529894e 333 if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
334 $qualifiers{ $_ } = 1 for @type_quals;
335 }
336
c5dabd71 337 my $null = defined $qualifiers{'not_null'}
338 ? $qualifiers{'not_null'} : 1;
339 delete $qualifiers{'not_null'};
340
35843e6b 341 my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
88b89793 342
d529894e 343 $return = {
f2cf1734 344 supertype => 'field',
345 name => $item{'field_name'},
346 data_type => $item{'data_type'}{'type'},
347 size => $item{'data_type'}{'size'},
348 list => $item{'data_type'}{'list'},
349 null => $null,
350 constraints => $item{'reference_definition(?)'},
88b89793 351 comments => [ @comments ],
d529894e 352 %qualifiers,
353 }
354 }
355 | <error>
dd2ef5ae 356
d529894e 357field_qualifier : not_null
358 {
359 $return = {
360 null => $item{'not_null'},
361 }
362 }
16dc9970 363
d529894e 364field_qualifier : default_val
365 {
366 $return = {
367 default => $item{'default_val'},
368 }
369 }
16dc9970 370
d529894e 371field_qualifier : auto_inc
372 {
373 $return = {
374 is_auto_inc => $item{'auto_inc'},
375 }
376 }
16dc9970 377
d529894e 378field_qualifier : primary_key
379 {
380 $return = {
381 is_primary_key => $item{'primary_key'},
382 }
383 }
16dc9970 384
d529894e 385field_qualifier : unsigned
386 {
387 $return = {
388 is_unsigned => $item{'unsigned'},
389 }
390 }
16dc9970 391
19c5bc53 392field_qualifier : /character set/i WORD
095b4549 393 {
394 $return = {
bd30a9a2 395 'CHARACTER SET' => $item[2],
396 }
397 }
398
399field_qualifier : /collate/i WORD
400 {
401 $return = {
402 COLLATE => $item[2],
403 }
404 }
405
406field_qualifier : /on update/i CURRENT_TIMESTAMP
407 {
408 $return = {
409 'ON UPDATE' => $item[2],
095b4549 410 }
411 }
412
bd356af8 413field_qualifier : /unique/i KEY(?)
414 {
415 $return = {
416 is_unique => 1,
417 }
418 }
419
420field_qualifier : KEY
421 {
422 $return = {
423 has_index => 1,
424 }
425 }
426
100684f3 427reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
658637cd 428 {
40c1ade1 429 $return = {
658637cd 430 type => 'foreign_key',
431 reference_table => $item[2],
432 reference_fields => $item[3][0],
433 match_type => $item[4][0],
100684f3 434 on_delete => $item[5][0],
435 on_update => $item[6][0],
658637cd 436 }
437 }
438
02a21f1a 439match_type : /match full/i { 'full' }
658637cd 440 |
02a21f1a 441 /match partial/i { 'partial' }
658637cd 442
100684f3 443on_delete : /on delete/i reference_option
658637cd 444 { $item[2] }
445
100684f3 446on_update :
6fa97af6 447 /on update/i 'CURRENT_TIMESTAMP'
448 { $item[2] }
449 |
450 /on update/i reference_option
658637cd 451 { $item[2] }
452
453reference_option: /restrict/i |
454 /cascade/i |
455 /set null/i |
456 /no action/i |
457 /set default/i
458 { $item[1] }
459
f2cf1734 460index : normal_index
371f5f88 461 | fulltext_index
58a88238 462 | <error>
d529894e 463
0d41bc9b 464table_name : NAME
d529894e 465
0d41bc9b 466field_name : NAME
d529894e 467
02a21f1a 468index_name : NAME
d529894e 469
470data_type : WORD parens_value_list(s?) type_qualifier(s?)
471 {
472 my $type = $item[1];
473 my $size; # field size, applicable only to non-set fields
474 my $list; # set list, applicable only to sets (duh)
475
44fcd0b5 476 if ( uc($type) =~ /^(SET|ENUM)$/ ) {
d529894e 477 $size = undef;
478 $list = $item[2][0];
479 }
480 else {
481 $size = $item[2][0];
482 $list = [];
483 }
484
6333c482 485 unless ( @{ $size || [] } ) {
486 if ( lc $type eq 'tinyint' ) {
7898fb70 487 $size = 4;
6333c482 488 }
489 elsif ( lc $type eq 'smallint' ) {
7898fb70 490 $size = 6;
6333c482 491 }
492 elsif ( lc $type eq 'mediumint' ) {
7898fb70 493 $size = 9;
6333c482 494 }
e78d62f2 495 elsif ( $type =~ /^int(eger)?$/i ) {
f2cf1734 496 $type = 'int';
7898fb70 497 $size = 11;
6333c482 498 }
499 elsif ( lc $type eq 'bigint' ) {
7898fb70 500 $size = 20;
6333c482 501 }
1eb08c80 502 elsif (
503 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
504 ) {
6333c482 505 $size = [8,2];
506 }
507 }
508
7898fb70 509 if ( $type =~ /^tiny(text|blob)$/i ) {
510 $size = 255;
256d534a 511 }
7898fb70 512 elsif ( $type =~ /^(blob|text)$/i ) {
513 $size = 65_535;
256d534a 514 }
7898fb70 515 elsif ( $type =~ /^medium(blob|text)$/i ) {
516 $size = 16_777_215;
256d534a 517 }
7898fb70 518 elsif ( $type =~ /^long(blob|text)$/i ) {
519 $size = 4_294_967_295;
256d534a 520 }
521
d529894e 522 $return = {
523 type => $type,
524 size => $size,
525 list => $list,
526 qualifiers => $item[3],
527 }
528 }
16dc9970 529
658637cd 530parens_field_list : '(' field_name(s /,/) ')'
531 { $item[2] }
532
d529894e 533parens_value_list : '(' VALUE(s /,/) ')'
534 { $item[2] }
16dc9970 535
d529894e 536type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
537 { lc $item[1] }
16dc9970 538
d529894e 539field_type : WORD
16dc9970 540
d529894e 541create_index : /create/i /index/i
dd2ef5ae 542
e78d62f2 543not_null : /not/i /null/i
544 { $return = 0 }
545 |
546 /null/i
547 { $return = 1 }
16dc9970 548
d529894e 549unsigned : /unsigned/i { $return = 0 }
16dc9970 550
09fa21a6 551#default_val : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
552# {
553# $item[2] =~ s/'//g;
554# $return = $item[2];
555# }
556
6fa97af6 557default_val :
558 /default/i 'CURRENT_TIMESTAMP'
559 {
560 $return = $item[2];
561 }
562 |
563 /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
09fa21a6 564 {
565 $item[2] =~ s/^\s*'|'\s*$//g;
d529894e 566 $return = $item[2];
567 }
16dc9970 568
d529894e 569auto_inc : /auto_increment/i { 1 }
16dc9970 570
d529894e 571primary_key : /primary/i /key/i { 1 }
16dc9970 572
f2cf1734 573constraint : primary_key_def
574 | unique_key_def
575 | foreign_key_def
576 | <error>
577
02a21f1a 578foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
40c1ade1 579 {
580 $return = {
f2cf1734 581 supertype => 'constraint',
40c1ade1 582 type => 'foreign_key',
02a21f1a 583 name => $item[1],
09fa21a6 584 fields => $item[2],
40c1ade1 585 %{ $item{'reference_definition'} },
586 }
587 }
588
e78d62f2 589foreign_key_def_begin : /constraint/i /foreign key/i WORD
590 { $return = $item[3] }
591 |
592 /constraint/i NAME /foreign key/i
593 { $return = $item[2] }
594 |
595 /constraint/i /foreign key/i
02a21f1a 596 { $return = '' }
597 |
e78d62f2 598 /foreign key/i WORD
02a21f1a 599 { $return = $item[2] }
600 |
601 /foreign key/i
602 { $return = '' }
40c1ade1 603
1853ba82 604primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 605 {
f2cf1734 606 $return = {
607 supertype => 'constraint',
608 name => $item{'index_name(?)'}[0],
609 type => 'primary_key',
610 fields => $item[4],
58a88238 611 };
d529894e 612 }
16dc9970 613
f2cf1734 614unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 615 {
f2cf1734 616 $return = {
617 supertype => 'constraint',
618 name => $item{'index_name(?)'}[0],
619 type => 'unique',
620 fields => $item[5],
d529894e 621 }
622 }
16dc9970 623
f2cf1734 624normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 625 {
f2cf1734 626 $return = {
627 supertype => 'index',
628 type => 'normal',
629 name => $item{'index_name(?)'}[0],
630 fields => $item[4],
d529894e 631 }
632 }
16dc9970 633
f2cf1734 634fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
371f5f88 635 {
f2cf1734 636 $return = {
637 supertype => 'index',
638 type => 'fulltext',
639 name => $item{'index_name(?)'}[0],
640 fields => $item[5],
371f5f88 641 }
642 }
643
d529894e 644name_with_opt_paren : NAME parens_value_list(s?)
645 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970 646
f2cf1734 647UNIQUE : /unique/i { 1 }
16dc9970 648
f2cf1734 649KEY : /key/i | /index/i
16dc9970 650
19c5bc53 651table_option : /comment/i /=/ /'.*?'/
35843e6b 652 {
653 my $comment = $item[3];
654 $comment =~ s/^'//;
655 $comment =~ s/'$//;
656 $return = { comment => $comment };
657 }
bd30a9a2 658 | /(default )?(charset|character set)/i /\s*=\s*/ WORD
d529894e 659 {
bd30a9a2 660 $return = { 'CHARACTER SET' => $item[3] };
d529894e 661 }
19c5bc53 662 | WORD /\s*=\s*/ WORD
663 {
664 $return = { $item[1] => $item[3] };
665 }
bd30a9a2 666
667default : /default/i
16dc9970 668
13aec984 669ADD : /add/i
670
671ALTER : /alter/i
672
40c1ade1 673CREATE : /create/i
674
675TEMPORARY : /temporary/i
676
677TABLE : /table/i
678
d529894e 679WORD : /\w+/
16dc9970 680
d529894e 681DIGITS : /\d+/
16dc9970 682
d529894e 683COMMA : ','
16dc9970 684
d529894e 685NAME : "`" /\w+/ "`"
686 { $item[2] }
687 | /\w+/
688 { $item[1] }
16dc9970 689
d529894e 690VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
691 { $item[1] }
f2cf1734 692 | /'.*?'/
693 {
694 # remove leading/trailing quotes
695 my $val = $item[1];
696 $val =~ s/^['"]|['"]$//g;
697 $return = $val;
698 }
d529894e 699 | /NULL/
700 { 'NULL' }
16dc9970 701
bd30a9a2 702CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
703 | /now\(\)/i
704 { 'CURRENT_TIMESTAMP' }
705
9bf756df 706END_OF_GRAMMAR
16dc9970 707
d529894e 708# -------------------------------------------------------------------
709sub parse {
70944bc5 710 my ( $translator, $data ) = @_;
40c1ade1 711 my $parser = Parse::RecDescent->new($GRAMMAR);
077ebf34 712
e099bee9 713 local $::RD_TRACE = $translator->trace ? 1 : undef;
714 local $DEBUG = $translator->debug;
d529894e 715
716 unless (defined $parser) {
717 return $translator->error("Error instantiating Parse::RecDescent ".
718 "instance: Bad grammer");
719 }
720
721 my $result = $parser->startrule($data);
40c1ade1 722 return $translator->error( "Parse failed." ) unless defined $result;
13aec984 723 warn "Parse result:".Dumper( $result ) if $DEBUG;
8ccdeb42 724
70944bc5 725 my $schema = $translator->schema;
13aec984 726 $schema->name($result->{'database_name'}) if $result->{'database_name'};
727
034ecdec 728 my @tables = sort {
13aec984 729 $result->{'tables'}{ $a }{'order'}
730 <=>
731 $result->{'tables'}{ $b }{'order'}
732 } keys %{ $result->{'tables'} };
034ecdec 733
734 for my $table_name ( @tables ) {
13aec984 735 my $tdata = $result->{tables}{ $table_name };
8ccdeb42 736 my $table = $schema->add_table(
737 name => $tdata->{'table_name'},
40c1ade1 738 ) or die $schema->error;
8ccdeb42 739
734dfc91 740 $table->comments( $tdata->{'comments'} );
f2cf1734 741
8ccdeb42 742 my @fields = sort {
743 $tdata->{'fields'}->{$a}->{'order'}
744 <=>
745 $tdata->{'fields'}->{$b}->{'order'}
746 } keys %{ $tdata->{'fields'} };
747
748 for my $fname ( @fields ) {
749 my $fdata = $tdata->{'fields'}{ $fname };
750 my $field = $table->add_field(
751 name => $fdata->{'name'},
752 data_type => $fdata->{'data_type'},
753 size => $fdata->{'size'},
754 default_value => $fdata->{'default'},
755 is_auto_increment => $fdata->{'is_auto_inc'},
756 is_nullable => $fdata->{'null'},
88b89793 757 comments => $fdata->{'comments'},
40c1ade1 758 ) or die $table->error;
f2cf1734 759
760 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
761
bd30a9a2 762 for my $qual ( qw[ binary unsigned zerofill list collate ],
763 'character set', 'on update' ) {
f2cf1734 764 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
765 next if ref $val eq 'ARRAY' && !@$val;
766 $field->extra( $qual, $val );
767 }
768 }
769
bd356af8 770 if ( $fdata->{'has_index'} ) {
771 $table->add_index(
772 name => '',
773 type => 'NORMAL',
774 fields => $fdata->{'name'},
775 ) or die $table->error;
776 }
777
778 if ( $fdata->{'is_unique'} ) {
779 $table->add_constraint(
780 name => '',
781 type => 'UNIQUE',
782 fields => $fdata->{'name'},
783 ) or die $table->error;
784 }
785
f2cf1734 786 if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
787 my %extra = $field->extra;
d14fe688 788 my $longest = 0;
f2cf1734 789 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
790 $longest = $len if $len > $longest;
791 }
792 $field->size( $longest ) if $longest;
793 }
794
795 for my $cdata ( @{ $fdata->{'constraints'} } ) {
796 next unless $cdata->{'type'} eq 'foreign_key';
797 $cdata->{'fields'} ||= [ $field->name ];
798 push @{ $tdata->{'constraints'} }, $cdata;
799 }
800 }
801
802 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
803 my $index = $table->add_index(
804 name => $idata->{'name'},
805 type => uc $idata->{'type'},
806 fields => $idata->{'fields'},
807 ) or die $table->error;
808 }
809
02a21f1a 810 if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
811 $table->options( \@options ) or die $table->error;
812 }
813
f2cf1734 814 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
815 my $constraint = $table->add_constraint(
816 name => $cdata->{'name'},
817 type => $cdata->{'type'},
818 fields => $cdata->{'fields'},
819 reference_table => $cdata->{'reference_table'},
820 reference_fields => $cdata->{'reference_fields'},
821 match_type => $cdata->{'match_type'} || '',
100684f3 822 on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
823 on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'},
f2cf1734 824 ) or die $table->error;
8ccdeb42 825 }
826 }
827
f62bd16c 828 return 1;
d529894e 829}
830
8311;
832
034ecdec 833# -------------------------------------------------------------------
d529894e 834# Where man is not nature is barren.
835# William Blake
034ecdec 836# -------------------------------------------------------------------
16dc9970 837
d529894e 838=pod
16dc9970 839
840=head1 AUTHOR
841
19c5bc53 842Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
8ccdeb42 843Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
16dc9970 844
845=head1 SEE ALSO
846
19c5bc53 847Parse::RecDescent, SQL::Translator::Schema.
16dc9970 848
849=cut