lib/SQL/Translator/Parser/MySQL.pm

   1 package SQL::Translator::Parser::MySQL;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: MySQL.pm,v 1.38 2003-08-26 04:01:36 kycl4rk Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
   7 #                    darren chamberlain <darren@cpan.org>,
   8 #                    Chris Mungall <cjm@fruitfly.org>
   9 #
  10 # This program is free software; you can redistribute it and/or
  11 # modify it under the terms of the GNU General Public License as
  12 # published by the Free Software Foundation; version 2.
  13 #
  14 # This program is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  22 # 02111-1307  USA
  23 # -------------------------------------------------------------------
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Parser::MySQL - parser for MySQL
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator;
  32   use SQL::Translator::Parser::MySQL;
  33
  34   my $translator = SQL::Translator->new;
  35   $translator->parser("SQL::Translator::Parser::MySQL");
  36
  37 =head1 DESCRIPTION
  38
  39 The grammar is influenced heavily by Tim Bunce's "mysql2ora" grammar.
  40
  41 Here's the word from the MySQL site
  42 (http://www.mysql.com/doc/en/CREATE_TABLE.html):
  43
  44   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name [(create_definition,...)]
  45   [table_options] [select_statement]
  46
  47   or
  48
  49   CREATE [TEMPORARY] TABLE [IF NOT EXISTS] tbl_name LIKE old_table_name;
  50
  51   create_definition:
  52     col_name type [NOT NULL | NULL] [DEFAULT default_value] [AUTO_INCREMENT]
  53               [PRIMARY KEY] [reference_definition]
  54     or    PRIMARY KEY (index_col_name,...)
  55     or    KEY [index_name] (index_col_name,...)
  56     or    INDEX [index_name] (index_col_name,...)
  57     or    UNIQUE [INDEX] [index_name] (index_col_name,...)
  58     or    FULLTEXT [INDEX] [index_name] (index_col_name,...)
  59     or    [CONSTRAINT symbol] FOREIGN KEY [index_name] (index_col_name,...)
  60               [reference_definition]
  61     or    CHECK (expr)
  62
  63   type:
  64           TINYINT[(length)] [UNSIGNED] [ZEROFILL]
  65     or    SMALLINT[(length)] [UNSIGNED] [ZEROFILL]
  66     or    MEDIUMINT[(length)] [UNSIGNED] [ZEROFILL]
  67     or    INT[(length)] [UNSIGNED] [ZEROFILL]
  68     or    INTEGER[(length)] [UNSIGNED] [ZEROFILL]
  69     or    BIGINT[(length)] [UNSIGNED] [ZEROFILL]
  70     or    REAL[(length,decimals)] [UNSIGNED] [ZEROFILL]
  71     or    DOUBLE[(length,decimals)] [UNSIGNED] [ZEROFILL]
  72     or    FLOAT[(length,decimals)] [UNSIGNED] [ZEROFILL]
  73     or    DECIMAL(length,decimals) [UNSIGNED] [ZEROFILL]
  74     or    NUMERIC(length,decimals) [UNSIGNED] [ZEROFILL]
  75     or    CHAR(length) [BINARY]
  76     or    VARCHAR(length) [BINARY]
  77     or    DATE
  78     or    TIME
  79     or    TIMESTAMP
  80     or    DATETIME
  81     or    TINYBLOB
  82     or    BLOB
  83     or    MEDIUMBLOB
  84     or    LONGBLOB
  85     or    TINYTEXT
  86     or    TEXT
  87     or    MEDIUMTEXT
  88     or    LONGTEXT
  89     or    ENUM(value1,value2,value3,...)
  90     or    SET(value1,value2,value3,...)
  91
  92   index_col_name:
  93           col_name [(length)]
  94
  95   reference_definition:
  96           REFERENCES tbl_name [(index_col_name,...)]
  97                      [MATCH FULL | MATCH PARTIAL]
  98                      [ON DELETE reference_option]
  99                      [ON UPDATE reference_option]
 100
 101   reference_option:
 102           RESTRICT | CASCADE | SET NULL | NO ACTION | SET DEFAULT
 103
 104   table_options:
 105           TYPE = {BDB | HEAP | ISAM | InnoDB | MERGE | MRG_MYISAM | MYISAM }
 106   or      AUTO_INCREMENT = #
 107   or      AVG_ROW_LENGTH = #
 108   or      CHECKSUM = {0 | 1}
 109   or      COMMENT = "string"
 110   or      MAX_ROWS = #
 111   or      MIN_ROWS = #
 112   or      PACK_KEYS = {0 | 1 | DEFAULT}
 113   or      PASSWORD = "string"
 114   or      DELAY_KEY_WRITE = {0 | 1}
 115   or      ROW_FORMAT= { default | dynamic | fixed | compressed }
 116   or      RAID_TYPE= {1 | STRIPED | RAID0 } RAID_CHUNKS=#  RAID_CHUNKSIZE=#
 117   or      UNION = (table_name,[table_name...])
 118   or      INSERT_METHOD= {NO | FIRST | LAST }
 119   or      DATA DIRECTORY="absolute path to directory"
 120   or      INDEX DIRECTORY="absolute path to directory"
 121
 122 =cut
 123
 124 use strict;
 125 use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
 126 $VERSION = sprintf "%d.%02d", q$Revision: 1.38 $ =~ /(\d+)\.(\d+)/;
 127 $DEBUG   = 0 unless defined $DEBUG;
 128
 129 use Data::Dumper;
 130 use Parse::RecDescent;
 131 use Exporter;
 132 use base qw(Exporter);
 133
 134 @EXPORT_OK = qw(parse);
 135
 136 # Enable warnings within the Parse::RecDescent module.
 137 $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
 138 $::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
 139 $::RD_HINT   = 1; # Give out hints to help fix problems.
 140
 141 $GRAMMAR = q!
 142
 143 {
 144     my ( %tables, $table_order, @table_comments );
 145 }
 146
 147 #
 148 # The "eofile" rule makes the parser fail if any "statement" rule
 149 # fails.  Otherwise, the first successful match by a "statement"
 150 # won't cause the failure needed to know that the parse, as a whole,
 151 # failed. -ky
 152 #
 153 startrule : statement(s) eofile { \%tables }
 154
 155 eofile : /^\Z/
 156
 157 statement : comment
 158     | use
 159     | set
 160     | drop
 161     | create
 162     | <error>
 163
 164 use : /use/i WORD ';'
 165     { @table_comments = () }
 166
 167 set : /set/i /[^;]+/ ';'
 168     { @table_comments = () }
 169
 170 drop : /drop/i TABLE /[^;]+/ ';'
 171
 172 drop : /drop/i WORD(s) ';'
 173     { @table_comments = () }
 174
 175 create : CREATE /database/i WORD ';'
 176     { @table_comments = () }
 177
 178 create : CREATE TEMPORARY(?) TABLE opt_if_not_exists(?) table_name '(' create_definition(s /,/) ')' table_option(s?) ';'
 179     {
 180         my $table_name                       = $item{'table_name'};
 181         $tables{ $table_name }{'order'}      = ++$table_order;
 182         $tables{ $table_name }{'table_name'} = $table_name;
 183
 184         if ( @table_comments ) {
 185             $tables{ $table_name }{'comments'} = [ @table_comments ];
 186             @table_comments = ();
 187         }
 188
 189         my $i = 1;
 190         for my $definition ( @{ $item[7] } ) {
 191             if ( $definition->{'supertype'} eq 'field' ) {
 192                 my $field_name = $definition->{'name'};
 193                 $tables{ $table_name }{'fields'}{ $field_name } =
 194                     { %$definition, order => $i };
 195                 $i++;
 196
 197                 if ( $definition->{'is_primary_key'} ) {
 198                     push @{ $tables{ $table_name }{'constraints'} },
 199                         {
 200                             type   => 'primary_key',
 201                             fields => [ $field_name ],
 202                         }
 203                     ;
 204                 }
 205             }
 206             elsif ( $definition->{'supertype'} eq 'constraint' ) {
 207                 push @{ $tables{ $table_name }{'constraints'} }, $definition;
 208             }
 209             elsif ( $definition->{'supertype'} eq 'index' ) {
 210                 push @{ $tables{ $table_name }{'indices'} }, $definition;
 211             }
 212         }
 213
 214         for my $opt ( @{ $item{'table_option(s?)'} } ) {
 215             if ( my ( $key, $val ) = each %$opt ) {
 216                 $tables{ $table_name }{'table_options'}{ $key } = $val;
 217             }
 218         }
 219
 220         1;
 221     }
 222
 223 opt_if_not_exists : /if not exists/i
 224
 225 create : CREATE UNIQUE(?) /(index|key)/i index_name /on/i table_name '(' field_name(s /,/) ')' ';'
 226     {
 227         @table_comments = ();
 228         push @{ $tables{ $item{'table_name'} }{'indices'} },
 229             {
 230                 name   => $item[4],
 231                 type   => $item[2] ? 'unique' : 'normal',
 232                 fields => $item[8],
 233             }
 234         ;
 235     }
 236
 237 create_definition : constraint
 238     | index
 239     | field
 240     | <error>
 241
 242 comment : /^\s*(?:#|-{2}).*\n/
 243     {
 244         my $comment =  $item[1];
 245         $comment    =~ s/^\s*(#|-{2})\s*//;
 246         $comment    =~ s/\s*$//;
 247         $return     = $comment;
 248         push @table_comments, $comment;
 249     }
 250
 251 field_comment : /^\s*(?:#|-{2}).*\n/
 252     {
 253         my $comment =  $item[1];
 254         $comment    =~ s/^\s*(#|-{2})\s*//;
 255         $comment    =~ s/\s*$//;
 256         $return     = $comment;
 257     }
 258
 259 blank : /\s*/
 260
 261 field : field_comment(s?) field_name data_type field_qualifier(s?) reference_definition(?) field_comment(s?)
 262     {
 263         my %qualifiers  = map { %$_ } @{ $item{'field_qualifier(s?)'} || [] };
 264         if ( my @type_quals = @{ $item{'data_type'}{'qualifiers'} || [] } ) {
 265             $qualifiers{ $_ } = 1 for @type_quals;
 266         }
 267
 268         my $null = defined $qualifiers{'not_null'}
 269                    ? $qualifiers{'not_null'} : 1;
 270         delete $qualifiers{'not_null'};
 271
 272         my @comments = ( @{ $item[1] }, @{ $item[6] } );
 273
 274         $return = {
 275             supertype   => 'field',
 276             name        => $item{'field_name'},
 277             data_type   => $item{'data_type'}{'type'},
 278             size        => $item{'data_type'}{'size'},
 279             list        => $item{'data_type'}{'list'},
 280             null        => $null,
 281             constraints => $item{'reference_definition(?)'},
 282             comments    => [ @comments ],
 283             %qualifiers,
 284         }
 285     }
 286     | <error>
 287
 288 field_qualifier : not_null
 289     {
 290         $return = {
 291              null => $item{'not_null'},
 292         }
 293     }
 294
 295 field_qualifier : default_val
 296     {
 297         $return = {
 298              default => $item{'default_val'},
 299         }
 300     }
 301
 302 field_qualifier : auto_inc
 303     {
 304         $return = {
 305              is_auto_inc => $item{'auto_inc'},
 306         }
 307     }
 308
 309 field_qualifier : primary_key
 310     {
 311         $return = {
 312              is_primary_key => $item{'primary_key'},
 313         }
 314     }
 315
 316 field_qualifier : unsigned
 317     {
 318         $return = {
 319              is_unsigned => $item{'unsigned'},
 320         }
 321     }
 322
 323 field_qualifier : /character set/i WORD
 324     {
 325         $return = {
 326             character_set => $item[2],
 327         }
 328     }
 329
 330 reference_definition : /references/i table_name parens_field_list(?) match_type(?) on_delete_do(?) on_update_do(?)
 331     {
 332         $return = {
 333             type             => 'foreign_key',
 334             reference_table  => $item[2],
 335             reference_fields => $item[3][0],
 336             match_type       => $item[4][0],
 337             on_delete_do     => $item[5][0],
 338             on_update_do     => $item[6][0],
 339         }
 340     }
 341
 342 match_type : /match full/i { 'match_full' }
 343     |
 344     /match partial/i { 'match_partial' }
 345
 346 on_delete_do : /on delete/i reference_option
 347     { $item[2] }
 348
 349 on_update_do : /on update/i reference_option
 350     { $item[2] }
 351
 352 reference_option: /restrict/i |
 353     /cascade/i   |
 354     /set null/i  |
 355     /no action/i |
 356     /set default/i
 357     { $item[1] }
 358
 359 index : normal_index
 360     | fulltext_index
 361     | <error>
 362
 363 table_name   : NAME
 364
 365 field_name   : NAME
 366
 367 index_name   : WORD
 368
 369 data_type    : WORD parens_value_list(s?) type_qualifier(s?)
 370     {
 371         my $type = $item[1];
 372         my $size; # field size, applicable only to non-set fields
 373         my $list; # set list, applicable only to sets (duh)
 374
 375         if ( uc($type) =~ /^(SET|ENUM)$/ ) {
 376             $size = undef;
 377             $list = $item[2][0];
 378         }
 379         else {
 380             $size = $item[2][0];
 381             $list = [];
 382         }
 383
 384         unless ( @{ $size || [] } ) {
 385             if ( lc $type eq 'tinyint' ) {
 386                 $size = 4;
 387             }
 388             elsif ( lc $type eq 'smallint' ) {
 389                 $size = 6;
 390             }
 391             elsif ( lc $type eq 'mediumint' ) {
 392                 $size = 9;
 393             }
 394             elsif ( $type =~ /^int(eger)?$/ ) {
 395                 $type = 'int';
 396                 $size = 11;
 397             }
 398             elsif ( lc $type eq 'bigint' ) {
 399                 $size = 20;
 400             }
 401             elsif (
 402                 lc $type =~ /(float|double|decimal|numeric|real|fixed|dec)/
 403             ) {
 404                 $size = [8,2];
 405             }
 406         }
 407
 408         if ( $type =~ /^tiny(text|blob)$/i ) {
 409             $size = 255;
 410         }
 411         elsif ( $type =~ /^(blob|text)$/i ) {
 412             $size = 65_535;
 413         }
 414         elsif ( $type =~ /^medium(blob|text)$/i ) {
 415             $size = 16_777_215;
 416         }
 417         elsif ( $type =~ /^long(blob|text)$/i ) {
 418             $size = 4_294_967_295;
 419         }
 420
 421         $return        = {
 422             type       => $type,
 423             size       => $size,
 424             list       => $list,
 425             qualifiers => $item[3],
 426         }
 427     }
 428
 429 parens_field_list : '(' field_name(s /,/) ')'
 430     { $item[2] }
 431
 432 parens_value_list : '(' VALUE(s /,/) ')'
 433     { $item[2] }
 434
 435 type_qualifier : /(BINARY|UNSIGNED|ZEROFILL)/i
 436     { lc $item[1] }
 437
 438 field_type   : WORD
 439
 440 create_index : /create/i /index/i
 441
 442 not_null     : /not/i /null/i { $return = 0 }
 443
 444 unsigned     : /unsigned/i { $return = 0 }
 445
 446 default_val  : /default/i /(?:')?[\w\d:.-]*(?:')?/
 447     {
 448         $item[2] =~ s/'//g;
 449         $return  =  $item[2];
 450     }
 451
 452 auto_inc : /auto_increment/i { 1 }
 453
 454 primary_key : /primary/i /key/i { 1 }
 455
 456 constraint : primary_key_def
 457     | unique_key_def
 458     | foreign_key_def
 459     | <error>
 460
 461 foreign_key_def : opt_constraint(?) /foreign key/i WORD(?) parens_field_list reference_definition
 462     {
 463         $return              =  {
 464             supertype        => 'constraint',
 465             type             => 'foreign_key',
 466             name             => $item[3][0],
 467             fields           => $item[4],
 468             %{ $item{'reference_definition'} },
 469         }
 470     }
 471
 472 opt_constraint : /constraint/i WORD
 473
 474 primary_key_def : primary_key index_name(?) '(' name_with_opt_paren(s /,/) ')'
 475     {
 476         $return       = {
 477             supertype => 'constraint',
 478             name      => $item{'index_name(?)'}[0],
 479             type      => 'primary_key',
 480             fields    => $item[4],
 481         };
 482     }
 483
 484 unique_key_def : UNIQUE KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 485     {
 486         $return       = {
 487             supertype => 'constraint',
 488             name      => $item{'index_name(?)'}[0],
 489             type      => 'unique',
 490             fields    => $item[5],
 491         }
 492     }
 493
 494 normal_index : KEY index_name(?) '(' name_with_opt_paren(s /,/) ')'
 495     {
 496         $return       = {
 497             supertype => 'index',
 498             type      => 'normal',
 499             name      => $item{'index_name(?)'}[0],
 500             fields    => $item[4],
 501         }
 502     }
 503
 504 fulltext_index : /fulltext/i KEY(?) index_name(?) '(' name_with_opt_paren(s /,/) ')'
 505     {
 506         $return       = {
 507             supertype => 'index',
 508             type      => 'fulltext',
 509             name      => $item{'index_name(?)'}[0],
 510             fields    => $item[5],
 511         }
 512     }
 513
 514 name_with_opt_paren : NAME parens_value_list(s?)
 515     { $item[2][0] ? "$item[1]($item[2][0][0])" : $item[1] }
 516
 517 UNIQUE : /unique/i { 1 }
 518
 519 KEY : /key/i | /index/i
 520
 521 table_option : /[^\s;]*/
 522     {
 523         $return = { split /=/, $item[1] }
 524     }
 525
 526 CREATE : /create/i
 527
 528 TEMPORARY : /temporary/i
 529
 530 TABLE : /table/i
 531
 532 WORD : /\w+/
 533
 534 DIGITS : /\d+/
 535
 536 COMMA : ','
 537
 538 NAME    : "`" /\w+/ "`"
 539     { $item[2] }
 540     | /\w+/
 541     { $item[1] }
 542
 543 VALUE   : /[-+]?\.?\d+(?:[eE]\d+)?/
 544     { $item[1] }
 545     | /'.*?'/
 546     {
 547         # remove leading/trailing quotes
 548         my $val = $item[1];
 549         $val    =~ s/^['"]|['"]$//g;
 550         $return = $val;
 551     }
 552     | /NULL/
 553     { 'NULL' }
 554
 555 !;
 556
 557 # -------------------------------------------------------------------
 558 sub parse {
 559     my ( $translator, $data ) = @_;
 560     my $parser = Parse::RecDescent->new($GRAMMAR);
 561
 562     local $::RD_TRACE  = $translator->trace ? 1 : undef;
 563     local $DEBUG       = $translator->debug;
 564
 565     unless (defined $parser) {
 566         return $translator->error("Error instantiating Parse::RecDescent ".
 567             "instance: Bad grammer");
 568     }
 569
 570     my $result = $parser->startrule($data);
 571     return $translator->error( "Parse failed." ) unless defined $result;
 572     warn Dumper( $result ) if $DEBUG;
 573
 574     my $schema = $translator->schema;
 575     my @tables = sort {
 576         $result->{ $a }->{'order'} <=> $result->{ $b }->{'order'}
 577     } keys %{ $result };
 578
 579     for my $table_name ( @tables ) {
 580         my $tdata =  $result->{ $table_name };
 581         my $table =  $schema->add_table(
 582             name  => $tdata->{'table_name'},
 583         ) or die $schema->error;
 584
 585         $table->comments( $tdata->{'comments'} );
 586
 587         my @fields = sort {
 588             $tdata->{'fields'}->{$a}->{'order'}
 589             <=>
 590             $tdata->{'fields'}->{$b}->{'order'}
 591         } keys %{ $tdata->{'fields'} };
 592
 593         for my $fname ( @fields ) {
 594             my $fdata = $tdata->{'fields'}{ $fname };
 595             my $field = $table->add_field(
 596                 name              => $fdata->{'name'},
 597                 data_type         => $fdata->{'data_type'},
 598                 size              => $fdata->{'size'},
 599                 default_value     => $fdata->{'default'},
 600                 is_auto_increment => $fdata->{'is_auto_inc'},
 601                 is_nullable       => $fdata->{'null'},
 602                 comments          => $fdata->{'comments'},
 603             ) or die $table->error;
 604
 605             $table->primary_key( $field->name ) if $fdata->{'is_primary_key'};
 606
 607             for my $qual ( qw[ binary unsigned zerofill list ] ) {
 608                 if ( my $val = $fdata->{ $qual } || $fdata->{ uc $qual } ) {
 609                     next if ref $val eq 'ARRAY' && !@$val;
 610                     $field->extra( $qual, $val );
 611                 }
 612             }
 613
 614             if ( $field->data_type =~ /(set|enum)/i && !$field->size ) {
 615                 my %extra = $field->extra;
 616                 my $longest = 0;
 617                 for my $len ( map { length } @{ $extra{'list'} || [] } ) {
 618                     $longest = $len if $len > $longest;
 619                 }
 620                 $field->size( $longest ) if $longest;
 621             }
 622
 623             for my $cdata ( @{ $fdata->{'constraints'} } ) {
 624                 next unless $cdata->{'type'} eq 'foreign_key';
 625                 $cdata->{'fields'} ||= [ $field->name ];
 626                 push @{ $tdata->{'constraints'} }, $cdata;
 627             }
 628         }
 629
 630         for my $idata ( @{ $tdata->{'indices'} || [] } ) {
 631             my $index  =  $table->add_index(
 632                 name   => $idata->{'name'},
 633                 type   => uc $idata->{'type'},
 634                 fields => $idata->{'fields'},
 635             ) or die $table->error;
 636         }
 637
 638         for my $cdata ( @{ $tdata->{'constraints'} || [] } ) {
 639             my $constraint       =  $table->add_constraint(
 640                 name             => $cdata->{'name'},
 641                 type             => $cdata->{'type'},
 642                 fields           => $cdata->{'fields'},
 643                 reference_table  => $cdata->{'reference_table'},
 644                 reference_fields => $cdata->{'reference_fields'},
 645                 match_type       => $cdata->{'match_type'} || '',
 646                 on_delete        => $cdata->{'on_delete_do'},
 647                 on_update        => $cdata->{'on_update_do'},
 648             ) or die $table->error;
 649         }
 650     }
 651
 652     return 1;
 653 }
 654
 655 1;
 656
 657 # -------------------------------------------------------------------
 658 # Where man is not nature is barren.
 659 # William Blake
 660 # -------------------------------------------------------------------
 661
 662 =pod
 663
 664 =head1 AUTHOR
 665
 666 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
 667 Chris Mungall E<lt>cjm@fruitfly.orgE<gt>.
 668
 669 =head1 SEE ALSO
 670
 671 perl(1), Parse::RecDescent, SQL::Translator::Schema.
 672
 673 =cut