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 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