lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License as
   8 # published by the Free Software Foundation; version 2.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =head1 NAME
  22
  23 SQL::Translator::Parser::MySQL - parser for MySQL
  24
  25 =head1 SYNOPSIS
  26
  27   use SQL::Translator;
  28   use SQL::Translator::Parser::MySQL;
  29
  30   my $translator = SQL::Translator->new;
  31   $translator->parser("SQL::Translator::Parser::MySQL");
  32
  33 =head1 DESCRIPTION
  34
  35 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
  36
  37 Here's the word from the MySQL site
  38 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
  39
  40   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
  41   [table_options] [select_statement]
  42
  43   or
  44
  45   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
  46
  47   create_definition:
  48     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
  49               [PRIMARY KEY] [reference_definition]
  50     or    PRIMARY KEY (index_col_name,...)
  51     or    KEY [index_name] (index_col_name,...)
  52     or    INDEX [index_name] (index_col_name,...)
  53     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
  54     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
  55     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
  56               [reference_definition]
  57     or    CHECK (expr)
  58
  59   type:
  60           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
  61     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
  62     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
  63     or    INT[(length)] [UNSIGNED] [ZEROFILL]
  64     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
  65     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
  66     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
  67     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
  68     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
  69     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
  70     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
  71     or    CHAR(length) [BINARY]
  72     or    VARCHAR(length) [BINARY]
  73     or    DATE
  74     or    TIME
  75     or    TIMESTAMP
  76     or    DATETIME
  77     or    TINYBLOB
  78     or    BLOB
  79     or    MEDIUMBLOB
  80     or    LONGBLOB
  81     or    TINYTEXT
  82     or    TEXT
  83     or    MEDIUMTEXT
  84     or    LONGTEXT
  85     or    ENUM(value1,value2,value3,...)
  86     or    SET(value1,value2,value3,...)
  87
  88   index_col_name:
  89           col_name [(length)]
  90
  91   reference_definition:
  92           REFERENCES tbl_name [(index_col_name,...)]
  93                      [MATCH FULL | MATCH PARTIAL]
  94                      [ON DELETE reference_option]
  95                      [ON UPDATE reference_option]
  96
  97   reference_option:
  98           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
  99
 100   table_options:
 101           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
 102   or      ENGINE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
 103   or      AUTO_INCREMENT = #
 104   or      AVG_ROW_LENGTH = #
 105   or      [ DEFAULT ] CHARACTER SET charset_name
 106   or      CHECKSUM = {0 | 1}
 107   or      COLLATE collation_name
 108   or      COMMENT = "string"
 109   or      MAX_ROWS = #
 110   or      MIN_ROWS = #
 111   or      PACK_KEYS = {0 | 1 | DEFAULT}
 112   or      PASSWORD = "string"
 113   or      DELAY_KEY_WRITE = {0 | 1}
 114   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
 115   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
 116   or      UNION = (table_name,[table_name...])
 117   or      INSERT_METHOD= {NO | FIRST | LAST }
 118   or      DATA DIRECTORY="absolute path to directory"
 119   or      INDEX DIRECTORY="absolute path to directory"
 120
 121
 122 A subset of the ALTER TABLE syntax that allows addition of foreign keys:
 123
 124   ALTER [IGNORE] TABLE tbl_name alter_specification [, alter_specification] ...
 125
 126   alter_specification:
 127           ADD [CONSTRAINT [symbol]]
 128           FOREIGN KEY [index_name] (index_col_name,...)
 129              [reference_definition]
 130
 131 A subset of INSERT that we ignore:
 132
 133   INSERT anything
 134
 135 =head1 ARGUMENTS
 136
 137 This parser takes a single optional parser_arg C<mysql_parser_version>, which
 138 provides the desired version for the target database. Any statement in the processed
 139 dump file, that is commented with a version higher than the one supplied, will be stripped.
 140
 141 Valid version specifiers for C<mysql_parser_version> are listed L<here|SQL::Translator::Utils/parse_mysql_version>
 142
 143 More information about the MySQL comment-syntax: L<http://dev.mysql.com/doc/refman/5.0/en/comments.html>
 144
 145
 146 =cut
 147
 148 use strict;
 149 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 150 $VERSION = '1.59';
 151 $DEBUG   = 0 unless defined $DEBUG;
 152
 153 use Data::Dumper;
 154 use Parse::RecDescent;
 155 use Exporter;
 156 use Storable qw(dclone);
 157 use DBI qw(:sql_types);
 158 use base qw(Exporter);
 159
 160 use SQL::Translator::Utils qw/parse_mysql_version/;
 161
 162 our %type_mapping = (
 163 );
 164
 165 @EXPORT_OK = qw(parse);
 166
 167 # Enable warnings within the Parse::RecDescent module.
 168 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 169 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 170 $::RD_HINT   = 1; # Give out hints to help fix problems.
 171
 172 use constant DEFAULT_PARSER_VERSION => 30000;
 173
 174 $GRAMMAR = << 'END_OF_GRAMMAR';
 175
 176 {
 177     my ( $database_name, %tables, $table_order, @table_comments, %views, $view_order, %procedures, $proc_order );
 178     my $delimiter = ';';
 179 }
 180
 181 #
 182 # The "eofile" rule makes the parser fail if any "statement" rule
 183 # fails.  Otherwise, the first successful match by a "statement"
 184 # won't cause the failure needed to know that the parse, as a whole,
 185 # failed. -ky
 186 #
 187 startrule : statement(s) eofile {
 188     { tables => \%tables, database_name => $database_name, views => \%views, procedures =>\%procedures }
 189 }
 190
 191 eofile : /^\Z/
 192
 193 statement : comment
 194     | use
 195     | set
 196     | drop
 197     | create
 198     | alter
 199     | insert
 200     | delimiter
 201     | empty_statement
 202     | <error>
 203
 204 use : /use/i WORD "$delimiter"
 205     {
 206         $database_name = $item[2];
 207         @table_comments = ();
 208     }
 209
 210 set : /set/i /[^;]+/ "$delimiter"
 211     { @table_comments = () }
 212
 213 drop : /drop/i TABLE /[^;]+/ "$delimiter"
 214
 215 drop : /drop/i WORD(s) "$delimiter"
 216     { @table_comments = () }
 217
 218 string :
 219   # MySQL strings, unlike common SQL strings, can be double-quoted or
 220   # single-quoted, and you can escape the delmiters by doubling (but only the
 221   # delimiter) or by backslashing.
 222
 223    /'(\\.|''|[^\\\'])*'/ |
 224    /"(\\.|""|[^\\\"])*"/
 225   # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
 226
 227 nonstring : /[^;\'"]+/
 228
 229 statement_body : (string | nonstring)(s?)
 230
 231 insert : /insert/i  statement_body "$delimiter"
 232
 233 delimiter : /delimiter/i /[\S]+/
 234     { $delimiter = $item[2] }
 235
 236 empty_statement : "$delimiter"
 237
 238 alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
 239     {
 240         my $table_name                       = $item{'table_name'};
 241     die "Cannot ALTER table '$table_name'; it does not exist"
 242         unless $tables{ $table_name };
 243         for my $definition ( @{ $item[4] } ) {
 244         $definition->{'extra'}->{'alter'} = 1;
 245         push @{ $tables{ $table_name }{'constraints'} }, $definition;
 246     }
 247     }
 248
 249 alter_specification : ADD foreign_key_def
 250     { $return = $item[2] }
 251
 252 create : CREATE /database/i WORD "$delimiter"
 253     { @table_comments = () }
 254
 255 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
 256     {
 257         my $table_name                       = $item{'table_name'};
 258         $tables{ $table_name }{'order'}      = ++$table_order;
 259         $tables{ $table_name }{'table_name'} = $table_name;
 260
 261         if ( @table_comments ) {
 262             $tables{ $table_name }{'comments'} = [ @table_comments ];
 263             @table_comments = ();
 264         }
 265
 266         my $i = 1;
 267         for my $definition ( @{ $item[7] } ) {
 268             if ( $definition->{'supertype'} eq 'field' ) {
 269                 my $field_name = $definition->{'name'};
 270                 $tables{ $table_name }{'fields'}{ $field_name } =
 271                     { %$definition, order => $i };
 272                 $i++;
 273
 274                 if ( $definition->{'is_primary_key'} ) {
 275                     push @{ $tables{ $table_name }{'constraints'} },
 276                         {
 277                             type   => 'primary_key',
 278                             fields => [ $field_name ],
 279                         }
 280                     ;
 281                 }
 282             }
 283             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 284                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 285             }
 286             elsif ( $definition->{'supertype'} eq 'index' ) {
 287                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 288             }
 289         }
 290
 291         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 292             for my $option ( @options ) {
 293                 my ( $key, $value ) = each %$option;
 294                 if ( $key eq 'comment' ) {
 295                     push @{ $tables{ $table_name }{'comments'} }, $value;
 296                 }
 297                 else {
 298                     push @{ $tables{ $table_name }{'table_options'} }, $option;
 299                 }
 300             }
 301         }
 302
 303         1;
 304     }
 305
 306 opt_if_not_exists : /if not exists/i
 307
 308 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
 309     {
 310         @table_comments = ();
 311         push @{ $tables{ $item{'table_name'} }{'indices'} },
 312             {
 313                 name   => $item[4],
 314                 type   => $item[2][0] ? 'unique' : 'normal',
 315                 fields => $item[8],
 316             }
 317         ;
 318     }
 319
 320 create : CREATE /trigger/i NAME not_delimiter "$delimiter"
 321     {
 322         @table_comments = ();
 323     }
 324
 325 create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
 326     {
 327         @table_comments = ();
 328         my $func_name = $item[3];
 329         my $owner = '';
 330         my $sql = "$item[1] $item[2] $item[3] $item[4]";
 331
 332         $procedures{ $func_name }{'order'}  = ++$proc_order;
 333         $procedures{ $func_name }{'name'}   = $func_name;
 334         $procedures{ $func_name }{'owner'}  = $owner;
 335         $procedures{ $func_name }{'sql'}    = $sql;
 336     }
 337
 338 PROCEDURE : /procedure/i
 339     | /function/i
 340
 341 create : CREATE algorithm /view/i NAME not_delimiter "$delimiter"
 342     {
 343         @table_comments = ();
 344         my $view_name = $item[4];
 345         my $sql = "$item[1] $item[2] $item[3] $item[4] $item[5]";
 346
 347         # Hack to strip database from function calls in SQL
 348         $sql =~ s#`\w+`\.(`\w+`\()##g;
 349
 350         $views{ $view_name }{'order'}  = ++$view_order;
 351         $views{ $view_name }{'name'}   = $view_name;
 352         $views{ $view_name }{'sql'}    = $sql;
 353     }
 354
 355 algorithm : /algorithm/i /=/ WORD
 356     {
 357         $return = "$item[1]=$item[3]";
 358     }
 359
 360 not_delimiter : /.*?(?=$delimiter)/is
 361
 362 create_definition : constraint
 363     | index
 364     | field
 365     | comment
 366     | <error>
 367
 368 comment : /^\s*(?:#|-{2}).*\n/
 369     {
 370         my $comment =  $item[1];
 371         $comment    =~ s/^\s*(#|--)\s*//;
 372         $comment    =~ s/\s*$//;
 373         $return     = $comment;
 374     }
 375
 376 comment : /\/\*/ /.*?\*\//s
 377     {
 378         my $comment = $item[2];
 379         $comment = substr($comment, 0, -2);
 380         $comment    =~ s/^\s*|\s*$//g;
 381         $return = $comment;
 382     }
 383
 384 field_comment : /^\s*(?:#|-{2}).*\n/
 385     {
 386         my $comment =  $item[1];
 387         $comment    =~ s/^\s*(#|--)\s*//;
 388         $comment    =~ s/\s*$//;
 389         $return     = $comment;
 390     }
 391
 392
 393 field_comment2 : /comment/i /'.*?'/
 394     {
 395         my $comment = $item[2];
 396         $comment    =~ s/^'//;
 397         $comment    =~ s/'$//;
 398         $return     = $comment;
 399     }
 400
 401 blank : /\s*/
 402
 403 field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
 404     {
 405         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 406         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 407             $qualifiers{ $_ } = 1 for @type_quals;
 408         }
 409
 410         my $null = defined $qualifiers{'not_null'}
 411                    ? $qualifiers{'not_null'} : 1;
 412         delete $qualifiers{'not_null'};
 413
 414         my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 415
 416         $return = {
 417             supertype   => 'field',
 418             name        => $item{'field_name'},
 419             data_type   => $item{'data_type'}{'type'},
 420             size        => $item{'data_type'}{'size'},
 421             list        => $item{'data_type'}{'list'},
 422             null        => $null,
 423             constraints => $item{'reference_definition(?)'},
 424             comments    => [ @comments ],
 425             %qualifiers,
 426         }
 427     }
 428     | <error>
 429
 430 field_qualifier : not_null
 431     {
 432         $return = {
 433              null => $item{'not_null'},
 434         }
 435     }
 436
 437 field_qualifier : default_val
 438     {
 439         $return = {
 440              default => $item{'default_val'},
 441         }
 442     }
 443
 444 field_qualifier : auto_inc
 445     {
 446         $return = {
 447              is_auto_inc => $item{'auto_inc'},
 448         }
 449     }
 450
 451 field_qualifier : primary_key
 452     {
 453         $return = {
 454              is_primary_key => $item{'primary_key'},
 455         }
 456     }
 457
 458 field_qualifier : unsigned
 459     {
 460         $return = {
 461              is_unsigned => $item{'unsigned'},
 462         }
 463     }
 464
 465 field_qualifier : /character set/i WORD
 466     {
 467         $return = {
 468             'CHARACTER SET' => $item[2],
 469         }
 470     }
 471
 472 field_qualifier : /collate/i WORD
 473     {
 474         $return = {
 475             COLLATE => $item[2],
 476         }
 477     }
 478
 479 field_qualifier : /on update/i CURRENT_TIMESTAMP
 480     {
 481         $return = {
 482             'ON UPDATE' => $item[2],
 483         }
 484     }
 485
 486 field_qualifier : /unique/i KEY(?)
 487     {
 488         $return = {
 489             is_unique => 1,
 490         }
 491     }
 492
 493 field_qualifier : KEY
 494     {
 495         $return = {
 496             has_index => 1,
 497         }
 498     }
 499
 500 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
 501     {
 502         $return = {
 503             type             => 'foreign_key',
 504             reference_table  => $item[2],
 505             reference_fields => $item[3][0],
 506             match_type       => $item[4][0],
 507             on_delete        => $item[5][0],
 508             on_update        => $item[6][0],
 509         }
 510     }
 511
 512 match_type : /match full/i { 'full' }
 513     |
 514     /match partial/i { 'partial' }
 515
 516 on_delete : /on delete/i reference_option
 517     { $item[2] }
 518
 519 on_update :
 520     /on update/i 'CURRENT_TIMESTAMP'
 521     { $item[2] }
 522     |
 523     /on update/i reference_option
 524     { $item[2] }
 525
 526 reference_option: /restrict/i |
 527     /cascade/i   |
 528     /set null/i  |
 529     /no action/i |
 530     /set default/i
 531     { $item[1] }
 532
 533 index : normal_index
 534     | fulltext_index
 535     | spatial_index
 536     | <error>
 537
 538 table_name   : NAME
 539
 540 field_name   : NAME
 541
 542 index_name   : NAME
 543
 544 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 545     {
 546         my $type = $item[1];
 547         my $size; # field size, applicable only to non-set fields
 548         my $list; # set list, applicable only to sets (duh)
 549
 550         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 551             $size = undef;
 552             $list = $item[2][0];
 553         }
 554         else {
 555             $size = $item[2][0];
 556             $list = [];
 557         }
 558
 559
 560         $return        = {
 561             type       => $type,
 562             size       => $size,
 563             list       => $list,
 564             qualifiers => $item[3],
 565         }
 566     }
 567
 568 parens_field_list : '(' field_name(s /,/) ')'
 569     { $item[2] }
 570
 571 parens_value_list : '(' VALUE(s /,/) ')'
 572     { $item[2] }
 573
 574 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 575     { lc $item[1] }
 576
 577 field_type   : WORD
 578
 579 create_index : /create/i /index/i
 580
 581 not_null     : /not/i /null/i
 582     { $return = 0 }
 583     |
 584     /null/i
 585     { $return = 1 }
 586
 587 unsigned     : /unsigned/i { $return = 0 }
 588
 589 #default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 590 #    {
 591 #        $item[2] =~ s/'//g;
 592 #        $return  =  $item[2];
 593 #    }
 594
 595 default_val :
 596     /default/i 'CURRENT_TIMESTAMP'
 597     {
 598         $return =  \$item[2];
 599     }
 600     |
 601     /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 602     {
 603         $item[2] =~ s/^\s*'|'\s*$//g;
 604         $return  =  $item[2];
 605     }
 606
 607 auto_inc : /auto_increment/i { 1 }
 608
 609 primary_key : /primary/i /key/i { 1 }
 610
 611 constraint : primary_key_def
 612     | unique_key_def
 613     | foreign_key_def
 614     | <error>
 615
 616 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 617     {
 618         $return              =  {
 619             supertype        => 'constraint',
 620             type             => 'foreign_key',
 621             name             => $item[1],
 622             fields           => $item[2],
 623             %{ $item{'reference_definition'} },
 624         }
 625     }
 626
 627 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 628     { $return = $item[3] }
 629     |
 630     /constraint/i NAME /foreign key/i
 631     { $return = $item[2] }
 632     |
 633     /constraint/i /foreign key/i
 634     { $return = '' }
 635     |
 636     /foreign key/i WORD
 637     { $return = $item[2] }
 638     |
 639     /foreign key/i
 640     { $return = '' }
 641
 642 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 643     {
 644         $return       = {
 645             supertype => 'constraint',
 646             name      => $item{'index_name(?)'}[0],
 647             type      => 'primary_key',
 648             fields    => $item[4],
 649         };
 650     }
 651
 652 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 653     {
 654         $return       = {
 655             supertype => 'constraint',
 656             name      => $item{'index_name(?)'}[0],
 657             type      => 'unique',
 658             fields    => $item[5],
 659         }
 660     }
 661
 662 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 663     {
 664         $return       = {
 665             supertype => 'index',
 666             type      => 'normal',
 667             name      => $item{'index_name(?)'}[0],
 668             fields    => $item[4],
 669         }
 670     }
 671
 672 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 673     {
 674         $return       = {
 675             supertype => 'index',
 676             type      => 'fulltext',
 677             name      => $item{'index_name(?)'}[0],
 678             fields    => $item[5],
 679         }
 680     }
 681
 682 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 683     {
 684         $return       = {
 685             supertype => 'index',
 686             type      => 'spatial',
 687             name      => $item{'index_name(?)'}[0],
 688             fields    => $item[5],
 689         }
 690     }
 691
 692 name_with_opt_paren : NAME parens_value_list(s?)
 693     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 694
 695 UNIQUE : /unique/i
 696
 697 KEY : /key/i | /index/i
 698
 699 table_option : /comment/i /=/ /'.*?'/
 700     {
 701         my $comment = $item[3];
 702         $comment    =~ s/^'//;
 703         $comment    =~ s/'$//;
 704         $return     = { comment => $comment };
 705     }
 706     | /(default )?(charset|character set)/i /\s*=?\s*/ WORD
 707     {
 708         $return = { 'CHARACTER SET' => $item[3] };
 709     }
 710     | /collate/i WORD
 711     {
 712         $return = { 'COLLATE' => $item[2] }
 713     }
 714     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
 715     {
 716         $return = { $item[1] => $item[4] };
 717     }
 718     | WORD /\s*=\s*/ MAYBE_QUOTED_WORD
 719     {
 720         $return = { $item[1] => $item[3] };
 721     }
 722
 723 MAYBE_QUOTED_WORD: /\w+/
 724                  | /'(\w+)'/
 725                  { $return = $1 }
 726                  | /"(\w+)"/
 727                  { $return = $1 }
 728
 729 default : /default/i
 730
 731 ADD : /add/i
 732
 733 ALTER : /alter/i
 734
 735 CREATE : /create/i
 736
 737 TEMPORARY : /temporary/i
 738
 739 TABLE : /table/i
 740
 741 WORD : /\w+/
 742
 743 DIGITS : /\d+/
 744
 745 COMMA : ','
 746
 747 BACKTICK : '`'
 748
 749 NAME    : BACKTICK /[^`]+/ BACKTICK
 750     { $item[2] }
 751     | /\w+/
 752     { $item[1] }
 753
 754 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 755     { $item[1] }
 756     | /'.*?'/
 757     {
 758         # remove leading/trailing quotes
 759         my $val = $item[1];
 760         $val    =~ s/^['"]|['"]$//g;
 761         $return = $val;
 762     }
 763     | /NULL/
 764     { 'NULL' }
 765
 766 CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
 767     | /now\(\)/i
 768     { 'CURRENT_TIMESTAMP' }
 769
 770 END_OF_GRAMMAR
 771
 772 # -------------------------------------------------------------------
 773 sub parse {
 774     my ( $translator, $data ) = @_;
 775     my $parser = Parse::RecDescent->new($GRAMMAR);
 776     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 777     local $DEBUG       = $translator->debug;
 778
 779     unless (defined $parser) {
 780         return $translator->error("Error instantiating Parse::RecDescent ".
 781             "instance: Bad grammer");
 782     }
 783
 784     # Preprocess for MySQL-specific and not-before-version comments from mysqldump
 785     my $parser_version =
 786         parse_mysql_version ($translator->parser_args->{mysql_parser_version}, 'mysql')
 787         || DEFAULT_PARSER_VERSION;
 788     while ( $data =~ s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es ) {}
 789
 790     my $result = $parser->startrule($data);
 791     return $translator->error( "Parse failed." ) unless defined $result;
 792     warn "Parse result:".Dumper( $result ) if $DEBUG;
 793
 794     my $schema = $translator->schema;
 795     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 796
 797     my @tables = sort {
 798         $result->{'tables'}{ $a }{'order'}
 799         <=>
 800         $result->{'tables'}{ $b }{'order'}
 801     } keys %{ $result->{'tables'} };
 802
 803     for my $table_name ( @tables ) {
 804         my $tdata =  $result->{tables}{ $table_name };
 805         my $table =  $schema->add_table(
 806             name  => $tdata->{'table_name'},
 807         ) or die $schema->error;
 808
 809         $table->comments( $tdata->{'comments'} );
 810
 811         my @fields = sort {
 812             $tdata->{'fields'}->{$a}->{'order'}
 813             <=>
 814             $tdata->{'fields'}->{$b}->{'order'}
 815         } keys %{ $tdata->{'fields'} };
 816
 817         for my $fname ( @fields ) {
 818             my $fdata = $tdata->{'fields'}{ $fname };
 819             my $field = $table->add_field(
 820                 name              => $fdata->{'name'},
 821                 data_type         => $fdata->{'data_type'},
 822                 size              => $fdata->{'size'},
 823                 default_value     => $fdata->{'default'},
 824                 is_auto_increment => $fdata->{'is_auto_inc'},
 825                 is_nullable       => $fdata->{'null'},
 826                 comments          => $fdata->{'comments'},
 827             ) or die $table->error;
 828
 829             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 830
 831             for my $qual ( qw[ binary unsigned zerofill list collate ],
 832                     'character set', 'on update' ) {
 833                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 834                     next if ref $val eq 'ARRAY' && !@$val;
 835                     $field->extra( $qual, $val );
 836                 }
 837             }
 838
 839             if ( $fdata->{'has_index'} ) {
 840                 $table->add_index(
 841                     name   => '',
 842                     type   => 'NORMAL',
 843                     fields => $fdata->{'name'},
 844                 ) or die $table->error;
 845             }
 846
 847             if ( $fdata->{'is_unique'} ) {
 848                 $table->add_constraint(
 849                     name   => '',
 850                     type   => 'UNIQUE',
 851                     fields => $fdata->{'name'},
 852                 ) or die $table->error;
 853             }
 854
 855             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 856                 next unless $cdata->{'type'} eq 'foreign_key';
 857                 $cdata->{'fields'} ||= [ $field->name ];
 858                 push @{ $tdata->{'constraints'} }, $cdata;
 859             }
 860
 861         }
 862
 863         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 864             my $index  =  $table->add_index(
 865                 name   => $idata->{'name'},
 866                 type   => uc $idata->{'type'},
 867                 fields => $idata->{'fields'},
 868             ) or die $table->error;
 869         }
 870
 871         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 872             my @cleaned_options;
 873             my @ignore_opts = $translator->parser_args->{ignore_opts}?split(/,/,$translator->parser_args->{ignore_opts}):();
 874             if (@ignore_opts) {
 875                 my $ignores = { map { $_ => 1 } @ignore_opts };
 876                 foreach my $option (@options) {
 877                     # make sure the option isn't in ignore list
 878                     my ($option_key) = keys %$option;
 879                     push(@cleaned_options, $option) unless (exists $ignores->{$option_key});
 880                 }
 881             } else {
 882                 @cleaned_options = @options;
 883             }
 884             $table->options( \@cleaned_options ) or die $table->error;
 885         }
 886
 887         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 888             my $constraint       =  $table->add_constraint(
 889                 name             => $cdata->{'name'},
 890                 type             => $cdata->{'type'},
 891                 fields           => $cdata->{'fields'},
 892                 reference_table  => $cdata->{'reference_table'},
 893                 reference_fields => $cdata->{'reference_fields'},
 894                 match_type       => $cdata->{'match_type'} || '',
 895                 on_delete        => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
 896                 on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
 897             ) or die $table->error;
 898         }
 899
 900         # After the constrains and PK/idxs have been created, we normalize fields
 901         normalize_field($_) for $table->get_fields;
 902     }
 903
 904     my @procedures = sort {
 905         $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
 906     } keys %{ $result->{procedures} };
 907     foreach my $proc_name (@procedures) {
 908         $schema->add_procedure(
 909             name  => $proc_name,
 910             owner => $result->{procedures}->{$proc_name}->{owner},
 911             sql   => $result->{procedures}->{$proc_name}->{sql},
 912         );
 913     }
 914
 915     my @views = sort {
 916         $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'}
 917     } keys %{ $result->{views} };
 918     foreach my $view_name (keys %{ $result->{views} }) {
 919         $schema->add_view(
 920             name => $view_name,
 921             sql  => $result->{views}->{$view_name}->{sql},
 922         );
 923     }
 924
 925     return 1;
 926 }
 927
 928 # Takes a field, and returns
 929 sub normalize_field {
 930     my ($field) = @_;
 931     my ($size, $type, $list, $changed) = @_;
 932
 933     $size = $field->size;
 934     $type = $field->data_type;
 935     $list = $field->extra->{list} || [];
 936
 937     if ( !ref $size && $size eq 0 ) {
 938         if ( lc $type eq 'tinyint' ) {
 939             $changed = $size != 4;
 940             $size = 4;
 941         }
 942         elsif ( lc $type eq 'smallint' ) {
 943             $changed = $size != 6;
 944             $size = 6;
 945         }
 946         elsif ( lc $type eq 'mediumint' ) {
 947             $changed = $size != 9;
 948             $size = 9;
 949         }
 950         elsif ( $type =~ /^int(eger)?$/i ) {
 951             $changed = $size != 11 || $type ne 'int';
 952             $type = 'int';
 953             $size = 11;
 954         }
 955         elsif ( lc $type eq 'bigint' ) {
 956             $changed = $size != 20;
 957             $size = 20;
 958         }
 959         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
 960             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
 961             $changed = @$old_size != 2 || $old_size->[0] != 8 || $old_size->[1] != 2;
 962             $size = [8,2];
 963         }
 964     }
 965
 966     if ( $type =~ /^tiny(text|blob)$/i ) {
 967         $changed = $size != 255;
 968         $size = 255;
 969     }
 970     elsif ( $type =~ /^(blob|text)$/i ) {
 971         $changed = $size != 65_535;
 972         $size = 65_535;
 973     }
 974     elsif ( $type =~ /^medium(blob|text)$/i ) {
 975         $changed = $size != 16_777_215;
 976         $size = 16_777_215;
 977     }
 978     elsif ( $type =~ /^long(blob|text)$/i ) {
 979         $changed = $size != 4_294_967_295;
 980         $size = 4_294_967_295;
 981     }
 982     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 983         my %extra = $field->extra;
 984         my $longest = 0;
 985         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 986             $longest = $len if $len > $longest;
 987         }
 988         $changed = 1;
 989         $size = $longest if $longest;
 990     }
 991
 992
 993     if ($changed) {
 994       # We only want to clone the field, not *everything*
 995       { local $field->{table} = undef;
 996         $field->parsed_field(dclone($field));
 997         $field->parsed_field->{table} = $field->table;
 998       }
 999       $field->size($size);
1000       $field->data_type($type);
1001       $field->sql_data_type( $type_mapping{lc $type} ) if exists $type_mapping{lc $type};
1002       $field->extra->{list} = $list if @$list;
1003     }
1004 }
1005
1006
1007 1;
1008
1009 # -------------------------------------------------------------------
1010 # Where man is not nature is barren.
1011 # William Blake
1012 # -------------------------------------------------------------------
1013
1014 =pod
1015
1016 =head1 AUTHOR
1017
1018 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1019 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1020
1021 =head1 SEE ALSO
1022
1023 Parse::RecDescent, SQL::Translator::Schema.
1024
1025 =cut