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 Valid version specifiers for C<mysql_parser_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
 124
 125 More information about the MySQL comment-syntax: L<http://dev.mysql.com/doc/refman/5.0/en/comments.html>
 126
 127
 128 =cut
 129
 130 use strict;
 131 use warnings;
 132
 133 our $VERSION = '1.59';
 134
 135 our $DEBUG;
 136 $DEBUG   = 0 unless defined $DEBUG;
 137
 138 use Data::Dumper;
 139 use Storable qw(dclone);
 140 use DBI qw(:sql_types);
 141 use SQL::Translator::Utils qw/parse_mysql_version ddl_parser_instance/;
 142
 143 use base qw(Exporter);
 144 our @EXPORT_OK = qw(parse);
 145
 146 our %type_mapping = ();
 147
 148 use constant DEFAULT_PARSER_VERSION => 30000;
 149
 150 our $GRAMMAR = << 'END_OF_GRAMMAR';
 151
 152 {
 153     my ( $database_name, %tables, $table_order, @table_comments, %views,
 154         $view_order, %procedures, $proc_order );
 155     my $delimiter = ';';
 156 }
 157
 158 #
 159 # The "eofile" rule makes the parser fail if any "statement" rule
 160 # fails.  Otherwise, the first successful match by a "statement"
 161 # won't cause the failure needed to know that the parse, as a whole,
 162 # failed. -ky
 163 #
 164 startrule : statement(s) eofile {
 165     {
 166         database_name => $database_name,
 167         tables        => \%tables,
 168         views         => \%views,
 169         procedures    => \%procedures,
 170     }
 171 }
 172
 173 eofile : /^\Z/
 174
 175 statement : comment
 176     | use
 177     | set
 178     | drop
 179     | create
 180     | alter
 181     | insert
 182     | delimiter
 183     | empty_statement
 184     | <error>
 185
 186 use : /use/i WORD "$delimiter"
 187     {
 188         $database_name = $item[2];
 189         @table_comments = ();
 190     }
 191
 192 set : /set/i /[^;]+/ "$delimiter"
 193     { @table_comments = () }
 194
 195 drop : /drop/i TABLE /[^;]+/ "$delimiter"
 196
 197 drop : /drop/i WORD(s) "$delimiter"
 198     { @table_comments = () }
 199
 200 bit:
 201     /(b'[01]+')/ |
 202     /(b"[01]+")/
 203
 204 string :
 205   # MySQL strings, unlike common SQL strings, can be double-quoted or
 206   # single-quoted, and you can escape the delmiters by doubling (but only the
 207   # delimiter) or by backslashing.
 208
 209    /'(\\.|''|[^\\\'])*'/ |
 210    /"(\\.|""|[^\\\"])*"/
 211   # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
 212
 213 nonstring : /[^;\'"]+/
 214
 215 statement_body : string | nonstring
 216
 217 insert : /insert/i  statement_body(s?) "$delimiter"
 218
 219 delimiter : /delimiter/i /[\S]+/
 220     { $delimiter = $item[2] }
 221
 222 empty_statement : "$delimiter"
 223
 224 alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
 225     {
 226         my $table_name                       = $item{'table_name'};
 227     die "Cannot ALTER table '$table_name'; it does not exist"
 228         unless $tables{ $table_name };
 229         for my $definition ( @{ $item[4] } ) {
 230         $definition->{'extra'}->{'alter'} = 1;
 231         push @{ $tables{ $table_name }{'constraints'} }, $definition;
 232     }
 233     }
 234
 235 alter_specification : ADD foreign_key_def
 236     { $return = $item[2] }
 237
 238 create : CREATE /database/i WORD "$delimiter"
 239     { @table_comments = () }
 240
 241 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
 242     {
 243         my $table_name                       = $item{'table_name'};
 244         die "There is more than one definition for $table_name"
 245             if ($tables{$table_name});
 246
 247         $tables{ $table_name }{'order'}      = ++$table_order;
 248         $tables{ $table_name }{'table_name'} = $table_name;
 249
 250         if ( @table_comments ) {
 251             $tables{ $table_name }{'comments'} = [ @table_comments ];
 252             @table_comments = ();
 253         }
 254
 255         my $i = 1;
 256         for my $definition ( @{ $item[7] } ) {
 257             if ( $definition->{'supertype'} eq 'field' ) {
 258                 my $field_name = $definition->{'name'};
 259                 $tables{ $table_name }{'fields'}{ $field_name } =
 260                     { %$definition, order => $i };
 261                 $i++;
 262
 263                 if ( $definition->{'is_primary_key'} ) {
 264                     push @{ $tables{ $table_name }{'constraints'} },
 265                         {
 266                             type   => 'primary_key',
 267                             fields => [ $field_name ],
 268                         }
 269                     ;
 270                 }
 271             }
 272             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 273                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 274             }
 275             elsif ( $definition->{'supertype'} eq 'index' ) {
 276                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 277             }
 278         }
 279
 280         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 281             for my $option ( @options ) {
 282                 my ( $key, $value ) = each %$option;
 283                 if ( $key eq 'comment' ) {
 284                     push @{ $tables{ $table_name }{'comments'} }, $value;
 285                 }
 286                 else {
 287                     push @{ $tables{ $table_name }{'table_options'} }, $option;
 288                 }
 289             }
 290         }
 291
 292         1;
 293     }
 294
 295 opt_if_not_exists : /if not exists/i
 296
 297 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
 298     {
 299         @table_comments = ();
 300         push @{ $tables{ $item{'table_name'} }{'indices'} },
 301             {
 302                 name   => $item[4],
 303                 type   => $item[2][0] ? 'unique' : 'normal',
 304                 fields => $item[8],
 305             }
 306         ;
 307     }
 308
 309 create : CREATE /trigger/i NAME not_delimiter "$delimiter"
 310     {
 311         @table_comments = ();
 312     }
 313
 314 create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
 315     {
 316         @table_comments = ();
 317         my $func_name = $item[3];
 318         my $owner = '';
 319         my $sql = "$item[1] $item[2] $item[3] $item[4]";
 320
 321         $procedures{ $func_name }{'order'}  = ++$proc_order;
 322         $procedures{ $func_name }{'name'}   = $func_name;
 323         $procedures{ $func_name }{'owner'}  = $owner;
 324         $procedures{ $func_name }{'sql'}    = $sql;
 325     }
 326
 327 PROCEDURE : /procedure/i
 328     | /function/i
 329
 330 create : CREATE replace(?) algorithm(?) /view/i NAME not_delimiter "$delimiter"
 331     {
 332         @table_comments = ();
 333         my $view_name = $item[5];
 334         my $sql = join(q{ }, grep { defined and length } $item[1], $item[2]->[0], $item[3]->[0])
 335             . " $item[4] $item[5] $item[6]";
 336
 337         # Hack to strip database from function calls in SQL
 338         $sql =~ s#`\w+`\.(`\w+`\()##g;
 339
 340         $views{ $view_name }{'order'}  = ++$view_order;
 341         $views{ $view_name }{'name'}   = $view_name;
 342         $views{ $view_name }{'sql'}    = $sql;
 343     }
 344
 345 replace : /or replace/i
 346
 347 algorithm : /algorithm/i /=/ WORD
 348     {
 349         $return = "$item[1]=$item[3]";
 350     }
 351
 352 not_delimiter : /.*?(?=$delimiter)/is
 353
 354 create_definition : constraint
 355     | index
 356     | field
 357     | comment
 358     | <error>
 359
 360 comment : /^\s*(?:#|-{2}).*\n/
 361     {
 362         my $comment =  $item[1];
 363         $comment    =~ s/^\s*(#|--)\s*//;
 364         $comment    =~ s/\s*$//;
 365         $return     = $comment;
 366     }
 367
 368 comment : /\/\*/ /.*?\*\//s
 369     {
 370         my $comment = $item[2];
 371         $comment = substr($comment, 0, -2);
 372         $comment    =~ s/^\s*|\s*$//g;
 373         $return = $comment;
 374     }
 375
 376 field_comment : /^\s*(?:#|-{2}).*\n/
 377     {
 378         my $comment =  $item[1];
 379         $comment    =~ s/^\s*(#|--)\s*//;
 380         $comment    =~ s/\s*$//;
 381         $return     = $comment;
 382     }
 383
 384
 385 field_comment2 : /comment/i /'.*?'/
 386     {
 387         my $comment = $item[2];
 388         $comment    =~ s/^'//;
 389         $comment    =~ s/'$//;
 390         $return     = $comment;
 391     }
 392
 393 blank : /\s*/
 394
 395 field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
 396     {
 397         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 398         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 399             $qualifiers{ $_ } = 1 for @type_quals;
 400         }
 401
 402         my $null = defined $qualifiers{'not_null'}
 403                    ? $qualifiers{'not_null'} : 1;
 404         delete $qualifiers{'not_null'};
 405
 406         my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 407
 408         $return = {
 409             supertype   => 'field',
 410             name        => $item{'field_name'},
 411             data_type   => $item{'data_type'}{'type'},
 412             size        => $item{'data_type'}{'size'},
 413             list        => $item{'data_type'}{'list'},
 414             null        => $null,
 415             constraints => $item{'reference_definition(?)'},
 416             comments    => [ @comments ],
 417             %qualifiers,
 418         }
 419     }
 420     | <error>
 421
 422 field_qualifier : not_null
 423     {
 424         $return = {
 425              null => $item{'not_null'},
 426         }
 427     }
 428
 429 field_qualifier : default_val
 430     {
 431         $return = {
 432              default => $item{'default_val'},
 433         }
 434     }
 435
 436 field_qualifier : auto_inc
 437     {
 438         $return = {
 439              is_auto_inc => $item{'auto_inc'},
 440         }
 441     }
 442
 443 field_qualifier : primary_key
 444     {
 445         $return = {
 446              is_primary_key => $item{'primary_key'},
 447         }
 448     }
 449
 450 field_qualifier : unsigned
 451     {
 452         $return = {
 453              is_unsigned => $item{'unsigned'},
 454         }
 455     }
 456
 457 field_qualifier : /character set/i WORD
 458     {
 459         $return = {
 460             'CHARACTER SET' => $item[2],
 461         }
 462     }
 463
 464 field_qualifier : /collate/i WORD
 465     {
 466         $return = {
 467             COLLATE => $item[2],
 468         }
 469     }
 470
 471 field_qualifier : /on update/i CURRENT_TIMESTAMP
 472     {
 473         $return = {
 474             'ON UPDATE' => $item[2],
 475         }
 476     }
 477
 478 field_qualifier : /unique/i KEY(?)
 479     {
 480         $return = {
 481             is_unique => 1,
 482         }
 483     }
 484
 485 field_qualifier : KEY
 486     {
 487         $return = {
 488             has_index => 1,
 489         }
 490     }
 491
 492 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
 493     {
 494         $return = {
 495             type             => 'foreign_key',
 496             reference_table  => $item[2],
 497             reference_fields => $item[3][0],
 498             match_type       => $item[4][0],
 499             on_delete        => $item[5][0],
 500             on_update        => $item[6][0],
 501         }
 502     }
 503
 504 match_type : /match full/i { 'full' }
 505     |
 506     /match partial/i { 'partial' }
 507
 508 on_delete : /on delete/i reference_option
 509     { $item[2] }
 510
 511 on_update :
 512     /on update/i 'CURRENT_TIMESTAMP'
 513     { $item[2] }
 514     |
 515     /on update/i reference_option
 516     { $item[2] }
 517
 518 reference_option: /restrict/i |
 519     /cascade/i   |
 520     /set null/i  |
 521     /no action/i |
 522     /set default/i
 523     { $item[1] }
 524
 525 index : normal_index
 526     | fulltext_index
 527     | spatial_index
 528     | <error>
 529
 530 table_name   : NAME
 531
 532 field_name   : NAME
 533
 534 index_name   : NAME
 535
 536 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 537     {
 538         my $type = $item[1];
 539         my $size; # field size, applicable only to non-set fields
 540         my $list; # set list, applicable only to sets (duh)
 541
 542         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 543             $size = undef;
 544             $list = $item[2][0];
 545         }
 546         else {
 547             $size = $item[2][0];
 548             $list = [];
 549         }
 550
 551
 552         $return        = {
 553             type       => $type,
 554             size       => $size,
 555             list       => $list,
 556             qualifiers => $item[3],
 557         }
 558     }
 559
 560 parens_field_list : '(' field_name(s /,/) ')'
 561     { $item[2] }
 562
 563 parens_value_list : '(' VALUE(s /,/) ')'
 564     { $item[2] }
 565
 566 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 567     { lc $item[1] }
 568
 569 field_type   : WORD
 570
 571 create_index : /create/i /index/i
 572
 573 not_null     : /not/i /null/i
 574     { $return = 0 }
 575     |
 576     /null/i
 577     { $return = 1 }
 578
 579 unsigned     : /unsigned/i { $return = 0 }
 580
 581 default_val :
 582     /default/i 'CURRENT_TIMESTAMP'
 583     {
 584         $return =  \$item[2];
 585     }
 586     |
 587     /default/i string
 588     {
 589         $item[2] =~ s/^\s*'|'\s*$//g or $item[2] =~ s/^\s*"|"\s*$//g;
 590         $return  =  $item[2];
 591     }
 592     |
 593     /default/i bit
 594     {
 595         $item[2] =~ s/b['"]([01]+)['"]/$1/g;
 596         $return  =  $item[2];
 597     }
 598     |
 599     /default/i /[\w\d:.-]+/
 600     {
 601         $return  =  $item[2];
 602     }
 603
 604 auto_inc : /auto_increment/i { 1 }
 605
 606 primary_key : /primary/i /key/i { 1 }
 607
 608 constraint : primary_key_def
 609     | unique_key_def
 610     | foreign_key_def
 611     | <error>
 612
 613 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 614     {
 615         $return              =  {
 616             supertype        => 'constraint',
 617             type             => 'foreign_key',
 618             name             => $item[1],
 619             fields           => $item[2],
 620             %{ $item{'reference_definition'} },
 621         }
 622     }
 623
 624 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 625     { $return = $item[3] }
 626     |
 627     /constraint/i NAME /foreign key/i
 628     { $return = $item[2] }
 629     |
 630     /constraint/i /foreign key/i
 631     { $return = '' }
 632     |
 633     /foreign key/i WORD
 634     { $return = $item[2] }
 635     |
 636     /foreign key/i
 637     { $return = '' }
 638
 639 primary_key_def : primary_key index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 640     {
 641         $return       = {
 642             supertype => 'constraint',
 643             type      => 'primary_key',
 644             fields    => $item[4],
 645             options   => $item[2][0] || $item[6][0],
 646         };
 647     }
 648     # In theory, and according to the doc, names should not be allowed here, but
 649     # MySQL accept (and ignores) them, so we are not going to be less :)
 650     | primary_key index_name_not_using(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 651     {
 652         $return       = {
 653             supertype => 'constraint',
 654             type      => 'primary_key',
 655             fields    => $item[4],
 656             options   => $item[6][0],
 657         };
 658     }
 659
 660 unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 661     {
 662         $return       = {
 663             supertype => 'constraint',
 664             name      => $item[3][0],
 665             type      => 'unique',
 666             fields    => $item[6],
 667             options   => $item[4][0] || $item[8][0],
 668         }
 669     }
 670
 671 normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 672     {
 673         $return       = {
 674             supertype => 'index',
 675             type      => 'normal',
 676             name      => $item[2][0],
 677             fields    => $item[5],
 678             options   => $item[3][0] || $item[7][0],
 679         }
 680     }
 681
 682 index_name_not_using : QUOTED_NAME
 683     | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
 684
 685 index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
 686
 687 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 688     {
 689         $return       = {
 690             supertype => 'index',
 691             type      => 'fulltext',
 692             name      => $item{'index_name(?)'}[0],
 693             fields    => $item[5],
 694         }
 695     }
 696
 697 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 698     {
 699         $return       = {
 700             supertype => 'index',
 701             type      => 'spatial',
 702             name      => $item{'index_name(?)'}[0],
 703             fields    => $item[5],
 704         }
 705     }
 706
 707 name_with_opt_paren : NAME parens_value_list(s?)
 708     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 709
 710 UNIQUE : /unique/i
 711
 712 KEY : /key/i | /index/i
 713
 714 table_option : /comment/i /=/ /'.*?'/
 715     {
 716         my $comment = $item[3];
 717         $comment    =~ s/^'//;
 718         $comment    =~ s/'$//;
 719         $return     = { comment => $comment };
 720     }
 721     | /(default )?(charset|character set)/i /\s*=?\s*/ WORD
 722     {
 723         $return = { 'CHARACTER SET' => $item[3] };
 724     }
 725     | /collate/i WORD
 726     {
 727         $return = { 'COLLATE' => $item[2] }
 728     }
 729     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
 730     {
 731         $return = { $item[1] => $item[4] };
 732     }
 733     | WORD /\s*=\s*/ MAYBE_QUOTED_WORD
 734     {
 735         $return = { $item[1] => $item[3] };
 736     }
 737
 738 MAYBE_QUOTED_WORD: /\w+/
 739                  | /'(\w+)'/
 740                  { $return = $1 }
 741                  | /"(\w+)"/
 742                  { $return = $1 }
 743
 744 default : /default/i
 745
 746 ADD : /add/i
 747
 748 ALTER : /alter/i
 749
 750 CREATE : /create/i
 751
 752 TEMPORARY : /temporary/i
 753
 754 TABLE : /table/i
 755
 756 WORD : /\w+/
 757
 758 DIGITS : /\d+/
 759
 760 COMMA : ','
 761
 762 BACKTICK : '`'
 763
 764 DOUBLE_QUOTE: '"'
 765
 766 QUOTED_NAME : BACKTICK /[^`]+/ BACKTICK
 767     { $item[2] }
 768     | DOUBLE_QUOTE /[^"]+/ DOUBLE_QUOTE
 769     { $item[2] }
 770
 771 NAME: QUOTED_NAME
 772     | /\w+/
 773
 774 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 775     { $item[1] }
 776     | /'.*?'/
 777     {
 778         # remove leading/trailing quotes
 779         my $val = $item[1];
 780         $val    =~ s/^['"]|['"]$//g;
 781         $return = $val;
 782     }
 783     | /NULL/
 784     { 'NULL' }
 785
 786 CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
 787     | /now\(\)/i
 788     { 'CURRENT_TIMESTAMP' }
 789
 790 END_OF_GRAMMAR
 791
 792 sub parse {
 793     my ( $translator, $data ) = @_;
 794
 795     # Enable warnings within the Parse::RecDescent module.
 796     local $::RD_ERRORS = 1 unless defined $::RD_ERRORS; # Make sure the parser dies when it encounters an error
 797     local $::RD_WARN   = 1 unless defined $::RD_WARN; # Enable warnings. This will warn on unused rules &c.
 798     local $::RD_HINT   = 1 unless defined $::RD_HINT; # Give out hints to help fix problems.
 799
 800     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 801     local $DEBUG       = $translator->debug;
 802
 803     my $parser = ddl_parser_instance('MySQL');
 804
 805     # Preprocess for MySQL-specific and not-before-version comments
 806     # from mysqldump
 807     my $parser_version = parse_mysql_version(
 808         $translator->parser_args->{mysql_parser_version}, 'mysql'
 809     ) || DEFAULT_PARSER_VERSION;
 810
 811     while ( $data =~
 812         s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
 813     ) {
 814         # do nothing; is there a better way to write this? -- ky
 815     }
 816
 817     my $result = $parser->startrule($data);
 818     return $translator->error( "Parse failed." ) unless defined $result;
 819     warn "Parse result:".Dumper( $result ) if $DEBUG;
 820
 821     my $schema = $translator->schema;
 822     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 823
 824     my @tables = sort {
 825         $result->{'tables'}{ $a }{'order'}
 826         <=>
 827         $result->{'tables'}{ $b }{'order'}
 828     } keys %{ $result->{'tables'} };
 829
 830     for my $table_name ( @tables ) {
 831         my $tdata =  $result->{tables}{ $table_name };
 832         my $table =  $schema->add_table(
 833             name  => $tdata->{'table_name'},
 834         ) or die $schema->error;
 835
 836         $table->comments( $tdata->{'comments'} );
 837
 838         my @fields = sort {
 839             $tdata->{'fields'}->{$a}->{'order'}
 840             <=>
 841             $tdata->{'fields'}->{$b}->{'order'}
 842         } keys %{ $tdata->{'fields'} };
 843
 844         for my $fname ( @fields ) {
 845             my $fdata = $tdata->{'fields'}{ $fname };
 846             my $field = $table->add_field(
 847                 name              => $fdata->{'name'},
 848                 data_type         => $fdata->{'data_type'},
 849                 size              => $fdata->{'size'},
 850                 default_value     => $fdata->{'default'},
 851                 is_auto_increment => $fdata->{'is_auto_inc'},
 852                 is_nullable       => $fdata->{'null'},
 853                 comments          => $fdata->{'comments'},
 854             ) or die $table->error;
 855
 856             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 857
 858             for my $qual ( qw[ binary unsigned zerofill list collate ],
 859                     'character set', 'on update' ) {
 860                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 861                     next if ref $val eq 'ARRAY' && !@$val;
 862                     $field->extra( $qual, $val );
 863                 }
 864             }
 865
 866             if ( $fdata->{'has_index'} ) {
 867                 $table->add_index(
 868                     name   => '',
 869                     type   => 'NORMAL',
 870                     fields => $fdata->{'name'},
 871                 ) or die $table->error;
 872             }
 873
 874             if ( $fdata->{'is_unique'} ) {
 875                 $table->add_constraint(
 876                     name   => '',
 877                     type   => 'UNIQUE',
 878                     fields => $fdata->{'name'},
 879                 ) or die $table->error;
 880             }
 881
 882             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 883                 next unless $cdata->{'type'} eq 'foreign_key';
 884                 $cdata->{'fields'} ||= [ $field->name ];
 885                 push @{ $tdata->{'constraints'} }, $cdata;
 886             }
 887
 888         }
 889
 890         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 891             my $index  =  $table->add_index(
 892                 name   => $idata->{'name'},
 893                 type   => uc $idata->{'type'},
 894                 fields => $idata->{'fields'},
 895             ) or die $table->error;
 896         }
 897
 898         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 899             my @cleaned_options;
 900             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
 901                 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
 902                 : ();
 903             if (@ignore_opts) {
 904                 my $ignores = { map { $_ => 1 } @ignore_opts };
 905                 foreach my $option (@options) {
 906                     # make sure the option isn't in ignore list
 907                     my ($option_key) = keys %$option;
 908                     if ( !exists $ignores->{$option_key} ) {
 909                         push @cleaned_options, $option;
 910                     }
 911                 }
 912             } else {
 913                 @cleaned_options = @options;
 914             }
 915             $table->options( \@cleaned_options ) or die $table->error;
 916         }
 917
 918         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 919             my $constraint       =  $table->add_constraint(
 920                 name             => $cdata->{'name'},
 921                 type             => $cdata->{'type'},
 922                 fields           => $cdata->{'fields'},
 923                 reference_table  => $cdata->{'reference_table'},
 924                 reference_fields => $cdata->{'reference_fields'},
 925                 match_type       => $cdata->{'match_type'} || '',
 926                 on_delete        => $cdata->{'on_delete'}
 927                                  || $cdata->{'on_delete_do'},
 928                 on_update        => $cdata->{'on_update'}
 929                                  || $cdata->{'on_update_do'},
 930             ) or die $table->error;
 931         }
 932
 933         # After the constrains and PK/idxs have been created,
 934         # we normalize fields
 935         normalize_field($_) for $table->get_fields;
 936     }
 937
 938     my @procedures = sort {
 939         $result->{procedures}->{ $a }->{'order'}
 940         <=>
 941         $result->{procedures}->{ $b }->{'order'}
 942     } keys %{ $result->{procedures} };
 943
 944     for my $proc_name ( @procedures ) {
 945         $schema->add_procedure(
 946             name  => $proc_name,
 947             owner => $result->{procedures}->{$proc_name}->{owner},
 948             sql   => $result->{procedures}->{$proc_name}->{sql},
 949         );
 950     }
 951     my @views = sort {
 952         $result->{views}->{ $a }->{'order'}
 953         <=>
 954         $result->{views}->{ $b }->{'order'}
 955     } keys %{ $result->{views} };
 956
 957     for my $view_name ( @views ) {
 958         $schema->add_view(
 959             name => $view_name,
 960             sql  => $result->{'views'}->{$view_name}->{sql},
 961         );
 962     }
 963
 964     return 1;
 965 }
 966
 967 # Takes a field, and returns
 968 sub normalize_field {
 969     my ($field) = @_;
 970     my ($size, $type, $list, $unsigned, $changed);
 971
 972     $size = $field->size;
 973     $type = $field->data_type;
 974     $list = $field->extra->{list} || [];
 975     $unsigned = defined($field->extra->{unsigned});
 976
 977     if ( !ref $size && $size eq 0 ) {
 978         if ( lc $type eq 'tinyint' ) {
 979             $changed = $size != 4 - $unsigned;
 980             $size = 4 - $unsigned;
 981         }
 982         elsif ( lc $type eq 'smallint' ) {
 983             $changed = $size != 6 - $unsigned;
 984             $size = 6 - $unsigned;
 985         }
 986         elsif ( lc $type eq 'mediumint' ) {
 987             $changed = $size != 9 - $unsigned;
 988             $size = 9 - $unsigned;
 989         }
 990         elsif ( $type =~ /^int(eger)?$/i ) {
 991             $changed = $size != 11 - $unsigned || $type ne 'int';
 992             $type = 'int';
 993             $size = 11 - $unsigned;
 994         }
 995         elsif ( lc $type eq 'bigint' ) {
 996             $changed = $size != 20;
 997             $size = 20;
 998         }
 999         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
1000             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
1001             $changed     = @$old_size != 2
1002                         || $old_size->[0] != 8
1003                         || $old_size->[1] != 2;
1004             $size        = [8,2];
1005         }
1006     }
1007
1008     if ( $type =~ /^tiny(text|blob)$/i ) {
1009         $changed = $size != 255;
1010         $size = 255;
1011     }
1012     elsif ( $type =~ /^(blob|text)$/i ) {
1013         $changed = $size != 65_535;
1014         $size = 65_535;
1015     }
1016     elsif ( $type =~ /^medium(blob|text)$/i ) {
1017         $changed = $size != 16_777_215;
1018         $size = 16_777_215;
1019     }
1020     elsif ( $type =~ /^long(blob|text)$/i ) {
1021         $changed = $size != 4_294_967_295;
1022         $size = 4_294_967_295;
1023     }
1024
1025     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1026         my %extra = $field->extra;
1027         my $longest = 0;
1028         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
1029             $longest = $len if $len > $longest;
1030         }
1031         $changed = 1;
1032         $size = $longest if $longest;
1033     }
1034
1035
1036     if ( $changed ) {
1037         # We only want to clone the field, not *everything*
1038         {
1039             local $field->{table} = undef;
1040             $field->parsed_field( dclone( $field ) );
1041             $field->parsed_field->{table} = $field->table;
1042         }
1043         $field->size( $size );
1044         $field->data_type( $type );
1045         $field->sql_data_type( $type_mapping{ lc $type } )
1046             if exists $type_mapping{ lc $type };
1047         $field->extra->{list} = $list if @$list;
1048     }
1049 }
1050
1051 1;
1052
1053 # -------------------------------------------------------------------
1054 # Where man is not nature is barren.
1055 # William Blake
1056 # -------------------------------------------------------------------
1057
1058 =pod
1059
1060 =head1 AUTHOR
1061
1062 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1063 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1064
1065 =head1 SEE ALSO
1066
1067 Parse::RecDescent, SQL::Translator::Schema.
1068
1069 =cut