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 # -------------------------------------------------------------------
 770 sub parse {
 771     my ( $translator, $data ) = @_;
 772     my $parser = Parse::RecDescent->new($GRAMMAR);
 773     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 774     local $DEBUG       = $translator->debug;
 775
 776     unless (defined $parser) {
 777         return $translator->error("Error instantiating Parse::RecDescent ".
 778             "instance: Bad grammer");
 779     }
 780
 781     # Preprocess for MySQL-specific and not-before-version comments
 782     # from mysqldump
 783     my $parser_version = parse_mysql_version(
 784         $translator->parser_args->{mysql_parser_version}, 'mysql'
 785     ) || DEFAULT_PARSER_VERSION;
 786
 787     while ( $data =~
 788         s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es
 789     ) {
 790         # do nothing; is there a better way to write this? -- ky
 791     }
 792
 793     my $result = $parser->startrule($data);
 794     return $translator->error( "Parse failed." ) unless defined $result;
 795     warn "Parse result:".Dumper( $result ) if $DEBUG;
 796
 797     my $schema = $translator->schema;
 798     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 799
 800     my @tables = sort {
 801         $result->{'tables'}{ $a }{'order'}
 802         <=>
 803         $result->{'tables'}{ $b }{'order'}
 804     } keys %{ $result->{'tables'} };
 805
 806     for my $table_name ( @tables ) {
 807         my $tdata =  $result->{tables}{ $table_name };
 808         my $table =  $schema->add_table(
 809             name  => $tdata->{'table_name'},
 810         ) or die $schema->error;
 811
 812         $table->comments( $tdata->{'comments'} );
 813
 814         my @fields = sort {
 815             $tdata->{'fields'}->{$a}->{'order'}
 816             <=>
 817             $tdata->{'fields'}->{$b}->{'order'}
 818         } keys %{ $tdata->{'fields'} };
 819
 820         for my $fname ( @fields ) {
 821             my $fdata = $tdata->{'fields'}{ $fname };
 822             my $field = $table->add_field(
 823                 name              => $fdata->{'name'},
 824                 data_type         => $fdata->{'data_type'},
 825                 size              => $fdata->{'size'},
 826                 default_value     => $fdata->{'default'},
 827                 is_auto_increment => $fdata->{'is_auto_inc'},
 828                 is_nullable       => $fdata->{'null'},
 829                 comments          => $fdata->{'comments'},
 830             ) or die $table->error;
 831
 832             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 833
 834             for my $qual ( qw[ binary unsigned zerofill list collate ],
 835                     'character set', 'on update' ) {
 836                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 837                     next if ref $val eq 'ARRAY' && !@$val;
 838                     $field->extra( $qual, $val );
 839                 }
 840             }
 841
 842             if ( $fdata->{'has_index'} ) {
 843                 $table->add_index(
 844                     name   => '',
 845                     type   => 'NORMAL',
 846                     fields => $fdata->{'name'},
 847                 ) or die $table->error;
 848             }
 849
 850             if ( $fdata->{'is_unique'} ) {
 851                 $table->add_constraint(
 852                     name   => '',
 853                     type   => 'UNIQUE',
 854                     fields => $fdata->{'name'},
 855                 ) or die $table->error;
 856             }
 857
 858             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 859                 next unless $cdata->{'type'} eq 'foreign_key';
 860                 $cdata->{'fields'} ||= [ $field->name ];
 861                 push @{ $tdata->{'constraints'} }, $cdata;
 862             }
 863
 864         }
 865
 866         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 867             my $index  =  $table->add_index(
 868                 name   => $idata->{'name'},
 869                 type   => uc $idata->{'type'},
 870                 fields => $idata->{'fields'},
 871             ) or die $table->error;
 872         }
 873
 874         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 875             my @cleaned_options;
 876             my @ignore_opts = $translator->parser_args->{'ignore_opts'}
 877                 ? split( /,/, $translator->parser_args->{'ignore_opts'} )
 878                 : ();
 879             if (@ignore_opts) {
 880                 my $ignores = { map { $_ => 1 } @ignore_opts };
 881                 foreach my $option (@options) {
 882                     # make sure the option isn't in ignore list
 883                     my ($option_key) = keys %$option;
 884                     if ( !exists $ignores->{$option_key} ) {
 885                         push @cleaned_options, $option;
 886                     }
 887                 }
 888             } else {
 889                 @cleaned_options = @options;
 890             }
 891             $table->options( \@cleaned_options ) or die $table->error;
 892         }
 893
 894         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 895             my $constraint       =  $table->add_constraint(
 896                 name             => $cdata->{'name'},
 897                 type             => $cdata->{'type'},
 898                 fields           => $cdata->{'fields'},
 899                 reference_table  => $cdata->{'reference_table'},
 900                 reference_fields => $cdata->{'reference_fields'},
 901                 match_type       => $cdata->{'match_type'} || '',
 902                 on_delete        => $cdata->{'on_delete'}
 903                                  || $cdata->{'on_delete_do'},
 904                 on_update        => $cdata->{'on_update'}
 905                                  || $cdata->{'on_update_do'},
 906             ) or die $table->error;
 907         }
 908
 909         # After the constrains and PK/idxs have been created,
 910         # we normalize fields
 911         normalize_field($_) for $table->get_fields;
 912     }
 913
 914     my @procedures = sort {
 915         $result->{procedures}->{ $a }->{'order'}
 916         <=>
 917         $result->{procedures}->{ $b }->{'order'}
 918     } keys %{ $result->{procedures} };
 919
 920     for my $proc_name ( @procedures ) {
 921         $schema->add_procedure(
 922             name  => $proc_name,
 923             owner => $result->{procedures}->{$proc_name}->{owner},
 924             sql   => $result->{procedures}->{$proc_name}->{sql},
 925         );
 926     }
 927     my @views = sort {
 928         $result->{views}->{ $a }->{'order'}
 929         <=>
 930         $result->{views}->{ $b }->{'order'}
 931     } keys %{ $result->{views} };
 932
 933     for my $view_name ( @views ) {
 934         $schema->add_view(
 935             name => $view_name,
 936             sql  => $result->{'views'}->{$view_name}->{sql},
 937         );
 938     }
 939
 940     return 1;
 941 }
 942
 943 # Takes a field, and returns
 944 sub normalize_field {
 945     my ($field) = @_;
 946     my ($size, $type, $list, $changed) = @_;
 947
 948     $size = $field->size;
 949     $type = $field->data_type;
 950     $list = $field->extra->{list} || [];
 951
 952     if ( !ref $size && $size eq 0 ) {
 953         if ( lc $type eq 'tinyint' ) {
 954             $changed = $size != 4;
 955             $size = 4;
 956         }
 957         elsif ( lc $type eq 'smallint' ) {
 958             $changed = $size != 6;
 959             $size = 6;
 960         }
 961         elsif ( lc $type eq 'mediumint' ) {
 962             $changed = $size != 9;
 963             $size = 9;
 964         }
 965         elsif ( $type =~ /^int(eger)?$/i ) {
 966             $changed = $size != 11 || $type ne 'int';
 967             $type = 'int';
 968             $size = 11;
 969         }
 970         elsif ( lc $type eq 'bigint' ) {
 971             $changed = $size != 20;
 972             $size = 20;
 973         }
 974         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
 975             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
 976             $changed     = @$old_size != 2
 977                         || $old_size->[0] != 8
 978                         || $old_size->[1] != 2;
 979             $size        = [8,2];
 980         }
 981     }
 982
 983     if ( $type =~ /^tiny(text|blob)$/i ) {
 984         $changed = $size != 255;
 985         $size = 255;
 986     }
 987     elsif ( $type =~ /^(blob|text)$/i ) {
 988         $changed = $size != 65_535;
 989         $size = 65_535;
 990     }
 991     elsif ( $type =~ /^medium(blob|text)$/i ) {
 992         $changed = $size != 16_777_215;
 993         $size = 16_777_215;
 994     }
 995     elsif ( $type =~ /^long(blob|text)$/i ) {
 996         $changed = $size != 4_294_967_295;
 997         $size = 4_294_967_295;
 998     }
 999
1000     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
1001         my %extra = $field->extra;
1002         my $longest = 0;
1003         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
1004             $longest = $len if $len > $longest;
1005         }
1006         $changed = 1;
1007         $size = $longest if $longest;
1008     }
1009
1010
1011     if ( $changed ) {
1012         # We only want to clone the field, not *everything*
1013         {
1014             local $field->{table} = undef;
1015             $field->parsed_field( dclone( $field ) );
1016             $field->parsed_field->{table} = $field->table;
1017         }
1018         $field->size( $size );
1019         $field->data_type( $type );
1020         $field->sql_data_type( $type_mapping{ lc $type } )
1021             if exists $type_mapping{ lc $type };
1022         $field->extra->{list} = $list if @$list;
1023     }
1024 }
1025
1026 1;
1027
1028 # -------------------------------------------------------------------
1029 # Where man is not nature is barren.
1030 # William Blake
1031 # -------------------------------------------------------------------
1032
1033 =pod
1034
1035 =head1 AUTHOR
1036
1037 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1038 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
1039
1040 =head1 SEE ALSO
1041
1042 Parse::RecDescent, SQL::Translator::Schema.
1043
1044 =cut