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