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 warnings;
 132 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 133 $VERSION = '1.59';
 134 $DEBUG   = 0 unless defined $DEBUG;
 135
 136 use Data::Dumper;
 137 use Parse::RecDescent;
 138 use Exporter;
 139 use Storable qw(dclone);
 140 use DBI qw(:sql_types);
 141 use base qw(Exporter);
 142
 143 use SQL::Translator::Utils qw/parse_mysql_version/;
 144
 145 our %type_mapping = ();
 146
 147 @EXPORT_OK = qw(parse);
 148
 149 # Enable warnings within the Parse::RecDescent module.
 150 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 151 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 152 $::RD_HINT   = 1; # Give out hints to help fix problems.
 153
 154 use constant DEFAULT_PARSER_VERSION => 30000;
 155
 156 $GRAMMAR = << 'END_OF_GRAMMAR';
 157
 158 {
 159     my ( $database_name, %tables, $table_order, @table_comments, %views,
 160         $view_order, %procedures, $proc_order );
 161     my $delimiter = ';';
 162 }
 163
 164 #
 165 # The "eofile" rule makes the parser fail if any "statement" rule
 166 # fails.  Otherwise, the first successful match by a "statement"
 167 # won't cause the failure needed to know that the parse, as a whole,
 168 # failed. -ky
 169 #
 170 startrule : statement(s) eofile {
 171     {
 172         database_name => $database_name,
 173         tables        => \%tables,
 174         views         => \%views,
 175         procedures    => \%procedures,
 176     }
 177 }
 178
 179 eofile : /^\Z/
 180
 181 statement : comment
 182     | use
 183     | set
 184     | drop
 185     | create
 186     | alter
 187     | insert
 188     | delimiter
 189     | empty_statement
 190     | <error>
 191
 192 use : /use/i WORD "$delimiter"
 193     {
 194         $database_name = $item[2];
 195         @table_comments = ();
 196     }
 197
 198 set : /set/i /[^;]+/ "$delimiter"
 199     { @table_comments = () }
 200
 201 drop : /drop/i TABLE /[^;]+/ "$delimiter"
 202
 203 drop : /drop/i WORD(s) "$delimiter"
 204     { @table_comments = () }
 205
 206 string :
 207   # MySQL strings, unlike common SQL strings, can be double-quoted or
 208   # single-quoted, and you can escape the delmiters by doubling (but only the
 209   # delimiter) or by backslashing.
 210
 211    /'(\\.|''|[^\\\'])*'/ |
 212    /"(\\.|""|[^\\\"])*"/
 213   # For reference, std sql str: /(?:(?:\')(?:[^\']*(?:(?:\'\')[^\']*)*)(?:\'))//
 214
 215 nonstring : /[^;\'"]+/
 216
 217 statement_body : string | nonstring
 218
 219 insert : /insert/i  statement_body(s?) "$delimiter"
 220
 221 delimiter : /delimiter/i /[\S]+/
 222     { $delimiter = $item[2] }
 223
 224 empty_statement : "$delimiter"
 225
 226 alter : ALTER TABLE table_name alter_specification(s /,/) "$delimiter"
 227     {
 228         my $table_name                       = $item{'table_name'};
 229     die "Cannot ALTER table '$table_name'; it does not exist"
 230         unless $tables{ $table_name };
 231         for my $definition ( @{ $item[4] } ) {
 232         $definition->{'extra'}->{'alter'} = 1;
 233         push @{ $tables{ $table_name }{'constraints'} }, $definition;
 234     }
 235     }
 236
 237 alter_specification : ADD foreign_key_def
 238     { $return = $item[2] }
 239
 240 create : CREATE /database/i WORD "$delimiter"
 241     { @table_comments = () }
 242
 243 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) /(,\s*)?\)/ table_option(s?) "$delimiter"
 244     {
 245         my $table_name                       = $item{'table_name'};
 246         $tables{ $table_name }{'order'}      = ++$table_order;
 247         $tables{ $table_name }{'table_name'} = $table_name;
 248
 249         if ( @table_comments ) {
 250             $tables{ $table_name }{'comments'} = [ @table_comments ];
 251             @table_comments = ();
 252         }
 253
 254         my $i = 1;
 255         for my $definition ( @{ $item[7] } ) {
 256             if ( $definition->{'supertype'} eq 'field' ) {
 257                 my $field_name = $definition->{'name'};
 258                 $tables{ $table_name }{'fields'}{ $field_name } =
 259                     { %$definition, order => $i };
 260                 $i++;
 261
 262                 if ( $definition->{'is_primary_key'} ) {
 263                     push @{ $tables{ $table_name }{'constraints'} },
 264                         {
 265                             type   => 'primary_key',
 266                             fields => [ $field_name ],
 267                         }
 268                     ;
 269                 }
 270             }
 271             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 272                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 273             }
 274             elsif ( $definition->{'supertype'} eq 'index' ) {
 275                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 276             }
 277         }
 278
 279         if ( my @options = @{ $item{'table_option(s?)'} } ) {
 280             for my $option ( @options ) {
 281                 my ( $key, $value ) = each %$option;
 282                 if ( $key eq 'comment' ) {
 283                     push @{ $tables{ $table_name }{'comments'} }, $value;
 284                 }
 285                 else {
 286                     push @{ $tables{ $table_name }{'table_options'} }, $option;
 287                 }
 288             }
 289         }
 290
 291         1;
 292     }
 293
 294 opt_if_not_exists : /if not exists/i
 295
 296 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' "$delimiter"
 297     {
 298         @table_comments = ();
 299         push @{ $tables{ $item{'table_name'} }{'indices'} },
 300             {
 301                 name   => $item[4],
 302                 type   => $item[2][0] ? 'unique' : 'normal',
 303                 fields => $item[8],
 304             }
 305         ;
 306     }
 307
 308 create : CREATE /trigger/i NAME not_delimiter "$delimiter"
 309     {
 310         @table_comments = ();
 311     }
 312
 313 create : CREATE PROCEDURE NAME not_delimiter "$delimiter"
 314     {
 315         @table_comments = ();
 316         my $func_name = $item[3];
 317         my $owner = '';
 318         my $sql = "$item[1] $item[2] $item[3] $item[4]";
 319
 320         $procedures{ $func_name }{'order'}  = ++$proc_order;
 321         $procedures{ $func_name }{'name'}   = $func_name;
 322         $procedures{ $func_name }{'owner'}  = $owner;
 323         $procedures{ $func_name }{'sql'}    = $sql;
 324     }
 325
 326 PROCEDURE : /procedure/i
 327     | /function/i
 328
 329 create : CREATE replace(?) algorithm(?) /view/i NAME not_delimiter "$delimiter"
 330     {
 331         @table_comments = ();
 332         my $view_name = $item[5];
 333         my $sql = join(q{ }, grep { defined and length } $item[1], $item[2]->[0], $item[3]->[0])
 334             . " $item[4] $item[5] $item[6]";
 335
 336         # Hack to strip database from function calls in SQL
 337         $sql =~ s#`\w+`\.(`\w+`\()##g;
 338
 339         $views{ $view_name }{'order'}  = ++$view_order;
 340         $views{ $view_name }{'name'}   = $view_name;
 341         $views{ $view_name }{'sql'}    = $sql;
 342     }
 343
 344 replace : /or replace/i
 345
 346 algorithm : /algorithm/i /=/ WORD
 347     {
 348         $return = "$item[1]=$item[3]";
 349     }
 350
 351 not_delimiter : /.*?(?=$delimiter)/is
 352
 353 create_definition : constraint
 354     | index
 355     | field
 356     | comment
 357     | <error>
 358
 359 comment : /^\s*(?:#|-{2}).*\n/
 360     {
 361         my $comment =  $item[1];
 362         $comment    =~ s/^\s*(#|--)\s*//;
 363         $comment    =~ s/\s*$//;
 364         $return     = $comment;
 365     }
 366
 367 comment : /\/\*/ /.*?\*\//s
 368     {
 369         my $comment = $item[2];
 370         $comment = substr($comment, 0, -2);
 371         $comment    =~ s/^\s*|\s*$//g;
 372         $return = $comment;
 373     }
 374
 375 field_comment : /^\s*(?:#|-{2}).*\n/
 376     {
 377         my $comment =  $item[1];
 378         $comment    =~ s/^\s*(#|--)\s*//;
 379         $comment    =~ s/\s*$//;
 380         $return     = $comment;
 381     }
 382
 383
 384 field_comment2 : /comment/i /'.*?'/
 385     {
 386         my $comment = $item[2];
 387         $comment    =~ s/^'//;
 388         $comment    =~ s/'$//;
 389         $return     = $comment;
 390     }
 391
 392 blank : /\s*/
 393
 394 field : field_comment(s?) field_name data_type field_qualifier(s?) field_comment2(?) reference_definition(?) on_update(?) field_comment(s?)
 395     {
 396         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 397         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 398             $qualifiers{ $_ } = 1 for @type_quals;
 399         }
 400
 401         my $null = defined $qualifiers{'not_null'}
 402                    ? $qualifiers{'not_null'} : 1;
 403         delete $qualifiers{'not_null'};
 404
 405         my @comments = ( @{ $item[1] }, @{ $item[5] }, @{ $item[8] } );
 406
 407         $return = {
 408             supertype   => 'field',
 409             name        => $item{'field_name'},
 410             data_type   => $item{'data_type'}{'type'},
 411             size        => $item{'data_type'}{'size'},
 412             list        => $item{'data_type'}{'list'},
 413             null        => $null,
 414             constraints => $item{'reference_definition(?)'},
 415             comments    => [ @comments ],
 416             %qualifiers,
 417         }
 418     }
 419     | <error>
 420
 421 field_qualifier : not_null
 422     {
 423         $return = {
 424              null => $item{'not_null'},
 425         }
 426     }
 427
 428 field_qualifier : default_val
 429     {
 430         $return = {
 431              default => $item{'default_val'},
 432         }
 433     }
 434
 435 field_qualifier : auto_inc
 436     {
 437         $return = {
 438              is_auto_inc => $item{'auto_inc'},
 439         }
 440     }
 441
 442 field_qualifier : primary_key
 443     {
 444         $return = {
 445              is_primary_key => $item{'primary_key'},
 446         }
 447     }
 448
 449 field_qualifier : unsigned
 450     {
 451         $return = {
 452              is_unsigned => $item{'unsigned'},
 453         }
 454     }
 455
 456 field_qualifier : /character set/i WORD
 457     {
 458         $return = {
 459             'CHARACTER SET' => $item[2],
 460         }
 461     }
 462
 463 field_qualifier : /collate/i WORD
 464     {
 465         $return = {
 466             COLLATE => $item[2],
 467         }
 468     }
 469
 470 field_qualifier : /on update/i CURRENT_TIMESTAMP
 471     {
 472         $return = {
 473             'ON UPDATE' => $item[2],
 474         }
 475     }
 476
 477 field_qualifier : /unique/i KEY(?)
 478     {
 479         $return = {
 480             is_unique => 1,
 481         }
 482     }
 483
 484 field_qualifier : KEY
 485     {
 486         $return = {
 487             has_index => 1,
 488         }
 489     }
 490
 491 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete(?) on_update(?)
 492     {
 493         $return = {
 494             type             => 'foreign_key',
 495             reference_table  => $item[2],
 496             reference_fields => $item[3][0],
 497             match_type       => $item[4][0],
 498             on_delete        => $item[5][0],
 499             on_update        => $item[6][0],
 500         }
 501     }
 502
 503 match_type : /match full/i { 'full' }
 504     |
 505     /match partial/i { 'partial' }
 506
 507 on_delete : /on delete/i reference_option
 508     { $item[2] }
 509
 510 on_update :
 511     /on update/i 'CURRENT_TIMESTAMP'
 512     { $item[2] }
 513     |
 514     /on update/i reference_option
 515     { $item[2] }
 516
 517 reference_option: /restrict/i |
 518     /cascade/i   |
 519     /set null/i  |
 520     /no action/i |
 521     /set default/i
 522     { $item[1] }
 523
 524 index : normal_index
 525     | fulltext_index
 526     | spatial_index
 527     | <error>
 528
 529 table_name   : NAME
 530
 531 field_name   : NAME
 532
 533 index_name   : NAME
 534
 535 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 536     {
 537         my $type = $item[1];
 538         my $size; # field size, applicable only to non-set fields
 539         my $list; # set list, applicable only to sets (duh)
 540
 541         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 542             $size = undef;
 543             $list = $item[2][0];
 544         }
 545         else {
 546             $size = $item[2][0];
 547             $list = [];
 548         }
 549
 550
 551         $return        = {
 552             type       => $type,
 553             size       => $size,
 554             list       => $list,
 555             qualifiers => $item[3],
 556         }
 557     }
 558
 559 parens_field_list : '(' field_name(s /,/) ')'
 560     { $item[2] }
 561
 562 parens_value_list : '(' VALUE(s /,/) ')'
 563     { $item[2] }
 564
 565 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 566     { lc $item[1] }
 567
 568 field_type   : WORD
 569
 570 create_index : /create/i /index/i
 571
 572 not_null     : /not/i /null/i
 573     { $return = 0 }
 574     |
 575     /null/i
 576     { $return = 1 }
 577
 578 unsigned     : /unsigned/i { $return = 0 }
 579
 580 default_val :
 581     /default/i 'CURRENT_TIMESTAMP'
 582     {
 583         $return =  \$item[2];
 584     }
 585     |
 586     /default/i /'(?:.*?(?:\\'|''))*.*?'|(?:')?[\w\d:.-]*(?:')?/
 587     {
 588         $item[2] =~ s/^\s*'|'\s*$//g;
 589         $return  =  $item[2];
 590     }
 591
 592 auto_inc : /auto_increment/i { 1 }
 593
 594 primary_key : /primary/i /key/i { 1 }
 595
 596 constraint : primary_key_def
 597     | unique_key_def
 598     | foreign_key_def
 599     | <error>
 600
 601 foreign_key_def : foreign_key_def_begin parens_field_list reference_definition
 602     {
 603         $return              =  {
 604             supertype        => 'constraint',
 605             type             => 'foreign_key',
 606             name             => $item[1],
 607             fields           => $item[2],
 608             %{ $item{'reference_definition'} },
 609         }
 610     }
 611
 612 foreign_key_def_begin : /constraint/i /foreign key/i WORD
 613     { $return = $item[3] }
 614     |
 615     /constraint/i NAME /foreign key/i
 616     { $return = $item[2] }
 617     |
 618     /constraint/i /foreign key/i
 619     { $return = '' }
 620     |
 621     /foreign key/i WORD
 622     { $return = $item[2] }
 623     |
 624     /foreign key/i
 625     { $return = '' }
 626
 627 primary_key_def : primary_key index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 628     {
 629         $return       = {
 630             supertype => 'constraint',
 631             name      => $item[2][0],
 632             type      => 'primary_key',
 633             fields    => $item[5],
 634             options   => $item[3][0] || $item[7][0],
 635         };
 636     }
 637
 638 unique_key_def : UNIQUE KEY(?) index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 639     {
 640         $return       = {
 641             supertype => 'constraint',
 642             name      => $item[3][0],
 643             type      => 'unique',
 644             fields    => $item[6],
 645             options   => $item[4][0] || $item[8][0],
 646         }
 647     }
 648
 649 normal_index : KEY index_name_not_using(?) index_type(?) '(' name_with_opt_paren(s /,/) ')' index_type(?)
 650     {
 651         $return       = {
 652             supertype => 'index',
 653             type      => 'normal',
 654             name      => $item[2][0],
 655             fields    => $item[5],
 656             options   => $item[3][0] || $item[7][0],
 657         }
 658     }
 659
 660 index_name_not_using : QUOTED_NAME
 661     | /(\b(?!using)\w+\b)/ { $return = ($1 =~ /^using/i) ? undef : $1 }
 662
 663 index_type : /using (btree|hash|rtree)/i { $return = uc $1 }
 664
 665 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 666     {
 667         $return       = {
 668             supertype => 'index',
 669             type      => 'fulltext',
 670             name      => $item{'index_name(?)'}[0],
 671             fields    => $item[5],
 672         }
 673     }
 674
 675 spatial_index : /spatial/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 676     {
 677         $return       = {
 678             supertype => 'index',
 679             type      => 'spatial',
 680             name      => $item{'index_name(?)'}[0],
 681             fields    => $item[5],
 682         }
 683     }
 684
 685 name_with_opt_paren : NAME parens_value_list(s?)
 686     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 687
 688 UNIQUE : /unique/i
 689
 690 KEY : /key/i | /index/i
 691
 692 table_option : /comment/i /=/ /'.*?'/
 693     {
 694         my $comment = $item[3];
 695         $comment    =~ s/^'//;
 696         $comment    =~ s/'$//;
 697         $return     = { comment => $comment };
 698     }
 699     | /(default )?(charset|character set)/i /\s*=?\s*/ WORD
 700     {
 701         $return = { 'CHARACTER SET' => $item[3] };
 702     }
 703     | /collate/i WORD
 704     {
 705         $return = { 'COLLATE' => $item[2] }
 706     }
 707     | /union/i /\s*=\s*/ '(' table_name(s /,/) ')'
 708     {
 709         $return = { $item[1] => $item[4] };
 710     }
 711     | WORD /\s*=\s*/ MAYBE_QUOTED_WORD
 712     {
 713         $return = { $item[1] => $item[3] };
 714     }
 715
 716 MAYBE_QUOTED_WORD: /\w+/
 717                  | /'(\w+)'/
 718                  { $return = $1 }
 719                  | /"(\w+)"/
 720                  { $return = $1 }
 721
 722 default : /default/i
 723
 724 ADD : /add/i
 725
 726 ALTER : /alter/i
 727
 728 CREATE : /create/i
 729
 730 TEMPORARY : /temporary/i
 731
 732 TABLE : /table/i
 733
 734 WORD : /\w+/
 735
 736 DIGITS : /\d+/
 737
 738 COMMA : ','
 739
 740 BACKTICK : '`'
 741
 742 DOUBLE_QUOTE: '"'
 743
 744 QUOTED_NAME : BACKTICK /[^`]+/ BACKTICK
 745     { $item[2] }
 746     | DOUBLE_QUOTE /[^"]+/ DOUBLE_QUOTE
 747     { $item[2] }
 748
 749 NAME: QUOTED_NAME
 750     | /\w+/
 751
 752 VALUE : /[-+]?\.?\d+(?:[eE]\d+)?/
 753     { $item[1] }
 754     | /'.*?'/
 755     {
 756         # remove leading/trailing quotes
 757         my $val = $item[1];
 758         $val    =~ s/^['"]|['"]$//g;
 759         $return = $val;
 760     }
 761     | /NULL/
 762     { 'NULL' }
 763
 764 CURRENT_TIMESTAMP : /current_timestamp(\(\))?/i
 765     | /now\(\)/i
 766     { 'CURRENT_TIMESTAMP' }
 767
 768 END_OF_GRAMMAR
 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