lib/SQL/Translator/Parser/MySQL.pm

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