lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.58 2007-03-19 17:15:24 duality72 Exp $
   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: 1.58 $ =~ /(\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     | <error>
 538
 539 table_name   : NAME
 540
 541 field_name   : NAME
 542
 543 index_name   : NAME
 544
 545 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 546     {
 547         my $type = $item[1];
 548         my $size; # field size, applicable only to non-set fields
 549         my $list; # set list, applicable only to sets (duh)
 550
 551         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 552             $size = undef;
 553             $list = $item[2][0];
 554         }
 555         else {
 556             $size = $item[2][0];
 557             $list = [];
 558         }
 559
 560
 561         $return        = {
 562             type       => $type,
 563             size       => $size,
 564             list       => $list,
 565             qualifiers => $item[3],
 566         }
 567     }
 568
 569 parens_field_list : '(' field_name(s /,/) ')'
 570     { $item[2] }
 571
 572 parens_value_list : '(' VALUE(s /,/) ')'
 573     { $item[2] }
 574
 575 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 576     { lc $item[1] }
 577
 578 field_type   : WORD
 579
 580 create_index : /create/i /index/i
 581
 582 not_null     : /not/i /null/i
 583     { $return = 0 }
 584     |
 585     /null/i
 586     { $return = 1 }
 587
 588 unsigned     : /unsigned/i { $return = 0 }
 589
 590 #default_val  : /default/i /(?:')?[\s\w\d:.-]*(?:')?/
 591 #    {
 592 #        $item[2] =~ s/'//g;
 593 #        $return  =  $item[2];
 594 #    }
 595
 596 default_val :
 597     /default/i 'CURRENT_TIMESTAMP'
 598     {
 599         $return =  $item[2];
 600     }
 601     |
 602     /default/i /'(?:.*?\\')*.*?'|(?:')?[\w\d:.-]*(?:')?/
 603     {
 604         $item[2] =~ s/^\s*'|'\s*$//g;
 605         $return  =  $item[2];
 606     }
 607
 608 auto_inc : /auto_increment/i { 1 }
 609
 610 primary_key : /primary/i /key/i { 1 }
 611
 612 constraint : primary_key_def
 613     | unique_key_def
 614     | foreign_key_def
 615     | <error>
 616
 617 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 618     {
 619         $return              =  {
 620             supertype        => 'constraint',
 621             type             => 'foreign_key',
 622             name             => $item[1],
 623             fields           => $item[2],
 624             %{ $item{'reference_definition'} },
 625         }
 626     }
 627
 628 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 629     { $return = $item[3] }
 630     |
 631     /constraint/i NAME /foreign key/i
 632     { $return = $item[2] }
 633     |
 634     /constraint/i /foreign key/i
 635     { $return = '' }
 636     |
 637     /foreign key/i WORD
 638     { $return = $item[2] }
 639     |
 640     /foreign key/i
 641     { $return = '' }
 642
 643 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 644     {
 645         $return       = {
 646             supertype => 'constraint',
 647             name      => $item{'index_name(?)'}[0],
 648             type      => 'primary_key',
 649             fields    => $item[4],
 650         };
 651     }
 652
 653 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 654     {
 655         $return       = {
 656             supertype => 'constraint',
 657             name      => $item{'index_name(?)'}[0],
 658             type      => 'unique',
 659             fields    => $item[5],
 660         }
 661     }
 662
 663 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 664     {
 665         $return       = {
 666             supertype => 'index',
 667             type      => 'normal',
 668             name      => $item{'index_name(?)'}[0],
 669             fields    => $item[4],
 670         }
 671     }
 672
 673 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 674     {
 675         $return       = {
 676             supertype => 'index',
 677             type      => 'fulltext',
 678             name      => $item{'index_name(?)'}[0],
 679             fields    => $item[5],
 680         }
 681     }
 682
 683 name_with_opt_paren : NAME parens_value_list(s?)
 684     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 685
 686 UNIQUE : /unique/i
 687
 688 KEY : /key/i | /index/i
 689
 690 table_option : /comment/i /=/ /'.*?'/
 691     {
 692         my $comment = $item[3];
 693         $comment    =~ s/^'//;
 694         $comment    =~ s/'$//;
 695         $return     = { comment => $comment };
 696     }
 697     | /(default )?(charset|character set)/i /\s*=?\s*/ WORD
 698     {
 699         $return = { 'CHARACTER SET' => $item[3] };
 700     }
 701     | /collate/i WORD
 702     {
 703         $return = { 'COLLATE' => $item[2] }
 704     }
 705     | WORD /\s*=\s*/ WORD
 706     {
 707         $return = { $item[1] => $item[3] };
 708     }
 709
 710 default : /default/i
 711
 712 ADD : /add/i
 713
 714 ALTER : /alter/i
 715
 716 CREATE : /create/i
 717
 718 TEMPORARY : /temporary/i
 719
 720 TABLE : /table/i
 721
 722 WORD : /\w+/
 723
 724 DIGITS : /\d+/
 725
 726 COMMA : ','
 727
 728 BACKTICK : '`'
 729
 730 NAME    : BACKTICK /\w+/ BACKTICK
 731     { $item[2] }
 732     | /\w+/
 733     { $item[1] }
 734
 735 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 736     { $item[1] }
 737     | /'.*?'/
 738     {
 739         # remove leading/trailing quotes
 740         my $val = $item[1];
 741         $val    =~ s/^['"]|['"]$//g;
 742         $return = $val;
 743     }
 744     | /NULL/
 745     { 'NULL' }
 746
 747 CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
 748     | /now\(\)/i
 749     { 'CURRENT_TIMESTAMP' }
 750
 751 END_OF_GRAMMAR
 752
 753 # -------------------------------------------------------------------
 754 sub parse {
 755     my ( $translator, $data ) = @_;
 756     my $parser = Parse::RecDescent->new($GRAMMAR);
 757
 758     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 759     local $DEBUG       = $translator->debug;
 760
 761     unless (defined $parser) {
 762         return $translator->error("Error instantiating Parse::RecDescent ".
 763             "instance: Bad grammer");
 764     }
 765
 766     # Preprocess for MySQL-specific and not-before-version comments from mysqldump
 767     my $parser_version =
 768         parse_mysql_version ($translator->parser_args->{mysql_parser_version}, 'mysql')
 769         || DEFAULT_PARSER_VERSION;
 770     while ( $data =~ s#/\*!(\d{5})?(.*?)\*/#($1 && $1 > $parser_version ? '' : $2)#es ) {}
 771
 772     my $result = $parser->startrule($data);
 773     return $translator->error( "Parse failed." ) unless defined $result;
 774     warn "Parse result:".Dumper( $result ) if $DEBUG;
 775
 776     my $schema = $translator->schema;
 777     $schema->name($result->{'database_name'}) if $result->{'database_name'};
 778
 779     my @tables = sort {
 780         $result->{'tables'}{ $a }{'order'}
 781         <=>
 782         $result->{'tables'}{ $b }{'order'}
 783     } keys %{ $result->{'tables'} };
 784
 785     for my $table_name ( @tables ) {
 786         my $tdata =  $result->{tables}{ $table_name };
 787         my $table =  $schema->add_table(
 788             name  => $tdata->{'table_name'},
 789         ) or die $schema->error;
 790
 791         $table->comments( $tdata->{'comments'} );
 792
 793         my @fields = sort {
 794             $tdata->{'fields'}->{$a}->{'order'}
 795             <=>
 796             $tdata->{'fields'}->{$b}->{'order'}
 797         } keys %{ $tdata->{'fields'} };
 798
 799         for my $fname ( @fields ) {
 800             my $fdata = $tdata->{'fields'}{ $fname };
 801             my $field = $table->add_field(
 802                 name              => $fdata->{'name'},
 803                 data_type         => $fdata->{'data_type'},
 804                 size              => $fdata->{'size'},
 805                 default_value     => $fdata->{'default'},
 806                 is_auto_increment => $fdata->{'is_auto_inc'},
 807                 is_nullable       => $fdata->{'null'},
 808                 comments          => $fdata->{'comments'},
 809             ) or die $table->error;
 810
 811             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 812
 813             for my $qual ( qw[ binary unsigned zerofill list collate ],
 814                     'character set', 'on update' ) {
 815                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 816                     next if ref $val eq 'ARRAY' && !@$val;
 817                     $field->extra( $qual, $val );
 818                 }
 819             }
 820
 821             if ( $fdata->{'has_index'} ) {
 822                 $table->add_index(
 823                     name   => '',
 824                     type   => 'NORMAL',
 825                     fields => $fdata->{'name'},
 826                 ) or die $table->error;
 827             }
 828
 829             if ( $fdata->{'is_unique'} ) {
 830                 $table->add_constraint(
 831                     name   => '',
 832                     type   => 'UNIQUE',
 833                     fields => $fdata->{'name'},
 834                 ) or die $table->error;
 835             }
 836
 837             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 838                 next unless $cdata->{'type'} eq 'foreign_key';
 839                 $cdata->{'fields'} ||= [ $field->name ];
 840                 push @{ $tdata->{'constraints'} }, $cdata;
 841             }
 842
 843         }
 844
 845         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 846             my $index  =  $table->add_index(
 847                 name   => $idata->{'name'},
 848                 type   => uc $idata->{'type'},
 849                 fields => $idata->{'fields'},
 850             ) or die $table->error;
 851         }
 852
 853         if ( my @options = @{ $tdata->{'table_options'} || [] } ) {
 854             $table->options( \@options ) or die $table->error;
 855         }
 856
 857         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 858             my $constraint       =  $table->add_constraint(
 859                 name             => $cdata->{'name'},
 860                 type             => $cdata->{'type'},
 861                 fields           => $cdata->{'fields'},
 862                 reference_table  => $cdata->{'reference_table'},
 863                 reference_fields => $cdata->{'reference_fields'},
 864                 match_type       => $cdata->{'match_type'} || '',
 865                 on_delete        => $cdata->{'on_delete'} || $cdata->{'on_delete_do'},
 866                 on_update        => $cdata->{'on_update'} || $cdata->{'on_update_do'},
 867             ) or die $table->error;
 868         }
 869
 870         # After the constrains and PK/idxs have been created, we normalize fields
 871         normalize_field($_) for $table->get_fields;
 872     }
 873
 874     my @procedures = sort {
 875         $result->{procedures}->{ $a }->{'order'} <=> $result->{procedures}->{ $b }->{'order'}
 876     } keys %{ $result->{procedures} };
 877     foreach my $proc_name (@procedures) {
 878         $schema->add_procedure(
 879             name  => $proc_name,
 880             owner => $result->{procedures}->{$proc_name}->{owner},
 881             sql   => $result->{procedures}->{$proc_name}->{sql},
 882         );
 883     }
 884
 885     my @views = sort {
 886         $result->{views}->{ $a }->{'order'} <=> $result->{views}->{ $b }->{'order'}
 887     } keys %{ $result->{views} };
 888     foreach my $view_name (keys %{ $result->{views} }) {
 889         $schema->add_view(
 890             name => $view_name,
 891             sql  => $result->{views}->{$view_name}->{sql},
 892         );
 893     }
 894
 895     return 1;
 896 }
 897
 898 # Takes a field, and returns
 899 sub normalize_field {
 900     my ($field) = @_;
 901     my ($size, $type, $list, $changed) = @_;
 902
 903     $size = $field->size;
 904     $type = $field->data_type;
 905     $list = $field->extra->{list} || [];
 906
 907     if ( !ref $size && $size eq 0 ) {
 908         if ( lc $type eq 'tinyint' ) {
 909             $changed = $size != 4;
 910             $size = 4;
 911         }
 912         elsif ( lc $type eq 'smallint' ) {
 913             $changed = $size != 6;
 914             $size = 6;
 915         }
 916         elsif ( lc $type eq 'mediumint' ) {
 917             $changed = $size != 9;
 918             $size = 9;
 919         }
 920         elsif ( $type =~ /^int(eger)?$/i ) {
 921             $changed = $size != 11 || $type ne 'int';
 922             $type = 'int';
 923             $size = 11;
 924         }
 925         elsif ( lc $type eq 'bigint' ) {
 926             $changed = $size != 20;
 927             $size = 20;
 928         }
 929         elsif ( lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/ ) {
 930             my $old_size = (ref $size || '') eq 'ARRAY' ? $size : [];
 931             $changed = @$old_size != 2 || $old_size->[0] != 8 || $old_size->[1] != 2;
 932             $size = [8,2];
 933         }
 934     }
 935
 936     if ( $type =~ /^tiny(text|blob)$/i ) {
 937         $changed = $size != 255;
 938         $size = 255;
 939     }
 940     elsif ( $type =~ /^(blob|text)$/i ) {
 941         $changed = $size != 65_535;
 942         $size = 65_535;
 943     }
 944     elsif ( $type =~ /^medium(blob|text)$/i ) {
 945         $changed = $size != 16_777_215;
 946         $size = 16_777_215;
 947     }
 948     elsif ( $type =~ /^long(blob|text)$/i ) {
 949         $changed = $size != 4_294_967_295;
 950         $size = 4_294_967_295;
 951     }
 952     if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 953         my %extra = $field->extra;
 954         my $longest = 0;
 955         for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 956             $longest = $len if $len > $longest;
 957         }
 958         $changed = 1;
 959         $size = $longest if $longest;
 960     }
 961
 962
 963     if ($changed) {
 964       # We only want to clone the field, not *everything*
 965       { local $field->{table} = undef;
 966         $field->parsed_field(dclone($field));
 967         $field->parsed_field->{table} = $field->table;
 968       }
 969       $field->size($size);
 970       $field->data_type($type);
 971       $field->sql_data_type( $type_mapping{lc $type} ) if exists $type_mapping{lc $type};
 972       $field->extra->{list} = $list if @$list;
 973     }
 974 }
 975
 976
 977 1;
 978
 979 # -------------------------------------------------------------------
 980 # Where man is not nature is barren.
 981 # William Blake
 982 # -------------------------------------------------------------------
 983
 984 =pod
 985
 986 =head1 AUTHOR
 987
 988 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 989 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 990
 991 =head1 SEE ALSO
 992
 993 Parse::RecDescent, SQL::Translator::Schema.
 994
 995 =cut