Bumping version to 1.59_01
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / MySQL.pm
1 package SQL::Translator::Parser::MySQL;
2
3 =head1 NAME
4
5 SQL::Translator::Parser::MySQL - parser for MySQL
6
7 =head1 SYNOPSIS
8
9   use SQL::Translator;
10   use SQL::Translator::Parser::MySQL;
11
12   my $translator = SQL::Translator->new;
13   $translator->parser("SQL::Translator::Parser::MySQL");
14
15 =head1 DESCRIPTION
16
17 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
18
19 Here's the word from the MySQL site
20 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
21
22   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
23   [table_options] [select_statement]
24
25   or
26
27   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
28
29   create_definition:
30     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
31               [PRIMARY KEY] [reference_definition]
32     or    PRIMARY KEY (index_col_name,...)
33     or    KEY [index_name] (index_col_name,...)
34     or    INDEX [index_name] (index_col_name,...)
35     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
36     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
37     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
38               [reference_definition]
39     or    CHECK (expr)
40
41   type:
42           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
43     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
44     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
45     or    INT[(length)] [UNSIGNED] [ZEROFILL]
46     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
47     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
48     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
49     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
50     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
51     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
52     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
53     or    CHAR(length) [BINARY]
54     or    VARCHAR(length) [BINARY]
55     or    DATE
56     or    TIME
57     or    TIMESTAMP
58     or    DATETIME
59     or    TINYBLOB
60     or    BLOB
61     or    MEDIUMBLOB
62     or    LONGBLOB
63     or    TINYTEXT
64     or    TEXT
65     or    MEDIUMTEXT
66     or    LONGTEXT
67     or    ENUM(value1,value2,value3,...)
68     or    SET(value1,value2,value3,...)
69
70   index_col_name:
71           col_name [(length)]
72
73   reference_definition:
74           REFERENCES tbl_name [(index_col_name,...)]
75                      [MATCH FULL | MATCH PARTIAL]
76                      [ON DELETE reference_option]
77                      [ON UPDATE reference_option]
78
79   reference_option:
80           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
81
82   table_options:
83           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
84   or      ENGINE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
85   or      AUTO_INCREMENT = #
86   or      AVG_ROW_LENGTH = #
87   or      [ DEFAULT ] CHARACTER SET charset_name
88   or      CHECKSUM = {0 | 1}
89   or      COLLATE collation_name
90   or      COMMENT = "string"
91   or      MAX_ROWS = #
92   or      MIN_ROWS = #
93   or      PACK_KEYS = {0 | 1 | DEFAULT}
94   or      PASSWORD = "string"
95   or      DELAY_KEY_WRITE = {0 | 1}
96   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
97   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
98   or      UNION = (table_name,[table_name...])
99   or      INSERT_METHOD= {NO | FIRST | LAST }
100   or      DATA DIRECTORY="absolute path to directory"
101   or      INDEX DIRECTORY="absolute path to directory"
102
103
104 A subset of the ALTER TABLE syntax that allows addition of foreign keys:
105
106   ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
107
108   alter_specification:
109           ADD [CONSTRAINT [symbol]]
110           FOREIGN KEY [index_name] (index_col_name,...)
111              [reference_definition]
112
113 A subset of INSERT that we ignore:
114
115   INSERT anything
116
117 =head1 ARGUMENTS
118
119 This parser takes a single optional parser_arg C<mysql_parser_version>, which
120 provides the desired version for the target database. Any statement in the processed
121 dump file, that is commented with a version higher than the one supplied, will be stripped.
122
123 The default C<mysql_parser_version> is set to the conservative value of 40000 (MySQL 4.0)
124
125 Valid version specifiers for C<mysql_parser_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
126
127 More information about the MySQL comment-syntax: L<http://dev.mysql.com/doc/refman/5.0/en/comments.html>
128
129
130 =cut
131
132 use strict;
133 use warnings;
134
135 our $VERSION = '1.59_01';
136
137 our $DEBUG;
138 $DEBUG   = 0 unless defined $DEBUG;
139
140 use Data::Dumper;
141 use Storable qw(dclone);
142 use DBI qw(:sql_types);
143 use SQL::Translator::Utils qw/parse_mysql_version ddl_parser_instance/;
144
145 use base qw(Exporter);
146 our @EXPORT_OK = qw(parse);
147
148 our %type_mapping = ();
149
150 use constant DEFAULT_PARSER_VERSION => 40000;
151
152 our $GRAMMAR = << 'END_OF_GRAMMAR';
153
154 {
155     my ( $database_name, %tables, $table_order, @table_comments, %views,
156         $view_order, %procedures, $proc_order );
157     my $delimiter = ';';
158 }
159
160 #
161 # The "eofile" rule makes the parser fail if any "statement" rule
162 # fails.  Otherwise, the first successful match by a "statement"
163 # won't cause the failure needed to know that the parse, as a whole,
164 # failed. -ky
165 #
166 startrule : statement(s) eofile {
167     {
168         database_name => $database_name,
169         tables        => \%tables,
170         views         => \%views,
171         procedures    => \%procedures,
172     }
173 }
174
175 eofile : /^\Z/
176
177 statement : comment
178     | use
179     | set
180     | drop
181     | create
182     | alter
183     | insert
184     | delimiter
185     | empty_statement
186     | <error>
187
188 use : /use/i NAME "$delimiter"
189     {
190         $database_name = $item[2];
191         @table_comments = ();
192     }
193
194 set : /set/i not_delimiter "$delimiter"
195     { @table_comments = () }
196
197 drop : /drop/i TABLE not_delimiter "$delimiter"
198
199 drop : /drop/i NAME(s) "$delimiter"
200     { @table_comments = () }
201
202 bit:
203     /(b'[01]{1,64}')/ |
204     /(b"[01]{1,64}")/
205
206 string :
207   # MySQL strings, unlike common SQL strings, can be double-quoted or
208   # single-quoted.
209
210   SQSTRING | DQSTRING
211
212 nonstring : /[^;\'"]+/
213
214 statement_body : string | nonstring
215
216 insert : /insert/i  statement_body(s?) "$delimiter"
217
218 delimiter : /delimiter/i /[\S]+/
219     { $delimiter = $item[2] }
220
221 empty_statement : "$delimiter"
222
223 alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
224     {
225         my $table_name                       = $item{'table_name'};
226     die "Cannot ALTER table '$table_name'; it does not exist"
227         unless $tables{ $table_name };
228         for my $definition ( @{ $item[4] } ) {
229         $definition->{'extra'}->{'alter'} = 1;
230         push @{ $tables{ $table_name }{'constraints'} }, $definition;
231     }
232     }
233
234 alter_specification : ADD foreign_key_def
235     { $return = $item[2] }
236
237 create : CREATE /database/i NAME "$delimiter"
238     { @table_comments = () }
239
240 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
241     {
242         my $table_name                       = $item{'table_name'};
243         die "There is more than one definition for $table_name"
244             if ($tables{$table_name});
245
246         $tables{ $table_name }{'order'}      = ++$table_order;
247         $tables{ $table_name }{'table_name'} = $table_name;
248
249         if ( @table_comments ) {
250             $tables{ $table_name }{'comments'} = [ @table_comments ];
251             @table_comments = ();
252         }
253
254         my $i = 1;
255         for my $definition ( @{ $item[7] } ) {
256             if ( $definition->{'supertype'} eq 'field' ) {
257                 my $field_name = $definition->{'name'};
258                 $tables{ $table_name }{'fields'}{ $field_name } =
259                     { %$definition, order => $i };
260                 $i++;
261
262                 if ( $definition->{'is_primary_key'} ) {
263                     push @{ $tables{ $table_name }{'constraints'} },
264                         {
265                             type   => 'primary_key',
266                             fields => [ $field_name ],
267                         }
268                     ;
269                 }
270             }
271             elsif ( $definition->{'supertype'} eq 'constraint' ) {
272                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
273             }
274             elsif ( $definition->{'supertype'} eq 'index' ) {
275                 push @{ $tables{ $table_name }{'indices'} }, $definition;
276             }
277         }
278
279         if ( my @options = @{ $item{'table_option(s?)'} } ) {
280             for my $option ( @options ) {
281                 my ( $key, $value ) = each %$option;
282                 if ( $key eq 'comment' ) {
283                     push @{ $tables{ $table_name }{'comments'} }, $value;
284                 }
285                 else {
286                     push @{ $tables{ $table_name }{'table_options'} }, $option;
287                 }
288             }
289         }
290
291         1;
292     }
293
294 opt_if_not_exists : /if not exists/i
295
296 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
297     {
298         @table_comments = ();
299         push @{ $tables{ $item{'table_name'} }{'indices'} },
300             {
301                 name   => $item[4],
302                 type   => $item[2][0] ? 'unique' : 'normal',
303                 fields => $item[8],
304             }
305         ;
306     }
307
308 create : CREATE /trigger/i NAME not_delimiter "$delimiter"
309     {
310         @table_comments = ();
311     }
312
313 create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
314     {
315         @table_comments = ();
316         my $func_name = $item[3];
317         my $owner = '';
318         my $sql = "$item[1] $item[2] $item[3] $item[4]";
319
320         $procedures{ $func_name }{'order'}  = ++$proc_order;
321         $procedures{ $func_name }{'name'}   = $func_name;
322         $procedures{ $func_name }{'owner'}  = $owner;
323         $procedures{ $func_name }{'sql'}    = $sql;
324     }
325
326 PROCEDURE : /procedure/i
327     | /function/i
328
329 create : CREATE or_replace(?) create_view_option(s?) /view/i NAME /as/i view_select_statement "$delimiter"
330     {
331         @table_comments = ();
332         my $view_name   = $item{'NAME'};
333         my $select_sql  = $item{'view_select_statement'};
334         my $options     = $item{'create_view_option(s?)'};
335
336         my $sql = join(q{ },
337             grep { defined and length }
338             map  { ref $_ eq 'ARRAY' ? @$_ : $_ }
339             $item{'CREATE'},
340             $item{'or_replace(?)'},
341             $options,
342             $view_name,
343             'as select',
344             join(', ',
345                 map {
346                     sprintf('%s%s',
347                         $_->{'name'},
348                         $_->{'alias'} ? ' as ' . $_->{'alias'} : ''
349                     )
350                 }
351                 @{ $select_sql->{'columns'} || [] }
352             ),
353             ' from ',
354             join(', ',
355                 map {
356                     sprintf('%s%s',
357                         $_->{'name'},
358                         $_->{'alias'} ? ' as ' . $_->{'alias'} : ''
359                     )
360                 }
361                 @{ $select_sql->{'from'}{'tables'} || [] }
362             ),
363             $select_sql->{'from'}{'where'}
364                 ? 'where ' . $select_sql->{'from'}{'where'}
365                 : ''
366             ,
367         );
368
369         # Hack to strip database from function calls in SQL
370         $sql =~ s#`\w+`\.(`\w+`\()##g;
371
372         $views{ $view_name }{'order'}   = ++$view_order;
373         $views{ $view_name }{'name'}    = $view_name;
374         $views{ $view_name }{'sql'}     = $sql;
375         $views{ $view_name }{'options'} = $options;
376         $views{ $view_name }{'select'}  = $item{'view_select_statement'};
377     }
378
379 create_view_option : view_algorithm | view_sql_security | view_definer
380
381 or_replace : /or replace/i
382
383 view_algorithm : /algorithm/i /=/ WORD
384     {
385         $return = "$item[1]=$item[3]";
386     }
387
388 view_definer : /definer=\S+/i
389
390 view_sql_security : /sql \s+ security  \s+ (definer|invoker)/ixs
391
392 not_delimiter : /.*?(?=$delimiter)/is
393
394 view_select_statement : /[(]?/ /select/i view_column_def /from/i view_table_def /[)]?/
395     {
396         $return = {
397             columns => $item{'view_column_def'},
398             from    => $item{'view_table_def'},
399         };
400     }
401
402 view_column_def : /(.*?)(?=\bfrom\b)/ixs
403     {
404         # split on commas not in parens,
405         # e.g., "concat_ws(\' \', first, last) as first_last"
406         my @tmp = $1 =~ /((?:[^(,]+|\(.*?\))+)/g;
407         my @cols;
408         for my $col ( @tmp ) {
409             my ( $name, $alias ) = map {
410               s/^\s+|\s+$//g;
411               s/[`]//g;
412               $_
413             } split /\s+as\s+/i, $col;
414
415             push @cols, { name => $name, alias => $alias || '' };
416         }
417
418         $return = \@cols;
419     }
420
421 not_delimiter : /.*?(?=$delimiter)/is
422
423 view_table_def : not_delimiter
424     {
425         my $clause = $item[1];
426         my $where  = $1 if $clause =~ s/\bwhere \s+ (.*)//ixs;
427         $clause    =~ s/[)]\s*$//;
428
429         my @tables;
430         for my $tbl ( split( /\s*,\s*/, $clause ) ) {
431             my ( $name, $alias ) = split /\s+as\s+/i, $tbl;
432             push @tables, { name => $name, alias => $alias || '' };
433         }
434
435         $return = {
436             tables => \@tables,
437             where  => $where || '',
438         };
439     }
440
441 view_column_alias : /as/i NAME
442     { $return = $item[2] }
443
444 create_definition : constraint
445     | index
446     | field
447     | comment
448     | <error>
449
450 comment : /^\s*(?:#|-{2}).*\n/
451     {
452         my $comment =  $item[1];
453         $comment    =~ s/^\s*(#|--)\s*//;
454         $comment    =~ s/\s*$//;
455         $return     = $comment;
456     }
457
458 comment : m{ / \* (?! \!) .*? \* / }xs
459     {
460         my $comment = $item[2];
461         $comment = substr($comment, 0, -2);
462         $comment    =~ s/^\s*|\s*$//g;
463         $return = $comment;
464     }
465
466 comment_like_command : m{/\*!(\d+)?}s
467
468 comment_end : m{ \* / }xs
469
470 field_comment : /^\s*(?:#|-{2}).*\n/
471     {
472         my $comment =  $item[1];
473         $comment    =~ s/^\s*(#|--)\s*//;
474         $comment    =~ s/\s*$//;
475         $return     = $comment;
476     }
477
478
479 blank : /\s*/
480
481 field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) on_update(?) field_comment(s?)
482     {
483         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
484         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
485             $qualifiers{ $_ } = 1 for @type_quals;
486         }
487
488         my $null = defined $qualifiers{'not_null'}
489                    ? $qualifiers{'not_null'} : 1;
490         delete $qualifiers{'not_null'};
491
492         my @comments = ( @{ $item[1] }, (exists $qualifiers{comment} ? delete $qualifiers{comment} : ()) , @{ $item[7] } );
493
494         $return = {
495             supertype   => 'field',
496             name        => $item{'field_name'},
497             data_type   => $item{'data_type'}{'type'},
498             size        => $item{'data_type'}{'size'},
499             list        => $item{'data_type'}{'list'},
500             null        => $null,
501             constraints => $item{'reference_definition(?)'},
502             comments    => [ @comments ],
503             %qualifiers,
504         }
505     }
506     | <error>
507
508 field_qualifier : not_null
509     {
510         $return = {
511              null => $item{'not_null'},
512         }
513     }
514
515 field_qualifier : default_val
516     {
517         $return = {
518              default => $item{'default_val'},
519         }
520     }
521
522 field_qualifier : auto_inc
523     {
524         $return = {
525              is_auto_inc => $item{'auto_inc'},
526         }
527     }
528
529 field_qualifier : primary_key
530     {
531         $return = {
532              is_primary_key => $item{'primary_key'},
533         }
534     }
535
536 field_qualifier : unsigned
537     {
538         $return = {
539              is_unsigned => $item{'unsigned'},
540         }
541     }
542
543 field_qualifier : /character set/i WORD
544     {
545         $return = {
546             'CHARACTER SET' => $item[2],
547         }
548     }
549
550 field_qualifier : /collate/i WORD
551     {
552         $return = {
553             COLLATE => $item[2],
554         }
555     }
556
557 field_qualifier : /on update/i CURRENT_TIMESTAMP
558     {
559         $return = {
560             'ON UPDATE' => $item[2],
561         }
562     }
563
564 field_qualifier : /unique/i KEY(?)
565     {
566         $return = {
567             is_unique => 1,
568         }
569     }
570
571 field_qualifier : KEY
572     {
573         $return = {
574             has_index => 1,
575         }
576     }
577
578 field_qualifier : /comment/i string
579     {
580         $return = {
581             comment => $item[2],
582         }
583     }
584
585 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
586     {
587         $return = {
588             type             => 'foreign_key',
589             reference_table  => $item[2],
590             reference_fields => $item[3][0],
591             match_type       => $item[4][0],
592             on_delete        => $item[5][0],
593             on_update        => $item[6][0],
594         }
595     }
596
597 match_type : /match full/i { 'full' }
598     |
599     /match partial/i { 'partial' }
600
601 on_delete : /on delete/i reference_option
602     { $item[2] }
603
604 on_update :
605     /on update/i CURRENT_TIMESTAMP
606     { $item[2] }
607     |
608     /on update/i reference_option
609     { $item[2] }
610
611 reference_option: /restrict/i |
612     /cascade/i   |
613     /set null/i  |
614     /no action/i |
615     /set default/i
616     { $item[1] }
617
618 index : normal_index
619     | fulltext_index
620     | spatial_index
621     | <error>
622
623 table_name   : NAME
624
625 field_name   : NAME
626
627 index_name   : NAME
628
629 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
630     {
631         my $type = $item[1];
632         my $size; # field size, applicable only to non-set fields
633         my $list; # set list, applicable only to sets (duh)
634
635         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
636             $size = undef;
637             $list = $item[2][0];
638         }
639         else {
640             $size = $item[2][0];
641             $list = [];
642         }
643
644
645         $return        = {
646             type       => $type,
647             size       => $size,
648             list       => $list,
649             qualifiers => $item[3],
650         }
651     }
652
653 parens_field_list : '(' field_name(s /,/) ')'
654     { $item[2] }
655
656 parens_value_list : '(' VALUE(s /,/) ')'
657     { $item[2] }
658
659 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
660     { lc $item[1] }
661
662 field_type   : WORD
663
664 create_index : /create/i /index/i
665
666 not_null     : /not/i /null/i
667     { $return = 0 }
668     |
669     /null/i
670     { $return = 1 }
671
672 unsigned     : /unsigned/i { $return = 0 }
673
674 default_val :
675     /default/i CURRENT_TIMESTAMP
676     {
677         $return =  $item[2];
678     }
679     |
680     /default/i VALUE
681     {
682         $return  =  $item[2];
683     }
684     |
685     /default/i bit
686     {
687         $item[2] =~ s/b['"]([01]+)['"]/$1/g;
688         $return  =  $item[2];
689     }
690     |
691     /default/i /[\w\d:.-]+/
692     {
693         $return  =  $item[2];
694     }
695
696 auto_inc : /auto_increment/i { 1 }
697
698 primary_key : /primary/i /key/i { 1 }
699
700 constraint : primary_key_def
701     | unique_key_def
702     | foreign_key_def
703     | <error>
704
705 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
706     {
707         $return              =  {
708             supertype        => 'constraint',
709             type             => 'foreign_key',
710             name             => $item[1],
711             fields           => $item[2],
712             %{ $item{'reference_definition'} },
713         }
714     }
715
716 foreign_key_def_begin : /constraint/i /foreign key/i NAME
717     { $return = $item[3] }
718     |
719     /constraint/i NAME /foreign key/i
720     { $return = $item[2] }
721     |
722     /constraint/i /foreign key/i
723     { $return = '' }
724     |
725     /foreign key/i NAME
726     { $return = $item[2] }
727     |
728     /foreign key/i
729     { $return = '' }
730
731 primary_key_def : primary_key index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
732     {
733         $return       = {
734             supertype => 'constraint',
735             type      => 'primary_key',
736             fields    => $item[4],
737             options   => $item[2][0] || $item[6][0],
738         };
739     }
740     # In theory, and according to the doc, names should not be allowed here, but
741     # MySQL accept (and ignores) them, so we are not going to be less :)
742     | primary_key index_name_not_using(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
743     {
744         $return       = {
745             supertype => 'constraint',
746             type      => 'primary_key',
747             fields    => $item[4],
748             options   => $item[6][0],
749         };
750     }
751
752 unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
753     {
754         $return       = {
755             supertype => 'constraint',
756             name      => $item[3][0],
757             type      => 'unique',
758             fields    => $item[6],
759             options   => $item[4][0] || $item[8][0],
760         }
761     }
762
763 normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
764     {
765         $return       = {
766             supertype => 'index',
767             type      => 'normal',
768             name      => $item[2][0],
769             fields    => $item[5],
770             options   => $item[3][0] || $item[7][0],
771         }
772     }
773
774 index_name_not_using : QUOTED_NAME
775     | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
776
777 index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
778
779 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
780     {
781         $return       = {
782             supertype => 'index',
783             type      => 'fulltext',
784             name      => $item{'index_name(?)'}[0],
785             fields    => $item[5],
786         }
787     }
788
789 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
790     {
791         $return       = {
792             supertype => 'index',
793             type      => 'spatial',
794             name      => $item{'index_name(?)'}[0],
795             fields    => $item[5],
796         }
797     }
798
799 name_with_opt_paren : NAME parens_value_list(s?)
800     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
801
802 UNIQUE : /unique/i
803
804 KEY : /key/i | /index/i
805
806 table_option : /comment/i /=/ string
807     {
808         $return     = { comment => $item[3] };
809     }
810     | /(default )?(charset|character set)/i /\s*=?\s*/ NAME
811     {
812         $return = { 'CHARACTER SET' => $item[3] };
813     }
814     | /collate/i NAME
815     {
816         $return = { 'COLLATE' => $item[2] }
817     }
818     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
819     {
820         $return = { $item[1] => $item[4] };
821     }
822     | WORD /\s*=\s*/ table_option_value
823     {
824         $return = { $item[1] => $item[3] };
825     }
826
827 table_option_value : VALUE
828                    | NAME
829
830 default : /default/i
831
832 ADD : /add/i
833
834 ALTER : /alter/i
835
836 CREATE : /create/i
837
838 TEMPORARY : /temporary/i
839
840 TABLE : /table/i
841
842 WORD : /\w+/
843
844 DIGITS : /\d+/
845
846 COMMA : ','
847
848 BACKTICK : '`'
849
850 DOUBLE_QUOTE: '"'
851
852 SINGLE_QUOTE: "'"
853
854 QUOTED_NAME : BQSTRING
855     | SQSTRING
856     | DQSTRING
857
858 # MySQL strings, unlike common SQL strings, can have the delmiters
859 # escaped either by doubling or by backslashing.
860 BQSTRING: BACKTICK <skip: ''> /(?:[^\\`]|``|\\.)*/ BACKTICK
861     { ($return = $item[3]) =~ s/(\\[\\`]|``)/substr($1,1)/ge }
862
863 DQSTRING: DOUBLE_QUOTE <skip: ''> /(?:[^\\"]|""|\\.)*/ DOUBLE_QUOTE
864     { ($return = $item[3]) =~ s/(\\[\\"]|"")/substr($1,1)/ge }
865
866 SQSTRING: SINGLE_QUOTE <skip: ''> /(?:[^\\']|''|\\.)*/ SINGLE_QUOTE
867     { ($return = $item[3]) =~ s/(\\[\\']|'')/substr($1,1)/ge }
868
869
870 NAME: QUOTED_NAME
871     | /\w+/
872
873 VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
874     { $item[1] }
875     | SQSTRING
876     | DQSTRING
877     | /NULL/i
878     { 'NULL' }
879
880 # always a scalar-ref, so that it is treated as a function and not quoted by consumers
881 CURRENT_TIMESTAMP :
882       /current_timestamp(\(\))?/i { \'CURRENT_TIMESTAMP' }
883     | /now\(\)/i { \'CURRENT_TIMESTAMP' }
884
885 END_OF_GRAMMAR
886
887 sub parse {
888     my ( $translator, $data ) = @_;
889
890     # Enable warnings within the Parse::RecDescent module.
891     # Make sure the parser dies when it encounters an error
892     local $::RD_ERRORS = 1 unless defined $::RD_ERRORS;
893     # Enable warnings. This will warn on unused rules &c.
894     local $::RD_WARN   = 1 unless defined $::RD_WARN;
895     # Give out hints to help fix problems.
896     local $::RD_HINT   = 1 unless defined $::RD_HINT;
897     local $::RD_TRACE  = $translator->trace ? 1 : undef;
898     local $DEBUG       = $translator->debug;
899
900     my $parser = ddl_parser_instance('MySQL');
901
902     # Preprocess for MySQL-specific and not-before-version comments
903     # from mysqldump
904     my $parser_version = parse_mysql_version(
905         $translator->parser_args->{mysql_parser_version}, 'mysql'
906     ) || DEFAULT_PARSER_VERSION;
907
908     while ( $data =~
909         s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
910     ) {
911         # do nothing; is there a better way to write this? -- ky
912     }
913
914     my $result = $parser->startrule($data);
915     return $translator->error( "Parse failed." ) unless defined $result;
916     warn "Parse result:".Dumper( $result ) if $DEBUG;
917
918     my $schema = $translator->schema;
919     $schema->name($result->{'database_name'}) if $result->{'database_name'};
920
921     my @tables = sort {
922         $result->{'tables'}{ $a }{'order'}
923         <=>
924         $result->{'tables'}{ $b }{'order'}
925     } keys %{ $result->{'tables'} };
926
927     for my $table_name ( @tables ) {
928         my $tdata =  $result->{tables}{ $table_name };
929         my $table =  $schema->add_table(
930             name  => $tdata->{'table_name'},
931         ) or die $schema->error;
932
933         $table->comments( $tdata->{'comments'} );
934
935         my @fields = sort {
936             $tdata->{'fields'}->{$a}->{'order'}
937             <=>
938             $tdata->{'fields'}->{$b}->{'order'}
939         } keys %{ $tdata->{'fields'} };
940
941         for my $fname ( @fields ) {
942             my $fdata = $tdata->{'fields'}{ $fname };
943             my $field = $table->add_field(
944                 name              => $fdata->{'name'},
945                 data_type         => $fdata->{'data_type'},
946                 size              => $fdata->{'size'},
947                 default_value     => $fdata->{'default'},
948                 is_auto_increment => $fdata->{'is_auto_inc'},
949                 is_nullable       => $fdata->{'null'},
950                 comments          => $fdata->{'comments'},
951             ) or die $table->error;
952
953             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
954
955             for my $qual ( qw[ binary unsigned zerofill list collate ],
956                     'character set', 'on update' ) {
957                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
958                     next if ref $val eq 'ARRAY' && !@$val;
959                     $field->extra( $qual, $val );
960                 }
961             }
962
963             if ( $fdata->{'has_index'} ) {
964                 $table->add_index(
965                     name   => '',
966                     type   => 'NORMAL',
967                     fields => $fdata->{'name'},
968                 ) or die $table->error;
969             }
970
971             if ( $fdata->{'is_unique'} ) {
972                 $table->add_constraint(
973                     name   => '',
974                     type   => 'UNIQUE',
975                     fields => $fdata->{'name'},
976                 ) or die $table->error;
977             }
978
979             for my $cdata ( @{ $fdata->{'constraints'} } ) {
980                 next unless $cdata->{'type'} eq 'foreign_key';
981                 $cdata->{'fields'} ||= [ $field->name ];
982                 push @{ $tdata->{'constraints'} }, $cdata;
983             }
984
985         }
986
987         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
988             my $index  =  $table->add_index(
989                 name   => $idata->{'name'},
990                 type   => uc $idata->{'type'},
991                 fields => $idata->{'fields'},
992             ) or die $table->error;
993         }
994
995         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
996             my @cleaned_options;
997             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
998                 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
999                 : ();
1000             if (@ignore_opts) {
1001                 my $ignores = { map { $_ => 1 } @ignore_opts };
1002                 foreach my $option (@options) {
1003                     # make sure the option isn't in ignore list
1004                     my ($option_key) = keys %$option;
1005                     if ( !exists $ignores->{$option_key} ) {
1006                         push @cleaned_options, $option;
1007                     }
1008                 }
1009             } else {
1010                 @cleaned_options = @options;
1011             }
1012             $table->options( \@cleaned_options ) or die $table->error;
1013         }
1014
1015         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
1016             my $constraint       =  $table->add_constraint(
1017                 name             => $cdata->{'name'},
1018                 type             => $cdata->{'type'},
1019                 fields           => $cdata->{'fields'},
1020                 reference_table  => $cdata->{'reference_table'},
1021                 reference_fields => $cdata->{'reference_fields'},
1022                 match_type       => $cdata->{'match_type'} || '',
1023                 on_delete        => $cdata->{'on_delete'}
1024                                  || $cdata->{'on_delete_do'},
1025                 on_update        => $cdata->{'on_update'}
1026                                  || $cdata->{'on_update_do'},
1027             ) or die $table->error;
1028         }
1029
1030         # After the constrains and PK/idxs have been created,
1031         # we normalize fields
1032         normalize_field($_) for $table->get_fields;
1033     }
1034
1035     my @procedures = sort {
1036         $result->{procedures}->{ $a }->{'order'}
1037         <=>
1038         $result->{procedures}->{ $b }->{'order'}
1039     } keys %{ $result->{procedures} };
1040
1041     for my $proc_name ( @procedures ) {
1042         $schema->add_procedure(
1043             name  => $proc_name,
1044             owner => $result->{procedures}->{$proc_name}->{owner},
1045             sql   => $result->{procedures}->{$proc_name}->{sql},
1046         );
1047     }
1048
1049     my @views = sort {
1050         $result->{views}->{ $a }->{'order'}
1051         <=>
1052         $result->{views}->{ $b }->{'order'}
1053     } keys %{ $result->{views} };
1054
1055     for my $view_name ( @views ) {
1056         my $view = $result->{'views'}{ $view_name };
1057         my @flds = map { $_->{'alias'} || $_->{'name'} }
1058                    @{ $view->{'select'}{'columns'} || [] };
1059         my @from = map { $_->{'alias'} || $_->{'name'} }
1060                    @{ $view->{'from'}{'tables'} || [] };
1061
1062         $schema->add_view(
1063             name    => $view_name,
1064             sql     => $view->{'sql'},
1065             order   => $view->{'order'},
1066             fields  => \@flds,
1067             tables  => \@from,
1068             options => $view->{'options'}
1069         );
1070     }
1071
1072     return 1;
1073 }
1074
1075 # Takes a field, and returns
1076 sub normalize_field {
1077     my ($field) = @_;
1078     my ($size, $type, $list, $unsigned, $changed);
1079
1080     $size = $field->size;
1081     $type = $field->data_type;
1082     $list = $field->extra->{list} || [];
1083     $unsigned = defined($field->extra->{unsigned});
1084
1085     if ( !ref $size && $size eq 0 ) {
1086         if ( lc $type eq 'tinyint' ) {
1087             $changed = $size != 4 - $unsigned;
1088             $size = 4 - $unsigned;
1089         }
1090         elsif ( lc $type eq 'smallint' ) {
1091             $changed = $size != 6 - $unsigned;
1092             $size = 6 - $unsigned;
1093         }
1094         elsif ( lc $type eq 'mediumint' ) {
1095             $changed = $size != 9 - $unsigned;
1096             $size = 9 - $unsigned;
1097         }
1098         elsif ( $type =~ /^int(eger)?$/i ) {
1099             $changed = $size != 11 - $unsigned || $type ne 'int';
1100             $type = 'int';
1101             $size = 11 - $unsigned;
1102         }
1103         elsif ( lc $type eq 'bigint' ) {
1104             $changed = $size != 20;
1105             $size = 20;
1106         }
1107         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
1108             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
1109             $changed     = @$old_size != 2
1110                         || $old_size->[0] != 8
1111                         || $old_size->[1] != 2;
1112             $size        = [8,2];
1113         }
1114     }
1115
1116     if ( $type =~ /^tiny(text|blob)$/i ) {
1117         $changed = $size != 255;
1118         $size = 255;
1119     }
1120     elsif ( $type =~ /^(blob|text)$/i ) {
1121         $changed = $size != 65_535;
1122         $size = 65_535;
1123     }
1124     elsif ( $type =~ /^medium(blob|text)$/i ) {
1125         $changed = $size != 16_777_215;
1126         $size = 16_777_215;
1127     }
1128     elsif ( $type =~ /^long(blob|text)$/i ) {
1129         $changed = $size != 4_294_967_295;
1130         $size = 4_294_967_295;
1131     }
1132
1133     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1134         my %extra = $field->extra;
1135         my $longest = 0;
1136         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
1137             $longest = $len if $len > $longest;
1138         }
1139         $changed = 1;
1140         $size = $longest if $longest;
1141     }
1142
1143
1144     if ( $changed ) {
1145         # We only want to clone the field, not *everything*
1146         {
1147             local $field->{table} = undef;
1148             $field->parsed_field( dclone( $field ) );
1149             $field->parsed_field->{table} = $field->table;
1150         }
1151         $field->size( $size );
1152         $field->data_type( $type );
1153         $field->sql_data_type( $type_mapping{ lc $type } )
1154             if exists $type_mapping{ lc $type };
1155         $field->extra->{list} = $list if @$list;
1156     }
1157 }
1158
1159 1;
1160
1161 # -------------------------------------------------------------------
1162 # Where man is not nature is barren.
1163 # William Blake
1164 # -------------------------------------------------------------------
1165
1166 =pod
1167
1168 =head1 AUTHOR
1169
1170 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1171 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1172
1173 =head1 SEE ALSO
1174
1175 Parse::RecDescent, SQL::Translator::Schema.
1176
1177 =cut