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.60';
 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     /default/i NAME # column value, allowed in MariaDB
 697     {
 698         $return  =  $item[2];
 699     }
 700
 701 auto_inc : /auto_increment/i { 1 }
 702
 703 primary_key : /primary/i /key/i { 1 }
 704
 705 constraint : primary_key_def
 706     | unique_key_def
 707     | foreign_key_def
 708     | check_def
 709     | <error>
 710
 711 expr : /[^)]* \( [^)]+ \) [^)]*/x # parens, balanced one deep
 712     | /[^)]+/
 713
 714 check_def : check_def_begin '(' expr ')'
 715     {
 716         $return              =  {
 717             supertype        => 'constraint',
 718             type             => 'check',
 719             name             => $item[1],
 720             expression       => $item[3],
 721         }
 722     }
 723
 724 check_def_begin : /constraint/i /check/i NAME
 725     { $return = $item[3] }
 726     |
 727     /constraint/i NAME /check/i
 728     { $return = $item[2] }
 729     |
 730     /constraint/i /check/i
 731     { $return = '' }
 732
 733 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 734     {
 735         $return              =  {
 736             supertype        => 'constraint',
 737             type             => 'foreign_key',
 738             name             => $item[1],
 739             fields           => $item[2],
 740             %{ $item{'reference_definition'} },
 741         }
 742     }
 743
 744 foreign_key_def_begin : /constraint/i /foreign key/i NAME
 745     { $return = $item[3] }
 746     |
 747     /constraint/i NAME /foreign key/i
 748     { $return = $item[2] }
 749     |
 750     /constraint/i /foreign key/i
 751     { $return = '' }
 752     |
 753     /foreign key/i NAME
 754     { $return = $item[2] }
 755     |
 756     /foreign key/i
 757     { $return = '' }
 758
 759 primary_key_def : primary_key index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 760     {
 761         $return       = {
 762             supertype => 'constraint',
 763             type      => 'primary_key',
 764             fields    => $item[4],
 765             options   => $item[2][0] || $item[6][0],
 766         };
 767     }
 768     # In theory, and according to the doc, names should not be allowed here, but
 769     # MySQL accept (and ignores) them, so we are not going to be less :)
 770     | primary_key index_name_not_using(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 771     {
 772         $return       = {
 773             supertype => 'constraint',
 774             type      => 'primary_key',
 775             fields    => $item[4],
 776             options   => $item[6][0],
 777         };
 778     }
 779
 780 unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 781     {
 782         $return       = {
 783             supertype => 'constraint',
 784             name      => $item[3][0],
 785             type      => 'unique',
 786             fields    => $item[6],
 787             options   => $item[4][0] || $item[8][0],
 788         }
 789     }
 790
 791 normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 792     {
 793         $return       = {
 794             supertype => 'index',
 795             type      => 'normal',
 796             name      => $item[2][0],
 797             fields    => $item[5],
 798             options   => $item[3][0] || $item[7][0],
 799         }
 800     }
 801
 802 index_name_not_using : QUOTED_NAME
 803     | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
 804
 805 index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
 806
 807 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 808     {
 809         $return       = {
 810             supertype => 'index',
 811             type      => 'fulltext',
 812             name      => $item{'index_name(?)'}[0],
 813             fields    => $item[5],
 814         }
 815     }
 816
 817 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 818     {
 819         $return       = {
 820             supertype => 'index',
 821             type      => 'spatial',
 822             name      => $item{'index_name(?)'}[0],
 823             fields    => $item[5],
 824         }
 825     }
 826
 827 name_with_opt_paren : NAME parens_value_list(s?)
 828     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 829
 830 UNIQUE : /unique/i
 831
 832 KEY : /key/i | /index/i
 833
 834 table_option : /comment/i /=/ string
 835     {
 836         $return     = { comment => $item[3] };
 837     }
 838     | /(default )?(charset|character set)/i /\s*=?\s*/ NAME
 839     {
 840         $return = { 'CHARACTER SET' => $item[3] };
 841     }
 842     | /collate/i NAME
 843     {
 844         $return = { 'COLLATE' => $item[2] }
 845     }
 846     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
 847     {
 848         $return = { $item[1] => $item[4] };
 849     }
 850     | WORD /\s*=\s*/ table_option_value
 851     {
 852         $return = { $item[1] => $item[3] };
 853     }
 854
 855 table_option_value : VALUE
 856                    | NAME
 857
 858 default : /default/i
 859
 860 ADD : /add/i
 861
 862 ALTER : /alter/i
 863
 864 CREATE : /create/i
 865
 866 TEMPORARY : /temporary/i
 867
 868 TABLE : /table/i
 869
 870 WORD : /\w+/
 871
 872 DIGITS : /\d+/
 873
 874 COMMA : ','
 875
 876 BACKTICK : '`'
 877
 878 DOUBLE_QUOTE: '"'
 879
 880 SINGLE_QUOTE: "'"
 881
 882 QUOTED_NAME : BQSTRING
 883     | SQSTRING
 884     | DQSTRING
 885
 886 # MySQL strings, unlike common SQL strings, can have the delmiters
 887 # escaped either by doubling or by backslashing.
 888 BQSTRING: BACKTICK <skip: ''> /(?:[^\\`]|``|\\.)*/ BACKTICK
 889     { ($return = $item[3]) =~ s/(\\[\\`]|``)/substr($1,1)/ge }
 890
 891 DQSTRING: DOUBLE_QUOTE <skip: ''> /(?:[^\\"]|""|\\.)*/ DOUBLE_QUOTE
 892     { ($return = $item[3]) =~ s/(\\[\\"]|"")/substr($1,1)/ge }
 893
 894 SQSTRING: SINGLE_QUOTE <skip: ''> /(?:[^\\']|''|\\.)*/ SINGLE_QUOTE
 895     { ($return = $item[3]) =~ s/(\\[\\']|'')/substr($1,1)/ge }
 896
 897
 898 NAME: QUOTED_NAME
 899     | /\w+/
 900
 901 VALUE : /[-+]?\d*\.?\d+(?:[eE]\d+)?/
 902     { $item[1] }
 903     | SQSTRING
 904     | DQSTRING
 905     | /NULL/i
 906     { 'NULL' }
 907
 908 # always a scalar-ref, so that it is treated as a function and not quoted by consumers
 909 CURRENT_TIMESTAMP :
 910       /current_timestamp(\(\))?/i { \'CURRENT_TIMESTAMP' }
 911     | /now\(\)/i { \'CURRENT_TIMESTAMP' }
 912
 913 END_OF_GRAMMAR
 914
 915 sub parse {
 916     my ( $translator, $data ) = @_;
 917
 918     # Enable warnings within the Parse::RecDescent module.
 919     # Make sure the parser dies when it encounters an error
 920     local $::RD_ERRORS = 1 unless defined $::RD_ERRORS;
 921     # Enable warnings. This will warn on unused rules &c.
 922     local $::RD_WARN   = 1 unless defined $::RD_WARN;
 923     # Give out hints to help fix problems.
 924     local $::RD_HINT   = 1 unless defined $::RD_HINT;
 925     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 926     local $DEBUG       = $translator->debug;
 927
 928     my $parser = ddl_parser_instance('MySQL');
 929
 930     # Preprocess for MySQL-specific and not-before-version comments
 931     # from mysqldump
 932     my $parser_version = parse_mysql_version(
 933         $translator->parser_args->{mysql_parser_version}, 'mysql'
 934     ) || DEFAULT_PARSER_VERSION;
 935
 936     while ( $data =~
 937         s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
 938     ) {
 939         # do nothing; is there a better way to write this? -- ky
 940     }
 941
 942     my $result = $parser->startrule($data);
 943     return $translator->error( "Parse failed." ) unless defined $result;
 944     warn "Parse result:".Dumper( $result ) if $DEBUG;
 945
 946     my $schema = $translator->schema;
 947     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 948
 949     my @tables = sort {
 950         $result->{'tables'}{ $a }{'order'}
 951         <=>
 952         $result->{'tables'}{ $b }{'order'}
 953     } keys %{ $result->{'tables'} };
 954
 955     for my $table_name ( @tables ) {
 956         my $tdata =  $result->{tables}{ $table_name };
 957         my $table =  $schema->add_table(
 958             name  => $tdata->{'table_name'},
 959         ) or die $schema->error;
 960
 961         $table->comments( $tdata->{'comments'} );
 962
 963         my @fields = sort {
 964             $tdata->{'fields'}->{$a}->{'order'}
 965             <=>
 966             $tdata->{'fields'}->{$b}->{'order'}
 967         } keys %{ $tdata->{'fields'} };
 968
 969         for my $fname ( @fields ) {
 970             my $fdata = $tdata->{'fields'}{ $fname };
 971             my $field = $table->add_field(
 972                 name              => $fdata->{'name'},
 973                 data_type         => $fdata->{'data_type'},
 974                 size              => $fdata->{'size'},
 975                 default_value     => $fdata->{'default'},
 976                 is_auto_increment => $fdata->{'is_auto_inc'},
 977                 is_nullable       => $fdata->{'null'},
 978                 comments          => $fdata->{'comments'},
 979             ) or die $table->error;
 980
 981             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 982
 983             for my $qual ( qw[ binary unsigned zerofill list collate ],
 984                     'character set', 'on update' ) {
 985                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 986                     next if ref $val eq 'ARRAY' && !@$val;
 987                     $field->extra( $qual, $val );
 988                 }
 989             }
 990
 991             if ( $fdata->{'has_index'} ) {
 992                 $table->add_index(
 993                     name   => '',
 994                     type   => 'NORMAL',
 995                     fields => $fdata->{'name'},
 996                 ) or die $table->error;
 997             }
 998
 999             if ( $fdata->{'is_unique'} ) {
1000                 $table->add_constraint(
1001                     name   => '',
1002                     type   => 'UNIQUE',
1003                     fields => $fdata->{'name'},
1004                 ) or die $table->error;
1005             }
1006
1007             for my $cdata ( @{ $fdata->{'constraints'} } ) {
1008                 next unless $cdata->{'type'} eq 'foreign_key';
1009                 $cdata->{'fields'} ||= [ $field->name ];
1010                 push @{ $tdata->{'constraints'} }, $cdata;
1011             }
1012
1013         }
1014
1015         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
1016             my $index  =  $table->add_index(
1017                 name   => $idata->{'name'},
1018                 type   => uc $idata->{'type'},
1019                 fields => $idata->{'fields'},
1020             ) or die $table->error;
1021         }
1022
1023         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
1024             my @cleaned_options;
1025             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
1026                 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
1027                 : ();
1028             if (@ignore_opts) {
1029                 my $ignores = { map { $_ => 1 } @ignore_opts };
1030                 foreach my $option (@options) {
1031                     # make sure the option isn't in ignore list
1032                     my ($option_key) = keys %$option;
1033                     if ( !exists $ignores->{$option_key} ) {
1034                         push @cleaned_options, $option;
1035                     }
1036                 }
1037             } else {
1038                 @cleaned_options = @options;
1039             }
1040             $table->options( \@cleaned_options ) or die $table->error;
1041         }
1042
1043         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
1044             my $constraint       =  $table->add_constraint(
1045                 name             => $cdata->{'name'},
1046                 type             => $cdata->{'type'},
1047                 fields           => $cdata->{'fields'},
1048                 expression       => $cdata->{'expression'},
1049                 reference_table  => $cdata->{'reference_table'},
1050                 reference_fields => $cdata->{'reference_fields'},
1051                 match_type       => $cdata->{'match_type'} || '',
1052                 on_delete        => $cdata->{'on_delete'}
1053                                  || $cdata->{'on_delete_do'},
1054                 on_update        => $cdata->{'on_update'}
1055                                  || $cdata->{'on_update_do'},
1056             ) or die $table->error;
1057         }
1058
1059         # After the constrains and PK/idxs have been created,
1060         # we normalize fields
1061         normalize_field($_) for $table->get_fields;
1062     }
1063
1064     my @procedures = sort {
1065         $result->{procedures}->{ $a }->{'order'}
1066         <=>
1067         $result->{procedures}->{ $b }->{'order'}
1068     } keys %{ $result->{procedures} };
1069
1070     for my $proc_name ( @procedures ) {
1071         $schema->add_procedure(
1072             name  => $proc_name,
1073             owner => $result->{procedures}->{$proc_name}->{owner},
1074             sql   => $result->{procedures}->{$proc_name}->{sql},
1075         );
1076     }
1077
1078     my @views = sort {
1079         $result->{views}->{ $a }->{'order'}
1080         <=>
1081         $result->{views}->{ $b }->{'order'}
1082     } keys %{ $result->{views} };
1083
1084     for my $view_name ( @views ) {
1085         my $view = $result->{'views'}{ $view_name };
1086         my @flds = map { $_->{'alias'} || $_->{'name'} }
1087                    @{ $view->{'select'}{'columns'} || [] };
1088         my @from = map { $_->{'alias'} || $_->{'name'} }
1089                    @{ $view->{'from'}{'tables'} || [] };
1090
1091         $schema->add_view(
1092             name    => $view_name,
1093             sql     => $view->{'sql'},
1094             order   => $view->{'order'},
1095             fields  => \@flds,
1096             tables  => \@from,
1097             options => $view->{'options'}
1098         );
1099     }
1100
1101     return 1;
1102 }
1103
1104 # Takes a field, and returns
1105 sub normalize_field {
1106     my ($field) = @_;
1107     my ($size, $type, $list, $unsigned, $changed);
1108
1109     $size = $field->size;
1110     $type = $field->data_type;
1111     $list = $field->extra->{list} || [];
1112     $unsigned = defined($field->extra->{unsigned});
1113
1114     if ( !ref $size && $size eq 0 ) {
1115         if ( lc $type eq 'tinyint' ) {
1116             $changed = $size != 4 - $unsigned;
1117             $size = 4 - $unsigned;
1118         }
1119         elsif ( lc $type eq 'smallint' ) {
1120             $changed = $size != 6 - $unsigned;
1121             $size = 6 - $unsigned;
1122         }
1123         elsif ( lc $type eq 'mediumint' ) {
1124             $changed = $size != 9 - $unsigned;
1125             $size = 9 - $unsigned;
1126         }
1127         elsif ( $type =~ /^int(eger)?$/i ) {
1128             $changed = $size != 11 - $unsigned || $type ne 'int';
1129             $type = 'int';
1130             $size = 11 - $unsigned;
1131         }
1132         elsif ( lc $type eq 'bigint' ) {
1133             $changed = $size != 20;
1134             $size = 20;
1135         }
1136         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
1137             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
1138             $changed     = @$old_size != 2
1139                         || $old_size->[0] != 8
1140                         || $old_size->[1] != 2;
1141             $size        = [8,2];
1142         }
1143     }
1144
1145     if ( $type =~ /^tiny(text|blob)$/i ) {
1146         $changed = $size != 255;
1147         $size = 255;
1148     }
1149     elsif ( $type =~ /^(blob|text)$/i ) {
1150         $changed = $size != 65_535;
1151         $size = 65_535;
1152     }
1153     elsif ( $type =~ /^medium(blob|text)$/i ) {
1154         $changed = $size != 16_777_215;
1155         $size = 16_777_215;
1156     }
1157     elsif ( $type =~ /^long(blob|text)$/i ) {
1158         $changed = $size != 4_294_967_295;
1159         $size = 4_294_967_295;
1160     }
1161
1162     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1163         my %extra = $field->extra;
1164         my $longest = 0;
1165         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
1166             $longest = $len if $len > $longest;
1167         }
1168         $changed = 1;
1169         $size = $longest if $longest;
1170     }
1171
1172
1173     if ( $changed ) {
1174         # We only want to clone the field, not *everything*
1175         {
1176             local $field->{table} = undef;
1177             $field->parsed_field( dclone( $field ) );
1178             $field->parsed_field->{table} = $field->table;
1179         }
1180         $field->size( $size );
1181         $field->data_type( $type );
1182         $field->sql_data_type( $type_mapping{ lc $type } )
1183             if exists $type_mapping{ lc $type };
1184         $field->extra->{list} = $list if @$list;
1185     }
1186 }
1187
1188 1;
1189
1190 # -------------------------------------------------------------------
1191 # Where man is not nature is barren.
1192 # William Blake
1193 # -------------------------------------------------------------------
1194
1195 =pod
1196
1197 =head1 AUTHOR
1198
1199 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1200 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1201
1202 =head1 SEE ALSO
1203
1204 Parse::RecDescent, SQL::Translator::Schema.
1205
1206 =cut