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