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';
 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 field_comment2 : /comment/i SQSTRING
 480     { $return = $item[2] }
 481
 482 blank : /\s*/
 483
 484 field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
 485     {
 486         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 487         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 488             $qualifiers{ $_ } = 1 for @type_quals;
 489         }
 490
 491         my $null = defined $qualifiers{'not_null'}
 492                    ? $qualifiers{'not_null'} : 1;
 493         delete $qualifiers{'not_null'};
 494
 495         my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 496
 497         $return = {
 498             supertype   => 'field',
 499             name        => $item{'field_name'},
 500             data_type   => $item{'data_type'}{'type'},
 501             size        => $item{'data_type'}{'size'},
 502             list        => $item{'data_type'}{'list'},
 503             null        => $null,
 504             constraints => $item{'reference_definition(?)'},
 505             comments    => [ @comments ],
 506             %qualifiers,
 507         }
 508     }
 509     | <error>
 510
 511 field_qualifier : not_null
 512     {
 513         $return = {
 514              null => $item{'not_null'},
 515         }
 516     }
 517
 518 field_qualifier : default_val
 519     {
 520         $return = {
 521              default => $item{'default_val'},
 522         }
 523     }
 524
 525 field_qualifier : auto_inc
 526     {
 527         $return = {
 528              is_auto_inc => $item{'auto_inc'},
 529         }
 530     }
 531
 532 field_qualifier : primary_key
 533     {
 534         $return = {
 535              is_primary_key => $item{'primary_key'},
 536         }
 537     }
 538
 539 field_qualifier : unsigned
 540     {
 541         $return = {
 542              is_unsigned => $item{'unsigned'},
 543         }
 544     }
 545
 546 field_qualifier : /character set/i WORD
 547     {
 548         $return = {
 549             'CHARACTER SET' => $item[2],
 550         }
 551     }
 552
 553 field_qualifier : /collate/i WORD
 554     {
 555         $return = {
 556             COLLATE => $item[2],
 557         }
 558     }
 559
 560 field_qualifier : /on update/i CURRENT_TIMESTAMP
 561     {
 562         $return = {
 563             'ON UPDATE' => $item[2],
 564         }
 565     }
 566
 567 field_qualifier : /unique/i KEY(?)
 568     {
 569         $return = {
 570             is_unique => 1,
 571         }
 572     }
 573
 574 field_qualifier : KEY
 575     {
 576         $return = {
 577             has_index => 1,
 578         }
 579     }
 580
 581 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
 582     {
 583         $return = {
 584             type             => 'foreign_key',
 585             reference_table  => $item[2],
 586             reference_fields => $item[3][0],
 587             match_type       => $item[4][0],
 588             on_delete        => $item[5][0],
 589             on_update        => $item[6][0],
 590         }
 591     }
 592
 593 match_type : /match full/i { 'full' }
 594     |
 595     /match partial/i { 'partial' }
 596
 597 on_delete : /on delete/i reference_option
 598     { $item[2] }
 599
 600 on_update :
 601     /on update/i CURRENT_TIMESTAMP
 602     { $item[2] }
 603     |
 604     /on update/i reference_option
 605     { $item[2] }
 606
 607 reference_option: /restrict/i |
 608     /cascade/i   |
 609     /set null/i  |
 610     /no action/i |
 611     /set default/i
 612     { $item[1] }
 613
 614 index : normal_index
 615     | fulltext_index
 616     | spatial_index
 617     | <error>
 618
 619 table_name   : NAME
 620
 621 field_name   : NAME
 622
 623 index_name   : NAME
 624
 625 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 626     {
 627         my $type = $item[1];
 628         my $size; # field size, applicable only to non-set fields
 629         my $list; # set list, applicable only to sets (duh)
 630
 631         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 632             $size = undef;
 633             $list = $item[2][0];
 634         }
 635         else {
 636             $size = $item[2][0];
 637             $list = [];
 638         }
 639
 640
 641         $return        = {
 642             type       => $type,
 643             size       => $size,
 644             list       => $list,
 645             qualifiers => $item[3],
 646         }
 647     }
 648
 649 parens_field_list : '(' field_name(s /,/) ')'
 650     { $item[2] }
 651
 652 parens_value_list : '(' VALUE(s /,/) ')'
 653     { $item[2] }
 654
 655 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 656     { lc $item[1] }
 657
 658 field_type   : WORD
 659
 660 create_index : /create/i /index/i
 661
 662 not_null     : /not/i /null/i
 663     { $return = 0 }
 664     |
 665     /null/i
 666     { $return = 1 }
 667
 668 unsigned     : /unsigned/i { $return = 0 }
 669
 670 default_val :
 671     /default/i CURRENT_TIMESTAMP
 672     {
 673         $return =  $item[2];
 674     }
 675     |
 676     /default/i VALUE
 677     {
 678         $return  =  $item[2];
 679     }
 680     |
 681     /default/i bit
 682     {
 683         $item[2] =~ s/b['"]([01]+)['"]/$1/g;
 684         $return  =  $item[2];
 685     }
 686     |
 687     /default/i /[\w\d:.-]+/
 688     {
 689         $return  =  $item[2];
 690     }
 691
 692 auto_inc : /auto_increment/i { 1 }
 693
 694 primary_key : /primary/i /key/i { 1 }
 695
 696 constraint : primary_key_def
 697     | unique_key_def
 698     | foreign_key_def
 699     | <error>
 700
 701 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 702     {
 703         $return              =  {
 704             supertype        => 'constraint',
 705             type             => 'foreign_key',
 706             name             => $item[1],
 707             fields           => $item[2],
 708             %{ $item{'reference_definition'} },
 709         }
 710     }
 711
 712 foreign_key_def_begin : /constraint/i /foreign key/i NAME
 713     { $return = $item[3] }
 714     |
 715     /constraint/i NAME /foreign key/i
 716     { $return = $item[2] }
 717     |
 718     /constraint/i /foreign key/i
 719     { $return = '' }
 720     |
 721     /foreign key/i NAME
 722     { $return = $item[2] }
 723     |
 724     /foreign key/i
 725     { $return = '' }
 726
 727 primary_key_def : primary_key index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 728     {
 729         $return       = {
 730             supertype => 'constraint',
 731             type      => 'primary_key',
 732             fields    => $item[4],
 733             options   => $item[2][0] || $item[6][0],
 734         };
 735     }
 736     # In theory, and according to the doc, names should not be allowed here, but
 737     # MySQL accept (and ignores) them, so we are not going to be less :)
 738     | primary_key index_name_not_using(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 739     {
 740         $return       = {
 741             supertype => 'constraint',
 742             type      => 'primary_key',
 743             fields    => $item[4],
 744             options   => $item[6][0],
 745         };
 746     }
 747
 748 unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 749     {
 750         $return       = {
 751             supertype => 'constraint',
 752             name      => $item[3][0],
 753             type      => 'unique',
 754             fields    => $item[6],
 755             options   => $item[4][0] || $item[8][0],
 756         }
 757     }
 758
 759 normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 760     {
 761         $return       = {
 762             supertype => 'index',
 763             type      => 'normal',
 764             name      => $item[2][0],
 765             fields    => $item[5],
 766             options   => $item[3][0] || $item[7][0],
 767         }
 768     }
 769
 770 index_name_not_using : QUOTED_NAME
 771     | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
 772
 773 index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
 774
 775 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 776     {
 777         $return       = {
 778             supertype => 'index',
 779             type      => 'fulltext',
 780             name      => $item{'index_name(?)'}[0],
 781             fields    => $item[5],
 782         }
 783     }
 784
 785 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 786     {
 787         $return       = {
 788             supertype => 'index',
 789             type      => 'spatial',
 790             name      => $item{'index_name(?)'}[0],
 791             fields    => $item[5],
 792         }
 793     }
 794
 795 name_with_opt_paren : NAME parens_value_list(s?)
 796     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 797
 798 UNIQUE : /unique/i
 799
 800 KEY : /key/i | /index/i
 801
 802 table_option : /comment/i /=/ string
 803     {
 804         $return     = { comment => $item[3] };
 805     }
 806     | /(default )?(charset|character set)/i /\s*=?\s*/ NAME
 807     {
 808         $return = { 'CHARACTER SET' => $item[3] };
 809     }
 810     | /collate/i NAME
 811     {
 812         $return = { 'COLLATE' => $item[2] }
 813     }
 814     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
 815     {
 816         $return = { $item[1] => $item[4] };
 817     }
 818     | WORD /\s*=\s*/ table_option_value
 819     {
 820         $return = { $item[1] => $item[3] };
 821     }
 822
 823 table_option_value : VALUE
 824                    | NAME
 825
 826 default : /default/i
 827
 828 ADD : /add/i
 829
 830 ALTER : /alter/i
 831
 832 CREATE : /create/i
 833
 834 TEMPORARY : /temporary/i
 835
 836 TABLE : /table/i
 837
 838 WORD : /\w+/
 839
 840 DIGITS : /\d+/
 841
 842 COMMA : ','
 843
 844 BACKTICK : '`'
 845
 846 DOUBLE_QUOTE: '"'
 847
 848 SINGLE_QUOTE: "'"
 849
 850 QUOTED_NAME : BQSTRING
 851     | SQSTRING
 852     | DQSTRING
 853
 854 # MySQL strings, unlike common SQL strings, can have the delmiters
 855 # escaped either by doubling or by backslashing.
 856 BQSTRING: BACKTICK <skip: ''> /(?:[^\\`]|``|\\.)*/ BACKTICK
 857     { ($return = $item[3]) =~ s/(\\[\\`]|``)/substr($1,1)/ge }
 858
 859 DQSTRING: DOUBLE_QUOTE <skip: ''> /(?:[^\\"]|""|\\.)*/ DOUBLE_QUOTE
 860     { ($return = $item[3]) =~ s/(\\[\\"]|"")/substr($1,1)/ge }
 861
 862 SQSTRING: SINGLE_QUOTE <skip: ''> /(?:[^\\']|''|\\.)*/ SINGLE_QUOTE
 863     { ($return = $item[3]) =~ s/(\\[\\']|'')/substr($1,1)/ge }
 864
 865
 866 NAME: QUOTED_NAME
 867     | /\w+/
 868
 869 VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
 870     { $item[1] }
 871     | SQSTRING
 872     | DQSTRING
 873     | /NULL/i
 874     { 'NULL' }
 875
 876 # always a scalar-ref, so that it is treated as a function and not quoted by consumers
 877 CURRENT_TIMESTAMP :
 878       /current_timestamp(\(\))?/i { \'CURRENT_TIMESTAMP' }
 879     | /now\(\)/i { \'CURRENT_TIMESTAMP' }
 880
 881 END_OF_GRAMMAR
 882
 883 sub parse {
 884     my ( $translator, $data ) = @_;
 885
 886     # Enable warnings within the Parse::RecDescent module.
 887     # Make sure the parser dies when it encounters an error
 888     local $::RD_ERRORS = 1 unless defined $::RD_ERRORS;
 889     # Enable warnings. This will warn on unused rules &c.
 890     local $::RD_WARN   = 1 unless defined $::RD_WARN;
 891     # Give out hints to help fix problems.
 892     local $::RD_HINT   = 1 unless defined $::RD_HINT;
 893     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 894     local $DEBUG       = $translator->debug;
 895
 896     my $parser = ddl_parser_instance('MySQL');
 897
 898     # Preprocess for MySQL-specific and not-before-version comments
 899     # from mysqldump
 900     my $parser_version = parse_mysql_version(
 901         $translator->parser_args->{mysql_parser_version}, 'mysql'
 902     ) || DEFAULT_PARSER_VERSION;
 903
 904     while ( $data =~
 905         s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
 906     ) {
 907         # do nothing; is there a better way to write this? -- ky
 908     }
 909
 910     my $result = $parser->startrule($data);
 911     return $translator->error( "Parse failed." ) unless defined $result;
 912     warn "Parse result:".Dumper( $result ) if $DEBUG;
 913
 914     my $schema = $translator->schema;
 915     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 916
 917     my @tables = sort {
 918         $result->{'tables'}{ $a }{'order'}
 919         <=>
 920         $result->{'tables'}{ $b }{'order'}
 921     } keys %{ $result->{'tables'} };
 922
 923     for my $table_name ( @tables ) {
 924         my $tdata =  $result->{tables}{ $table_name };
 925         my $table =  $schema->add_table(
 926             name  => $tdata->{'table_name'},
 927         ) or die $schema->error;
 928
 929         $table->comments( $tdata->{'comments'} );
 930
 931         my @fields = sort {
 932             $tdata->{'fields'}->{$a}->{'order'}
 933             <=>
 934             $tdata->{'fields'}->{$b}->{'order'}
 935         } keys %{ $tdata->{'fields'} };
 936
 937         for my $fname ( @fields ) {
 938             my $fdata = $tdata->{'fields'}{ $fname };
 939             my $field = $table->add_field(
 940                 name              => $fdata->{'name'},
 941                 data_type         => $fdata->{'data_type'},
 942                 size              => $fdata->{'size'},
 943                 default_value     => $fdata->{'default'},
 944                 is_auto_increment => $fdata->{'is_auto_inc'},
 945                 is_nullable       => $fdata->{'null'},
 946                 comments          => $fdata->{'comments'},
 947             ) or die $table->error;
 948
 949             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 950
 951             for my $qual ( qw[ binary unsigned zerofill list collate ],
 952                     'character set', 'on update' ) {
 953                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 954                     next if ref $val eq 'ARRAY' && !@$val;
 955                     $field->extra( $qual, $val );
 956                 }
 957             }
 958
 959             if ( $fdata->{'has_index'} ) {
 960                 $table->add_index(
 961                     name   => '',
 962                     type   => 'NORMAL',
 963                     fields => $fdata->{'name'},
 964                 ) or die $table->error;
 965             }
 966
 967             if ( $fdata->{'is_unique'} ) {
 968                 $table->add_constraint(
 969                     name   => '',
 970                     type   => 'UNIQUE',
 971                     fields => $fdata->{'name'},
 972                 ) or die $table->error;
 973             }
 974
 975             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 976                 next unless $cdata->{'type'} eq 'foreign_key';
 977                 $cdata->{'fields'} ||= [ $field->name ];
 978                 push @{ $tdata->{'constraints'} }, $cdata;
 979             }
 980
 981         }
 982
 983         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 984             my $index  =  $table->add_index(
 985                 name   => $idata->{'name'},
 986                 type   => uc $idata->{'type'},
 987                 fields => $idata->{'fields'},
 988             ) or die $table->error;
 989         }
 990
 991         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 992             my @cleaned_options;
 993             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
 994                 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
 995                 : ();
 996             if (@ignore_opts) {
 997                 my $ignores = { map { $_ => 1 } @ignore_opts };
 998                 foreach my $option (@options) {
 999                     # make sure the option isn't in ignore list
1000                     my ($option_key) = keys %$option;
1001                     if ( !exists $ignores->{$option_key} ) {
1002                         push @cleaned_options, $option;
1003                     }
1004                 }
1005             } else {
1006                 @cleaned_options = @options;
1007             }
1008             $table->options( \@cleaned_options ) or die $table->error;
1009         }
1010
1011         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
1012             my $constraint       =  $table->add_constraint(
1013                 name             => $cdata->{'name'},
1014                 type             => $cdata->{'type'},
1015                 fields           => $cdata->{'fields'},
1016                 reference_table  => $cdata->{'reference_table'},
1017                 reference_fields => $cdata->{'reference_fields'},
1018                 match_type       => $cdata->{'match_type'} || '',
1019                 on_delete        => $cdata->{'on_delete'}
1020                                  || $cdata->{'on_delete_do'},
1021                 on_update        => $cdata->{'on_update'}
1022                                  || $cdata->{'on_update_do'},
1023             ) or die $table->error;
1024         }
1025
1026         # After the constrains and PK/idxs have been created,
1027         # we normalize fields
1028         normalize_field($_) for $table->get_fields;
1029     }
1030
1031     my @procedures = sort {
1032         $result->{procedures}->{ $a }->{'order'}
1033         <=>
1034         $result->{procedures}->{ $b }->{'order'}
1035     } keys %{ $result->{procedures} };
1036
1037     for my $proc_name ( @procedures ) {
1038         $schema->add_procedure(
1039             name  => $proc_name,
1040             owner => $result->{procedures}->{$proc_name}->{owner},
1041             sql   => $result->{procedures}->{$proc_name}->{sql},
1042         );
1043     }
1044
1045     my @views = sort {
1046         $result->{views}->{ $a }->{'order'}
1047         <=>
1048         $result->{views}->{ $b }->{'order'}
1049     } keys %{ $result->{views} };
1050
1051     for my $view_name ( @views ) {
1052         my $view = $result->{'views'}{ $view_name };
1053         my @flds = map { $_->{'alias'} || $_->{'name'} }
1054                    @{ $view->{'select'}{'columns'} || [] };
1055         my @from = map { $_->{'alias'} || $_->{'name'} }
1056                    @{ $view->{'from'}{'tables'} || [] };
1057
1058         $schema->add_view(
1059             name    => $view_name,
1060             sql     => $view->{'sql'},
1061             order   => $view->{'order'},
1062             fields  => \@flds,
1063             tables  => \@from,
1064             options => $view->{'options'}
1065         );
1066     }
1067
1068     return 1;
1069 }
1070
1071 # Takes a field, and returns
1072 sub normalize_field {
1073     my ($field) = @_;
1074     my ($size, $type, $list, $unsigned, $changed);
1075
1076     $size = $field->size;
1077     $type = $field->data_type;
1078     $list = $field->extra->{list} || [];
1079     $unsigned = defined($field->extra->{unsigned});
1080
1081     if ( !ref $size && $size eq 0 ) {
1082         if ( lc $type eq 'tinyint' ) {
1083             $changed = $size != 4 - $unsigned;
1084             $size = 4 - $unsigned;
1085         }
1086         elsif ( lc $type eq 'smallint' ) {
1087             $changed = $size != 6 - $unsigned;
1088             $size = 6 - $unsigned;
1089         }
1090         elsif ( lc $type eq 'mediumint' ) {
1091             $changed = $size != 9 - $unsigned;
1092             $size = 9 - $unsigned;
1093         }
1094         elsif ( $type =~ /^int(eger)?$/i ) {
1095             $changed = $size != 11 - $unsigned || $type ne 'int';
1096             $type = 'int';
1097             $size = 11 - $unsigned;
1098         }
1099         elsif ( lc $type eq 'bigint' ) {
1100             $changed = $size != 20;
1101             $size = 20;
1102         }
1103         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
1104             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
1105             $changed     = @$old_size != 2
1106                         || $old_size->[0] != 8
1107                         || $old_size->[1] != 2;
1108             $size        = [8,2];
1109         }
1110     }
1111
1112     if ( $type =~ /^tiny(text|blob)$/i ) {
1113         $changed = $size != 255;
1114         $size = 255;
1115     }
1116     elsif ( $type =~ /^(blob|text)$/i ) {
1117         $changed = $size != 65_535;
1118         $size = 65_535;
1119     }
1120     elsif ( $type =~ /^medium(blob|text)$/i ) {
1121         $changed = $size != 16_777_215;
1122         $size = 16_777_215;
1123     }
1124     elsif ( $type =~ /^long(blob|text)$/i ) {
1125         $changed = $size != 4_294_967_295;
1126         $size = 4_294_967_295;
1127     }
1128
1129     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1130         my %extra = $field->extra;
1131         my $longest = 0;
1132         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
1133             $longest = $len if $len > $longest;
1134         }
1135         $changed = 1;
1136         $size = $longest if $longest;
1137     }
1138
1139
1140     if ( $changed ) {
1141         # We only want to clone the field, not *everything*
1142         {
1143             local $field->{table} = undef;
1144             $field->parsed_field( dclone( $field ) );
1145             $field->parsed_field->{table} = $field->table;
1146         }
1147         $field->size( $size );
1148         $field->data_type( $type );
1149         $field->sql_data_type( $type_mapping{ lc $type } )
1150             if exists $type_mapping{ lc $type };
1151         $field->extra->{list} = $list if @$list;
1152     }
1153 }
1154
1155 1;
1156
1157 # -------------------------------------------------------------------
1158 # Where man is not nature is barren.
1159 # William Blake
1160 # -------------------------------------------------------------------
1161
1162 =pod
1163
1164 =head1 AUTHOR
1165
1166 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1167 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1168
1169 =head1 SEE ALSO
1170
1171 Parse::RecDescent, SQL::Translator::Schema.
1172
1173 =cut