Slight change to comment parsing to allow asterisks in comments
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm
CommitLineData
16dc9970 1package SQL::Translator::Parser::MySQL;
2
49e1eb70 3# -------------------------------------------------------------------
73212389 4# $Id: MySQL.pm,v 1.56 2007-02-19 20:15:13 duality72 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 ];
73212389 137$VERSION = sprintf "%d.%02d", q$Revision: 1.56 $ =~ /(\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 );
86318717 156 my $delimiter = ';';
8ccdeb42 157}
d529894e 158
629b76f9 159#
160# The "eofile" rule makes the parser fail if any "statement" rule
161# fails. Otherwise, the first successful match by a "statement"
162# won't cause the failure needed to know that the parse, as a whole,
163# failed. -ky
164#
13aec984 165startrule : statement(s) eofile {
166 { tables => \%tables, database_name => $database_name }
167}
629b76f9 168
169eofile : /^\Z/
d529894e 170
171statement : comment
dcb4fa06 172 | use
33d0d6d4 173 | set
61745327 174 | drop
d529894e 175 | create
13aec984 176 | alter
177 | insert
86318717 178 | delimiter
179 | empty_statement
d529894e 180 | <error>
181
86318717 182use : /use/i WORD "$delimiter"
13aec984 183 {
184 $database_name = $item[2];
185 @table_comments = ();
186 }
dcb4fa06 187
86318717 188set : /set/i /[^;]+/ "$delimiter"
c5dabd71 189 { @table_comments = () }
734dfc91 190
86318717 191drop : /drop/i TABLE /[^;]+/ "$delimiter"
33d0d6d4 192
86318717 193drop : /drop/i WORD(s) "$delimiter"
c5dabd71 194 { @table_comments = () }
61745327 195
9bf756df 196string :
197 # MySQL strings, unlike common SQL strings, can be double-quoted or
198 # single-quoted, and you can escape the delmiters by doubling (but only the
199 # delimiter) or by backslashing.
200
201 /'(\\.|''|[^\\\'])*'/ |
202 /"(\\.|""|[^\\\"])*"/
203 # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
204
205nonstring : /[^;\'"]+/
206
207statement_body : (string | nonstring)(s?)
208
86318717 209insert : /insert/i statement_body "$delimiter"
13aec984 210
86318717 211delimiter : /delimiter/i /[\S]+/
212 { $delimiter = $item[2] }
213
214empty_statement : "$delimiter"
215
216alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
13aec984 217 {
218 my $table_name = $item{'table_name'};
219 die "Cannot ALTER table '$table_name'; it does not exist"
220 unless $tables{ $table_name };
221 for my $definition ( @{ $item[4] } ) {
222 $definition->{'extra'}->{'alter'} = 1;
223 push @{ $tables{ $table_name }{'constraints'} }, $definition;
224 }
225 }
226
227alter_specification : ADD foreign_key_def
228 { $return = $item[2] }
229
86318717 230create : CREATE /database/i WORD "$delimiter"
c5dabd71 231 { @table_comments = () }
dcb4fa06 232
86318717 233create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
d529894e 234 {
235 my $table_name = $item{'table_name'};
236 $tables{ $table_name }{'order'} = ++$table_order;
237 $tables{ $table_name }{'table_name'} = $table_name;
238
734dfc91 239 if ( @table_comments ) {
240 $tables{ $table_name }{'comments'} = [ @table_comments ];
241 @table_comments = ();
242 }
243
61745327 244 my $i = 1;
40c1ade1 245 for my $definition ( @{ $item[7] } ) {
f2cf1734 246 if ( $definition->{'supertype'} eq 'field' ) {
d529894e 247 my $field_name = $definition->{'name'};
248 $tables{ $table_name }{'fields'}{ $field_name } =
249 { %$definition, order => $i };
250 $i++;
251
252 if ( $definition->{'is_primary_key'} ) {
f2cf1734 253 push @{ $tables{ $table_name }{'constraints'} },
d529894e 254 {
255 type => 'primary_key',
256 fields => [ $field_name ],
16dc9970 257 }
d529894e 258 ;
259 }
dd2ef5ae 260 }
f2cf1734 261 elsif ( $definition->{'supertype'} eq 'constraint' ) {
f2cf1734 262 push @{ $tables{ $table_name }{'constraints'} }, $definition;
40c1ade1 263 }
f2cf1734 264 elsif ( $definition->{'supertype'} eq 'index' ) {
734dfc91 265 push @{ $tables{ $table_name }{'indices'} }, $definition;
dd2ef5ae 266 }
d529894e 267 }
dd2ef5ae 268
02a21f1a 269 if ( my @options = @{ $item{'table_option(s?)'} } ) {
35843e6b 270 for my $option ( @options ) {
271 my ( $key, $value ) = each %$option;
272 if ( $key eq 'comment' ) {
273 push @{ $tables{ $table_name }{'comments'} }, $value;
274 }
275 else {
276 push @{ $tables{ $table_name }{'table_options'} }, $option;
277 }
278 }
d529894e 279 }
58a88238 280
281 1;
d529894e 282 }
dd2ef5ae 283
40c1ade1 284opt_if_not_exists : /if not exists/i
285
86318717 286create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
d529894e 287 {
734dfc91 288 @table_comments = ();
d529894e 289 push @{ $tables{ $item{'table_name'} }{'indices'} },
290 {
291 name => $item[4],
292 type => $item[2] ? 'unique' : 'normal',
293 fields => $item[8],
dd2ef5ae 294 }
d529894e 295 ;
296 }
dd2ef5ae 297
f2cf1734 298create_definition : constraint
299 | index
d529894e 300 | field
02a21f1a 301 | comment
d529894e 302 | <error>
303
734dfc91 304comment : /^\s*(?:#|-{2}).*\n/
305 {
306 my $comment = $item[1];
a82fa2cb 307 $comment =~ s/^\s*(#|--)\s*//;
734dfc91 308 $comment =~ s/\s*$//;
309 $return = $comment;
734dfc91 310 }
311
73212389 312comment : /\/\*/ /.*?\*\//
e78d62f2 313 {
314 my $comment = $item[2];
73212389 315 $comment = substr($comment, 0, -2);
e78d62f2 316 $comment =~ s/^\s*|\s*$//g;
317 $return = $comment;
318 }
86318717 319
734dfc91 320field_comment : /^\s*(?:#|-{2}).*\n/
321 {
322 my $comment = $item[1];
a82fa2cb 323 $comment =~ s/^\s*(#|--)\s*//;
734dfc91 324 $comment =~ s/\s*$//;
325 $return = $comment;
326 }
d529894e 327
35843e6b 328
329field_comment2 : /comment/i /'.*?'/
330 {
331 my $comment = $item[2];
332 $comment =~ s/^'//;
333 $comment =~ s/'$//;
334 $return = $comment;
335 }
336
d529894e 337blank : /\s*/
338
100684f3 339field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
d529894e 340 {
734dfc91 341 my %qualifiers = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
d529894e 342 if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
343 $qualifiers{ $_ } = 1 for @type_quals;
344 }
345
c5dabd71 346 my $null = defined $qualifiers{'not_null'}
347 ? $qualifiers{'not_null'} : 1;
348 delete $qualifiers{'not_null'};
349
35843e6b 350 my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
88b89793 351
d529894e 352 $return = {
f2cf1734 353 supertype => 'field',
354 name => $item{'field_name'},
355 data_type => $item{'data_type'}{'type'},
356 size => $item{'data_type'}{'size'},
357 list => $item{'data_type'}{'list'},
358 null => $null,
359 constraints => $item{'reference_definition(?)'},
88b89793 360 comments => [ @comments ],
d529894e 361 %qualifiers,
362 }
363 }
364 | <error>
dd2ef5ae 365
d529894e 366field_qualifier : not_null
367 {
368 $return = {
369 null => $item{'not_null'},
370 }
371 }
16dc9970 372
d529894e 373field_qualifier : default_val
374 {
375 $return = {
376 default => $item{'default_val'},
377 }
378 }
16dc9970 379
d529894e 380field_qualifier : auto_inc
381 {
382 $return = {
383 is_auto_inc => $item{'auto_inc'},
384 }
385 }
16dc9970 386
d529894e 387field_qualifier : primary_key
388 {
389 $return = {
390 is_primary_key => $item{'primary_key'},
391 }
392 }
16dc9970 393
d529894e 394field_qualifier : unsigned
395 {
396 $return = {
397 is_unsigned => $item{'unsigned'},
398 }
399 }
16dc9970 400
19c5bc53 401field_qualifier : /character set/i WORD
095b4549 402 {
403 $return = {
bd30a9a2 404 'CHARACTER SET' => $item[2],
405 }
406 }
407
408field_qualifier : /collate/i WORD
409 {
410 $return = {
411 COLLATE => $item[2],
412 }
413 }
414
415field_qualifier : /on update/i CURRENT_TIMESTAMP
416 {
417 $return = {
418 'ON UPDATE' => $item[2],
095b4549 419 }
420 }
421
bd356af8 422field_qualifier : /unique/i KEY(?)
423 {
424 $return = {
425 is_unique => 1,
426 }
427 }
428
429field_qualifier : KEY
430 {
431 $return = {
432 has_index => 1,
433 }
434 }
435
100684f3 436reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
658637cd 437 {
40c1ade1 438 $return = {
658637cd 439 type => 'foreign_key',
440 reference_table => $item[2],
441 reference_fields => $item[3][0],
442 match_type => $item[4][0],
100684f3 443 on_delete => $item[5][0],
444 on_update => $item[6][0],
658637cd 445 }
446 }
447
02a21f1a 448match_type : /match full/i { 'full' }
658637cd 449 |
02a21f1a 450 /match partial/i { 'partial' }
658637cd 451
100684f3 452on_delete : /on delete/i reference_option
658637cd 453 { $item[2] }
454
100684f3 455on_update :
6fa97af6 456 /on update/i 'CURRENT_TIMESTAMP'
457 { $item[2] }
458 |
459 /on update/i reference_option
658637cd 460 { $item[2] }
461
462reference_option: /restrict/i |
463 /cascade/i |
464 /set null/i |
465 /no action/i |
466 /set default/i
467 { $item[1] }
468
f2cf1734 469index : normal_index
371f5f88 470 | fulltext_index
58a88238 471 | <error>
d529894e 472
0d41bc9b 473table_name : NAME
d529894e 474
0d41bc9b 475field_name : NAME
d529894e 476
02a21f1a 477index_name : NAME
d529894e 478
479data_type : WORD parens_value_list(s?) type_qualifier(s?)
480 {
481 my $type = $item[1];
482 my $size; # field size, applicable only to non-set fields
483 my $list; # set list, applicable only to sets (duh)
484
44fcd0b5 485 if ( uc($type) =~ /^(SET|ENUM)$/ ) {
d529894e 486 $size = undef;
487 $list = $item[2][0];
488 }
489 else {
490 $size = $item[2][0];
491 $list = [];
492 }
493
6333c482 494 unless ( @{ $size || [] } ) {
495 if ( lc $type eq 'tinyint' ) {
7898fb70 496 $size = 4;
6333c482 497 }
498 elsif ( lc $type eq 'smallint' ) {
7898fb70 499 $size = 6;
6333c482 500 }
501 elsif ( lc $type eq 'mediumint' ) {
7898fb70 502 $size = 9;
6333c482 503 }
e78d62f2 504 elsif ( $type =~ /^int(eger)?$/i ) {
f2cf1734 505 $type = 'int';
7898fb70 506 $size = 11;
6333c482 507 }
508 elsif ( lc $type eq 'bigint' ) {
7898fb70 509 $size = 20;
6333c482 510 }
1eb08c80 511 elsif (
512 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
513 ) {
6333c482 514 $size = [8,2];
515 }
516 }
517
7898fb70 518 if ( $type =~ /^tiny(text|blob)$/i ) {
519 $size = 255;
256d534a 520 }
7898fb70 521 elsif ( $type =~ /^(blob|text)$/i ) {
522 $size = 65_535;
256d534a 523 }
7898fb70 524 elsif ( $type =~ /^medium(blob|text)$/i ) {
525 $size = 16_777_215;
256d534a 526 }
7898fb70 527 elsif ( $type =~ /^long(blob|text)$/i ) {
528 $size = 4_294_967_295;
256d534a 529 }
530
d529894e 531 $return = {
532 type => $type,
533 size => $size,
534 list => $list,
535 qualifiers => $item[3],
536 }
537 }
16dc9970 538
658637cd 539parens_field_list : '(' field_name(s /,/) ')'
540 { $item[2] }
541
d529894e 542parens_value_list : '(' VALUE(s /,/) ')'
543 { $item[2] }
16dc9970 544
d529894e 545type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
546 { lc $item[1] }
16dc9970 547
d529894e 548field_type : WORD
16dc9970 549
d529894e 550create_index : /create/i /index/i
dd2ef5ae 551
e78d62f2 552not_null : /not/i /null/i
553 { $return = 0 }
554 |
555 /null/i
556 { $return = 1 }
16dc9970 557
d529894e 558unsigned : /unsigned/i { $return = 0 }
16dc9970 559
09fa21a6 560#default_val : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
561# {
562# $item[2] =~ s/'//g;
563# $return = $item[2];
564# }
565
6fa97af6 566default_val :
567 /default/i 'CURRENT_TIMESTAMP'
568 {
569 $return = $item[2];
570 }
571 |
572 /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
09fa21a6 573 {
574 $item[2] =~ s/^\s*'|'\s*$//g;
d529894e 575 $return = $item[2];
576 }
16dc9970 577
d529894e 578auto_inc : /auto_increment/i { 1 }
16dc9970 579
d529894e 580primary_key : /primary/i /key/i { 1 }
16dc9970 581
f2cf1734 582constraint : primary_key_def
583 | unique_key_def
584 | foreign_key_def
585 | <error>
586
02a21f1a 587foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
40c1ade1 588 {
589 $return = {
f2cf1734 590 supertype => 'constraint',
40c1ade1 591 type => 'foreign_key',
02a21f1a 592 name => $item[1],
09fa21a6 593 fields => $item[2],
40c1ade1 594 %{ $item{'reference_definition'} },
595 }
596 }
597
e78d62f2 598foreign_key_def_begin : /constraint/i /foreign key/i WORD
599 { $return = $item[3] }
600 |
601 /constraint/i NAME /foreign key/i
602 { $return = $item[2] }
603 |
604 /constraint/i /foreign key/i
02a21f1a 605 { $return = '' }
606 |
e78d62f2 607 /foreign key/i WORD
02a21f1a 608 { $return = $item[2] }
609 |
610 /foreign key/i
611 { $return = '' }
40c1ade1 612
1853ba82 613primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 614 {
f2cf1734 615 $return = {
616 supertype => 'constraint',
617 name => $item{'index_name(?)'}[0],
618 type => 'primary_key',
619 fields => $item[4],
58a88238 620 };
d529894e 621 }
16dc9970 622
f2cf1734 623unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 624 {
f2cf1734 625 $return = {
626 supertype => 'constraint',
627 name => $item{'index_name(?)'}[0],
628 type => 'unique',
629 fields => $item[5],
d529894e 630 }
631 }
16dc9970 632
f2cf1734 633normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
d529894e 634 {
f2cf1734 635 $return = {
636 supertype => 'index',
637 type => 'normal',
638 name => $item{'index_name(?)'}[0],
639 fields => $item[4],
d529894e 640 }
641 }
16dc9970 642
f2cf1734 643fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
371f5f88 644 {
f2cf1734 645 $return = {
646 supertype => 'index',
647 type => 'fulltext',
648 name => $item{'index_name(?)'}[0],
649 fields => $item[5],
371f5f88 650 }
651 }
652
d529894e 653name_with_opt_paren : NAME parens_value_list(s?)
654 { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
16dc9970 655
f2cf1734 656UNIQUE : /unique/i { 1 }
16dc9970 657
f2cf1734 658KEY : /key/i | /index/i
16dc9970 659
19c5bc53 660table_option : /comment/i /=/ /'.*?'/
35843e6b 661 {
662 my $comment = $item[3];
663 $comment =~ s/^'//;
664 $comment =~ s/'$//;
665 $return = { comment => $comment };
666 }
bd30a9a2 667 | /(default )?(charset|character set)/i /\s*=\s*/ WORD
d529894e 668 {
bd30a9a2 669 $return = { 'CHARACTER SET' => $item[3] };
d529894e 670 }
19c5bc53 671 | WORD /\s*=\s*/ WORD
672 {
673 $return = { $item[1] => $item[3] };
674 }
bd30a9a2 675
676default : /default/i
16dc9970 677
13aec984 678ADD : /add/i
679
680ALTER : /alter/i
681
40c1ade1 682CREATE : /create/i
683
684TEMPORARY : /temporary/i
685
686TABLE : /table/i
687
d529894e 688WORD : /\w+/
16dc9970 689
d529894e 690DIGITS : /\d+/
16dc9970 691
d529894e 692COMMA : ','
16dc9970 693
d529894e 694NAME : "`" /\w+/ "`"
695 { $item[2] }
696 | /\w+/
697 { $item[1] }
16dc9970 698
d529894e 699VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
700 { $item[1] }
f2cf1734 701 | /'.*?'/
702 {
703 # remove leading/trailing quotes
704 my $val = $item[1];
705 $val =~ s/^['"]|['"]$//g;
706 $return = $val;
707 }
d529894e 708 | /NULL/
709 { 'NULL' }
16dc9970 710
bd30a9a2 711CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
712 | /now\(\)/i
713 { 'CURRENT_TIMESTAMP' }
714
9bf756df 715END_OF_GRAMMAR
16dc9970 716
d529894e 717# -------------------------------------------------------------------
718sub parse {
70944bc5 719 my ( $translator, $data ) = @_;
40c1ade1 720 my $parser = Parse::RecDescent->new($GRAMMAR);
077ebf34 721
e099bee9 722 local $::RD_TRACE = $translator->trace ? 1 : undef;
723 local $DEBUG = $translator->debug;
d529894e 724
725 unless (defined $parser) {
726 return $translator->error("Error instantiating Parse::RecDescent ".
727 "instance: Bad grammer");
728 }
729
730 my $result = $parser->startrule($data);
40c1ade1 731 return $translator->error( "Parse failed." ) unless defined $result;
13aec984 732 warn "Parse result:".Dumper( $result ) if $DEBUG;
8ccdeb42 733
70944bc5 734 my $schema = $translator->schema;
13aec984 735 $schema->name($result->{'database_name'}) if $result->{'database_name'};
736
034ecdec 737 my @tables = sort {
13aec984 738 $result->{'tables'}{ $a }{'order'}
739 <=>
740 $result->{'tables'}{ $b }{'order'}
741 } keys %{ $result->{'tables'} };
034ecdec 742
743 for my $table_name ( @tables ) {
13aec984 744 my $tdata = $result->{tables}{ $table_name };
8ccdeb42 745 my $table = $schema->add_table(
746 name => $tdata->{'table_name'},
40c1ade1 747 ) or die $schema->error;
8ccdeb42 748
734dfc91 749 $table->comments( $tdata->{'comments'} );
f2cf1734 750
8ccdeb42 751 my @fields = sort {
752 $tdata->{'fields'}->{$a}->{'order'}
753 <=>
754 $tdata->{'fields'}->{$b}->{'order'}
755 } keys %{ $tdata->{'fields'} };
756
757 for my $fname ( @fields ) {
758 my $fdata = $tdata->{'fields'}{ $fname };
759 my $field = $table->add_field(
760 name => $fdata->{'name'},
761 data_type => $fdata->{'data_type'},
762 size => $fdata->{'size'},
763 default_value => $fdata->{'default'},
764 is_auto_increment => $fdata->{'is_auto_inc'},
765 is_nullable => $fdata->{'null'},
88b89793 766 comments => $fdata->{'comments'},
40c1ade1 767 ) or die $table->error;
f2cf1734 768
769 $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
770
bd30a9a2 771 for my $qual ( qw[ binary unsigned zerofill list collate ],
772 'character set', 'on update' ) {
f2cf1734 773 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
774 next if ref $val eq 'ARRAY' && !@$val;
775 $field->extra( $qual, $val );
776 }
777 }
778
bd356af8 779 if ( $fdata->{'has_index'} ) {
780 $table->add_index(
781 name => '',
782 type => 'NORMAL',
783 fields => $fdata->{'name'},
784 ) or die $table->error;
785 }
786
787 if ( $fdata->{'is_unique'} ) {
788 $table->add_constraint(
789 name => '',
790 type => 'UNIQUE',
791 fields => $fdata->{'name'},
792 ) or die $table->error;
793 }
794
f2cf1734 795 if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
796 my %extra = $field->extra;
d14fe688 797 my $longest = 0;
f2cf1734 798 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
799 $longest = $len if $len > $longest;
800 }
801 $field->size( $longest ) if $longest;
802 }
803
804 for my $cdata ( @{ $fdata->{'constraints'} } ) {
805 next unless $cdata->{'type'} eq 'foreign_key';
806 $cdata->{'fields'} ||= [ $field->name ];
807 push @{ $tdata->{'constraints'} }, $cdata;
808 }
809 }
810
811 for my $idata ( @{ $tdata->{'indices'} || [] } ) {
812 my $index = $table->add_index(
813 name => $idata->{'name'},
814 type => uc $idata->{'type'},
815 fields => $idata->{'fields'},
816 ) or die $table->error;
817 }
818
02a21f1a 819 if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
820 $table->options( \@options ) or die $table->error;
821 }
822
f2cf1734 823 for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
824 my $constraint = $table->add_constraint(
825 name => $cdata->{'name'},
826 type => $cdata->{'type'},
827 fields => $cdata->{'fields'},
828 reference_table => $cdata->{'reference_table'},
829 reference_fields => $cdata->{'reference_fields'},
830 match_type => $cdata->{'match_type'} || '',
100684f3 831 on_delete => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
832 on_update => $cdata->{'on_update'} || $cdata->{'on_update_do'},
f2cf1734 833 ) or die $table->error;
8ccdeb42 834 }
835 }
836
f62bd16c 837 return 1;
d529894e 838}
839
8401;
841
034ecdec 842# -------------------------------------------------------------------
d529894e 843# Where man is not nature is barren.
844# William Blake
034ecdec 845# -------------------------------------------------------------------
16dc9970 846
d529894e 847=pod
16dc9970 848
849=head1 AUTHOR
850
19c5bc53 851Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
8ccdeb42 852Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
16dc9970 853
854=head1 SEE ALSO
855
19c5bc53 856Parse::RecDescent, SQL::Translator::Schema.
16dc9970 857
858=cut